Ordered Factorization

Author

Eric W. Weisstein
November 29, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/NumberTheory/OrderedFactorization.nb.

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

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

Additional Authors

Knopfmacher, A. and Mays, M.  "Ordered and Unordered Factorizations of Integers.''  Mathematica J. 10, 72–89, 2006.

Initialization

<<DiscreteMath`Combinatorica`
<<NumberTheory`NumberTheoryFunctions`

Enumeration

OrderedFactorizations1[1]={{}};
OrderedFactorizations1[n_?PrimeQ]:={{n}}
OrderedFactorizations1[n_]:=Module[{d=Divisors[n],i},Flatten[Table[Prepend[#,d[[i]]]&/@OrderedFactorizations1[n/d[[i]]],{i,2,Length[d]}],1]]

OrderedFactorizations1/@Range[10]

Length/@%

OrderedFactorizations/@Range[1000];//Timing

OrderedFactorizations2[1]={{}};
OrderedFactorizations2[n_?PrimeQ]:={{n}}
OrderedFactorizations2[n_]:=
First/@Function[d,Prepend[#,d]&/@OrderedFactorizations2[n/d]]/@Rest[Divisors[n]]

OrderedFactorizations2/@Range[10]

OrderedFactorizations2/@Range[1000];//Timing

OrderedFactorizations[1]={{}};
OrderedFactorizations[n_?PrimeQ]:={{n}}
OrderedFactorizations[n_]:=OrderedFactorizations[n]=
Flatten[Function[d,Prepend[#,d]&/@OrderedFactorizations[n/d]]/@Rest[Divisors[n]],1]

OrderedFactorizations/@Range[1000];//Timing

Length[OrderedFactorizations[30^3]]

UnorderedFactorizations[m_,1]:={{}}
UnorderedFactorizations[1,n_]:={{}}
UnorderedFactorizations[m_,n_?PrimeQ]:=If[m<n,{},{{n}}]
UnorderedFactorizations[m_,n_]:=UnorderedFactorizations[m,n]=Module[{d},
Flatten[Function[d,Append[#,d]&/@UnorderedFactorizations[d,n/d]]/@Select[Divisors[n],1<#≤m&],1]
]
UnorderedFactorizations[1]:={{1}}
UnorderedFactorizations[n_]:=UnorderedFactorizations[n,n]

OrderedFactorizations3[n_]:=Flatten[Permutations /@UnorderedFactorizations[n],1]

Length[OrderedFactorizations3[30^3]]//Timing

Counts

Hille

First Recursion

H1[1]:=1
H1[n_]:=H1[n]=Plus@@H1/@Most[Divisors[n]]

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

Second Recursion

H2[1]:=1/2
H2[n_]:=H2[n]=-2Plus@@((-1)^Length[#]H2[n/Times@@#]&/@Rest[Subsets[PrimeFactorList[n]]])

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

MacMahon

PrimePowerList[n_]:=Last/@FactorInteger[n]

H3[n_]:=Sum[(-1)^i Binomial[j,i] Times@@(Binomial[#1+j-i-1,#]&)/@#,{j,Plus@@#},{i,0,j}]&[PrimePowerList[n]]

H3/@Range[10]

Product of two prime powers

H3[i_,j_]:=2^(i+j-1)Sum[(Binomial[i,k]Binomial[j,k])/2^k,{k,0,j}]

FullSimplify[H3[(Subscript[α, 1]),(Subscript[α, 2])],(Subscript[α, 1])>0&&(Subscript[α, 2])>0&&((Subscript[α, 1])|(Subscript[α, 2]))∈Integers]

{H3[2^3 3^4],H3[3,4],(2^(-1+(Subscript[α, 2]))) Hypergeometric2F1[-(Subscript[α, 1]),1+(Subscript[α, 2]),1,-1]/.{(Subscript[α, 1])->3,(Subscript[α, 2])->4}}

With Distinct Parts

DistinctOrderedFactorizations1[n_]:=Select[OrderedFactorizations[n],Length[#]==Length[Union[#]]&]

(dof1=DistinctOrderedFactorizations1/@Range[1000]);//Timing

DistinctOrderedFactorizations1/@Range[10]

DistinctOrderedFactorizations[n_]:=Select[OrderedFactorizations[n],Unequal@@#&]

(dof2=DistinctOrderedFactorizations/@Range[1000]);//Timing

dof1==dof2

DistinctOrderedFactorizations/@Range[10]

Max/@Map[Length,DistinctOrderedFactorizations/@Range[2,50],{2}]

Counts

H[n_,1]:=1
H[1,k_]:=0
H[n_,0]:=0
H[1,0]:=1
H[1,1]:=0
H[n_ ?PrimeQ,k_]:=KroneckerDelta[k,1]
H[n_ /;(2^k)>n,k_]:=0
H[n_,k_]:=H[n,k]=(k-1)!*Sum[((-1)^j/(k-1-j)!)*Plus@@(H[n/#,k-1-j]&)/@Select[Rest[Divisors[n]],IntegerQ[#^(1/(j+1))]&],{j,0,k-1}]

H[24,#]&/@Range[0,Floor[Log[2,24]]]

Flatten[Last[Position[#,_?(#≠0&)]]&/@Table[H[n,k],{n,2,50},{k,Floor[Log[2,n]]}]]

Table[H[n,k],{n,50},{k,Floor[Log[2,n]]}]//TableForm