Subfactorial

Author

Eric W. Weisstein
November 13, 2008

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

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

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

Initialization

MakeBoxes[Subfactorial[n_],TraditionalForm]:=RowBox[{"!",MakeBoxes[n,TraditionalForm]}]

subfactorial[0]:=1
subfactorial[n_Integer]:=subfactorial[n]=n subfactorial[n-1]+(-1)^n
SetAttributes[subfactorial,Listable]

Enumeration

Subfactorial[Range[0,10]]

subfactorial/@Range[0,10]

Timings

Subfactorial[Range[10^3]];//Timing

Subfactorial[Range[10^4]];//Timing

Block[{$RecursionLimit=10^3},subfactorial[Range[10^3]]];//Timing

Block[{$RecursionLimit=10^4},subfactorial[Range[10^4]]];//Timing

Subfactorial[10^4]===subfactorial[10^4]

Plots

<<Utilities`Plot`
<<Utilities`Typesetting`

Real Axis

Plot[Through[{Re,Im}[Subfactorial[n]]],{n,-5,10},PlotRange->{-1.5,3},Method->{"AxesInFront"->False},Evaluated->True,BaseStyle->Thickness[.004],Epilog->{Red,PointSize[.02],Point[Table[{n,Subfactorial[n]},{n,0,10}]]},AxesLabel->{n,Subfactorial[n]}]

Complex Plane

ComplexPlot3D[Subfactorial[z],{z,-5,5}]

ComplexPlot3D[Subfactorial[z],{z,-5,5},"PolygonReduction"->.2]

ComplexContourPlot[Subfactorial[z],{z,-5,5}]

ComplexContourPlot[Subfactorial[z],{z,-5,5},Contours->10,"MeshRegions"->False,"PackGraphicsComplex"->True]

Powers of 10

Directly

Table[Digits[Subfactorial[10^n]],{n,4}]//Timing

Table[Digits[Floor[((10^n)!+1)/E]],{n,6}]//Timing

Table[Digits[Floor[((10^n)!+1)/E]],{n,8}]//Timing

Table[Digits[Round[(Gamma[10^n+1,-1])/E]],{n,4}]

Table[Digits[Round[(Gamma[10^n+1,-1])/E]],{n,8}]//Timing

...hangs...

Using Asymptotic Expansion

Series[(Gamma[z+1,-1])/E,{z,∞,1}]

Log[10,Normal[%]]

Log[10,Normal[Series[(Gamma[z+1,-1])/E,{z,∞,0}]]]

expr=Simplify[Simplify[%61,z>0]/.z->10^n,n∈Integers&&n≥0]

expr=FullSimplify[%/.z->10^n,n∈Integers&&n≥0]

Table[1+Floor[expr],{n,10}]//Timing

expr=FullSimplify[Normal[Series[Log[10,(Gamma[z+1,-1])/E],{z,∞,1}]],z∈Integers&&z>0]/.z->10^n

expr=Simplify[%/.(((-1))^(10^n))->1,n∈Integers&&n>0]

Table[1+Floor[expr],{n,10}]//Timing

*Almost* the Same as Factorial

Block[{$MaxExtraPrecision=Infinity},Table[Floor[Log[10,(10^n)!]+1],{n,0,8}]]//Timing

As Derangements

