# Obtain all the (multinomial) subsets

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.

• Where did you get TakeList? AFAIK that is not a built-in Mathematica function. Mar 9, 2018 at 1:12
• Have you seen Subsets[] already? Mar 9, 2018 at 1:20
• @m_goldberg TakeList was introduced in MMA 11.2 Mar 9, 2018 at 1:20
• @OkkesDulgerci. Thanks. I'm still using 11.1 Mar 9, 2018 at 1:28
• Tuples[Range, 1] and Tuples[Range,2]? Mar 9, 2018 at 1:31

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 = InternalPartitionRagged[#, {2, 2, 1}] & /@ Permutations[set];
res1 = DeleteDuplicates[Table[Map[Sort, allofthem[[i]]], {i, 1, Length[allofthem]}]];
Sort[(Sort /@ res)] == Sort[Sort /@ res1]


True

• very nice! thanks! although it would be necessary to generate the dummy set for different partitions. Mar 9, 2018 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. Mar 9, 2018 at 13:53

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}}}

• Very Nice Carl! Mar 9, 2018 at 16:41

I found this other way of doing it:

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


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

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]];
`