Partition Function Q

Author

Eric W. Weisstein
February 14, 2017

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Combinatorics/PartitionFunctionQ.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PartitionFunctionQ.html.

©2017 Wolfram Research, Inc. except for portions noted otherwise

Enumeration

PartitionsQ[Range[10]]

Q(n) is Prime

A035359

(p=Position[PartitionsQ[Range[10^3]],_?PrimeQ]//Flatten)//Timing

(p=Position[PartitionsQ[Range[10^4]],_?PrimeQ]//Flatten)//Timing

l={3,4,5,7,22,70,100,495,1247,2072,320397,3335367,16168775,37472505,52940251,78840125,81191852};

IntegerLength/@PartitionsQ[l]

$Version

DateString[]

Do[
Print[{i,l[[i]],IntegerLength[q=PartitionsQ[l[[i]]]]//Timing,PrimeQ[q]//Timing}],
{i,Length[l]}
]

Sums

(∑_(n=0)^∞)q(n) (x^n)==(1/(QPochhammer2[x, x]))

V8

$Version

Sum[PartitionsQ[n] x^(n),{n,0,Infinity}]

Generating Functions

Generating Function

Sum[PartitionsQ[n]x^n,{n,∞}]//FullSimplify

GeneratingFunction[PartitionsQ[n],n,z]

ExponentialGeneratingFunction

Sum[PartitionsQ[n]((x^n)/(n!)),{n,0,∞}]

ExponentialGeneratingFunction[PartitionsQ[n],n,z]

DirichletGeneratingFunction

Sum[((PartitionsQ[n])/(n^s)),{n,∞}]

Lambert Series

Sum[((PartitionsQ[n](x^n))/(1-(x^n))),{n,∞}]

Definition

Straightforward but Slow

PartitionsQCount1[n_]:=Count[Partitions[n],_?(UnsameQ@@#&)]
PartitionsQList1[n_]:=Select[Partitions[n],(UnsameQ@@#&)]

PartitionsQCount1/@Range[20]

PartitionsQ/@Range[20]

Much Faster

PartitionsJ[p_]:=Reduce`NaturalLinearSolve[{Range[p]},{p},True][[1]]
PartitionsQList[n_]:=Flatten[Position[#,1]]&/@Select[PartitionsJ[10],Max[#]==1&]

PartitionsQList1[40];//Timing

PartitionsQList[40];//Timing

Check

Equal@@Sort/@Map[Sort,{PartitionsQList1[30],PartitionsQList[30]},{2}]//Timing

Algorthims

Built-in

PartitionsQ[10^3]//Timing

PartitionsQ[10^4]//Timing

Table[PartitionsQ[10^5+n];//Timing,{n,5}][[All,1]]

Table[PartitionsQ[10^6+n];//Timing,{n,1}]

Do[Print[{n,IntegerLength[PartitionsQ[10^n]]//Timing}],{n,0,7}]

Recurrence

Generating function

Series[QPochhammer[(q^2),q],{q,0,3}]

(1/2)Series[QPochhammer[-1,q],{q,0,3}]

(1/2)SeriesCoefficient[QPochhammer[-1,q],{q,0,10^3}]//Timing

(1/2)SeriesCoefficient[QPochhammer[-1,q],{q,0,10^4}]//Timing

SeriesCoefficient[QPochhammer[(q^2)]/QPochhammer[q],{q,0,10^3}]//Timing

Generating Function

V8

GeneratingFunction[PartitionsQ[n],n,q]

FullSimplify[%]

(∏_n^∞)((1-(x^(2 n)))/(1-(x^n)))==((QPochhammer2[(x^2), (x^2)])/(QPochhammer2[x, x]))

Product[(1-x^(2n))/(1-x^n),{n,∞}]

Series[Product[(1-x^(2n))/(1-x^n),{n,20}],{x,0,10}]

Table[PartitionsQ[n],{n,20}]

(∏_m^∞)((x^m)+1)==((QPochhammer2[-1, x])/2)

Product[ (1 + x^m), {m, ∞}]

Series[Product[ (1+x^m),{m,1,200}],{x,0,10}]

(1/((∏_m^∞)(1-(x^(2 m+1)))))==((1-x)/(QPochhammer2[x, (x^2)]))

1/Product[ (1-x^(2m+1)),{m,∞}]

Series[1/Product[ (1-x^(2m+1)),{m,0,200}],{x,0,10}]

Product[(1-x^(2n))/(1-x^n),{n,10}]

Even

Table[PartitionsQ[n],{n,100}]

Select[Table[PartitionsQ[n],{n,100}],OddQ]

q=Table[PartitionsQ[n],{n,1000}];

ListPlot[Table[Count[Take[q,n],_?OddQ]/n,{n,1000}],PlotJoined->True,AxesLabel->TraditionalForm/@{n,"Fraction of odd" Q[n]},PlotStyle->Red]

Table[k(3k+i)/2,{i,-1,1,2},{k,10}]

PartitionsQ/@Flatten[%]

Rademacher-Type Sum

s[h_,k_]:=Sum[r/k(h r/k-Floor[h r/k]-1/2),{r,k-1}]
A[k_,n_]:=Plus@@(Function[h,Exp[Pi I(s[h,k]-s[2h,k])]Exp[-2Pi I h n/k]]/@Select[Range[k],GCD[#,k]==1&])

MyPartitionsQ[n_,kmax_]:=Plus@@Table[A[2k-1,n]Derivative[1][BesselJ[0,Pi I/(2k-1) Sqrt[1/3(#+1/24)]]&][n],{k,kmax}]/Sqrt[2]

FullSimplify[Derivative[1][BesselJ[0,Pi I/(2k-1) Sqrt[1/3(#+1/24)]]&][n]]

10

Table[MyPartitionsQ[10,n],{n,10,30,10}]//N//Timing

PartitionsQ[10]

100

PartitionsQ[100]//Timing

N[MyPartitionsQ[100,25],30]//Timing

Recurrence Relations

PartitionsQ[Range[20]]

Q(n_):=(1/n)(∑_k^n)(s(k)-2 s((k/2))) Q(n-k)

s[n_]:=If[Mod[n,1]==0,DivisorSigma[1,n],0]
q[n_]:=1/n Sum[(s[k]-2s[k/2])PartitionsQ[n-k],{k,n}]

q/@Range[10]

s[n_]:=Piecewise[{{DivisorSigma[1,n],Mod[n,1]==0}},0]

1/n Sum[(s[k]-2s[k/2])PartitionsQ[n-k],{k,n}]//InputForm

q[n_]:=1/n (Sum[DivisorSigma[1,k]PartitionsQ[n-k],{k,n}]-2Sum[DivisorSigma[1,k]PartitionsQ[n-2k],{k,n/2}])

q/@Range[20]

q[0]:=1
q[n_]:=1/n (Sum[DivisorSigma[1,k]q[n-k],{k,n}]-2Sum[DivisorSigma[1,k]q[n-2k],{k,n/2}])

q/@Range[10]

Q(n)=2 (∑_k^n)(((-1))^(k+1)) Q(n-(k^2))+s(n)

Table[Reduce[(n==j(3j+1)/2||n==j(3j-1)/2)&&j>0,j,Integers],{n,20}]

s[n_]:=Module[{j,soln},
soln=Reduce[(n==j(3j+1)/2||n==j(3j-1)/2)&&j>0,j,Integers];
If[soln===False,0,(-1)^soln[[-1]]]
]

Table[s[n],{n,30}]

q[0]:=1
q[n_]:=q[n]=s[n]+2Sum[(((-1))^(k+1))q[n-(k^2)],{k,(Sqrt[n])}]

q/@Range[20]

Block[{$MaxRecursion=Infinity},q[200]]

PartitionsQ[200]//Timing

Table[PartitionsQ[n],{n,1000,1500}];//Timing

PartitionsQ[1500]

Clear[q]

q[0]:=1
q[nn_]:=Module[{k,n},
Do[q[n]=s[n]+2Sum[(((-1))^(k+1))q[n-(k^2)],{k,(Sqrt[n])}],{n,nn}];
q[nn]
]

q/@Range[20]

Clear[q]

q[1500];//Timing

q[1500]

Partition Function Q(n,k)

partitionsq[n_,k_]:=PartitionsP[n] /; k≥n;
partitionsq[n_,0]:=0;
partitionsq[1,k_]:=1;
partitionsq[n_,k_]:=partitionsq[n,k-1]+partitionsq[n-k,k];

Select[Partitions[10],Length[#]≤2&]

{partitionsq[10,2],Length[%]}

Table[partitionsq[n,k],{n,6},{k,n}]//ColumnForm

Table[partitionsq[n,k],{n,6},{k,n}]//Flatten

{
{1+1+1+1+1},
{1+1+1+2,2+2+1},
{1+1+3,2+3},
{1+4},
{5}
}

a[n_]:=s[n]-2s[n/2]

Table[a[n],{n,10}]

s[n_Integer]:=DivisorSigma[1,n]
s[n_]:=0

q[0]:=1
q[1]:=1
q[n_]:=q[n]=Module[{k},Sum[(s[k]-2s[k/2])q[n-k],{k,n}]/n]

Table[q[n],{n,0,20}]

Table[PartitionsQ[n],{n,0,20}]

Q(n,k), Partitions into k distinct parts

Select[Partitions[10],Max[Length/@Split[#]]==1&&Length[#]==3&]

Table[
Length@Select[Partitions[n],Max[Length/@Split[#]]==1&&Length[#]==k&],{n,15},{k,n}]//ColumnForm

Table[ConstrainedIntegerPartitionsP[n-Binomial[k,2],k],{n,15},{k,n}]//ColumnForm