Permutations with some identical elements

Permutations with some identical elements is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Sometimes you want to find all permutations of elements where some elements are repeated, e.g. you have 3 red balls, 2 blue balls and one black ball.

If you just do all permutations of the 6 elements, each permutation will be duplicated 12 times where you can't tell that the identical elements have switched places.

Given an input of the form   [a₁, a₂, ···, a_k]   where   a_k   denotes how many duplicates of element   k   you should have,
each   a_k > 0   and the sum of all   a_k   is   n.

You should get   n! / (a₁! × a₂! ... × a_k!)   permutations as a result.

(You may, of course, denote the elements   0..k-1   if that works better.)

For example, the input   [2,1]   should give results   (1,1,2),   (1,2,1)   and  (2,1,1).

Alternatively, if zero-based:   (0,0,1),   (0,1,0)   and   (1,0,0).

Task

List the permutations you get from the input   [2, 3, 1].

Optionally output the permutations as strings where the first element is represented by A, the second by B and the third by C  
(the example result would then be AAB, ABA and BAA).

Related tasks

•   Anagrams
•   Permutations
•   Permutations/Derangements

11l

Translation of: Nim

F shouldSwap(s, start, curr)
   L(i) start .< curr
      I s[i] == s[curr]
         R 0B
   R 1B

F findPerms(ss, index, n, &res)
   I index >= n
      res.append(ss)
      R

   V s = copy(ss)
   L(i) index .< n
      I shouldSwap(s, index, i)
         swap(&s[index], &s[i])
         findPerms(s, index + 1, n, &res)
         swap(&s[index], &s[i])

F createSlice(nums, charSet)
   V result = ‘’
   L(n) nums
      V i = L.index
      L 0 .< n
         result ‘’= charSet[i]
   R result

[String] res1, res2, res3
V nums = [2, 1]

V s = createSlice(nums, ‘12’)
findPerms(s, 0, s.len, &res1)
print(res1.join(‘ ’))
print()

