6
$\begingroup$

I tried to compute IntegerPartitions[100] using mathematica on my intel core i3 system. the system hangsup everytime. Is there another way to do such a large computation?

$\endgroup$
5
  • 2
    $\begingroup$ Assume it is possible. What would you do with this result? Will it be in some ways useful? $\endgroup$
    – yarchik
    Jul 22 '16 at 7:21
  • $\begingroup$ s I need to compute a frequency plot of each number across all partitions of n. e.g freq of occurrence of 1, 2,3,4 and 5 across all partitions of 5 $\endgroup$ Jul 22 '16 at 7:43
  • $\begingroup$ It might be possible to do it. Can you please provide an illustration of what kind of frequency plot are you expecting for, say 20, instead 100? $\endgroup$
    – yarchik
    Jul 22 '16 at 7:50
  • $\begingroup$ It is what you are looking for IntegerPartitions[5] // Flatten // Histogram? $\endgroup$
    – yarchik
    Jul 22 '16 at 7:54
  • $\begingroup$ what other visualisations apart from histogram can i obtain? $\endgroup$ Jul 22 '16 at 8:35
12
$\begingroup$

There are 190,569,292 unrestricted integer partitions of 100 (PartitionsP@100).

This will need >1gb of RAM just to keep the final result.

You can generate them in blocks, e.g., partitions 3000000-3000010:

IntegerPartitions[100, All, All, {3000000, 3000010}]

In any case, you'll be looking at a long computation.

However, if you're just after the tally of the members of the unrestricted partitions (that's my interpretation based on OP and responses to comments), this will be quite snappy (e.g., takes a few hundredths of a second for tally of partitions of 100 on an ancient netbook) - returns results as would Sort@Tally@Flatten@IntegerPartitions[...], use results as desired for visualization:

partTally[m_] := Module[{t},
  t[n_, n_] = 1;
  t[n_, k_] /; k < n := t[n, k] = t[n - k, k] + PartitionsP[n - k]; 
  t[_, _] = 0;
  Table[{z, t[m, z]}, {z, 1, m}]];

Usage example:

result=partTally[100];
Short[result]
ListPlot[result, PlotRange -> All, InterpolationOrder -> 0, Joined -> True];

{{1, 1452423276}, {2, 681391671}, {3, 425625071}, <<94>>, {98, 2}, {99, 1}, {100, 1}}

enter image description here

$\endgroup$
9
$\begingroup$

You may use PartitionsP to skip calculating the partitions. This will improve performance "infinity-fold" (in practical terms) for the integer frequency counts on larger numbers.

ClearAll[integerPartitionFrequency];
integerPartitionFrequency[number_Integer, int_Integer] := 
 Total@PartitionsP[Range[number - int, 0, -int]]

Then compare

KeySort@Counts@Flatten@IntegerPartitions[10]
(* <|1 -> 97, 2 -> 41, 3 -> 21, 4 -> 13, 5 -> 8, 6 -> 5, 7 -> 3, 8 -> 2, 9 -> 1, 10 -> 1|> *)

and

