# Totally orderless partition

This is a slight variation of: How to generate all possible orderless partitions of a list according to another list?

Consider each set following a partition a "box" and each element a "ball".

What are all the possible partitions where the balls are distinct but boxes are identical(i.e. no ordering among the boxes) and there is no ordering of the balls in a box?

(Note that @Mr. Wizard's answer covered the case where the balls inside any given box was orderless. I am going a step further and demanding the boxes to be treated identical.)

My attempt:

I assume that the partition sizes are non-decreasing(eg {1,2,2) for the set{1,2,3,4,5}) so that I can use OrderedQ to filter the identical(canonical) configurations.

part[a_List, p_List] := Module[{f, sym}, Attributes[f] = Orderless;
sym = Unique["x", Temporary] & /@ p;
ReplaceList[f @@ a,
With[{patt =
MapThread[Pattern[#1, Repeated[_, {#2}]] &, {sym, p}]}, (f @@
patt) /; OrderedQ[patt] == 0] -> List /@ sym]]


or

part[a_List, p_List] := Module[{f, sym}, Attributes[f] = Orderless;
sym = Unique["x", Temporary] & /@ p;
ReplaceList[f @@ a, ,
f @@ (patt :
Pattern[#1, Repeated[_, {#2}]] &, {sym, p}]) /; (OrderedQ[
patt] == 0) :> List /@ sym]]


Now, if one tries to evaluate:

part[{1, 2, 3, 4, 5}, {1, 2, 2}]


duplicates in :

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


like: {{1}, {2, 3}, {4, 5}} and {{1}, {4, 5}, {2, 3}} should not appear anymore.

But, none of them work. Help will be appreciated.

Edit 1:

This is another attempt I made, which returns the same answer. OrderedQ doesn't seem to work:

part[a_List, p_List] := Module[{f, sym}, Attributes[f] = Orderless;
sym = Unique["x", Temporary] & /@ p;
ReplaceList[f @@ a,
With[{patt =
MapThread[Pattern[#1, Repeated[_, {#2}]] &, {sym, p}]},
Rule[Condition[f @@ patt, OrderedQ[List /@ sym] == True],
List /@ sym]]]]

• Is DeleteDuplicatesBy[yourResult, Sort] what you are looking for? May 14 '18 at 1:33
• @MarcoB No. I don't want to use DeleteDuplicatesBy as it will probably be inefficient for a large list. I want to instead use OrderedQ or the likes as I have mentioned in my post. May 14 '18 at 1:49
• @MarcoB Can you just find the bug in my existing code? This is just a slight variation of Mr. Wizard's referenced answer from a long time back. May 14 '18 at 1:51

Say the output of your part function is called "list". Then

Union[Sort /@ list]


removes the duplicates.

• DeleteDuplicatesBy[list, Sort] would also achieve your same result; it avoids changing the sorting of the overall list, in case that is not desirable. May 14 '18 at 1:32

This works:

OrderlessPartition[set_List, part_List] :=
Module[{f, part2, list}, Attributes[f] = Orderless;
part2 = Sort@part;
list = Unique["x", Temporary] & /@ part2;
ReplaceList[f @@ set,
With[{list1 = list, list2 = List /@ list},

OrderlessPartition[Range[6], {1, 2, 3}]