Tag Info

New answers tagged

6

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


3

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


3

myIP[int_] := Block[{ip = IntegerPartitions[int], r}, r = Range[1, int]; Tally[Join[r, #]][[All, 2]] - 1 & /@ ip]


4

Ah, came across this from the "related" bar, time for a necro :-} Here's a direct and fast one-liner: numSST[t_, s_] := Block[{p = Normal[Times @@ (1 + x^s) + O[x]^(t + 1)], x = 1}, p];


2

Here's my implementation of satisfying the first two conditions. capPartitions[n_Integer, s_Integer, k_Integer] := Flatten[Table[ Join[ConstantArray[s, i], #] & /@ Select[IntegerPartitions[n - i s], AllTrue[#, # < s &] &], {i, k, 0, -1}], 1] Not extremely efficient, rather generates more possible partitions than necessary, ...


1

I slightly modified the set partition code from the book Computational Discrete Mathematics by Pemmaraju and Skiena. kSetPartitions[{}, 0] := {{}} kSetPartitions[s_List, 0] := {} kSetPartitions[s_List, k_Integer] := {} /; (k > Length[s]) kSetPartitions[s_List, k_Integer] := {Map[{#} &, s]} /; (k === Length[s]) kSetPartitions[s_List, k_Integer] := ...


15

Here is a totally different approach based on the fact that successive products forming the generating function are due to multiplication by a binomial $1+t*z^j$. Form a matrix $v$ of zeros with $n+1$ rows and $k+1$ columns. Initialize the top left corner to 1. Iterate $v=v+w$ where $w$ is the matrix $v$ shifted down by $j$ rows and to the right by 1. The ...


16

This seems pretty quick, particularly on larger cases / larger k, e.g. 451, 29, 101 finishes in a few seconds on the loungebook. N.B. - I have not tested this exhaustively, just thrown together from ideas... If[Min[#3, #1 - Tr@Range@(#2 - 1)] < 0, 0, SeriesCoefficient[QPochhammer[-x y, x, Min[#3, #1 - Tr@Range@(#2 - 1)]], {x , ...


17

Here is a summary of comments (before @ciao's best answer above), with a change in notation. These functions calculate the number of partitions of n into exactly k distinct parts of size at most m. NumberOfWays000[n_, k_, m_] := Count[Map[Length,Map[DeleteDuplicates, IntegerPartitions[n,{k},Range[m]]]], k] NumberOfWays001[n_, k_, m_] := ...



Top 50 recent answers are included