4
$\begingroup$

I need to apply a function to integer partitions of many integers, but only the partitions without duplicate numbers. Select[IntegerPartitions[n], DuplicateFreeQ] is obviously too memory-consuming because it generates all partitions with duplicates first and then selects the partitions without any duplicates; it does not work for large n values (even 100 doesn't work).

Take a look at this:

Length@IntegerPartitions[85]
(* 30167357 *)

Length@Select[IntegerPartitions[85], DuplicateFreeQ]
(* 121792 *)

Only a small portion of the partitions have no duplicates. Is there a way to generate duplicate-free partitions without wasting so much memory?

Edit:

The purpose of this is to find the coefficient of any $x^n$ in: $$ \prod_{i\geq1} {(1+a_i x^i)} $$

The output of IntegerPartitions (without duplicates) is useful because it would simply be Plus @@ Times @@@ (parts[n] /. m_Integer :> a[m]). Coefficient was very slow.

$\endgroup$
  • $\begingroup$ Maybe here? I think that yields the number of such partitions, but perhaps it can be adapted/ $\endgroup$ – march Jan 12 '16 at 5:31
  • $\begingroup$ @march The codes listed in the link are somewhat better than Select[...], but they still would cause a memory problem for large inputs. $\endgroup$ – JungHwan Min Jan 12 '16 at 5:44
  • $\begingroup$ In any case, that question looks the same as yours $\endgroup$ – Dr. belisarius Jan 12 '16 at 5:52
  • $\begingroup$ How big and how fast do you need this to be? No matter what, it's going to run out of RAM for bulk generation (e.g., by 200 there are 487,067,746 partitions with distinct elements, by 220 there are 1,586,861,606). Even better, elucidation of what you're trying to accomplish (why do you need partitions of this type) might help, there may be a clever way to get to the end result. $\endgroup$ – ciao Jan 12 '16 at 7:03
  • 3
    $\begingroup$ Exactly this question was asked some time ago on SO. If you use getPartitions from my answer there, as getPartitions[85, Range[85]] // Length, you get 121792. $\endgroup$ – Leonid Shifrin Jan 12 '16 at 10:17
3
$\begingroup$

This, based on stackoverflow iterative partitions lets you generate those partitions incrementally and will let you discard those which contain duplicates as you go.

First some test data to make sure this works

Length[IntegerPartitions[20]]

which returns 627 and

Length[Select[IntegerPartitions[20], DuplicateFreeQ]]

which returns 64.

Now a test case which does not discard the duplicates.

partition[target_, maxValue_, suffix_] :=
  If [target == 0, Sow[suffix],
    If [maxValue > 1, partition[target, maxValue-1, suffix]];
    If [maxValue <= target,
      partition[target-maxValue, maxValue, Join[{maxValue}, suffix]]]];
Length[Reap[partition[20, 20, {}]][[2, 1]]]

which returns 627 and finally the version which does discard duplicates

partition[target_, maxValue_, suffix_] :=
  If [target == 0, If[Length[suffix] == Length[Union[suffix]], Sow[suffix]],
    If [maxValue > 1, partition[target, maxValue-1, suffix]];
    If [maxValue <= target,
      partition[target-maxValue, maxValue, Join[{maxValue}, suffix]]]];
Length[Reap[partition[20, 20, {}]][[2, 1]]]

which returns 64.

So the translation into Mathematica looks like it might be working correctly. This also appears to work with substantially larger numbers without running out of memory, but for larger numbers it is going to take substantial time. This looks like it might be a candidate for Compile and it might be feasible to "turn this inside out" to create a generator which could be called repeatedly to generate NextIntegerPartition each time, but I'll leave those ideas for another question.

Can you either replace that Sow[suffix] with Sow[yourFunction[suffix]] or possibly just do your calculations on suffix without Sow[suffix], which should allow much larger n at the expense of likely stunning run times?

But this does appear to satisfy your requirement of generating integer partitions and discard duplicates possibly without needing to hold all of the results in memory at once.

$\endgroup$
  • $\begingroup$ Both your versions iterate through partitions with duplicates, the latter only does not sow them. To avoid wasting time on this, we can do: partition[target_, maxValue_, suffix_] := If[target == 0, Sow[suffix], If[maxValue > 1, partition[target, maxValue - 1, suffix]]; If[0 < maxValue <= target, partition[target - maxValue, maxValue - 1, Join[{maxValue}, suffix]]]] $\endgroup$ – Marius Ladegård Meyer Jan 12 '16 at 8:05
2
$\begingroup$

I post this as a modest gain in efficiency. Consider the partition $N$ into distinct integers in ascending order. Let $T_n$ be the largest triangular numberless than $N$. So if there can be a partition of $m>n$ integers then $N=\sum_{j=1}^m a_j$. Now, $N=T_n+\delta<T_{n+1}$ where $0\leq\delta<n+1$. As $a_1\ge1$ and $a_{i+1}-a_i\ge1$ then $N\ge T_{n+1}$: a contradiction. Hence, the the search up to $n$ limits the search space, e.g. need only search up to partitions of length 12.

  ip[num_] := 
 Module[{t}, 
  t[n_] := Floor[x] /. NSolve[x^2 + x - 2 n == 0 && x > 0, x][[1]];
  Select[IntegerPartitions[num, t[num]], DuplicateFreeQ]]

Note:

  • Length@ip[85] is 121792
  • still exponential time

    res = {#, Timing[ip@#][[1]]} & /@ Range[85];
    ListPlot[res]
    

enter image description here

func[n_] := Select[IntegerPartitions[n], DuplicateFreeQ]
res2 = {#, Timing[func[#]][[1]]} & /@ Range[60];
ListPlot[{res, res2}, Joined -> True, PlotLegends -> {"ip", "func"}]

enter image description here

...only a modest gain....and for the record ip[85] == func[85] yields True.

The experts will not doubt have better constructive approaches.

$\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.