Permutations with some identical elements: Difference between revisions

added haskell
m (→‎{{header|Tailspin}}: syntax update)
(added haskell)
Line 205:
 
[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]
</pre>
 
=={{header|Haskell}}==
<lang 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' = if n == 1 then xs else (x,n-1) : 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)]</lang>
 
{{out}}
<pre>
[[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"]
</pre>
 
Anonymous user