NextKSizePartition, or how to partition a set into subsets of size $k$ but incrementally

Question

This question might seem very much like the linked one below but it differs in a very special way; Mr.Wizard suggested I start a new post:

Partition a set into subsets of size $k$

What I want is to generate all the partitions of a set into subsets of size $k$ but incrementally, that is, one by one, so that I can generate one, process the partition in some way, and then continue with the next one in some loop. Ideally, the program will give the partitions in some sorted way, and if started with some partition, it would go on to give the next one, and then the next one, and so on. One could think of this as the NextKSizePartition function which given a partition finds the next one, in some kind of order ... if the program were to return them in lexicographic order, then that would be even better. Of course, the set of elements has to be a multiple of $k$. Note that a function like this is not available in Combinatorica.

The rationale for wanting this is that if you want, say, the partitions of the set of numbers from 1 to 16 into sets of size 2, you already get over a million of them ... if you want 18, over 10 million, and son on. So very soon you get into numbers that don’t fit in memory, but can still be processed sequentially. In what I look for, the higher up I check for certain properties, the better, even if it is just an increment in the set size by 2 or 4. In the world of combinatorial and graph theoretical conjectures, there is a fine threshold of when something might fail and when it is likely to stand ...

I hope the request is clear

Answer 1

Here is my approach, building on Rojo's original from the linked quesiton. I use a primary function partition2 and two auxiliary functions f1 and f2.

I believe this is working but I have not tested it extensively yet.

Usage

• partitions2 spits out an object that includes continuation information.
• f1 extracts the partition for use.
• f2 produces the next partition object.

Example:

p = partitions2[Range@6, 2]
f1 @ p
f2 @ p

{{1, 2}, {3, 4}, {5, 6}, 〈{3, 4, 5, 6}, 2, 2, 3〉, 〈{1, 2, 3, 4, 5, 6}, 2, 2, 5〉}
{{1, 2}, {3, 4}, {5, 6}}
{{1, 2}, {3, 5}, {4, 6}, 〈{3, 4, 5, 6}, 2, 3, 3〉, 〈{1, 2, 3, 4, 5, 6}, 2, 2, 5〉}

check against the original partitions function:

{a, b} = {12, 3};
p1 = partitions[Range@a, b];
p2 = f1 /@ NestList[f2, partitions2[Range@a, b], Length@p1 - 1];
p1 === p2

True

Code

Update: replaced Inactive/Activate with AngleBracket and added argument tests.

ClearAll[partitions2, f1, f2]
partitions2[list : {__}, l_Integer?Positive] :=
  With[{ln = Length @ list},
    If[ln == l,
      {list},
      partitions2[list, l, 1, Binomial[ln - 1, l - 1]]
    ] /; Divisible[ln, l]
  ]
partitions2[list_, l_, n_, m_] /; n <= m :=
  {#, ## & @@ partitions2[list ~Complement~ #, l], 〈list, l, n + 1, m〉} & @@
    Subsets[list, {l}, {n}]
f1[{Longest[p__List], c___}] := {p}
f2[{p___, List, _List, 〈__, n, m_〉 /; n > m, cr___}] := f2 @ {p, {}, cr}
f2[{p___List, _, _, 〈c__〉, cr___}] := {p, ##, cr} & @@ partitions2[c]

---

Partition ranking

Here is a rank function to generate the continuation information from a given partition. At its core this uses RankKSubset from the old Combinatorica package; since loading that may cause conflicts I reproduce it here.

rank[p : {_}] := p
rank[p : {x_, y___List}] :=
  Module[{u, l, ln, r},
    u = Union @@ p;
    {l, ln} = Length /@ {x, u};
    r = RankKSubset @@ ArrayComponents[{x, u}];
    Join[{x}, rank[{y}], {〈u, l, r + 2, Binomial[ln - 1, l - 1]〉}]
  ]
(* Combinatorica function *)
RankKSubset[{}, s_List] := 0;
RankKSubset[ss_List, s_List] := 0 /; Length[ss] === Length[s];
RankKSubset[ss_List, s_List] := Position[s, ss[[1]]][[1, 1]] - 1 /; Length[ss] === 1;
RankKSubset[ss_List, s_List] := 
  Block[{n = Length[s], k = Length[ss], 
    x = Position[s, ss[[1]]][[1, 1]], $RecursionLimit = ∞}, 
   Binomial[n, k] - Binomial[n - x + 1, k] + RankKSubset[Rest[ss], Drop[s, x]]];

Testing:

rank[{{1, 2, 7}, {3, 8, 11}, {4, 6, 10}, {5, 9, 12}}]
% === Nest[f2, partitions2[Range@12, 3], 1325]

 {{1, 2, 7}, {3, 8, 11}, {4, 6, 10}, {5, 9, 12},
  〈{4, 5, 6, 9, 10, 12}, 3, 7, 10〉,
  〈{3, 4, 5, 6, 8, 9, 10, 11, 12}, 3, 22, 28〉,
  〈{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, 3, 6, 55〉}
True