nums = [2, 3, 1]
s = createSlice(nums, ‘123’)
findPerms(s, 0, s.len, &res2)
L(val) res2
   print(val, end' I (L.index + 1) % 10 == 0 {"\n"} E ‘ ’)
print()

s = createSlice(nums, ‘ABC’)
findPerms(s, 0, s.len, &res3)
L(val) res3
   print(val, end' I (L.index + 1) % 10 == 0 {"\n"} E ‘ ’)

Output:

112 121 211

112223 112232 112322 113222 121223 121232 121322 122123 122132 122213
122231 122321 122312 123221 123212 123122 132221 132212 132122 131222
211223 211232 211322 212123 212132 212213 212231 212321 212312 213221
213212 213122 221123 221132 221213 221231 221321 221312 222113 222131
222311 223121 223112 223211 231221 231212 231122 232121 232112 232211
312221 312212 312122 311222 321221 321212 321122 322121 322112 322211

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC
ABBBCA ABBCBA ABBCAB ABCBBA ABCBAB ABCABB ACBBBA ACBBAB ACBABB ACABBB
BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCBA BABCAB BACBBA
BACBAB BACABB BBAABC BBAACB BBABAC BBABCA BBACBA BBACAB BBBAAC BBBACA
BBBCAA BBCABA BBCAAB BBCBAA BCABBA BCABAB BCAABB BCBABA BCBAAB BCBBAA
CABBBA CABBAB CABABB CAABBB CBABBA CBABAB CBAABB CBBABA CBBAAB CBBBAA

C++

#include <algorithm>
#include <iostream>

int main() {
    std::string str("AABBBC");
    int count = 0;
    do {
        std::cout << str << (++count % 10 == 0 ? '\n' : ' ');
    } while (std::next_permutation(str.begin(), str.end()));
}

Output:

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC
ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA
BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB
BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA
BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA
CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

Dart

Translation of: Tailspin

import 'dart:io';

void main() {
  stdout.writeln(distinctPerms([2,3,1]).map((p) => alpha("ABC", p)).toList());
}

String alpha(String alphabet, List<int> perm) {
  return perm.map((i) => alphabet[i]).join("");
}

Iterable<List<int>> distinctPerms(List<int> reps) sync* {
  Iterable<List<int>> perms(List<List<int>> elements) sync* {
    if (elements.length == 1) {
      yield List.of(elements[0]);
    } else {
      for (int k = 0; k < elements.length; k++) {
        List<List<int>> tail = [];
        for (int i = 0; i < elements.length; i++) {
          if (i == k) {
            if (elements[i].length > 1) {
              tail.add(List.of(elements[i].skip(1)));
            }
          } else {
            tail.add(elements[i]);
          }
        }
        yield* perms(tail).map((t) {
          t.insert(0, elements[k][0]);
          return t;
        });
      }
    }
  }
  List<List<int>> elements = [];
  for (int i = 0; i < reps.length; i++) {
    elements.add(List.filled(reps[i], i));
  }
  yield* perms(elements);
}

Output:

[AABBBC, AABBCB, AABCBB, AACBBB, ABABBC, ABABCB, ABACBB, ABBABC, ABBACB, ABBBAC, ABBBCA, ABBCAB, ABBCBA, ABCABB, ABCBAB, ABCBBA, ACABBB, ACBABB, ACBBAB, ACBBBA, BAABBC, BAABCB, BAACBB, BABABC, BABACB, BABBAC, BABBCA, BABCAB, BABCBA, BACABB, BACBAB, BACBBA, BBAABC, BBAACB, BBABAC, BBABCA, BBACAB, BBACBA, BBBAAC, BBBACA, BBBCAA, BBCAAB, BBCABA, BBCBAA, BCAABB, BCABAB, BCABBA, BCBAAB, BCBABA, BCBBAA, CAABBB, CABABB, CABBAB, CABBBA, CBAABB, CBABAB, CBABBA, CBBAAB, CBBABA, CBBBAA]

Factor

Removing duplicates from the list of all permutations:

USING: arrays grouping math math.combinatorics prettyprint
sequences sets ;

: distinct-permutations ( seq -- seq )
    [ CHAR: A + <array> ] map-index "" concat-as <permutations>
    members ;

{ 2 3 1 } distinct-permutations 10 group simple-table.

Output:

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC
ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA
BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB
BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA
BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA
CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

Generating distinct permutations directly (more efficient in time and space):

Translation of: Go

USING: arrays io kernel locals math math.ranges sequences ;
IN: rosetta-code.distinct-permutations

: should-swap? ( start curr seq -- ? )
    [ nipd nth ] [ <slice> member? not ] 3bi ;

:: .find-permutations ( seq index n -- )
    index n >= [ seq write bl ] [
        index n [a,b) [
            :> i
            index i seq should-swap? [
                index i seq exchange
                seq index 1 + n .find-permutations
                index i seq exchange
            ] when
        ] each
    ] if ;

: first-permutation ( nums charset -- seq )
    [ <array> ] 2map "" concat-as ;

: .distinct-permutations ( nums charset -- )
    first-permutation 0 over length .find-permutations nl ;

: main ( -- )
    { 2 1 } "12"
    { 2 3 1 } "123"
    { 2 3 1 } "ABC"
    [ .distinct-permutations ] 2tri@ ;

MAIN: main

Output:

112 121 211 
112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122321 122312 123221 123212 123122 132221 132212 132122 131222 211223 211232 211322 212123 212132 212213 212231 212321 212312 213221 213212 213122 221123 221132 221213 221231 221321 221312 222113 222131 222311 223121 223112 223211 231221 231212 231122 232121 232112 232211 312221 312212 312122 311222 321221 321212 321122 322121 322112 322211 
AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCBA ABBCAB ABCBBA ABCBAB ABCABB ACBBBA ACBBAB ACBABB ACABBB BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCBA BABCAB BACBBA BACBAB BACABB BBAABC BBAACB BBABAC BBABCA BBACBA BBACAB BBBAAC BBBACA BBBCAA BBCABA BBCAAB BBCBAA BCABBA BCABAB BCAABB BCBABA BCBAAB BCBBAA CABBBA CABBAB CABABB CAABBB CBABBA CBABAB CBAABB CBBABA CBBAAB CBBBAA 

Go

This is based on the C++ code here.

package main

import "fmt"

func shouldSwap(s []byte, start, curr int) bool {
    for i := start; i < curr; i++ {
        if s[i] == s[curr] {
            return false
        }
    }
    return true
}

func findPerms(s []byte, index, n int, res *[]string) {
    if index >= n {
        *res = append(*res, string(s))
        return
    }
    for i := index; i < n; i++ {
        check := shouldSwap(s, index, i)
        if check {
            s[index], s[i] = s[i], s[index]
            findPerms(s, index+1, n, res)
            s[index], s[i] = s[i], s[index]
        }
    }
}

func createSlice(nums []int, charSet string) []byte {
    var chars []byte
    for i := 0; i < len(nums); i++ {
        for j := 0; j < nums[i]; j++ {
            chars = append(chars, charSet[i])
        }
    }
    return chars
}

func main() {
    var res, res2, res3 []string
    nums := []int{2, 1}
    s := createSlice(nums, "12")
    findPerms(s, 0, len(s), &res)
    fmt.Println(res)
    fmt.Println()

    nums = []int{2, 3, 1}
    s = createSlice(nums, "123")
    findPerms(s, 0, len(s), &res2)
    fmt.Println(res2)
    fmt.Println()

    s = createSlice(nums, "ABC")
    findPerms(s, 0, len(s), &res3)
    fmt.Println(res3)
}

Output:

[112 121 211]

[112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122321 122312 123221 123212 123122 132221 132212 132122 131222 211223 211232 211322 212123 212132 212213 212231 212321 212312 213221 213212 213122 221123 221132 221213 221231 221321 221312 222113 222131 222311 223121 223112 223211 231221 231212 231122 232121 232112 232211 312221 312212 312122 311222 321221 321212 321122 322121 322112 322211]

[AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCBA ABBCAB ABCBBA ABCBAB ABCABB ACBBBA ACBBAB ACBABB ACABBB BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCBA BABCAB BACBBA BACBAB BACABB BBAABC BBAACB BBABAC BBABCA BBACBA BBACAB BBBAAC BBBACA BBBCAA BBCABA BBCAAB BBCBAA BCABBA BCABAB BCAABB BCBABA BCBAAB BCBBAA CABBBA CABBAB CABABB CAABBB CBABBA CBABAB CBAABB CBBABA CBBAAB CBBBAA]

Haskell

permutationsSomeIdentical :: [(a, Int)] -> [[a]]
permutationsSomeIdentical [] = [[]]
permutationsSomeIdentical xs =
  [ x : ys
    | (x, xs_) <- select xs,
      ys <- permutationsSomeIdentical xs_
  ]
  where
    select [] = []
    select ((x, n) : xs) =
      (x, xs_) :
        [ (y, (x, n) : cs)
          | (y, cs) <- select xs
        ]
      where
        xs_
          | 1 == n = xs
          | otherwise = (x, pred n) : xs


main :: IO ()
main = do
  print $ permutationsSomeIdentical [(1, 2), (2, 1)]
  print $ permutationsSomeIdentical [(1, 2), (2, 3), (3, 1)]
  print $ permutationsSomeIdentical [('A', 2), ('B', 3), ('C', 1)]

Output:

[[1,1,2],[1,2,1],[2,1,1]]
[[1,1,2,2,2,3],[1,1,2,2,3,2],[1,1,2,3,2,2],[1,1,3,2,2,2],[1,2,1,2,2,3],[1,2,1,2,3,2],[1,2,1,3,2,2],[1,2,2,1,2,3],[1,2,2,1,3,2],[1,2,2,2,1,3],[1,2,2,2,3,1],[1,2,2,3,1,2],[1,2,2,3,2,1],[1,2,3,1,2,2],[1,2,3,2,1,2],[1,2,3,2,2,1],[1,3,1,2,2,2],[1,3,2,1,2,2],[1,3,2,2,1,2],[1,3,2,2,2,1],[2,1,1,2,2,3],[2,1,1,2,3,2],[2,1,1,3,2,2],[2,1,2,1,2,3],[2,1,2,1,3,2],[2,1,2,2,1,3],[2,1,2,2,3,1],[2,1,2,3,1,2],[2,1,2,3,2,1],[2,1,3,1,2,2],[2,1,3,2,1,2],[2,1,3,2,2,1],[2,2,1,1,2,3],[2,2,1,1,3,2],[2,2,1,2,1,3],[2,2,1,2,3,1],[2,2,1,3,1,2],[2,2,1,3,2,1],[2,2,2,1,1,3],[2,2,2,1,3,1],[2,2,2,3,1,1],[2,2,3,1,1,2],[2,2,3,1,2,1],[2,2,3,2,1,1],[2,3,1,1,2,2],[2,3,1,2,1,2],[2,3,1,2,2,1],[2,3,2,1,1,2],[2,3,2,1,2,1],[2,3,2,2,1,1],[3,1,1,2,2,2],[3,1,2,1,2,2],[3,1,2,2,1,2],[3,1,2,2,2,1],[3,2,1,1,2,2],[3,2,1,2,1,2],[3,2,1,2,2,1],[3,2,2,1,1,2],[3,2,2,1,2,1],[3,2,2,2,1,1]]
["AABBBC","AABBCB","AABCBB","AACBBB","ABABBC","ABABCB","ABACBB","ABBABC","ABBACB","ABBBAC","ABBBCA","ABBCAB","ABBCBA","ABCABB","ABCBAB","ABCBBA","ACABBB","ACBABB","ACBBAB","ACBBBA","BAABBC","BAABCB","BAACBB","BABABC","BABACB","BABBAC","BABBCA","BABCAB","BABCBA","BACABB","BACBAB","BACBBA","BBAABC","BBAACB","BBABAC","BBABCA","BBACAB","BBACBA","BBBAAC","BBBACA","BBBCAA","BBCAAB","BBCABA","BBCBAA","BCAABB","BCABAB","BCABBA","BCBAAB","BCBABA","BCBBAA","CAABBB","CABABB","CABBAB","CABBBA","CBAABB","CBABAB","CBABBA","CBBAAB","CBBABA","CBBBAA"]

J

   ~.@(A.~ i.@!@#) (# i.@#) 2 1
0 0 1
0 1 0
1 0 0
   (; {&'ABC') ~.@(A.~ i.@!@#) (# i.@#) 2 3 1
┌───────────┬──────┐
│0 0 1 1 1 2│AABBBC│
│0 0 1 1 2 1│AABBCB│
│0 0 1 2 1 1│AABCBB│
│0 0 2 1 1 1│AACBBB│
│0 1 0 1 1 2│ABABBC│
│0 1 0 1 2 1│ABABCB│
│0 1 0 2 1 1│ABACBB│
│0 1 1 0 1 2│ABBABC│
│0 1 1 0 2 1│ABBACB│
│0 1 1 1 0 2│ABBBAC│
│0 1 1 1 2 0│ABBBCA│
│0 1 1 2 0 1│ABBCAB│
│0 1 1 2 1 0│ABBCBA│
│0 1 2 0 1 1│ABCABB│
│0 1 2 1 0 1│ABCBAB│
│0 1 2 1 1 0│ABCBBA│
│0 2 0 1 1 1│ACABBB│
│0 2 1 0 1 1│ACBABB│
│0 2 1 1 0 1│ACBBAB│
│0 2 1 1 1 0│ACBBBA│
│1 0 0 1 1 2│BAABBC│
│1 0 0 1 2 1│BAABCB│
│1 0 0 2 1 1│BAACBB│
│1 0 1 0 1 2│BABABC│
│1 0 1 0 2 1│BABACB│
│1 0 1 1 0 2│BABBAC│
│1 0 1 1 2 0│BABBCA│
│1 0 1 2 0 1│BABCAB│
│1 0 1 2 1 0│BABCBA│
│1 0 2 0 1 1│BACABB│
│1 0 2 1 0 1│BACBAB│
│1 0 2 1 1 0│BACBBA│
│1 1 0 0 1 2│BBAABC│
│1 1 0 0 2 1│BBAACB│
│1 1 0 1 0 2│BBABAC│
│1 1 0 1 2 0│BBABCA│
│1 1 0 2 0 1│BBACAB│
│1 1 0 2 1 0│BBACBA│
│1 1 1 0 0 2│BBBAAC│
│1 1 1 0 2 0│BBBACA│
│1 1 1 2 0 0│BBBCAA│
│1 1 2 0 0 1│BBCAAB│
│1 1 2 0 1 0│BBCABA│
│1 1 2 1 0 0│BBCBAA│
│1 2 0 0 1 1│BCAABB│
│1 2 0 1 0 1│BCABAB│
│1 2 0 1 1 0│BCABBA│
│1 2 1 0 0 1│BCBAAB│
│1 2 1 0 1 0│BCBABA│
│1 2 1 1 0 0│BCBBAA│
│2 0 0 1 1 1│CAABBB│
│2 0 1 0 1 1│CABABB│
│2 0 1 1 0 1│CABBAB│
│2 0 1 1 1 0│CABBBA│
│2 1 0 0 1 1│CBAABB│
│2 1 0 1 0 1│CBABAB│
│2 1 0 1 1 0│CBABBA│
│2 1 1 0 0 1│CBBAAB│
│2 1 1 0 1 0│CBBABA│
│2 1 1 1 0 0│CBBBAA│
└───────────┴──────┘

jq

Works with: jq

Works with gojq, the Go implementation of jq

First, we present the filters for generating the distinct permutations, and then some functions for pretty printing a solution for the task.

# Given an array of counts of the nonnegative integers, produce an array reflecting the multiplicities:
# e.g. [3,1] => [0,0,0,1]
def items:
  . as $in
  | reduce range(0;length) as $i ([]; . + [range(0;$in[$i])|$i]);

# distinct permutations of the input array, via insertion
def distinct_permutations:
  # Given an array as input, generate a stream by inserting $x at different positions to the left
  def insert($x):
     ((index([$x]) // length) + 1) as $ix
     | range(0; $ix) as $pos
     | .[0:$pos] + [$x] + .[$pos:];

  if length <= 1 then .
  else
    .[0] as $first
    | .[1:] | distinct_permutations | insert($first)
  end;

For pretty-printing the results:

# Input: an array
# Output: a stream of arrays
def nwise($n):
  def w: if length <= $n then . else .[:$n], (.[$n:]|w) end;
  w;

def to_table:
  nwise(10) | join("  ");

The task:

[2,3,1] | items | [distinct_permutations | join("")] | to_table

Output:

001112  010112  100112  011012  101012  110012  011102  101102  110102  111002
011120  101120  110120  111020  111200  001121  010121  100121  011021  101021
110021  011201  101201  110201  112001  011210  101210  110210  112010  112100
001211  010211  100211  012011  102011  120011  012101  102101  120101  121001
012110  102110  120110  121010  121100  002111  020111  200111  021011  201011
210011  021101  201101  210101  211001  021110  201110  210110  211010  211100

Julia

With the Combinatorics package, create all permutations and filter out the duplicates

using Combinatorics

catlist(spec) = mapreduce(i -> repeat([i], spec[i]), vcat, 1:length(spec))

alphastringfromintvector(v) = String([Char(Int('A') + i - 1) for i in v])

function testpermwithident(spec)
    println("\nTesting $spec yielding:")
    for (i, p) in enumerate(unique(collect(permutations(catlist(spec)))))
        print(alphastringfromintvector(p), "  ", i % 10 == 0 ? "\n" : "")
    end
end

testpermwithident([2, 3, 1])

Output:

Testing [2, 3, 1] yielding:
AABBBC  AABBCB  AABCBB  AACBBB  ABABBC  ABABCB  ABACBB  ABBABC  ABBACB  ABBBAC
ABBBCA  ABBCAB  ABBCBA  ABCABB  ABCBAB  ABCBBA  ACABBB  ACBABB  ACBBAB  ACBBBA
BAABBC  BAABCB  BAACBB  BABABC  BABACB  BABBAC  BABBCA  BABCAB  BABCBA  BACABB
BACBAB  BACBBA  BBAABC  BBAACB  BBABAC  BBABCA  BBACAB  BBACBA  BBBAAC  BBBACA
BBBCAA  BBCAAB  BBCABA  BBCBAA  BCAABB  BCABAB  BCABBA  BCBAAB  BCBABA  BCBBAA
CAABBB  CABABB  CABBAB  CABBBA  CBAABB  CBABAB  CBABBA  CBBAAB  CBBABA  CBBBAA

Generate directly

Translation of: Tailspin

alpha(s, v) = map(i -> s[i], v)

function distinctPerms(spec)
    function perm(elements)
        if length(elements) == 1
            deepcopy(elements)
        else
          [pushfirst!(p, elements[k][1]) for k in 1:length(elements) for p in perm(filter(dups -> length(dups) != 0,
            [ if i == k dups[2:end] else dups end
              for (i, dups) in enumerate(elements)]))
          ]
        end
    end
    elements = [fill(x...) for x in enumerate(spec)]
    perm(elements)
end

println(map(p -> join(alpha("ABC", p), ""), distinctPerms([2, 3, 1])))

Output:

["AABBBC", "AABBCB", "AABCBB", "AACBBB", "ABABBC", "ABABCB", "ABACBB", "ABBABC", "ABBACB", "ABBBAC", "ABBBCA", "ABBCAB", "ABBCBA", "ABCABB", "ABCBAB", "ABCBBA", "ACABBB", "ACBABB", "ACBBAB", "ACBBBA", "BAABBC", "BAABCB", "BAACBB", "BABABC", "BABACB", "BABBAC", "BABBCA", "BABCAB", "BABCBA", "BACABB", "BACBAB", "BACBBA", "BBAABC", "BBAACB", "BBABAC", "BBABCA", "BBACAB", "BBACBA", "BBBAAC", "BBBACA", "BBBCAA", "BBCAAB", "BBCABA", "BBCBAA", "BCAABB", "BCABAB", "BCABBA", "BCBAAB", "BCBABA", "BCBBAA", "CAABBB", "CABABB", "CABBAB", "CABBBA", "CBAABB", "CBABAB", "CBABBA", "CBBAAB", "CBBABA", "CBBBAA"]

Mathematica/Wolfram Language

ClearAll[PermsFromFrequencies]
PermsFromFrequencies[l_List] := Module[{digs},
  digs = Flatten[MapIndexed[ReverseApplied[ConstantArray], l]];
  Permutations[digs]
  ]
PermsFromFrequencies[{2, 3, 1}] // Column

Output:

{1,1,2,2,2,3}
{1,1,2,2,3,2}
{1,1,2,3,2,2}
{1,1,3,2,2,2}
{1,2,1,2,2,3}
{1,2,1,2,3,2}
{1,2,1,3,2,2}
{1,2,2,1,2,3}
{1,2,2,1,3,2}
{1,2,2,2,1,3}
{1,2,2,2,3,1}
{1,2,2,3,1,2}
{1,2,2,3,2,1}
{1,2,3,1,2,2}
{1,2,3,2,1,2}
{1,2,3,2,2,1}
{1,3,1,2,2,2}
{1,3,2,1,2,2}
{1,3,2,2,1,2}
{1,3,2,2,2,1}
{2,1,1,2,2,3}
{2,1,1,2,3,2}
{2,1,1,3,2,2}
{2,1,2,1,2,3}
{2,1,2,1,3,2}
{2,1,2,2,1,3}
{2,1,2,2,3,1}
{2,1,2,3,1,2}
{2,1,2,3,2,1}
{2,1,3,1,2,2}
{2,1,3,2,1,2}
{2,1,3,2,2,1}
{2,2,1,1,2,3}
{2,2,1,1,3,2}
{2,2,1,2,1,3}
{2,2,1,2,3,1}
{2,2,1,3,1,2}
{2,2,1,3,2,1}
{2,2,2,1,1,3}
{2,2,2,1,3,1}
{2,2,2,3,1,1}
{2,2,3,1,1,2}
{2,2,3,1,2,1}
{2,2,3,2,1,1}
{2,3,1,1,2,2}
{2,3,1,2,1,2}
{2,3,1,2,2,1}
{2,3,2,1,1,2}
{2,3,2,1,2,1}
{2,3,2,2,1,1}
{3,1,1,2,2,2}
{3,1,2,1,2,2}
{3,1,2,2,1,2}
{3,1,2,2,2,1}
{3,2,1,1,2,2}
{3,2,1,2,1,2}
{3,2,1,2,2,1}
{3,2,2,1,1,2}
{3,2,2,1,2,1}
{3,2,2,2,1,1}

MiniZinc

%Permutations with some identical elements. Nigel Galloway, September 9th., 2019
include "count.mzn";
enum                   N={A,B,C};
array [1..6] of var N: G; constraint count(G,A,2) /\ count(G,C,1);
output [show(G)]

Output:

minizinc --all-solutions produces:

[C, B, B, B, A, A]
----------
[B, C, B, B, A, A]
----------
[B, B, C, B, A, A]
----------
[B, B, B, C, A, A]
----------
[C, B, B, A, A, B]
----------
[B, C, B, A, A, B]
----------
[B, B, C, A, A, B]
----------
[B, B, B, A, A, C]
----------
[C, B, A, B, A, B]
----------
[B, C, A, B, A, B]
----------
[B, B, A, C, A, B]
----------
[B, B, A, B, A, C]
----------
[C, A, B, B, A, B]
----------
[B, A, C, B, A, B]
----------
[B, A, B, C, A, B]
----------
[B, A, B, B, A, C]
----------
[A, C, B, B, A, B]
----------
[A, B, C, B, A, B]
----------
[A, B, B, C, A, B]
----------
[A, B, B, B, A, C]
----------
[C, B, B, A, B, A]
----------
[B, C, B, A, B, A]
----------
[B, B, C, A, B, A]
----------
[B, B, B, A, C, A]
----------
[C, B, A, A, B, B]
----------
[B, C, A, A, B, B]
----------
[B, B, A, A, C, B]
----------
[B, B, A, A, B, C]
----------
[C, A, B, A, B, B]
----------
[B, A, C, A, B, B]
----------
[B, A, B, A, C, B]
----------
[B, A, B, A, B, C]
----------
[A, C, B, A, B, B]
----------
[A, B, C, A, B, B]
----------
[A, B, B, A, C, B]
----------
[A, B, B, A, B, C]
----------
[C, B, A, B, B, A]
----------
[B, C, A, B, B, A]
----------
[B, B, A, C, B, A]
----------
[B, B, A, B, C, A]
----------
[C, A, A, B, B, B]
----------
[B, A, A, C, B, B]
----------
[B, A, A, B, C, B]
----------
[B, A, A, B, B, C]
----------
[A, C, A, B, B, B]
----------
[A, B, A, C, B, B]
----------
[A, B, A, B, C, B]
----------
[A, B, A, B, B, C]
----------
[C, A, B, B, B, A]
----------
[B, A, C, B, B, A]
----------
[B, A, B, C, B, A]
----------
[B, A, B, B, C, A]
----------
[A, C, B, B, B, A]
----------
[A, B, C, B, B, A]
----------
[A, B, B, C, B, A]
----------
[A, B, B, B, C, A]
----------
[A, A, C, B, B, B]
----------
[A, A, B, C, B, B]
----------
[A, A, B, B, C, B]
----------
[A, A, B, B, B, C]
----------
==========

Nim

Translation of: Go

import strutils

func shouldSwap(s: string; start, curr: int): bool =
  for i in start..<curr:
    if s[i] == s[curr]: return false
  return true


func findPerms(s: string; index, n: int; res: var seq[string]) =
  if index >= n:
    res.add s
    return
  var s = s
  for i in index..<n:
    if s.shouldSwap(index, i):
      swap s[index], s[i]
      findPerms(s, index+1, n, res)
      swap s[index], s[i]


func createSlice(nums: openArray[int]; charSet: string): string =
  for i, n in nums:
      for _ in 1..n:
        result.add charSet[i]


when isMainModule:
  var res1, res2, res3: seq[string]
  var nums = @[2, 1]

  var s = createSlice(nums, "12")
  s.findPerms(0, s.len, res1)
  echo res1.join(" ")
  echo()

  nums = @[2, 3, 1]
  s = createSlice(nums, "123")
  findPerms(s, 0, s.len, res2)
  for i, val in res2:
    stdout.write val, if (i + 1) mod 10 == 0: '\n' else: ' '
  echo()

  s = createSlice(nums, "ABC")
  findPerms(s, 0, s.len, res3)
  for i, val in res3:
    stdout.write val, if (i + 1) mod 10 == 0: '\n' else: ' '

Output:

112 121 211

112223 112232 112322 113222 121223 121232 121322 122123 122132 122213
122231 122321 122312 123221 123212 123122 132221 132212 132122 131222
211223 211232 211322 212123 212132 212213 212231 212321 212312 213221
213212 213122 221123 221132 221213 221231 221321 221312 222113 222131
222311 223121 223112 223211 231221 231212 231122 232121 232112 232211
312221 312212 312122 311222 321221 321212 321122 322121 322112 322211

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC
ABBBCA ABBCBA ABBCAB ABCBBA ABCBAB ABCABB ACBBBA ACBBAB ACBABB ACABBB
BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCBA BABCAB BACBBA
BACBAB BACABB BBAABC BBAACB BBABAC BBABCA BBACBA BBACAB BBBAAC BBBACA
BBBCAA BBCABA BBCAAB BBCBAA BCABBA BCABAB BCAABB BCBABA BCBAAB BCBBAA
CABBBA CABBAB CABABB CAABBB CBABBA CBABAB CBAABB CBBABA CBBAAB CBBBAA

Pascal

modified version to get permutations of different lenght.
Most time consuming is appending to the stringlist.So I limited that to 10000
One can use the string directly in EvaluatePerm.

program PermWithRep;//of different length
{$IFDEF FPC}
  {$mode Delphi}
  {$Optimization ON,All}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,classes {for stringlist};
const
  cTotalSum = 16;
  cMaxCardsOnDeck = cTotalSum;
  CMaxCardsUsed   = cTotalSum;

type
  tDeckIndex     = 0..cMaxCardsOnDeck-1;
  tSequenceIndex = 0..CMaxCardsUsed;
  tDiffCardCount = Byte;//A..Z

  tSetElem     = packed record
                   Elemcount : tDeckIndex;
                   Elem  : tDiffCardCount;
                 end;

  tRemSet = array [low(tDeckIndex)..High(tDeckIndex)] of tSetElem;
  tpRemSet = ^tRemSet;
  tRemainSet      = array [low(tSequenceIndex)..High(tSequenceIndex)] of tRemSet;
  tCardSequence   = array [low(tSequenceIndex)..High(tSequenceIndex)] of tDiffCardCount;

var
{$ALIGN 32}
  RemainSets     : tRemainSet;
  CardString    : AnsiString;
  CS : pchar;
  sl :TStringList;
  gblMaxCardsUsed,
  gblMaxUsedIdx,
  gblPermCount : NativeInt;

//*****************************************************************************
procedure Out_SL(const sl:TStringlIst;colCnt:NativeInt);
var
  j,i : NativeInt;
begin
  j := colCnt;
  For i := 0 to sl.count-1 do
  Begin
    write(sl[i],' ');
    dec(j);
    if j= 0 then
    Begin
      writeln;
      j := colCnt;
    end;
  end;
  if j <> colCnt then
    writeln;
end;

procedure SetClear(var ioSet:tRemSet);
begin
  fillChar(ioSet[0],SizeOf(ioSet),#0);
end;

procedure SetInit(var ioSet:tRemSet;const inSet:tRemSet);
var
  i,j,k,sum : integer;
begin
  ioSet := inSet;
  sum := 0;
  k := 0;
  write('Initial set : ');
  For i := Low(ioSet) to High(ioSet) do
  Begin
    j := inSet[i].ElemCount;
    if j <> 0 then
      inc(k);
    sum += j;
    For j := j downto 1 do
      write(chr(inSet[i].Elem));
  end;
  gblMaxCardsUsed := sum;
  gblMaxUsedIdx := k;
  writeln(' lenght: ',sum,' different elements : ',k);
end;

procedure EvaluatePerm;
Begin
  //append maximal 10000 strings
  if gblPermCount < 10000 then
    sl.append(CS);
end;

procedure Permute(depth,MaxCardsUsed:NativeInt);
var
  pSetElem : tpRemSet;//^tSetElem;
  i : NativeInt;
begin
  i := 0;
  pSetElem := @RemainSets[depth];
  repeat
    if pSetElem^[i].Elemcount > 0 then begin
      //take one of the same elements of the stack
      //insert in result here string
      CS[depth] := chr(pSetElem^[i].Elem);
      //done one permutation
      IF depth = MaxCardsUsed then
      begin
        inc(gblpermCount);
        EvaluatePerm;
      end
      else
      begin
        RemainSets[depth+1]:=RemainSets[depth];
        //remove one element
        dec(RemainSets[depth+1][i].ElemCount);
        Permute(depth+1,MaxCardsUsed);
      end;
    end;
    //move on to the next Elem
    inc(i);
  until i >= gblMaxUsedIdx;
end;

procedure Permutate(MaxCardsUsed:NativeInt);
Begin
  gblpermCount := 0;
  if MaxCardsUsed > gblMaxCardsUsed then
    MaxCardsUsed := gblMaxCardsUsed;

  if MaxCardsUsed>0 then
  Begin
    setlength(CardString,MaxCardsUsed);
    CS := @CardString[1];
    permute(0,MaxCardsUsed-1)
  end;
end;

var
  Manifolds : tRemSet;
  j :nativeInt;
Begin
  SetClear(Manifolds);
  with Manifolds[0] do
  begin
    Elemcount := 2; Elem := Ord('A');
  end;
  with Manifolds[1] do
  begin
    Elemcount := 3; Elem := Ord('B');
  end;
  with Manifolds[2] do
  begin
    Elemcount := 1; Elem := Ord('C');
  end;

  try
    sl := TStringList.create;

    SetInit(RemainSets[0], Manifolds);
    j := gblMaxCardsUsed;
    writeln('Count of elements: ',j);
    while j > 1 do
    begin
      sl.clear;
      Permutate(j);
      writeln('Length ',j:2,' Permutations ',gblpermCount:7);
      Out_SL(sl,80 DIV (Length(CS)+1));
      writeln;
      dec(j);
    end;
    //change to 1,2,3
    Manifolds[0].Elem := Ord('1');
    Manifolds[1].Elem := Ord('2');
    Manifolds[2].Elem := Ord('3');

    SetInit(RemainSets[0], Manifolds);
    j := gblMaxCardsUsed;
    writeln('Count of elements: ',j);
    while j > 1 do
    begin
      sl.clear;
      Permutate(j);
      writeln('Length ',j:2,' Permutations ',gblpermCount:7);
      Out_SL(sl,80 DIV (Length(CS)+1));
      writeln;
      dec(j);
    end;

  //extend by 3 more elements
  with Manifolds[3] do
  begin
    Elemcount := 2;   Elem := Ord('4');
  end;
  with Manifolds[4] do
  begin
    Elemcount := 3;  Elem := Ord('5');
  end;
  with Manifolds[5] do
  begin
    Elemcount := 1;  Elem := Ord('6');
  end;
  SetInit(RemainSets[0], Manifolds);
  j := gblMaxCardsUsed;
  writeln('Count of elements: ',j);
  sl.clear;
  Permutate(j);
  writeln('Length ',j:2,' Permutations ',gblpermCount:7);
  //Out_SL(sl,80 DIV (Length(CS)+1));
  writeln;

  except
    writeln(' Stringlist Error ');
  end;
  sl.free;
end.

Output:

Initial set : AABBBC lenght: 6
Count of elements: 6
Length  6 Permutations      60
AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA
ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA BAABBC BAABCB
BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB BACBAB BACBBA BBAABC
BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA BBBCAA BBCAAB BBCABA BBCBAA
BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA CAABBB CABABB CABBAB CABBBA CBAABB
CBABAB CBABBA CBBAAB CBBABA CBBBAA

Length  5 Permutations      60
AABBB AABBC AABCB AACBB ABABB ABABC ABACB ABBAB ABBAC ABBBA ABBBC ABBCA ABBCB
ABCAB ABCBA ABCBB ACABB ACBAB ACBBA ACBBB BAABB BAABC BAACB BABAB BABAC BABBA
BABBC BABCA BABCB BACAB BACBA BACBB BBAAB BBAAC BBABA BBABC BBACA BBACB BBBAA
BBBAC BBBCA BBCAA BBCAB BBCBA BCAAB BCABA BCABB BCBAA BCBAB BCBBA CAABB CABAB
CABBA CABBB CBAAB CBABA CBABB CBBAA CBBAB CBBBA

Length  4 Permutations      38
AABB AABC AACB ABAB ABAC ABBA ABBB ABBC ABCA ABCB ACAB ACBA ACBB BAAB BAAC BABA
BABB BABC BACA BACB BBAA BBAB BBAC BBBA BBBC BBCA BBCB BCAA BCAB BCBA BCBB CAAB
CABA CABB CBAA CBAB CBBA CBBB

Length  3 Permutations      19
AAB AAC ABA ABB ABC ACA ACB BAA BAB BAC BBA BBB BBC BCA BCB CAA CAB CBA CBB

Length  2 Permutations       8
AA AB AC BA BB BC CA CB

Initial set : 112223 lenght: 6
Count of elements: 6
Length  6 Permutations      60
112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231
122312 122321 123122 123212 123221 131222 132122 132212 132221 211223 211232
211322 212123 212132 212213 212231 212312 212321 213122 213212 213221 221123
221132 221213 221231 221312 221321 222113 222131 222311 223112 223121 223211
231122 231212 231221 232112 232121 232211 311222 312122 312212 312221 321122
321212 321221 322112 322121 322211

Length  5 Permutations      60
11222 11223 11232 11322 12122 12123 12132 12212 12213 12221 12223 12231 12232
12312 12321 12322 13122 13212 13221 13222 21122 21123 21132 21212 21213 21221
21223 21231 21232 21312 21321 21322 22112 22113 22121 22123 22131 22132 22211
22213 22231 22311 22312 22321 23112 23121 23122 23211 23212 23221 31122 31212
31221 31222 32112 32121 32122 32211 32212 32221

Length  4 Permutations      38
1122 1123 1132 1212 1213 1221 1222 1223 1231 1232 1312 1321 1322 2112 2113 2121
2122 2123 2131 2132 2211 2212 2213 2221 2223 2231 2232 2311 2312 2321 2322 3112
3121 3122 3211 3212 3221 3222

Length  3 Permutations      19
112 113 121 122 123 131 132 211 212 213 221 222 223 231 232 311 312 321 322

Length  2 Permutations       8
11 12 13 21 22 23 31 32

Initial set : 112223445556 lenght: 12
Count of elements: 12
Length 12 Permutations 3326400

Perl

Library: ntheory

use ntheory qw<formultiperm>;

formultiperm { print join('',@_) . ' ' } [<1 1 2>];           print "\n\n";
formultiperm { print join('',@_) . ' ' } [<1 1 2 2 2 3>];     print "\n\n";
formultiperm { print join('',@_) . ' ' } [split //,'AABBBC']; print "\n";

Output:

112 121 211

112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122312 122321 123122 123212 123221 131222 132122 132212 132221 211223 211232 211322 212123 212132 212213 212231 212312 212321 213122 213212 213221 221123 221132 221213 221231 221312 221321 222113 222131 222311 223112 223121 223211 231122 231212 231221 232112 232121 232211 311222 312122 312212 312221 321122 321212 321221 322112 322121 322211

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

Phix

Translation of: Go

with javascript_semantics 
function shouldSwap(string s, integer start, curr)
    for i=start to curr-1 do
        if s[i] == s[curr] then
            return false
        end if
    end for
    return true
end function
 
function findPerms(string s, integer i=1, sequence res={})
    if i>length(s) then
        res = append(res, s)
    else
        for j=i to length(s) do
            if shouldSwap(s, i, j) then
                integer {si, sj} = {s[i], s[j]}
                s[i] = sj
                s[j] = si
                res = findPerms(s, i+1, res)
                s[i] = si
                s[j] = sj
            end if
        end for
    end if
    return res
end function
 
function createSlice(sequence nums, string charSet)
    string chars = ""
    for i=1 to length(nums) do
        chars &= repeat(charSet[i],nums[i])
    end for
    return chars
end function
 
pp(findPerms(createSlice({2,1}, "12")))     -- (=== findPerms("112"))
pp(findPerms(createSlice({2,3,1}, "123")))  -- (=== findPerms("112223"))
pp(findPerms(createSlice({2,3,1}, "ABC")))  -- (=== findPerms("AABBBC"))

Output:

{`112`, `121`, `211`}
{`112223`, `112232`, `112322`, `113222`, `121223`, `121232`, `121322`,
 `122123`, `122132`, `122213`, `122231`, `122321`, `122312`, `123221`,
 `123212`, `123122`, `132221`, `132212`, `132122`, `131222`, `211223`,
 `211232`, `211322`, `212123`, `212132`, `212213`, `212231`, `212321`,
 `212312`, `213221`, `213212`, `213122`, `221123`, `221132`, `221213`,
 `221231`, `221321`, `221312`, `222113`, `222131`, `222311`, `223121`,
 `223112`, `223211`, `231221`, `231212`, `231122`, `232121`, `232112`,
 `232211`, `312221`, `312212`, `312122`, `311222`, `321221`, `321212`,
 `321122`, `322121`, `322112`, `322211`}
{`AABBBC`, `AABBCB`, `AABCBB`, `AACBBB`, `ABABBC`, `ABABCB`, `ABACBB`,
 `ABBABC`, `ABBACB`, `ABBBAC`, `ABBBCA`, `ABBCBA`, `ABBCAB`, `ABCBBA`,
 `ABCBAB`, `ABCABB`, `ACBBBA`, `ACBBAB`, `ACBABB`, `ACABBB`, `BAABBC`,
 `BAABCB`, `BAACBB`, `BABABC`, `BABACB`, `BABBAC`, `BABBCA`, `BABCBA`,
 `BABCAB`, `BACBBA`, `BACBAB`, `BACABB`, `BBAABC`, `BBAACB`, `BBABAC`,
 `BBABCA`, `BBACBA`, `BBACAB`, `BBBAAC`, `BBBACA`, `BBBCAA`, `BBCABA`,
 `BBCAAB`, `BBCBAA`, `BCABBA`, `BCABAB`, `BCAABB`, `BCBABA`, `BCBAAB`,
 `BCBBAA`, `CABBBA`, `CABBAB`, `CABABB`, `CAABBB`, `CBABBA`, `CBABAB`,
 `CBAABB`, `CBBABA`, `CBBAAB`, `CBBBAA`}

You can also use a builtin function to produce exactly the same output (createSlice omitted for clarity)

with javascript_semantics 
requires("1.0.2")
pp(permutes("112"))
pp(permutes("112223"))
pp(permutes("AABBBC"))

Python

Set filters out unique permutations

#Aamrun, 5th October 2021

from itertools import permutations

numList = [2,3,1]

baseList = []

for i in numList:
    for j in range(0,i):
        baseList.append(i)

stringDict = {'A':2,'B':3,'C':1}

baseString=""

for i in stringDict:
    for j in range(0,stringDict[i]):
        baseString+=i

print("Permutations for " + str(baseList) + " : ")
[print(i) for i in set(permutations(baseList))]

print("Permutations for " + baseString + " : ")
[print(i) for i in set(permutations(baseString))]

Output:

Permutations for [2, 2, 3, 3, 3, 1] : 
(2, 1, 3, 2, 3, 3)
(3, 2, 3, 3, 1, 2)
(3, 2, 3, 1, 2, 3)
(3, 3, 1, 2, 2, 3)
(3, 3, 2, 2, 3, 1)
(3, 1, 3, 3, 2, 2)
(3, 1, 3, 2, 3, 2)
(2, 3, 3, 3, 1, 2)
(3, 3, 1, 3, 2, 2)
(3, 1, 2, 3, 2, 3)
(3, 2, 2, 1, 3, 3)
(3, 2, 3, 2, 1, 3)
(3, 1, 3, 2, 2, 3)
(2, 3, 1, 3, 2, 3)
(3, 2, 1, 2, 3, 3)
(2, 3, 3, 2, 1, 3)
(2, 3, 1, 3, 3, 2)
(3, 3, 2, 3, 2, 1)
(3, 3, 2, 2, 1, 3)
(2, 2, 3, 3, 3, 1)
(2, 3, 1, 2, 3, 3)
(3, 3, 2, 3, 1, 2)
(3, 3, 3, 2, 2, 1)
(2, 1, 2, 3, 3, 3)
(2, 3, 2, 3, 3, 1)
(2, 1, 3, 3, 3, 2)
(2, 2, 3, 3, 1, 3)
(3, 1, 2, 2, 3, 3)
(2, 3, 2, 1, 3, 3)
(3, 2, 1, 3, 3, 2)
(1, 3, 3, 3, 2, 2)
(3, 3, 3, 2, 1, 2)
(2, 3, 2, 3, 1, 3)
(3, 2, 2, 3, 3, 1)
(1, 3, 2, 2, 3, 3)
(2, 1, 3, 3, 2, 3)
(3, 2, 1, 3, 2, 3)
(1, 3, 3, 2, 2, 3)
(1, 3, 3, 2, 3, 2)
(1, 2, 3, 3, 3, 2)
(2, 3, 3, 1, 3, 2)
(3, 3, 2, 1, 3, 2)
(1, 2, 3, 2, 3, 3)
(3, 3, 2, 1, 2, 3)
(3, 2, 3, 3, 2, 1)
(1, 3, 2, 3, 3, 2)
(1, 2, 3, 3, 2, 3)
(2, 3, 3, 1, 2, 3)
(3, 2, 2, 3, 1, 3)
(1, 3, 2, 3, 2, 3)
(3, 1, 2, 3, 3, 2)
(2, 3, 3, 2, 3, 1)
(3, 3, 1, 2, 3, 2)
(2, 2, 3, 1, 3, 3)
(3, 3, 3, 1, 2, 2)
(1, 2, 2, 3, 3, 3)
(3, 2, 3, 1, 3, 2)
(2, 2, 1, 3, 3, 3)
(2, 3, 3, 3, 2, 1)
(3, 2, 3, 2, 3, 1)
Permutations for AABBBC : 
('B', 'B', 'A', 'C', 'B', 'A')
('B', 'C', 'B', 'A', 'B', 'A')
('A', 'B', 'A', 'B', 'B', 'C')
('B', 'A', 'B', 'B', 'C', 'A')
('C', 'B', 'A', 'B', 'B', 'A')
('A', 'A', 'B', 'C', 'B', 'B')
('A', 'B', 'B', 'C', 'A', 'B')
('B', 'C', 'B', 'B', 'A', 'A')
('B', 'B', 'A', 'A', 'C', 'B')
('A', 'B', 'C', 'B', 'B', 'A')
('A', 'C', 'A', 'B', 'B', 'B')
('B', 'B', 'B', 'A', 'A', 'C')
('C', 'B', 'B', 'A', 'B', 'A')
('A', 'A', 'C', 'B', 'B', 'B')
('C', 'A', 'A', 'B', 'B', 'B')
('B', 'C', 'A', 'A', 'B', 'B')
('A', 'B', 'B', 'A', 'C', 'B')
('B', 'B', 'C', 'A', 'B', 'A')
('A', 'A', 'B', 'B', 'B', 'C')
('C', 'B', 'B', 'B', 'A', 'A')
('B', 'C', 'A', 'B', 'B', 'A')
('C', 'A', 'B', 'A', 'B', 'B')
('B', 'A', 'A', 'B', 'C', 'B')
('B', 'B', 'B', 'C', 'A', 'A')
('B', 'B', 'C', 'B', 'A', 'A')
('B', 'A', 'B', 'C', 'A', 'B')
('A', 'C', 'B', 'B', 'B', 'A')
('B', 'B', 'A', 'A', 'B', 'C')
('C', 'B', 'A', 'A', 'B', 'B')
('C', 'A', 'B', 'B', 'A', 'B')
('B', 'A', 'A', 'C', 'B', 'B')
('B', 'C', 'B', 'A', 'A', 'B')
('B', 'B', 'A', 'B', 'A', 'C')
('A', 'B', 'B', 'A', 'B', 'C')
('B', 'A', 'A', 'B', 'B', 'C')
('A', 'B', 'B', 'C', 'B', 'A')
('B', 'A', 'C', 'B', 'B', 'A')
('C', 'B', 'A', 'B', 'A', 'B')
('B', 'A', 'B', 'A', 'C', 'B')
('A', 'B', 'A', 'B', 'C', 'B')
('A', 'B', 'C', 'A', 'B', 'B')
('B', 'B', 'B', 'A', 'C', 'A')
('A', 'B', 'B', 'B', 'A', 'C')
('B', 'B', 'A', 'C', 'A', 'B')
('A', 'B', 'C', 'B', 'A', 'B')
('C', 'A', 'B', 'B', 'B', 'A')
('A', 'A', 'B', 'B', 'C', 'B')
('B', 'A', 'B', 'B', 'A', 'C')
('A', 'B', 'A', 'C', 'B', 'B')
('A', 'C', 'B', 'A', 'B', 'B')
('B', 'A', 'C', 'A', 'B', 'B')
('B', 'B', 'A', 'B', 'C', 'A')
('B', 'C', 'A', 'B', 'A', 'B')
('C', 'B', 'B', 'A', 'A', 'B')
('B', 'A', 'B', 'A', 'B', 'C')
('B', 'A', 'B', 'C', 'B', 'A')
('B', 'A', 'C', 'B', 'A', 'B')
('A', 'B', 'B', 'B', 'C', 'A')
('B', 'B', 'C', 'A', 'A', 'B')
('A', 'C', 'B', 'B', 'A', 'B')

Alternatively, generalized to accept any iterable.

"""Permutations with some identical elements. Requires Python >= 3.7."""
from itertools import chain
from itertools import permutations
from itertools import repeat

from typing import Iterable
from typing import Tuple
from typing import TypeVar

T = TypeVar("T")


def permutations_repeated(
    duplicates: Iterable[int],
    symbols: Iterable[T],
) -> Iterable[Tuple[T, ...]]:
    """Return distinct permutations for `symbols` repeated `duplicates` times."""
    iters = (repeat(sym, dup) for sym, dup in zip(symbols, duplicates))
    return sorted(
        set(
            permutations(
                chain.from_iterable(iters),
            ),
        ),
    )


def main() -> None:
    print(permutations_repeated([2, 3, 1], range(1, 4)))  # 1-based
    print(permutations_repeated([2, 3, 1], range(3)))  # 0-based
    print(permutations_repeated([2, 3, 1], ["A", "B", "C"]))  # letters


if __name__ == "__main__":
    main()

Output:

[(1, 1, 2, 2, 2, 3), (1, 1, 2, 2, 3, 2), (1, 1, 2, 3, 2, 2), (1, 1, 3, 2, 2, 2), (1, 2, 1, 2, 2, 3), (1, 2, 1, 2, 3, 2), (1, 2, 1, 3, 2, 2), (1, 2, 2, 1, 2, 3), (1, 2, 2, 1, 3, 2), (1, 2, 2, 2, 1, 3), (1, 2, 2, 2, 3, 1), (1, 2, 2, 3, 1, 2), (1, 2, 2, 3, 2, 1), (1, 2, 3, 1, 2, 2), (1, 2, 3, 2, 1, 2), (1, 2, 3, 2, 2, 1), (1, 3, 1, 2, 2, 2), (1, 3, 2, 1, 2, 2), (1, 3, 2, 2, 1, 2), (1, 3, 2, 2, 2, 1), (2, 1, 1, 2, 2, 3), (2, 1, 1, 2, 3, 2), (2, 1, 1, 3, 2, 2), (2, 1, 2, 1, 2, 3), (2, 1, 2, 1, 3, 2), (2, 1, 2, 2, 1, 3), (2, 1, 2, 2, 3, 1), (2, 1, 2, 3, 1, 2), (2, 1, 2, 3, 2, 1), (2, 1, 3, 1, 2, 2), (2, 1, 3, 2, 1, 2), (2, 1, 3, 2, 2, 1), (2, 2, 1, 1, 2, 3), (2, 2, 1, 1, 3, 2), (2, 2, 1, 2, 1, 3), (2, 2, 1, 2, 3, 1), (2, 2, 1, 3, 1, 2), (2, 2, 1, 3, 2, 1), (2, 2, 2, 1, 1, 3), (2, 2, 2, 1, 3, 1), (2, 2, 2, 3, 1, 1), (2, 2, 3, 1, 1, 2), (2, 2, 3, 1, 2, 1), (2, 2, 3, 2, 1, 1), (2, 3, 1, 1, 2, 2), (2, 3, 1, 2, 1, 2), (2, 3, 1, 2, 2, 1), (2, 3, 2, 1, 1, 2), (2, 3, 2, 1, 2, 1), (2, 3, 2, 2, 1, 1), (3, 1, 1, 2, 2, 2), (3, 1, 2, 1, 2, 2), (3, 1, 2, 2, 1, 2), (3, 1, 2, 2, 2, 1), (3, 2, 1, 1, 2, 2), (3, 2, 1, 2, 1, 2), (3, 2, 1, 2, 2, 1), (3, 2, 2, 1, 1, 2), (3, 2, 2, 1, 2, 1), (3, 2, 2, 2, 1, 1)]
[(0, 0, 1, 1, 1, 2), (0, 0, 1, 1, 2, 1), (0, 0, 1, 2, 1, 1), (0, 0, 2, 1, 1, 1), (0, 1, 0, 1, 1, 2), (0, 1, 0, 1, 2, 1), (0, 1, 0, 2, 1, 1), (0, 1, 1, 0, 1, 2), (0, 1, 1, 0, 2, 1), (0, 1, 1, 1, 0, 2), (0, 1, 1, 1, 2, 0), (0, 1, 1, 2, 0, 1), (0, 1, 1, 2, 1, 0), (0, 1, 2, 0, 1, 1), (0, 1, 2, 1, 0, 1), (0, 1, 2, 1, 1, 0), (0, 2, 0, 1, 1, 1), (0, 2, 1, 0, 1, 1), (0, 2, 1, 1, 0, 1), (0, 2, 1, 1, 1, 0), (1, 0, 0, 1, 1, 2), (1, 0, 0, 1, 2, 1), (1, 0, 0, 2, 1, 1), (1, 0, 1, 0, 1, 2), (1, 0, 1, 0, 2, 1), (1, 0, 1, 1, 0, 2), (1, 0, 1, 1, 2, 0), (1, 0, 1, 2, 0, 1), (1, 0, 1, 2, 1, 0), (1, 0, 2, 0, 1, 1), (1, 0, 2, 1, 0, 1), (1, 0, 2, 1, 1, 0), (1, 1, 0, 0, 1, 2), (1, 1, 0, 0, 2, 1), (1, 1, 0, 1, 0, 2), (1, 1, 0, 1, 2, 0), (1, 1, 0, 2, 0, 1), (1, 1, 0, 2, 1, 0), (1, 1, 1, 0, 0, 2), (1, 1, 1, 0, 2, 0), (1, 1, 1, 2, 0, 0), (1, 1, 2, 0, 0, 1), (1, 1, 2, 0, 1, 0), (1, 1, 2, 1, 0, 0), (1, 2, 0, 0, 1, 1), (1, 2, 0, 1, 0, 1), (1, 2, 0, 1, 1, 0), (1, 2, 1, 0, 0, 1), (1, 2, 1, 0, 1, 0), (1, 2, 1, 1, 0, 0), (2, 0, 0, 1, 1, 1), (2, 0, 1, 0, 1, 1), (2, 0, 1, 1, 0, 1), (2, 0, 1, 1, 1, 0), (2, 1, 0, 0, 1, 1), (2, 1, 0, 1, 0, 1), (2, 1, 0, 1, 1, 0), (2, 1, 1, 0, 0, 1), (2, 1, 1, 0, 1, 0), (2, 1, 1, 1, 0, 0)]
[('A', 'A', 'B', 'B', 'B', 'C'), ('A', 'A', 'B', 'B', 'C', 'B'), ('A', 'A', 'B', 'C', 'B', 'B'), ('A', 'A', 'C', 'B', 'B', 'B'), ('A', 'B', 'A', 'B', 'B', 'C'), ('A', 'B', 'A', 'B', 'C', 'B'), ('A', 'B', 'A', 'C', 'B', 'B'), ('A', 'B', 'B', 'A', 'B', 'C'), ('A', 'B', 'B', 'A', 'C', 'B'), ('A', 'B', 'B', 'B', 'A', 'C'), ('A', 'B', 'B', 'B', 'C', 'A'), ('A', 'B', 'B', 'C', 'A', 'B'), ('A', 'B', 'B', 'C', 'B', 'A'), ('A', 'B', 'C', 'A', 'B', 'B'), ('A', 'B', 'C', 'B', 'A', 'B'), ('A', 'B', 'C', 'B', 'B', 'A'), ('A', 'C', 'A', 'B', 'B', 'B'), ('A', 'C', 'B', 'A', 'B', 'B'), ('A', 'C', 'B', 'B', 'A', 'B'), ('A', 'C', 'B', 'B', 'B', 'A'), ('B', 'A', 'A', 'B', 'B', 'C'), ('B', 'A', 'A', 'B', 'C', 'B'), ('B', 'A', 'A', 'C', 'B', 'B'), ('B', 'A', 'B', 'A', 'B', 'C'), ('B', 'A', 'B', 'A', 'C', 'B'), ('B', 'A', 'B', 'B', 'A', 'C'), ('B', 'A', 'B', 'B', 'C', 'A'), ('B', 'A', 'B', 'C', 'A', 'B'), ('B', 'A', 'B', 'C', 'B', 'A'), ('B', 'A', 'C', 'A', 'B', 'B'), ('B', 'A', 'C', 'B', 'A', 'B'), ('B', 'A', 'C', 'B', 'B', 'A'), ('B', 'B', 'A', 'A', 'B', 'C'), ('B', 'B', 'A', 'A', 'C', 'B'), ('B', 'B', 'A', 'B', 'A', 'C'), ('B', 'B', 'A', 'B', 'C', 'A'), ('B', 'B', 'A', 'C', 'A', 'B'), ('B', 'B', 'A', 'C', 'B', 'A'), ('B', 'B', 'B', 'A', 'A', 'C'), ('B', 'B', 'B', 'A', 'C', 'A'), ('B', 'B', 'B', 'C', 'A', 'A'), ('B', 'B', 'C', 'A', 'A', 'B'), ('B', 'B', 'C', 'A', 'B', 'A'), ('B', 'B', 'C', 'B', 'A', 'A'), ('B', 'C', 'A', 'A', 'B', 'B'), ('B', 'C', 'A', 'B', 'A', 'B'), ('B', 'C', 'A', 'B', 'B', 'A'), ('B', 'C', 'B', 'A', 'A', 'B'), ('B', 'C', 'B', 'A', 'B', 'A'), ('B', 'C', 'B', 'B', 'A', 'A'), ('C', 'A', 'A', 'B', 'B', 'B'), ('C', 'A', 'B', 'A', 'B', 'B'), ('C', 'A', 'B', 'B', 'A', 'B'), ('C', 'A', 'B', 'B', 'B', 'A'), ('C', 'B', 'A', 'A', 'B', 'B'), ('C', 'B', 'A', 'B', 'A', 'B'), ('C', 'B', 'A', 'B', 'B', 'A'), ('C', 'B', 'B', 'A', 'A', 'B'), ('C', 'B', 'B', 'A', 'B', 'A'), ('C', 'B', 'B', 'B', 'A', 'A')]

Quackery

This is Narayana Pandita’s algorithm to generate the lexicographically next permutation from a given permutation, described in गणित कौमुदी ("Ganita Kaumudi", Google translation "Math skills", literal translation "Moonlight of Mathematics") pub. CE1356.

Starting with a list of characters (Initially in lexicographic order, A < B < C < D < E < F etc., here we consider an arbitrary permutation in the middle of the sequence.)

[ B C F E D A ]

Scan from right to left to find the first character that is less than the previous character (N).

[ B C F E D A ]
    ↑

• If they are in reverse order [ F E D C B A ] that is the lexicographically last permutation.

Scan from right to left to find the first one that is greater than N.

[ B C F E D A ]
    ↑     ↑

Exchange them.

[ B D F E C A ]
    ↑     ↑

Reverse the order of the characters to the right of the first found character.

[ B D A C E F ]
    ↑

This is the next permutation.

• There is one permutation of the empty list, [ ]; it is the empty list, [ ]. The code presented here checks explicitly for this to avoid an array out of bounds error.

• When the lexicographically last permutation is detected, the code presented here reverses the whole list and skips the rest of the steps, returning the lexicographically first permutation, so repeated calls to nextperm will cycle through the permutations forever. This means there is no requirement to start with the lexicographically first permutation, but you will need to either precompute the number of permutations (countperms) or compare each permutation returned by nextperm to the first permutation.

  [ dup [] = if done
    0 over dup -1 peek
    over size times
      [ over i 1 - peek
        tuck > if
          [ rot drop i
            unrot
            conclude ] ]
    2drop split
    swap dup [] = iff
      [ drop reverse ] done
    -1 pluck
    rot 0 unrot
    dup size times
      [ 2dup i peek
        < if
          [ rot drop i 1+
            unrot
            conclude ] ]
    rot split
    swap -1 pluck
    dip
      [ unrot join join
        reverse ]
    swap join join ]        is nextperm  ( [ --> [ )

  [ 1 swap times
      [ i^ 1+ * ] ]         is !         ( n --> n )

  [ 0 over
    witheach +
    !
    swap witheach
      [ ! / ] ]             is permcount ( [ --> n )

  [ [] swap 
    $ "" over
    witheach
      [ i^ char A +
        swap of join ]
    swap permcount
    times
      [ dup dip 
          [ nested join ]
        nextperm ]
    drop 70 wrap$ ]         is task     ( [ -->   )

  ' [ 2 3 1 ] task

Output:

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC
ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA
BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB
BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA
BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA
CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

Bonus code

Counting the permutations of "senselessness". It would be more efficient to use the formula given in the task description, n!/(a1! × a2! ... × ak!), (implemented as permcount), which yields 180180. This confirms that computation.

  0
  $ "senselessness"
  dup
  [ rot 1+ unrot
    nextperm 
    2dup = until ]
  2drop 
  echo
  say " permutations generated"

Output:

180180 permutations generated

Raku

(formerly Perl 6)

Works with: Rakudo version 2019.07

sub permutations-with-some-identical-elements ( @elements, @reps = () ) {
    with @elements { (@reps ?? flat $_ Zxx @reps !! flat .keys.map(*+1) Zxx .values).permutations».join.unique }
 }

for (<2 1>,), (<2 3 1>,), (<A B C>, <2 3 1>), (<🦋 ⚽ 🙄>, <2 2 1>) {
    put permutations-with-some-identical-elements |$_;
    say '';
}

Output:

112 121 211

112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122312 122321 123122 123212 123221 131222 132122 132212 132221 211223 211232 211322 212123 212132 212213 212231 212312 212321 213122 213212 213221 221123 221132 221213 221231 221312 221321 222113 222131 222311 223112 223121 223211 231122 231212 231221 232112 232121 232211 311222 312122 312212 312221 321122 321212 321221 322112 322121 322211

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

🦋🦋⚽⚽🙄 🦋🦋⚽🙄⚽ 🦋🦋🙄⚽⚽ 🦋⚽🦋⚽🙄 🦋⚽🦋🙄⚽ 🦋⚽⚽🦋🙄 🦋⚽⚽🙄🦋 🦋⚽🙄🦋⚽ 🦋⚽🙄⚽🦋 🦋🙄🦋⚽⚽ 🦋🙄⚽🦋⚽ 🦋🙄⚽⚽🦋 ⚽🦋🦋⚽🙄 ⚽🦋🦋🙄⚽ ⚽🦋⚽🦋🙄 ⚽🦋⚽🙄🦋 ⚽🦋🙄🦋⚽ ⚽🦋🙄⚽🦋 ⚽⚽🦋🦋🙄 ⚽⚽🦋🙄🦋 ⚽⚽🙄🦋🦋 ⚽🙄🦋🦋⚽ ⚽🙄🦋⚽🦋 ⚽🙄⚽🦋🦋 🙄🦋🦋⚽⚽ 🙄🦋⚽🦋⚽ 🙄🦋⚽⚽🦋 🙄⚽🦋🦋⚽ 🙄⚽🦋⚽🦋 🙄⚽⚽🦋🦋

REXX

shows permutation list

/*REXX program  computes and displays  the  permutations  with some identical elements. */
parse arg g                                      /*obtain optional arguments from the CL*/
if g='' | g=","  then g= 2 3 1                   /*Not specified?  Then use the defaults*/
#= words(g)                                      /*obtain the number of source items.   */
@= left('ABCDEFGHIJKLMNOPQRSTUVWXYZ',  #)        /*@:   the (output) letters to be used.*/
LO=                                              /*LO:  the start of the sequence.      */
HI=                                              /*HI:   "   end   "  "      "          */
      do i=1  for #;      @.i= word(g, i)        /*get number of characters for an arg. */
      LO= LO || copies(i, @.i)                   /*build the  LO  number for the range. */
      HI=       copies(i, @.i) || HI             /*  "    "   HI     "    "   "    "    */
      end   /*i*/
$=                                               /*initialize the output string to null.*/
      do j=LO  to  HI                            /*generate the enumerated output string*/
      if verify(j, LO)\==0  then iterate         /*An invalid digital string?  Then skip*/
         do k=1  for #                           /*parse string for correct # of digits.*/
         if countstr(k, j)\==@.k  then iterate j /*Incorrect number of digits?  Skip.   */
         end   /*k*/
      $= $ j                                     /*append digital string to the list.   */
      end      /*j*/
                                                 /*stick a fork in it,  we're all done. */
say 'number of permutations: '    words($)
say
say strip(translate($, @, left(123456789, #) ) ) /*display the translated string to term*/

output   when using the inputs of:     2   1

number of permutations:  3

AAB ABA BAA

output   when using the default inputs:     2   3   1

number of permutations:  60

AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

only shows permutation count

If any of the arguments is negative, the list of the permutations is suppressed, only the permutation count is shown.

/*REXX program  computes and displays  the  permutations  with some identical elements. */
parse arg g                                      /*obtain optional arguments from the CL*/
if g='' | g=","  then g= 2 3 1                   /*Not specified?  Then use the defaults*/
#= words(g)                                      /*obtain the number of source items.   */
@= left('ABCDEFGHIJKLMNOPQRSTUVWXYZ',  #)        /*@:   the (output) letters to be used.*/
show= 1                                          /*if = 1,  will show permutation list. */
sum= 0
LO=                                              /*LO:  the start of the sequence.      */
HI=                                              /*HI:   "   end   "  "      "          */
      do i=1  for #;        y= word(g, i)        /*get number of characters for an arg. */
      show= show & y>=0;    a= abs(y)            /*Is it negative?  Then don't show list*/
      sum= sum + a;       @.i= a                 /*use the absolute value of an argument*/
      LO= LO || copies(i, @.i)                   /*build the  LO  number for the range. */
      HI=       copies(i, @.i) || HI             /*  "    "   HI     "    "   "    "    */
      end   /*i*/
$=                                               /*initialize the output string to null.*/
numeric digits max(9, sum)                       /*ensure enough numeric decimal digits.*/

      do j=LO  to  HI                            /*generate the enumerated output string*/
      if verify(j, LO)\==0  then iterate         /*An invalid digital string?  Then skip*/
         do k=1  for #                           /*parse string for correct # of digits.*/
         if countstr(k, j)\==@.k  then iterate j /*Incorrect number of digits?  Skip.   */
         end   /*k*/
      $= $ j                                     /*append digital string to the list.   */
      end      /*j*/
                                                 /*stick a fork in it,  we're all done. */
say 'number of permutations: '    words($)       /*# perms with some identical elements.*/
say
if show  then say strip(translate($, @, left(123456789, #) ) ) /*display translated str.*/

output   when using the inputs of:     -2   3   1   1   1

number of permutations:  3360

output   when using the inputs of:     -1   2   1   2   1

number of permutations:  1260

output   when using the inputs of:     -1   2   3   2   1

number of permutations:  15120

output   when using the inputs of:     -1   1   5   2

number of permutations:  1512

output   when using the inputs of:     -1   1   1   1   6

number of permutations:  5040

RPL

Based on the algorithm used by the Quackery implementation.

Works with: HP version 48G

RPL code

Comment

≪ → a b ≪ DUP a GET OVER b GET ROT ROT b SWAP PUT a ROT PUT ≫ ≫ 'SWAPITEMS' STO ≪ DUP SIZE → n ≪ IF n 1 > THEN 1 CF n WHILE 1 FC? OVER 1 > AND REPEAT DUP2 GET ROT ROT 1 - DUP2 GET IF 4 ROLL < THEN 1 SF END END IF 1 FC?C THEN DROP SORT ELSE SWAP n WHILE 1 FC? OVER AND REPEAT DUP2 GET IF 3 PICK 5 PICK GET > THEN 1 SF ELSE 1 - END END 3 PICK SWAPITEMS SWAP DUP2 1 SWAP SUB ROT ROT 1 + n SUB REVLIST + END END ≫ ≫ ‘NEXTPERM’ STO

SWAPITEMS ( {list} a b → {list} ) get list items at a and b positions swap them return new list NEXTPERM ( {list} → {list} ) check at least 2 items in the list flag 1 controls loop break loop j = end downto 2 get list[j] and list[j-1] exit loop if list[j-1]<list[j] end loop if no break, this is the last perm else loop k = end downto 2 look for list[k] > list[j] end loop swap list[j] and list[k] reverse list, starting from j+1 return next permutation

≪ → s
  ≪ "" 1 s SIZE FOR j
        s j GET 64 + CHR + NEXT
≫ ≫ '→ABC' STO 

≪ { } 
   1 3 PICK SIZE FOR j
      1 3 PICK j GET START j + NEXT NEXT
   SWAP DROP → b
  ≪ { } b
     DO
        SWAP OVER →ABC +
        SWAP NEXTPERM
     UNTIL DUP b == END DROP
≫ ≫ 'TASK' STO 

{ 2 3 1 } TASK

Output:

1: { "AABBBC" "AABBCB" "AABCBB" "AACBBB" "ABABBC" "ABABCB" "ABACBB" "ABBABC" "ABBACB" "ABBBAC" ABBBCA" "ABBCAB" "ABBCBA" "ABCABB" "ABCBAB" "ABCBBA" "ACABBB" "ACBABB" "ACBBAB" "ACBBBA" "BAABBC" "BAABCB" "BAACBB" "BABABC" "BABACB" "BABBAC" "BABBCA" "BABCAB" "BABCBA" "BACABB" "BACBAB" "BACBBA" "BBAABC" "BBAACB" "BBABAC" "BBABCA" "BBACAB" "BBACBA" "BBBAAC" "BBBACA" "BBBCAA" "BBCAAB" "BBCABA" "BBCBAA" "BCAABB" "BCABAB" "BCABBA" "BCBAAB" "BCBABA" "BCBBAA" "CAABBB" "CABABB" "CABBAB" "CABBBA" "CBAABB" "CBABAB" "CBABBA" "CBBAAB" "CBBABA" "CBBBAA"}

Ruby

require 'set' # for older Ruby versions

def permutations_with_identical_elements(reps, elements=nil)
  elements ||= (1..reps.size)
  all = elements.zip(reps).flat_map{|el, r| [el]*r}
  all.permutation.inject(Set.new){|s, perm| s << perm.join}
end

permutations_with_identical_elements([2,3,1]).each_slice(10) {|slice| puts slice.join(" ")}

p permutations_with_identical_elements([2,1], ["A", "B"])

Output:

112223 112232 112322 113222 121223 121232 121322 122123 122132 122213
122231 122312 122321 123122 123212 123221 131222 132122 132212 132221
211223 211232 211322 212123 212132 212213 212231 212312 212321 213122
213212 213221 221123 221132 221213 221231 221312 221321 222113 222131
222311 223112 223121 223211 231122 231212 231221 232112 232121 232211
311222 312122 312212 312221 321122 321212 321221 322112 322121 322211
#<Set: {"AAB", "ABA", "BAA"}>

Sidef

Simple implementation, by filtering out the duplicated permutations.

func permutations_with_some_identical_elements (reps) {
    reps.map_kv {|k,v| v.of(k+1)... }.permutations.uniq
}

say permutations_with_some_identical_elements([2,1]).map{.join}.join(' ')
say permutations_with_some_identical_elements([2,3,1]).map{.join}.join(' ')

Output:

112 121 211
112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122312 122321 123122 123212 123221 131222 132122 132212 132221 211223 211232 211322 212123 212132 212213 212231 212312 212321 213122 213212 213221 221123 221132 221213 221231 221312 221321 222113 222131 222311 223112 223121 223211 231122 231212 231221 232112 232121 232211 311222 312122 312212 312221 321122 321212 321221 322112 322121 322211

More efficient approach, by generating the permutations without duplicates:

func next_uniq_perm (array) {

    var k = array.end
    return ([], false) if (k < 0)
    var i = k-1

    while ((i >= 0) && (array[i] >= array[i+1])) {
        --i
    }

    return (array.flip, false) if (i == -1)

    if (array[i+1] > array[k]) {
        array = [array.first(i+1)..., array.slice(i+1).first(k).flip...]
    }

    var j = i+1
    while (array[i] >= array[j]) {
        j++
    }

    array.clone!
    array.swap(i,j)

    return (array, true)
}

func unique_permutations(array, reps=[]) {
    var perm = (reps ? reps : array).map_kv {|k,v| v.of { reps ? array[k] : (k+1) }... }
    var perms = [perm]
    loop {
        (perm, var more) = next_uniq_perm(perm)
        break if !more
        perms << perm
    }
    return perms
}

for a,b in ([[[2,1]], [[2,3,1]], [%w(A B C), [2,3,1]]]) {
    say "\nPermutations with array = #{a}#{b ? \" and reps = #{b}\" : ''}:"
    say unique_permutations(a,b).map{.join}.join(' ')
}

Output:

Permutations with array = [2, 1]:
112 121 211

Permutations with array = [2, 3, 1]:
112223 112232 112322 113222 121223 121232 121322 122123 122132 122213 122231 122312 122321 123122 123212 123221 131222 132122 132212 132221 211223 211232 211322 212123 212132 212213 212231 212312 212321 213122 213212 213221 221123 221132 221213 221231 221312 221321 222113 222131 222311 223112 223121 223211 231122 231212 231221 232112 232121 232211 311222 312122 312212 312221 321122 321212 321221 322112 322121 322211

Permutations with array = ["A", "B", "C"] and reps = [2, 3, 1]:
AABBBC AABBCB AABCBB AACBBB ABABBC ABABCB ABACBB ABBABC ABBACB ABBBAC ABBBCA ABBCAB ABBCBA ABCABB ABCBAB ABCBBA ACABBB ACBABB ACBBAB ACBBBA BAABBC BAABCB BAACBB BABABC BABACB BABBAC BABBCA BABCAB BABCBA BACABB BACBAB BACBBA BBAABC BBAACB BBABAC BBABCA BBACAB BBACBA BBBAAC BBBACA BBBCAA BBCAAB BBCABA BBCBAA BCAABB BCABAB BCABBA BCBAAB BCBABA BCBBAA CAABBB CABABB CABBAB CABBBA CBAABB CBABAB CBABBA CBBAAB CBBABA CBBBAA

Tailspin

Creates lots of new arrays, which might be wasteful.

templates distinctPerms
  templates perms
    when <[](1)> do $(1) !
    otherwise
      def elements: $;
      1..$::length -> \(
        def k: $;
        def tail: $elements -> \[i](
          when <?($i <=$k>)> do $ -> \(<[](2..)> $(2..last)!\) !
          otherwise $!
        \);
        $tail -> perms -> [$elements($k;1), $...] !
      \) !
  end perms
  $ -> \[i]([1..$ -> $i] !\) -> perms !
end distinctPerms

def alpha: ['ABC'...];
[[2,3,1] -> distinctPerms -> '$alpha($)...;' ] -> !OUT::write

Output:

[AABBBC, AABBCB, AABCBB, AACBBB, ABABBC, ABABCB, ABACBB, ABBABC, ABBACB, ABBBAC, ABBBCA, ABBCAB, ABBCBA, ABCABB, ABCBAB, ABCBBA, ACABBB, ACBABB, ACBBAB, ACBBBA, BAABBC, BAABCB, BAACBB, BABABC, BABACB, BABBAC, BABBCA, BABCAB, BABCBA, BACABB, BACBAB, BACBBA, BBAABC, BBAACB, BBABAC, BBABCA, BBACAB, BBACBA, BBBAAC, BBBACA, BBBCAA, BBCAAB, BBCABA, BBCBAA, BCAABB, BCABAB, BCABBA, BCBAAB, BCBABA, BCBBAA, CAABBB, CABABB, CABBAB, CABBBA, CBAABB, CBABAB, CBABBA, CBBAAB, CBBABA, CBBBAA]

Work in place (slightly modified from the Go solution to preserve lexical order)

Translation of: Go

templates distinctPerms
  templates shouldSwap&{start:}
        when <?($@distinctPerms($start..~$) <~[<=$@distinctPerms($)>]>)> do $!
  end shouldSwap
  templates findPerms
    when <$@distinctPerms::length..> do $@distinctPerms !
    otherwise
      def index: $;
      $index..$@distinctPerms::length -> shouldSwap&{start: $index}
      -> \(
          @findPerms: $;
          @distinctPerms([$, $index]): $@distinctPerms([$index, $])...;
          $index + 1 -> findPerms !
      \) !
      @distinctPerms([$@findPerms, $index..~$@findPerms]): $@distinctPerms($index..$@findPerms)...;
  end findPerms
  @: $ -> \[i](1..$ -> $i !\);
  1 -> findPerms !
end distinctPerms
 
def alpha: ['ABC'...];
[[2,3,1] -> distinctPerms -> '$alpha($)...;' ] -> !OUT::write

Output:

[AABBBC, AABBCB, AABCBB, AACBBB, ABABBC, ABABCB, ABACBB, ABBABC, ABBACB, ABBBAC, ABBBCA, ABBCAB, ABBCBA, ABCABB, ABCBAB, ABCBBA, ACABBB, ACBABB, ACBBAB, ACBBBA, BAABBC, BAABCB, BAACBB, BABABC, BABACB, BABBAC, BABBCA, BABCAB, BABCBA, BACABB, BACBAB, BACBBA, BBAABC, BBAACB, BBABAC, BBABCA, BBACAB, BBACBA, BBBAAC, BBBACA, BBBCAA, BBCAAB, BBCABA, BBCBAA, BCAABB, BCABAB, BCABBA, BCBAAB, BCBABA, BCBBAA, CAABBB, CABABB, CABBAB, CABBBA, CBAABB, CBABAB, CBABBA, CBBAAB, CBBABA, CBBBAA]

Wren

Library: Wren-perm

import "./perm" for Perm

var createList = Fn.new { |nums, charSet|
    var chars = []
    for (i in 0...nums.count) {
        for (j in 0...nums[i]) chars.add(charSet[i])
    }
    return chars
}

var nums = [2, 1]
var a = createList.call(nums, "12")
System.print(Perm.listDistinct(a).map { |p| p.join() }.toList)
System.print()

nums = [2, 3, 1]
a = createList.call(nums, "123")
System.print(Perm.listDistinct(a).map { |p| p.join() }.toList)
System.print()

a = createList.call(nums, "ABC")
System.print(Perm.listDistinct(a).map { |p| p.join() }.toList)

Output:

[112, 121, 211]

[112223, 112232, 112322, 113222, 121223, 121232, 121322, 122123, 122132, 122213, 122231, 122321, 122312, 123221, 123212, 123122, 132221, 132212, 132122, 131222, 211223, 211232, 211322, 212123, 212132, 212213, 212231, 212321, 212312, 213221, 213212, 213122, 221123, 221132, 221213, 221231, 221321, 221312, 222113, 222131, 222311, 223121, 223112, 223211, 231221, 231212, 231122, 232121, 232112, 232211, 312221, 312212, 312122, 311222, 321221, 321212, 321122, 322121, 322112, 322211]

[AABBBC, AABBCB, AABCBB, AACBBB, ABABBC, ABABCB, ABACBB, ABBABC, ABBACB, ABBBAC, ABBBCA, ABBCBA, ABBCAB, ABCBBA, ABCBAB, ABCABB, ACBBBA, ACBBAB, ACBABB, ACABBB, BAABBC, BAABCB, BAACBB, BABABC, BABACB, BABBAC, BABBCA, BABCBA, BABCAB, BACBBA, BACBAB, BACABB, BBAABC, BBAACB, BBABAC, BBABCA, BBACBA, BBACAB, BBBAAC, BBBACA, BBBCAA, BBCABA, BBCAAB, BBCBAA, BCABBA, BCABAB, BCAABB, BCBABA, BCBAAB, BCBBAA, CABBBA, CABBAB, CABABB, CAABBB, CBABBA, CBABAB, CBAABB, CBBABA, CBBAAB, CBBBAA]

zkl

  // eg ( (2,3,1), "ABC" ) == permute "A","A","B","B","B","C" and remove duplicates
  //  --> ( "AABBBC", "AABBCB" .. )
  // this gets ugly lots sooner than it should
fcn permutationsWithSomeIdenticalElements(ns,abcs){
   ns.zipWith(fcn(n,c){ List.createLong(n,c) },abcs).flatten() : # (3,"B")-->("B","B,"B")
   Utils.Helpers.permute(_) : Utils.Helpers.listUnique(_)
   .apply("concat")  // ("A","A","B","B","B","C")-->"AABBCB" 
}

permutationsWithSomeIdenticalElements(T(2,1),"123").println();
permutationsWithSomeIdenticalElements(T(2,1),L("\u2192","\u2191")).concat("  ").println();

z:=permutationsWithSomeIdenticalElements(T(2,3,1),"ABC");
println(z.len());
z.pump(Void,T(Void.Read,9,False),  // print rows of ten items
	fcn{ vm.arglist.concat("  ").println() });

Output:

L("112","121","211")
→→↑  →↑→  ↑→→
60
AABBBC  AABBCB  AABCBB  AACBBB  ACABBB  CAABBB  CABABB  ACBABB  ABCABB  ABACBB
ABABCB  ABABBC  BAABBC  BAABCB  BAACBB  BACABB  BCAABB  CBAABB  ABBABC  ABBACB
ABBCAB  ABCBAB  ACBBAB  CABBAB  BABABC  BABACB  BABCAB  BACBAB  BCABAB  CBABAB
CBBAAB  BCBAAB  BBCAAB  BBACAB  BBAACB  BBAABC  CBABBA  BCABBA  BACBBA  BABCBA
BABBCA  BABBAC  CBBABA  BCBABA  BBCABA  BBACBA  BBABCA  BBABAC  ABBBAC  ABBBCA
ABBCBA  ABCBBA  ACBBBA  CABBBA  BBBAAC  BBBACA  BBBCAA  BBCBAA  BCBBAA  CBBBAA