Message Boards Message Boards

3
|
6778 Views
|
4 Replies
|
14 Total Likes
View groups...
Share
Share this post:
GROUPS:

Removing Repeated Permutations

Posted 11 years ago
A friend has asked on a popular social network how to find all permutations of a list with duplicates removed, but not to remove those where each element is the same. The best description I can give is as follows;
func[n_] := Tuples[Range[0, n - 1], {n}]
For n=3 this gives the following:
{{0, 0, 0}, {0, 0, 1}, {0, 0, 2}, {0, 1, 0}, {0, 1, 1}, {0, 1, 2}, {0,2, 0}, {0, 2, 1}, {0, 2, 2}, {1, 0, 0}, {1, 0, 1}, {1, 0, 2}, {1, 1, 0}, {1, 1, 1}, {1, 1, 2}, {1, 2, 0}, {1, 2, 1}, {1, 2, 2}, {2, 0,0}, {2, 0, 1}, {2, 0, 2}, {2, 1, 0}, {2, 1, 1}, {2, 1, 2}, {2, 2,0}, {2, 2, 1}, {2, 2, 2}}

But for my friends purposes, the following are equivalent {0,1,0} and {1,0,0}. 

One way that's been suggested to remove this degeneracy is with DeleteDuplicates and mapping Sort.
func2[n_] := DeleteDuplicates[Sort /@ Tuples[Range[0, n - 1], n]]

But that gets very slow very quickly, and I'm hopeful there's a built in combinatorical function for this.

Any suggestions?
POSTED BY: Martin Hadley
4 Replies
I think what you are looking for are called Combinations with Repetition and there is an absolutely awsome website called Rosetta Code which gives an efficent implementation of generator for this type of sets. 
CombinWithRep[S_List, k_] := Module[{occupation, assignment},
  occupation = Flatten[Permutations /@ IntegerPartitions[k, {Length[S]}, Range[0, k]], 1];
  assignment = Flatten[Table[ConstantArray[z, {#[[z]]}], {z, Length[#]}]] & /@ occupation;
  Thread[S[[#]]] & /@ assignment
  ]
Now, let's try this out on your example:
CombinWithRep[{0, 1, 2}, 3]
(* Output *)
{{0, 0, 0}, {1, 1, 1}, {2, 2, 2}, {0, 0, 1}, {0, 0, 2}, {0, 1, 1}, {0, 2, 2}, {1, 1, 2}, {1, 2, 2}, {0, 1, 2}}
Does this look OK? BTW  Jon McLoone wrote an absolutely cool blog about Rosetta Code site: Code Length Measured in 14 Languages
POSTED BY: Vitaliy Kaurov
Thanks Vitaliy! That's exactly what seems to be needed in this case.

I will add Rosetta Code to my list of "how on Earth do I do this?" sites - I'd completely forgotten Jon's post despite watching him write some of it.
POSTED BY: Martin Hadley
Posted 11 years ago
n = 3; Flatten[Table[{i, j, k}, {i, 0, n - 1}, {j, i, n - 1}, {k, j, n - 1}], 1]

or
arr = {1, 3, 5, 8}; n = Length[arr];
Flatten[Table[arr[[{i, j, k, l}]], {i, 1, n}, {j, i, n}, {k, j, n}, {l, k, n}], 3]
POSTED BY: wayne wang
Not so elegant as what Vitaliy showed, but here is a procedural method that does not generate any duplicates.
CombinWithRep2[n_] := Module[
  {indices, j, ilist},
  indices = Array[j, n];
  j[0] = 0;
  ilist = Map[{j[#1], j[# - 1], n - 1} &, Range[n]];
  Flatten[Table[indices, Evaluate[Sequence @@ ilist]], n - 1]
  ]
The usual example:
In[43]:= CombinWithRep2[3]

Out[43]= {{0, 0, 0}, {0, 0, 1}, {0, 0, 2}, {0, 1, 1}, {0, 1, 2}, {0,
  2, 2}, {1, 1, 1}, {1, 1, 2}, {1, 2, 2}, {2, 2, 2}}
POSTED BY: Daniel Lichtblau
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract