4
$\begingroup$

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.

Improve this question
$\endgroup$
6
  • $\begingroup$ Where did you get TakeList? AFAIK that is not a built-in Mathematica function. $\endgroup$
    – m_goldberg
    Mar 9, 2018 at 1:12
  • 2
    $\begingroup$ Have you seen Subsets[] already? $\endgroup$
    – J. M.'s persistent exhaustion ♦
    Mar 9, 2018 at 1:20
  • 2
    $\begingroup$ @m_goldberg TakeList was introduced in MMA 11.2 $\endgroup$
    – OkkesDulgerci
    Mar 9, 2018 at 1:20
  • $\begingroup$ @OkkesDulgerci. Thanks. I'm still using 11.1 $\endgroup$
    – m_goldberg
    Mar 9, 2018 at 1:28
  • $\begingroup$ Tuples[Range[5], 1] and Tuples[Range[5],2]? $\endgroup$
    – David G. Stork
    Mar 9, 2018 at 1:31

4 Answers 4

Reset to default
5
$\begingroup$

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ very nice! thanks! although it would be necessary to generate the dummy set for different partitions. $\endgroup$
    – Carlos A. Arango
    Mar 9, 2018 at 13:20
  • $\begingroup$ 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. $\endgroup$
    – Anjan Kumar
    Mar 9, 2018 at 13:53
1
$\begingroup$

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

Improve this answer
$\endgroup$
1
  • $\begingroup$ Very Nice Carl! $\endgroup$
    – Carlos A. Arango
    Mar 9, 2018 at 16:41
0
$\begingroup$

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.

Improve this answer
$\endgroup$
0
$\begingroup$

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]]];
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.