Association @@ Function[{num}, (# -> integerPartitionFrequency[num, #] & /@ Range[num])][10]
(* <|1 -> 97, 2 -> 41, 3 -> 21, 4 -> 13, 5 -> 8, 6 -> 5, 7 -> 3, 8 -> 2, 9 -> 1, 10 -> 1|> *)

integerPartitionFrequency makes use of the partitions being combinations instead of permutations. It calculates the number of partitions of number with int in position 1 (leaving number- int to partition), then with int in position 1 and 2 (leaving number- 2 int to partition), then with int in position 1, 2, and 3 (leaving number- 3 int to partition), and so on while $\text{number} - n \text{int} \geq 0$. Then it Totals these counts.

Take number = 4 and int = 2. Then

  • 2 in position 1 -> PartitionsP[number - int] == PartitionsP[2] == 2
  • 2 in position 1 and 2 -> PartitionsP[number - 2 int] == PartitionsP[0] == 1

Giving a frequency of 3 for int = 2. This matches with the number of 2's in IntergerPartitions[4]. Since PartitionsP threads over lists then Range is used to produce the list of $\text{number} - n \text{int}$ values.

Now for 100this returns immediately.

Association @@ 
 Function[{num}, (# -> integerPartitionFrequency[num, #] & /@ 
     Range[num])][100]
(*
<|1 -> 1452423276, 2 -> 681391671, 3 -> 425625071, 4 -> 298674842, 
 5 -> 223239954, 6 -> 173559786, 7 -> 138586227, 8 -> 112799928, 
 9 -> 93128655, 10 -> 77732922, 11 -> 65437378, 12 -> 55461711, 
 13 -> 47261866, 14 -> 40451977, 15 -> 34745939, 16 -> 29931593, 
 17 -> 25844039, 18 -> 22357203, 19 -> 19369326, 20 -> 16800909, 
 21 -> 14585738, 22 -> 12671374, 23 -> 11012882, 24 -> 9574403, 
 25 -> 8324449, 26 -> 7237775, 27 -> 6291737, 28 -> 5468189, 
 29 -> 4750480, 30 -> 4125348, 31 -> 3580375, 32 -> 3105717, 
 33 -> 2692000, 34 -> 2331869, 35 -> 2018162, 36 -> 1745348, 
 37 -> 1507935, 38 -> 1301731, 39 -> 1122507, 40 -> 967094, 
 41 -> 832205, 42 -> 715451, 43 -> 614289, 44 -> 526900, 45 -> 451318,
  46 -> 386177, 47 -> 329942, 48 -> 281594, 49 -> 239945, 
 50 -> 204227, 51 -> 173525, 52 -> 147273, 53 -> 124754, 54 -> 105558,
  55 -> 89134, 56 -> 75175, 57 -> 63261, 58 -> 53174, 59 -> 44583, 
 60 -> 37338, 61 -> 31185, 62 -> 26015, 63 -> 21637, 64 -> 17977, 
 65 -> 14883, 66 -> 12310, 67 -> 10143, 68 -> 8349, 69 -> 6842, 
 70 -> 5604, 71 -> 4565, 72 -> 3718, 73 -> 3010, 74 -> 2436, 
 75 -> 1958, 76 -> 1575, 77 -> 1255, 78 -> 1002, 79 -> 792, 80 -> 627,
  81 -> 490, 82 -> 385, 83 -> 297, 84 -> 231, 85 -> 176, 86 -> 135, 
 87 -> 101, 88 -> 77, 89 -> 56, 90 -> 42, 91 -> 30, 92 -> 22, 
 93 -> 15, 94 -> 11, 95 -> 7, 96 -> 5, 97 -> 3, 98 -> 2, 99 -> 1, 
 100 -> 1|>
*)

These can be directly plotted several ways. For example with ListPlot.

ListPlot[integerPartitionFrequency[100, #] & /@ Range[100], 
 Filling -> Axis, ScalingFunctions -> "Log"]

enter image description here

Hope this helps.

$\endgroup$
4
  • 1
    $\begingroup$ +1. Would you care to briefly explain the math behind this? $\endgroup$
    – LLlAMnYP
    Jul 22 '16 at 11:24
  • $\begingroup$ @LLlAMnYP Added explanation to the post. $\endgroup$
    – Edmund
    Jul 22 '16 at 12:38
  • $\begingroup$ now how do i plot this data? $\endgroup$ Jul 22 '16 at 14:21
  • $\begingroup$ @Ramprashanth See update. $\endgroup$
    – Edmund
    Jul 22 '16 at 15:16
4
$\begingroup$

Here is a combination of @ciao's suggesting and @yarchik's comment:

assoc = <||>; max = 70; step = 10000;
Do[assoc =
   Merge[
    {assoc, 
     Counts[Flatten[
       IntegerPartitions[max, All, 
        All, {n, Min[n + step - 1, PartitionsP[max]]}]]]}, Total],
  {n, 1, PartitionsP[max], step}] // AbsoluteTiming
(* 66 seconds *)
DiscretePlot[assoc[x], {x, 1, 70}]

enter image description here

Be aware, that PartitionsP[70] ~= 4 000 000. So for max == 100 the computation should take at least an hour (on my machine). I'm near confident, that there's an analytical solution.

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