9
$\begingroup$

Mathematica can generate integer partitions of an integer $N$. For example, IntegerPartitions[4] quickly gives

{{4}, {3, 1}, {2, 2}, {2, 1, 1}, {1, 1, 1, 1}}

This is nice, but I wish to generate a partition given as $[N_1,N_2,\ldots,]$ with $\sum_{i}i N_i=N$, where $N_i$ counts the number of $i$ in the partition. For example, in the above-mentioned example of $N=4$, we would have

{{0, 0, 0, 1}, {1, 0, 1, 0}, {0, 2, 0, 0}, {2, 1, 0, 0}, {4, 0, 0, 0}}

How could I generate this with Mathematica?

$\endgroup$
8
$\begingroup$
myIP[int_] := Block[{ip = IntegerPartitions[int], r},
  r = Range[1, int];
  Tally[Join[r, #]][[All, 2]] - 1 & /@ ip]
$\endgroup$
  • $\begingroup$ Thank you! This also works! In my computer your code is fastest at say N=35. $\endgroup$ – user16070 Aug 29 '15 at 1:58
  • $\begingroup$ Why not r = Range[int]? $\endgroup$ – J. M. will be back soon Aug 29 '15 at 2:42
  • $\begingroup$ @Guesswhoitis. No reason, came from a routine I use for restricted partitions (so min/max may not be 1/arg)... $\endgroup$ – ciao Aug 29 '15 at 3:02
9
$\begingroup$

I needed to do this sometime ago while investigating Bell polynomial analogs. Normally, you'd do

FrobeniusSolve[Range[n], n]

but the fastest variation (and quite compact, too!) I found was

Outer[Count, IntegerPartitions[n], Range[n], 1]

A different approach

Some undocumented magic is needed for this approach; in particular, with the system setting "SparseArrayOptions" -> {"TreatRepeatedEntries" -> 1} that adds up entries in duplicate positions, we can write something like this:

SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> 1}];
cp[n_Integer?Positive] := SparseArray[Flatten[MapIndexed[
        Thread[Transpose[PadRight[{#2, #1}, Automatic, #2]] -> 1] &, 
        IntegerPartitions[n]]]]

This is slightly faster than my previous approach, but still slower than ciao's.


Finally, ciao's code can be optimized slightly, with a modest gain in speed:

myIP2[n_Integer?Positive] := Block[{r = Range[n], tmp},
      tmp = Tally[Join[r, #]] & /@ IntegerPartitions[n];
      tmp[[All, All, 2]] - 1]
$\endgroup$
  • 1
    $\begingroup$ Very nice with Outer. +1 $\endgroup$ – Edmund Aug 29 '15 at 0:24
  • $\begingroup$ Thank you so much! This is indeed compact and fast. $\endgroup$ – user16070 Aug 29 '15 at 1:56
  • $\begingroup$ MyIP is faster in my tests... yours? $\endgroup$ – ciao Aug 29 '15 at 1:58
  • $\begingroup$ @ciao, yes, yours seems to edge out mine for large integers. I came up with yet another variation, tho; wait... $\endgroup$ – J. M. will be back soon Aug 29 '15 at 2:43
  • $\begingroup$ Nice opts... +1 $\endgroup$ – ciao Aug 29 '15 at 4:04
4
$\begingroup$
nCountPartitions[int_Integer?Positive] :=
 Module[{partitions = IntegerPartitions[int], selectList},
  selectList = Function[{i}, Select[# == i &]] /@ Range[int];
  Length /@ Through[selectList[#]] & /@ partitions
  ]

nCountPartitions[4]
(* {{0, 0, 0, 1}, {1, 0, 1, 0}, {0, 2, 0, 0}, {2, 1, 0, 0}, {4, 0, 0, 0}} *)

selectList is a list of Select functions, one for each possible integer.

Function[{i}, Select[# == i &]] /@ Range[4]
(* {Select[#1 == 1 &], Select[#1 == 2 &], Select[#1 == 3 &], Select[#1 == 4 &]} *)

Each partition is passed Through to this list of functions that select out their matches. The Length of these select list are then taken.

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