MyDerangements[n_]:=Select[Permutations[n],!Equal@@@(Or@@Transpose[{Range[n],#}])&]

(d1=Table[MyDerangements[n],{n,4}])//ColumnForm

(d2=Table[Derangements[n],{n,4}])//ColumnForm

Counts

Length/@d1

Length/@d2

Table[Subfactorial[n],{n,4}]

Primes

!n

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

Given by the recurrence equation !n ==n(!n+!(n+1)),so the sequence cannot contain  any odd  primes

Sums

n! (∑_(k=0)^n)((((-1))^k)/(k!))==(!n)

n!Sum[((((-1))^k)/(k!)),{k,0,n}]

FullSimplify[%]

(∑_(k=0)^n)k! (((-1))^(n-k)) (Binomial[n, k])==(!n)

s=Sum[Binomial[n,k](((-1))^(n-k))k!,{k,0,n}]

(∑_(k=0)^n)((n! (((-1))^(n-k)))/((n-k)!))==(!n)

Sum[(((((-1))^(n-k))n!)/((n-k)!)),{k,0,n}]

Generating Function

Regular

From Sasha, Nov 13, 2008

GeneratingFunction[Subfactorial[n],n,x]

Sum[Subfactorial[n] x^n,{n,0,Infinity}]

Sum[Subfactorial[n] x^n,{n,0,Infinity},Regularization->"Borel"]

Series[(E^(-1-1/x)*ExpIntegralEi[1+1/x])/x,{x,0,20},Assumptions->x>0]

CoefficientList[%,x]

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

SeriesCoefficient[(E^(-1-1/x)*ExpIntegralEi[1+1/x])/x,{x,0,n}]

Exponential

ExponentialGeneratingFunction[Subfactorial[n],n,x]

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

Sum[Subfactorial[n]((x^n)/(n!)),{n,0,10}]

Through[{Numerator,Denominator}[CoefficientList[%,x]]]

Series[((Exp[-x])/(1-x)),{x,0,10}]//Normal

SeriesCoefficient[((Exp[-x])/(1-x)),{x,0,n}]

FullSimplify[%,n∈Integers]

Formulas

((Γ(n+1,-1))/e)

Subfactorial[n]//FunctionExpand

n!Sum[((((-1))^k)/(k!)),{k,0,n}]//FullSimplify

⌊((n!+1)/e)⌋

For n≥1

Table[Floor[((n!+1)/E)],{n,0,10}]

Subfactorial[Range[0,10]]

Floor[((n!+1)/E)]//FunctionExpand//FullSimplify

⌊(e+(1/e)) n!⌋-⌊e n!⌋

For n≠1

Table[Floor[(E+(E^(-1)))n!]-Floor[E n!],{n,0,10}]

Floor[(E+(E^(-1)))n!]-Floor[E n!]//FunctionExpand//FullSimplify

Limit

(lim_(n->∞)) ((!n)/(n!))==(1/e)

Limit[((Subfactorial[n])/(Factorial[n])),n->∞]

Recurrence

a(n)==(n-1) (a(n-2)+a(n-1))

RSolve[{a[n]==(n-1)(a[n-1]+a[n-2]),a[1]==0,a[2]==1},a[n],n]

FullSimplify[%]

a(n)==n a(n-1)+(((-1))^n)

RSolve[{a[n]==n a[n-1]+(-1)^n,a[1]==0,a[2]==1},a[n],n]

FullSimplify[%]

Derivative and Integral

Derivative

FullSimplify[D[((Gamma[n+1,-1])/E),n]]

D[Subfactorial[x],x]

FunctionExpand[%]//FullSimplify

FullSimplify[%,x∈Integers&&x>0]

Derivative[1][Subfactorial][1]

N[%]

((MeijerG[{{},{1,1}},{{0,0,1+x},{}},-1])/E)+I π Subfactorial[x]/.x->1.

Plot[Through[{Re,Im}[((MeijerG[{{},{1,1}},{{0,0,1+x},{}},-1])/E)+I π Subfactorial[x]]],{x,0,2},Evaluated->True]

Integral of Derivative

Integrate[D[Subfactorial[x],x],x]

Integrate[FunctionExpand[D[Subfactorial[x],x]],x]//FullSimplify

Integrals

Indefinite

Integrate[Subfactorial[x],x]

Integrate[FunctionExpand[Subfactorial[x]],x]

(∫_(-1)^∞)(e^(-(x+1))) (x^n)dx==Subfactorial(n)

Integrate[(x^n)(E^(-(x+1))),{x,-1,∞}]

Continued Fractions

Subfactorial[Range[10]]

n!/E+(-1)^n(1/(n+2+ContinuedFractionK[-k,n+k+2,{k,∞}]))

N[Table[n!/E+(-1)^n(1/(n+2+ContinuedFractionK[-k,n+k+2,{k,100}])),{n,10}],50]

Table[ContinuedFractionK[-k,n+k+2,{k,200}],{n,5}]//N