# IntegerPartitions without duplicates

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.

• Maybe here? I think that yields the number of such partitions, but perhaps it can be adapted/ Commented Jan 12, 2016 at 5:31
• @march The codes listed in the link are somewhat better than Select[...], but they still would cause a memory problem for large inputs. Commented Jan 12, 2016 at 5:44
• In any case, that question looks the same as yours Commented Jan 12, 2016 at 5:52
• 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.
– ciao
Commented Jan 12, 2016 at 7:03
• 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. Commented Jan 12, 2016 at 10:17

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.

• 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]]]] Commented Jan 12, 2016 at 8:05

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]

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

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

The experts will not doubt have better constructive approaches.