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.

$\endgroup$
  • $\begingroup$ Where did you get TakeList? AFAIK that is not a built-in Mathematica function. $\endgroup$ – m_goldberg Mar 9 '18 at 1:12
  • 2
    $\begingroup$ Have you seen Subsets[] already? $\endgroup$ – J. M. is away Mar 9 '18 at 1:20
  • 2
    $\begingroup$ @m_goldberg TakeList was introduced in MMA 11.2 $\endgroup$ – Okkes Dulgerci Mar 9 '18 at 1:20
  • $\begingroup$ @OkkesDulgerci. Thanks. I'm still using 11.1 $\endgroup$ – m_goldberg Mar 9 '18 at 1:28
  • $\begingroup$ Tuples[Range[5], 1] and Tuples[Range[5],2]? $\endgroup$ – David G. Stork Mar 9 '18 at 1:31
4
$\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

$\endgroup$
  • $\begingroup$ very nice! thanks! although it would be necessary to generate the dummy set for different partitions. $\endgroup$ – Carlos A. Arango Mar 9 '18 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 '18 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}}}

$\endgroup$
  • $\begingroup$ Very Nice Carl! $\endgroup$ – Carlos A. Arango Mar 9 '18 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.

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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