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

4 Answers 4

11
$\begingroup$
myIP[int_] := Block[{ip = IntegerPartitions[int], r},
  r = Range[1, int];
  Tally[Join[r, #]][[All, 2]] - 1 & /@ ip]
$\endgroup$
3
  • $\begingroup$ Thank you! This also works! In my computer your code is fastest at say N=35. $\endgroup$
    – user16070
    Aug 29, 2015 at 1:58
  • $\begingroup$ Why not r = Range[int]? $\endgroup$ Aug 29, 2015 at 2:42
  • $\begingroup$ @J.M. No reason, came from a routine I use for restricted partitions (so min/max may not be 1/arg)... $\endgroup$
    – ciao
    Aug 29, 2015 at 3:02
14
$\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$
5
  • 1
    $\begingroup$ Very nice with Outer. +1 $\endgroup$
    – Edmund
    Aug 29, 2015 at 0:24
  • $\begingroup$ Thank you so much! This is indeed compact and fast. $\endgroup$
    – user16070
    Aug 29, 2015 at 1:56
  • $\begingroup$ MyIP is faster in my tests... yours? $\endgroup$
    – ciao
    Aug 29, 2015 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$ Aug 29, 2015 at 2:43
  • $\begingroup$ Nice opts... +1 $\endgroup$
    – ciao
    Aug 29, 2015 at 4:04
7
$\begingroup$
Reverse@GroupTheory`Tools`IntegerPartitionCounts[4]

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

GroupTheory`Tools`IntegerPartitionCounts[70] // Length // AbsoluteTiming

{2.48625, 4087968}

$\endgroup$
6
$\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$
0

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.