4

I have a set, lets say: set = {1, 2, 3, 4, 5}

I want to get all the possible subsets with 1, 2, and 2 elements.

What I did was to generate all possible permutations (5!) of set and use TakeList:

allofthem = TakeList[#, {2, 2, 1}] & /@ Permutations[set]

Afterwards, I had to order them (at level 2) and use DeleteDuplicates:

DeleteDuplicates[
  Table[Map[Sort, allofthem[[i]]], {i, 1, Length[allofthem]}]]

I would like to do this in a simpler way, perhaps avoiding the use of Table

Any help would be appreciated.

Carl Woll
  • 130,679
  • 6
  • 243
  • 355
Carlos A. Arango
  • 41
  • 4

4 Answers4

5

Update As noted in the comments, the dummy set can be based on numbers too. The result would still be the same.

setDummy[sub_] := ConstantArray @@@ Transpose[{Range[Length[sub]], sub}] // Flatten
setDummy[{2,2,1}]

{1, 1, 2, 2, 3}

One way would be to use a dummy set to represent required permutations such as {x, x, y, y, z}. Subsequently, obtain permutations of it and then arrange set accordingly to achieve the desired result.

set = {1, 2, 3, 4, 5};
setDummy = {x, x, y, y, z};
res = Keys @ GatherBy[#, Last] & /@ (Thread[set -> #] & /@ Permutations[setDummy])

{{{1, 2}, {3, 4}, {5}}, {{1, 2}, {3, 5}, {4}}, {{1, 2}, {3}, {4, 5}}, {{1, 3}, {2, 4}, {5}}, {{1, 3}, {2, 5}, {4}}, {{1, 4}, {2, 3}, {5}}, {{1, 5}, {2, 3}, {4}}, {{1, 4}, {2, 5}, {3}}, {{1, 5}, {2, 4}, {3}}, {{1, 3}, {2}, {4, 5}}, {{1, 4}, {2}, {3, 5}}, {{1, 5}, {2}, {3, 4}}, {{1, 4}, {2, 3}, {5}}, {{1, 5}, {2, 3}, {4}}, {{1, 3}, {2, 4}, {5}}, {{1, 3}, {2, 5}, {4}}, {{1, 5}, {2, 4}, {3}}, {{1, 4}, {2, 5}, {3}}, {{1, 2}, {3, 4}, {5}}, {{1, 2}, {3, 5}, {4}}, {{1, 2}, {3}, {4, 5}}, {{1, 5}, {2}, {3, 4}}, {{1, 4}, {2}, {3, 5}}, {{1, 3}, {2}, {4, 5}}, {{1}, {2, 3}, {4, 5}}, {{1}, {2, 4}, {3, 5}}, {{1}, {2, 5}, {3, 4}}, {{1}, {2, 5}, {3, 4}}, {{1}, {2, 4}, {3, 5}}, {{1}, {2, 3}, {4, 5}}}

set = {1, 2, 3, 4, 5};
allofthem = Internal`PartitionRagged[#, {2, 2, 1}] & /@ Permutations[set];
res1 = DeleteDuplicates[Table[Map[Sort, allofthem[[i]]], {i, 1, Length[allofthem]}]];
Sort[(Sort /@ res)] == Sort[Sort /@ res1]

True

Anjan Kumar
  • 4,979
  • 1
  • 15
  • 28
  • very nice! thanks! although it would be necessary to generate the dummy set for different partitions. – Carlos A. Arango Mar 09 '18 at 13:20
  • Here I have used a symbolic set, you can indeed generate a number based set for different partitions i.e., {1, 1, 2, 2, 3}. The code would work exactly as previous. – Anjan Kumar Mar 09 '18 at 13:53
1

This is just a repackaging of @Anjan's nice answer. I will make use of my function GatherByList:

GatherByList[list_, representatives_] := Module[{func},
    func /: Map[func,_] := representatives;
    GatherBy[list,func]
]

Then, I will define a function to produce a result for an input partition:

multiSet[partition_] := With[
    {
    perms = Permutations[Flatten @ Map[ConstantArray[Unique[], #]&] @ partition],
    elems = Range @ Total[partition]
    },

    GatherByList[elems, #]& /@ perms
]

Example:

multiSet[{2, 2, 1}]

{{{1, 2}, {3, 4}, {5}}, {{1, 2}, {3, 5}, {4}}, {{1, 2}, {3}, {4, 5}}, {{1, 3}, {2, 4}, {5}}, {{1, 3}, {2, 5}, {4}}, {{1, 4}, {2, 3}, {5}}, {{1, 5}, {2, 3}, {4}}, {{1, 4}, {2, 5}, {3}}, {{1, 5}, {2, 4}, {3}}, {{1, 3}, {2}, {4, 5}}, {{1, 4}, {2}, {3, 5}}, {{1, 5}, {2}, {3, 4}}, {{1, 4}, {2, 3}, {5}}, {{1, 5}, {2, 3}, {4}}, {{1, 3}, {2, 4}, {5}}, {{1, 3}, {2, 5}, {4}}, {{1, 5}, {2, 4}, {3}}, {{1, 4}, {2, 5}, {3}}, {{1, 2}, {3, 4}, {5}}, {{1, 2}, {3, 5}, {4}}, {{1, 2}, {3}, {4, 5}}, {{1, 5}, {2}, {3, 4}}, {{1, 4}, {2}, {3, 5}}, {{1, 3}, {2}, {4, 5}}, {{1}, {2, 3}, {4, 5}}, {{1}, {2, 4}, {3, 5}}, {{1}, {2, 5}, {3, 4}}, {{1}, {2, 5}, {3, 4}}, {{1}, {2, 4}, {3, 5}}, {{1}, {2, 3}, {4, 5}}}

Carl Woll
  • 130,679
  • 6
  • 243
  • 355
0

I found this other way of doing it:

ReplaceAll[#, 0 -> Nothing] & /@ 
 DeleteDuplicates[
  Sort /@ ArrayReshape[#, {3, 2}] & /@ Permutations[Range[5]]]

Although it is restriceted to subsets of 2,2, and 1 elements.

Carlos A. Arango
  • 41
  • 4
0

Another way of doing it:

1) define a grouping vector: 

grp = {1, 2, 2}

2) Define the indexes to use in Take (could this be improved by using Mod?)

grp2 = Union /@ 
  Transpose[List[Accumulate[grp] - grp + 1, Accumulate[grp]]]

or better:

grp2=Range[Accumulate[grp] - grp + 1, Accumulate[grp]]

3) Define a function with Take and grp2

take[x__] := Take[x, #] & /@ grp2

4) Find all the (Multinomial) subsets grouped according to grp

psubsets = DeleteDuplicates[Sort /@ take[#] & /@ Permutations[Range[5]]];
Carlos A. Arango
  • 41
  • 4