3
$\begingroup$

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

$\endgroup$
  • $\begingroup$ Oh, I come to the impression that do a completely different thing: I generate all subsets of lenght k. That's is apparently not what you want. I delete my post. $\endgroup$ – Henrik Schumacher Nov 21 '19 at 15:35
  • $\begingroup$ @HenrikSchumacher Thank you nevertheless. $\endgroup$ – EGME Nov 21 '19 at 15:36
  • $\begingroup$ Related 9554 and this. $\endgroup$ – Rohit Namjoshi Nov 21 '19 at 17:47
  • $\begingroup$ I got to this late today, but I have a working proof of concept that I should be able to complete into something reusable and post tomorrow. $\endgroup$ – Mr.Wizard Nov 22 '19 at 3:29
  • $\begingroup$ What's wrong with say something like Subsets[Range@100, {4}, {10^6}] (giving the 10^6th subset of size 4 of the range [1,100]) - it pulls a given subset in a few hundred-thousandths of a second on a laptop... $\endgroup$ – ciao Nov 22 '19 at 23:52
5
$\begingroup$

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
$\endgroup$
  • $\begingroup$ Thank you!! ... it is a bit late today here but I will test this during the weekend ... $\endgroup$ – EGME Nov 22 '19 at 20:25
  • $\begingroup$ @EGME Can we start with the initial set elements sorted? If so I don't need to keep a separate list in the continuation information. $\endgroup$ – Mr.Wizard Nov 23 '19 at 14:55
  • $\begingroup$ Yes, this is perfectly acceptable ... hmm, I haven’t written your code into the computer yet ... I hope you don’t delete it ... I am trying to figure out how it works ... I have a technical question ... will this be of the kind that it will have a lot of information stored before it actually gets to the first complete partition (like in Rojo’s code) ...?? $\endgroup$ – EGME Nov 23 '19 at 14:58
  • $\begingroup$ @EGME (1) I won't delete it, but even if I did you can always look at past revisions by clicking the "edited ..." link below-center of the post body. (2) I'm not sure I understand what you mean, but if I do: no, this really does generate these one at a time, so e.g. you can do partitions2[Range@1000, 100] and it won't just grind away for eternity. $\endgroup$ – Mr.Wizard Nov 23 '19 at 15:02
  • $\begingroup$ Ok, excellent, then it seems it gets you one at a time ... I will get around to it ... I might need to ask you questions ... I am doing serious multitasking here ... hmm, I dont see the “edited” link in my pages ... anyway ... thank you ... your simplified code will probably be good to see ... $\endgroup$ – EGME Nov 23 '19 at 15:06

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.