Continued Fractions Article Summary Notebook:

▶ Summary Package and Working Notebook Document Information:

Author: Maxie D. Schmidt (maxieds@gmail.com)
Revision Information: 2015.10.30-v1
Required Local Package Files: Requires multifact-cfracs-summary.nb (this notebook)
Optional External Packages: The RISC Sigma package for Mathematica (Sigma.m package file).

▶ Package Description:

This prepared summary notebook file, with working filename multifact-cfracs-summary.nb, attached to the submission of this manuscript contains working Mathematica code to verify the formulas, propositions, and other identities cited in the article. Given the length of the article, the Mathematica summary notebook included with this submission is intended to help the reviewer to process the article more quickly, and to help the reader with verifying and modifying the examples presented as applications of the new results cited below. The summary notebook also contains numerical data to verify examples and congruences specifically referenced in several of the applications given in the article.

▶ Definitions of Mathematica Routines and Helper Functions:

The local working notebook file contains definitions of Mathematica routines and helper functions, as well as definitions of specific identities referenced within the article intended to assist with more quickly verifying that these formulas are correct as listed in the manuscript text. The required subroutines contained in this package are loaded by entering the following lines:

FP[h_, alpha_, R_, z_]:=FP[h,alpha,R,z]=If[h≤1, KroneckerDelta[h==1, True], (1-(R+2*alpha*(h-1))*z)*FP[h-1, alpha,R,z]-(alpha*R+(alpha^2)*(h-2))*(h-1)*(z^2)*FP[h-2, alpha,R,z]]
FQ[h_, alpha_, R_, z_]:=FQ[h,alpha,R,z]=If[h≤1, KroneckerDelta[h==0, True]+(1-R*z)*KroneckerDelta[h==1, True], (1-(R+2*alpha*(h-1))*z)*FQ[h-1, alpha,R,z]-(alpha*R+(alpha^2)*(h-2))*(h-1)*(z^2)*FQ[h-2, alpha,R,z]]
Conv[h_, alpha_, R_, z_]:=(FP[h, alpha,R,z]/FQ[h, alpha,R,z])

Clear[Chn,ChnV2,ChnV3]
Chn[h_,n_,alpha_,R_]:=Chn[h,n,alpha,R]=SeriesCoefficient[FP[h,alpha,R,z],{z,0,n}]
ChnV2[h_,n_,alpha_,R_]:=ChnV2[h,n,alpha,R]=Sum[Binomial[h,i]*Power[-1,i]*pn[i,-alpha,R+(h-1)*alpha]*pn[n-i,alpha,R],{i,0,n}]
ChnV3[h_,n_,alpha_,R_]:=ChnV3[h,n,alpha,R]=Sum[Binomial[h,i]*Power[-alpha,i]*pn[i,-alpha,R+(h-1)*alpha]*pn[n-i,alpha,R],{i,0,n}]
Rhk[h_,k_,alpha_,R_]:=Rhk[h,k,alpha,R]=SeriesCoefficient[FP[h,alpha,R,z],{R,0,k}]

S1[n_,k_]:=S1[n,k]=Power[-1,n-k]*StirlingS1[n,k]
S2[n_,k_]:=S2[n,k]=StirlingS2[n,k]
Fcf[alpha_,n_,k_]:=Fcf[alpha,n,k]=If[n≤0||k≤0,KroneckerDelta[n,k,0],(alpha n+1-2 alpha)*Fcf[alpha,n-1,k]+Fcf[alpha,n-1,k-1]]

E2[n_,m_]:=E2[n,m]=Which[
n==0&&m==0,1,
n<0||m<0,0,
True,(m+1)*E2[n-1,m]+(2n-1-m)*E2[n-1,m-1]
]
EulerianE2[n_,m_]:=E2[n,m]
EulerianE1[n_,m_]:=EulerianE1[n,m]=Factorial[n]*SeriesCoefficient[(1-w)/(Exp[(w-1)*z]-w),{w,0,m},{z,0,n}]

StirlingPoly[n_,x_]:=SeriesCoefficient[Power[z Exp[z]/(Exp[z]-1),x],{z,0,n}]/x
StirlingAlphaPoly[a_,n_,x_]:=SeriesCoefficient[Exp[(1-a)*z]*Power[a z Exp[a z]/(Exp[a z]-1),x],{z,0,n}]/x
StirlingPolyStar[n_,x_]:=StirlingPolyStar[n,x]=If[x>0,SeriesCoefficient[Power[z Exp[z]/(Exp[z]-1),x],{z,0,n}]*Factorial[x-1]*(x-n)/Factorial[x-n],1]

pn[n_,a_,R_]:=pn[n,a,R]=If[n≥1,Product[(R+a*j),{j,0,n-1}],KroneckerDelta[n,0]]
GouldG[n_,x_,a_,b_]:=x/(x- a n)*FallingFactorial[(x-a n)/b,n]
Hn[a_,n_,r_]:=Sum[Power[a k+1-a,-r],{k,1,n}]
Hn[a_,b_,n_,r_,t_]:=Sum[Power[a k+b,-r]*Power[t,k],{k,1,n}]

Spn[p_,n_]:=Sum[Power[m,p],{m,0,n-1}]
Spn[p_,u_,n_]:=Sum[Power[m,p]*Power[u,m],{m,0,n-1}]
Spn[p_,a_,b_,u_,n_]:=Sum[Power[a m+b,p]*Power[u,m],{m,0,n-1}]

AlphaFactorial[alpha_,n_]:=If[n≤0,KroneckerDelta[-alpha<n≤0,True],n*AlphaFactorial[alpha,n-alpha]]
FallingFactorial[x_,n_]:=FactorialPower[x,n]
RisingFactorial[x_,n_]:=Pochhammer[x,n]
PH[x_,n_]:=Pochhammer[x,n]
CentralBinomial[n_]:=Binomial[2n,n]

U[a_,b_,z_]:=U[a,b,z]=HypergeometricU[a,b,z]
M[a_,b_,z_]:=M[a,b,z]=Hypergeometric1F1[a,b,z]
Ln[n_,b_,x_]:=Ln[n,b,x]=LaguerreL[n,b,x]

PrimeCondFn[m_]:=Which[
PrimeQ[m],Style[#1,Bold,Background->Lighter[LightGreen],FontColor->Darker[Green]]&,
True,#1&
]

PrimePairCondFn[m_,primePairQ_]:=Which[
PrimeQ[m]&&primePairQ[m]==True,Style[#1,Bold,Background->Lighter[LightGreen],FontColor->Darker[Green]]&,
PrimeQ[m]==True,Style[#1,Bold,Background->Lighter[LightBlue],FontColor->Darker[Blue]]&,
True,(#1)&
]

PrimeTupleCondFn[m_,d_]:=Which[
PrimeQ[m]&&PrimeQ[m+d]==True,Style[#1,Bold,Background->Lighter[LightGreen],FontColor->Darker[Green]]&,
PrimeQ[m]==True,Style[#1,Bold,Background->Lighter[LightBlue],FontColor->Darker[Blue]]&,
True,(#1)&
]

ColorHightHighlightFn[color_]:=Style[#1,Bold,Background->Lighter[color],FontColor->Blend[{Black,Darker[color]},2/3]]&
ColorHightHighlightFn[fg_,bg_]:=Style[#1,Bold,Background->Lighter[bg],FontColor->Darker[fg]]&
PrimeTripleHighlightFn[m_,d1_,d2_,d3_]:=
Which[
PrimeQ[m+d1]&&PrimeQ[m+d2]&&PrimeQ[m+d3],ColorHightHighlightFn[Green,LightGreen],
PrimeQ[m+d1]&&PrimeQ[m+d2],ColorHightHighlightFn[Cyan,LightCyan],
PrimeQ[m+d1]&&PrimeQ[m+d3],ColorHightHighlightFn[Pink,LightPink],
PrimeQ[m+d2]&&PrimeQ[m+d3],ColorHightHighlightFn[Orange,LightOrange],
PrimeQ[m+d1],ColorHightHighlightFn[Blue,LightBlue],
True,(#1)&
];
PrimeTripleCondFn[m_,d1_,d2_,d3_]:=PrimeTripleHighlightFn[m,d1,d2,d3]

CheckMarkEquals[rhs_,lhs_:True,cmFontSize_:16]:=If[rhs==lhs,Framed[Style[✓,Background->LightGreen,Bold,Underlined,FontColor->Green,FontSize->cmFontSize],Background->LightGreen],Framed[Style[𝒳,Background->LightRed,Bold,Underlined,FontColor->Red,FontSize->cmFontSize],Background->LightRed]]

getMarkedSeriesData[sinput_,coeffCmpFn_]:=Module[{cflist,redGreenCoeffs,origSData,markedSeriesData},
cflist=CoefficientList[Normal[sinput],z];
redGreenCoeffs=MapIndexed[If[#===coeffCmpFn[First[#2]-1],Style[#1,Bold,FontColor->Green,Background->LightGreen],Style[#1,Bold,FontColor->Red,Background->LightRed]]&,cflist];
origSData=Map[sinput[[#1]]&,Range[1,Length[sinput]]];
origSData=ReplacePart[origSData,3->redGreenCoeffs];
markedSeriesData=SeriesData@@origSData;
Return[markedSeriesData];
]

getGenJSFracSeriesExample[seriesOGFCoeffFn_,exampleAFn_,exampleBFn_,convh_,zcfupper_,ModFn_:Mod[#1,#2,-1]&]:=Module[{cfz,cfzFS,cfzSeriesExp,expectedOGFApproxSum,diffSeries,modhTbl},
cfz=ContinuedFractionK[exampleAFn[n],exampleBFn[n],{n,1,convh},GenerateConditions-> True];
cfzFS=FS[cfz];
cfzSeriesExp=Series[cfz,{z,0,zcfupper}] // FS;
expectedOGFApproxSum=Sum[seriesOGFCoeffFn[n]*Power[z,n],{n,0,zcfupper}];
diffSeries=Collect[FS[(expectedOGFApproxSum)-Normal[cfzSeriesExp]],z^_,Factor];
modhTbl=Table[{Index->n,ModFn[seriesOGFCoeffFn[n],convh],ModFn[SeriesCoefficient[cfz,{z,0,n}],convh]},{n,1,zcfupper}];
Map[Print,{cfz,cfzFS,cfzSeriesExp,cexpectedOGFApproxSum,diffSeries,getMarkedSeriesData[cfzSeriesExp,seriesOGFCoeffFn],TF[modhTbl]}];
]
simplifySumOfTerms[input_,simpFn_:FullSimplify]:=Plus@@Map[simpFn,Table[input[[i]],{i,Range[1,Length[input]]}]]

Other shorthand function definitions for built-in Mathematica routines:

FS[input_]:=FullSimplify[input]
FE[input_]:=FunctionExpand[input]
PE[input_]:=PowerExpand[input]
TF[input_]:=TableForm[input]
CF[input_]:=ColumnForm[input]
MF[input_]:=MatrixForm[input]

Shortened draft:

▶ Shortened draft of the summary reference data prepared for the initial article submission:

This summary notebook document contains a shortened version of the contents in the full documentation to be released as in the reference [23]. This draft is prepared to accompany the submission of the article “Jaocbi Type Continued Fractions for the Ordinary Generating Functions of Generalized Factorial Functions” submitted to the Journal of Integer Sequences in 2015. Additional computations related to the examples in the article can be obtained by contacting the author by email at maxieds@gmail.com.

▶ §1: Introduction:

▶▶ Definitions of the generalized product sequences and α-factorial functions:

Definition of the generalized product sequences:
(Subscript[p, n])(α,R) := (∏_(j=0)^(n-1))(R+α j) + (KroneckerDeltaSeq[0,n])

nupper=12;
Table[{Index->n,(Subscript[p, n])[α,R], pn[n,α,R]},{n,0,nupper}] // TF

Definitions of the corresponding rising factorial (Pochhammer symbol), falling factorial, and factorial power sequences implemented by stock built-in Mathematica functions:

nupper=6;
Table[{Index->n,CF[{PHSymbol->TraditionalForm[HoldForm[Pochhammer[x,n]]],RisingFact->(x^(OverBar[n])),RisingFactorial[x,n], pn[n,1,x]}], CF[{FallingFact->(x^(UnderBar[n])),FE[FallingFactorial[x,n]],pn[n,-1,x]}], CF[{FactorialPower->TraditionalForm[HoldForm[FactorialPower[x,n,-a]]],Factor[FE[FactorialPower[x,n,-a]]],pn[n,a,x]}]},{n,0,nupper}] // TF

The single and double factorial functions, n! and n!!, are already implemented in Mathematica as Factorial[n] (or n!) and Factorial2[n](or n!!), respectively.   The next table compares these built-in function definitions with the package function AlphaFactorial[α, n] for the more general α-factorial function cases:

nupper=18;
Table[{Index->n,ToString[StringForm["`1`!", n]],AlphaFactorial[1,n],Factorial[n],
       Index->n, ToString[StringForm["`1`!!", n]],AlphaFactorial[2,n],Factorial2[n],n!!},{n,0,nupper}] // TF

Definitions of the generalized cases of the α-factorial functions for integers n ≥0, or n > -α:

(Subscript[n!, (α)]):= ({{{, ({{n × (Subscript[(n-α)!, (α)]), if n ≥ 1}, {1, if -α < n ≤ 0}})}})
 
The next table computes additional special cases of the more general α-factorial functions using the package function,AlphaFactorial[α, n]:

alphaupper=6;nupper=18;
Table[factfn[alpha,n]->AlphaFactorial[alpha,n],{n,0,nupper},{alpha,1,alphaupper}] // TF

Relations to the Gould Polynomials,(Subscript[G, n])(x;a,b):
The Gould polynomials are defined through the Pochhammer symbol to be
 (Subscript[G, n])(x;-a,-b) = (((-1))^n) × ((x (Pochhammer[((x-a n)/b), n]))/(x-a n)) 
and
(Binomial[-((n β+γ)/α), n-k]) ×(n-k)! = (Subscript[G, n-k])(-β k-γ;β,α) × (β n+γ)/(β k+γ)

nupper=4;
Table[{Index->n,CF[{FS[pn[n,a,b n+g]],FS[Power[a,n]*Pochhammer[(b n+g)/a,n]],FS[FE[Power[-a,n]*(b n+g)/g*GouldG[n,g,-b,-a]]]}],CF[{ProductSeqDiff->FS[pn[n,a,b (n+1)+g+a]]-FS[FE[Power[-a,n]/(-g/a)*GouldG[n+1,g,-b,-a]]],FS[pn[n,a,b (n+1)+g+a]]}],CF[{ProductSeqDiff->FS[pn[n,a,b (n)+g]]-FS[FE[Power[-a,n]/(-(g-a-b)/a)*GouldG[n+1,g-a-b,-b,-a]]],FS[pn[n,a,b (n)+g]]}]},{n,0,nupper}] // TF

nupper=12;
Table[BinomGPDiff[n,k]->FS[FE[Binomial[-(b n+g)/a,n-k]*Factorial[n-k]]]-
               FS[FE[GouldG[n-k,-g-k*b,b,a]*(b n+g)/(b k+g)]],{n,0,nupper},{k,0,n}] // TF

▶▶ The Generalized Coefficient Triangles from [MULTIFACTJIS]  (2010):

Definition of the Generalized  α-Factorial  Function Coefficient Triangles,(Subscript[[({{n}, {k}})], α]):
(Subscript[[({{n}, {k}})], α]) := (Subscript[(α n+1-2α) [({{n-1}, {k}})], α]) + (Subscript[[({{n-1}, {k-1}})], α]) +  (KroneckerDeltaSeq[0,n]) (KroneckerDeltaSeq[0,k])
Compute tables of the first few rows of the generalized triangle for a fixed α:

nkupper=6;
Table[fcf[n,k]->CF[{Fcf[α,n,k],Expand[Fcf[α,n,k]],Factor[Fcf[α,n,k]],FS[Fcf[α,n,k]]}],{n,0,nkupper},{k,0,n}] // TF

Generating functions for the rows of the triangle:

nupper=8;
Table[{Index->n,FS[Sum[Fcf[α,n+1,k+1]*Power[w,k],{k,0,n}]]-FS[SeriesCoefficient[Power[1-α z,-(w+1)/α],{z,0,n}]*Factorial[n]],FS[Sum[Fcf[α,n+1,k+1]*Power[w,k],{k,0,n}]]},{n,0,nupper}] // TF

Exponential generating function for the triangle for fixed lower indices (k+1):

nupper=8;
Table[FCFCoeffDiff[n,k]->{FS[Fcf[α,n+1,k+1]]-FS[SeriesCoefficient[Power[1-α z,-1/α]*Power[Log[1/(1-α z)],k]/Factorial[k]/Power[α,k],{z,0,n}]*Factorial[n]]},{n,0,nupper},{k,0,nupper}] // TF

Compute Tables of Special Cases of the Generalized α-Factorial Coefficient Triangles,(Subscript[[({{n}, {k}})], α]):

alpha=1;nkupper=10;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

alpha=2;nkupper=10;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

alpha=3;nkupper=10;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

alpha=4;nkupper=10;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

Polynomial expansions identities of n!,n!!,and(Subscript[n!, (α)])by the Generalized Stirling number triangles:
(1) Expansions of the Single Factorial Function
       (2) Expansions of the Double Factorial Functions 
       (3) Expansions of the α-Factorial Functions,(Subscript[n!, (α)])
       (4) Expansions of the α-Factorial Functions,(Subscript[(α n-d)!, (α)])

nupper=16;
Table[{Index->n,ToString[StringForm["`1`!", n]],CF[{Factorial[n],Sum[S1[n,m]*Power[n,m]*Power[-1,n-m],{m,0,n}],Sum[S1[n,m],{m,0,n}]}]},{n,1,nupper}] // TF

nupper=16;
Table[{Index->n,ToString[StringForm["`1`!!", n]],CF[{Factorial2[n],Sum[S1[Floor[n/2],m]*Power[n,m]*Power[-2,Floor[n/2]-m],{m,0,n}],Sum[S1[Floor[(n+1)/2],m]*Power[n,m]*Power[-2,Floor[(n+1)/2]-m],{m,0,n}],Sum[S1[Ceiling[n/2],m]*Power[n,m]*Power[-2,Ceiling[n/2]-m],{m,0,n}]}],ToString[StringForm["(2×`1`-1)!!", n]],CF[{AlphaFactorial[2,2 n-1],Factorial2[2n-1],Sum[Fcf[2,n,m]*Power[2 n,m-1]*Power[-1,n-m],{m,0,n}]}],ToString[StringForm["(2×`1`)!!", n]],CF[{AlphaFactorial[2,2 n],Factorial2[2n],Sum[2*Fcf[2,n,m]*Power[2 n+1,m-1]*Power[-1,n-m],{m,0,n}],Power[2,n]*Sum[S1[n,m],{m,0,n}]}]},{n,1,nupper}] // TF

nupper=8;alphaupper=6;
Table[afact[alpha,n]->CF[{Alpha->alpha,IndexN->n,ParamD->d,ToString["n(Subscript[!, (α)])"],ToString[StringForm["(`1`)(Subscript[!, (`2`)])",n,alpha]],FormulaDiffsMatch->{Sum[S1[Ceiling[(n-1)/alpha],m]*Power[-alpha,Ceiling[(n-1)/alpha]-m]*Power[n,m],{m,0,n}],Sum[S1[Ceiling[(n)/alpha],m]*Power[-alpha,Ceiling[(n)/alpha]-m]*Power[n,m],{m,0,n}],Sum[S1[Floor[(n+alpha-1)/alpha],m]*Power[-alpha,Floor[(n+alpha-1)/alpha]-m]*Power[n,m],{m,0,n}],Sum[Fcf[alpha,Ceiling[(n-1)/alpha]+1,m+1]*Power[-1,Ceiling[(n-1)/alpha]-m]*Power[n+1,m],{m,0,n}],Sum[S1[Floor[(n+alpha-1)/alpha],m]*Power[-alpha,Floor[(n+alpha-1)/alpha]-m]*Power[n,m],{m,0,n}],Sum[Fcf[alpha,Floor[(n+alpha-1)/alpha]+1,m+1]*Power[-1,Floor[(n+alpha-1)/alpha]-m]*Power[n+1,m],{m,0,n}]}===ConstantArray[AlphaFactorial[alpha,n],6],AlphaFactorial[alpha,n]}],{n,1,nupper},{alpha,1,alphaupper}] // TF

nupper=21;alphaupper=10;
nupper=8;alphaupper=6;
Table[afact[alpha,n]->CF[{Alpha->alpha,IndexN->n,ParamD->d,ToString["(αn-d)(Subscript[!, (α)])"],ToString[StringForm["(`1`×`2`-`3`)(Subscript[!, (`1`)])",a,n,d]],FormulaDiffsMatch->{Sum[Fcf[alpha,n+1,m+1]*Power[alpha n+1-d,m]*Power[-1,n-m],{m,0,n}],(alpha-d)*Sum[Fcf[alpha,n,m]*Power[alpha n+1-d,m-1]*Power[-1,n-m],{m,1,n}]}===ConstantArray[AlphaFactorial[alpha,alpha n-d],2],AlphaFactorial[alpha,alpha n-d]}],{alpha,1,alphaupper},{n,1,nupper},{d,0,alpha-1}] // TF

Expansions of the generalized product sequences, (Subscript[p, n])(±α,s±1) and (Subscript[p, n])(α,R),by the coefficients,(Subscript[[({{n}, {k}})], α]):

nupper=6;
Table[{Index->n,CF[{ProductSeqFromulaDiff->pn[n,α,s+1]-FS[Sum[Fcf[α,n+1,m+1]*Power[s,m],{m,0,n}]],pn[n,α,s+1],ProductSeqFromulaDiff->pn[n,-α,s-1]-FS[Sum[Fcf[α,n+1,m+1]*Power[s,m]*Power[-1,n-m],{m,0,n}]],pn[n,-α,s-1]}],CF[{ProductSeqFromulaDiff->pn[n,α,R]-FS[Sum[Fcf[α,n+1,m+1]*Power[R-1,m],{m,0,n}]],pn[n,α,R]}]},{n,0,nupper}] // TF

Definitions of the (Generalized) Stirling Convolution Polynomials,(Subscript[σ, n])(x)and(Subscript[σ, n]^((α)))(x),from [MULTIFACTJIS] (2010):
(Subscript[σ, n])(x) :=(Subscript[[({{x}, {x-n}})], 1]) × (((x-n-1)!)/(x!))  
and 
(Subscript[σ, n]^((α)))(x):=(Subscript[[({{x}, {x-n}})], α]) × (((x-n-1)!)/(x!))=[(z^n)]{(e^((1-α)z))× ((((((αze)^(αz))/((e^(αz))-1))))^x)}

nupper=8;
Table[{Index->n,CF[{TraditionalForm[ToExpression[ToString[StringForm["x \\sigma_{`1`}(x)",n]],TeXForm]],
      Factor[StirlingPoly[n,x]],FactorTerms[StirlingPoly[n,x]]}],CF[{x (Subscript[σ, n]^((α)))(x),Collect[x*StirlingAlphaPoly[α,n,x],x,Factor],Collect[x*StirlingAlphaPoly[α,n,x],α,Factor]}]},{n,0,nupper}] // TF

Known Identities and EGFs for the Binomial Coefficients,(Binomial[((s-1)/α), k])
Compute tables to verify the generalized coefficient triangle and polynomial sequence expansions, and then the generating function identities stated in the article:

nupper=6;
Table[gfcfs[n]->{FS[FE[Binomial[(s-1)/a,n]]]-FS[Sum[Fcf[a,n+1,n+1-m]*Power[-1,m]*Power[s,n-m]/Power[a,n]/Factorial[n],{m,0,n}]],FS[FE[Binomial[(s-1)/a,n]]]-FS[Sum[Power[-1,m]*(n+1)*StirlingAlphaPoly[a,m,n+1]*Power[s/a,n-m]/Power[a,m]/Factorial[n-m],{m,0,n}]],FS[FE[Binomial[(s-1)/a,n]]]},{n,0,nupper}] // TF

kupper=6;
Table[gfcfs[k]->{FS[FE[Binomial[(s-1)/a,k]]]-FS[SeriesCoefficient[Exp[(s-1+a)*z/a]*Power[-z*Exp[-z]/(Exp[-z]-1),k+1],{z,0,k}]],FS[FE[Binomial[(s-1)/a,k]]]-FS[SeriesCoefficient[-z*Exp[(s-1+a)*z/a]/(1+w z-Exp[z]),{w,0,k},{z,0,k}]],FS[FE[Binomial[(s-1)/a,k]]]},{k,0,kupper}] // TF

▶▶ Examples of the known J-fraction and S-fraction series:

▶▶▶ Special Case Infinite Fraction Series Examples Cited in the Introduction:

The Pochhammer Symbol,or Rising Factorial Function,J-Fraction expansions by the series defined by the function,(Subscript[R, 0])(x,z): 
Compute the first few convergents,(Subscript[Conv, h])(1,x;z), and the corresponding series coefficients modulo h:

RisingFactJFracExampleCoeffFn=Pochhammer[x,#1]&;
RisingFactJFracExampleAFn[k_]:=If[k==1,1,-(k-1)*(x+k-2)*Power[z,2]]
RisingFactJFracExampleBFn[k_]:=If[k<0,0,1-(x+2 k-2)*Power[z,1]]

convh=2;zcfupper=2 convh+4;
getGenJSFracSeriesExample[RisingFactJFracExampleCoeffFn,RisingFactJFracExampleAFn,RisingFactJFracExampleBFn,convh,zcfupper,PolynomialMod]

convh=3;zcfupper=2 convh+4;
getGenJSFracSeriesExample[RisingFactJFracExampleCoeffFn,RisingFactJFracExampleAFn,RisingFactJFracExampleBFn,convh,zcfupper,PolynomialMod]

convh=4;zcfupper=2 convh+4;
getGenJSFracSeriesExample[RisingFactJFracExampleCoeffFn,RisingFactJFracExampleAFn,RisingFactJFracExampleBFn,convh,zcfupper,PolynomialMod]

convh=5;zcfupper=2 convh+4;
getGenJSFracSeriesExample[RisingFactJFracExampleCoeffFn,RisingFactJFracExampleAFn,RisingFactJFracExampleBFn,convh,zcfupper,PolynomialMod]

J-Fraction Example I: (Single Factorial Function):
[(z^n)](Subscript[F, 1,h])(z) ↦ n!  if 0 ≤ n ≤ 2h 
n!  ≡  [(z^n)](Subscript[F, 1,h])(z) (mod h) ∀ n ≥ 0

JSFracExampleCoeffFn=Factorial;
JSFracExampleAFn[k_]:=If[k==1,1,-Power[k-1,2]*Power[z,2]]
JSFracExampleBFn[k_]:=If[k<0,0,1-(2k)*Power[z,1]]

convh=6;zcfupper=4 convh+5;
getGenJSFracSeriesExample[JSFracExampleCoeffFn,JSFracExampleAFn,JSFracExampleBFn,convh,zcfupper]

J-Fraction Example II: (Shifted Single Factorial Function):
[(z^n)](Subscript[F, 2,h])(z) ↦ (n+1)!  if 0 ≤ n ≤ 2h 
(n+1)!  ≡  [(z^n)](Subscript[F, 2,h])(z) (mod h) ∀ n ≥ 0

JSFracExampleCoeffFn=Factorial[#1+1]&;
JSFracExampleAFn[k_]:=If[k==1,1,-k*(k-1)*Power[z,2]]
JSFracExampleBFn[k_]:=If[k<0,0,1-(2k-1)*Power[z,1]]

convh=6;zcfupper=4 convh+5;
getGenJSFracSeriesExample[JSFracExampleCoeffFn,JSFracExampleAFn,JSFracExampleBFn,convh,zcfupper]

S-Fraction Example I: (Double Factorial Function):
[(z^(2n))](Subscript[F, 3,h])(z) ↦ (2n-1)!!  if 0 ≤ 2n ≤ 2h 
(2n-1)!!  ≡  [(z^(2n))](Subscript[F, 3,h])(z) (mod h) ∀ n ≥ 0

JSFracExampleCoeffFn=If[EvenQ[#1],Factorial2[#1-1],0]&;
JSFracExampleAFn[k_]:=If[k==1,1,-(k-1)*Power[z,2]]
JSFracExampleBFn[k_]:=If[k<0,1,1]

convh=6;zcfupper=4 convh+5;
getGenJSFracSeriesExample[JSFracExampleCoeffFn,JSFracExampleAFn,JSFracExampleBFn,convh,zcfupper]

S-Fraction Example II: (Catalan Numbers and Central Binomial Coefficient Sequences):
[(z^(2n))](Subscript[F, 4,h])(z) ↦ (CatalanNumber[n])  if 0 ≤ 2n ≤ 2h 
(CatalanNumber[n])  ≡  [(z^(2n))](Subscript[F, 4,h])(z) (mod h) ∀ n ≥ 0

JSFracExampleCoeffFn=If[EvenQ[#1],CatalanNumber[#1/2],0]&;
JSFracExampleAFn[k_]:=If[k==1,1,-Power[z,2]]
JSFracExampleBFn[k_]:=If[k<0,1,1]

convh=6;zcfupper=4 convh+5;
getGenJSFracSeriesExample[JSFracExampleCoeffFn,JSFracExampleAFn,JSFracExampleBFn,convh,zcfupper]

▶▶▶ Application from the Concluding Remarks:
          S-fraction generating functions Involving the central binomial coefficients and the Catalan numbers:

S-fraction series approximations to the Catalan number OGF and S-fraction series approximations to the central binomial coefficient OGF:

CatalanNumberSFracAFnParam[k_,z_]:=If[k==1,1,-1*Power[z,1]]
CatalanNumberSFracBFnParam[k_,z_]:=If[k<0,0,1]
CatalanNumberSFractionGF[h_,z_]:=ContinuedFractionK[CatalanNumberSFracAFnParam[n,z],CatalanNumberSFracBFnParam[n,z],{n,1,h}]
CentralBinomDerivGF[Cz_,z_]:=(z)*D[Cz,{z,1}]+Cz
CentralBinomSFractionGF[h_,z_]:=CentralBinomDerivGF[ContinuedFractionK[CatalanNumberSFracAFnParam[n,z],CatalanNumberSFracBFnParam[n,z],{n,1,h}],z]

{hupper,hlower,hdiff}={8,3,2};
getSFracSeriesDataMapFn[h_,sFracInput_,expectedCoeffFn_]:=Map[#1[sFracInput]&,{Factor,Apart[FS[#1]]&,getMarkedSeriesData[Series[#1,{z,0,h+2}],expectedCoeffFn]&}]
Table[{Index->h,CF[Flatten[{CatalanNumberSFracOGFData[h],
getSFracSeriesDataMapFn[h,CatalanNumberSFractionGF[h,z],CatalanNumber]}]],CF[Flatten[{CentralBinomialSFracOGFData[h],
getSFracSeriesDataMapFn[h,CentralBinomSFractionGF[h,z],CentralBinomial]}]]},{h,hlower,hupper,hdiff}] // TF

▶▶▶ Footnote: Regularized OGF Sums and Laplace-Borel Transformation Integrals:

Examples of Borel-Regularized Sums for the α-Factorial Function OGFs:
(∑_(n=0)^∞)n! (z^n)                ↦-(((e^(-1/z)) (Gamma2[0, -(1/z)]))/z)
(∑_(n=0)^∞)(n+1)! (z^n)      ↦(((e^(-1/z)) (Gamma2[-1, -(1/z)]))/(z^2)) 
(∑_(n=0)^∞)(2 n+1)!! (z^n) ↦(((e^(-(1/(2 z)))) (((-(1/z)))^(3/2)) (Gamma2[-(1/2), -(1/(2 z))]))/(2 (Sqrt[2])))
The particular cited special cases (Mathematica is able to generate these regularized sums automatically):

Sum[n! Power[z,n],{n,0,Infinity},Regularization->"Borel"]
Sum[(n+1)! Power[z,n],{n,0,Infinity},Regularization->"Borel"]
Sum[Factorial2[n] Power[z,n],{n,1,Infinity,2},Regularization->"Borel"]

Verify several known cases of exponenial generating function (EGF) identities for the generalized product sequences,(Subscript[p, n])(α,R) /n!
[(z^n)] (((1-z))^((a s)/b))   =((((-1))^n)/(n!))((((1/b)))^n) ×( (∏_(j=0)^(n-1))(a s-b j) )
[(z^n)] (((1+b z))^((a s)/b))=(1/(n!))×( (∏_(j=0)^(n-1))(a s-b j) ) 
(Subscript[p, n])(α,R) = n! × [(z^n)] (((1-α z))^(-R/α))

nupper=6;
Table[{Index->n,CF[{EGFCoeffDiff->FS[SeriesCoefficient[Power[1-z,a s/b],{z,0,n}]]-FS[Power[-1/b,n]/Factorial[n]*Product[(a s-b j),{j,0,n-1}]],FS[Power[-1/b,n]/Factorial[n]*Product[(a s-b j),{j,0,n-1}]]}],CF[{EGFCoeffDiff->FS[SeriesCoefficient[Power[1+z*b,a s/b],{z,0,n}]]-FS[1/Factorial[n]*Product[(a s-b j),{j,0,n-1}]],FS[1/Factorial[n]*Product[(a s-b j),{j,0,n-1}]]}],CF[{EGFCoeffDiff->FS[SeriesCoefficient[Power[1-a*z,-R/a],{z,0,n}]]-FS[1/Factorial[n]*pn[n,a,R]],FS[1/Factorial[n]*pn[n,a,R]]}]},{n,0,nupper}] // TF

Compute the regularized sum integrals:
(∫_0^∞)exp(-t) (((1-t z a))^(-(R/a)))dt ↦(e^(-(1/(a z)))) (((-a z))^(-(R/a))) (Gamma2[1-(R/a), -(1/(a z))]) (if a > 0)
(∫_0^∞)exp(-t) (((1-t z a))^(-(R/a)))dt ↦-(((e^(-(1/(a z)))) (ExpIntegralE[(R/a), -(1/(a z))]))/(a z)) (if a < 0)

zcfupper=12;
Integrate[Exp[-t]*Power[(1-t z*a),-R/a],{t,0,Infinity},Assumptions->a>0]
TraditionalForm[%[[1]]]
Series[%,{z,0,zcfupper},Assumptions->%%[[2]]] // FS

zcfupper=12;
Integrate[Exp[-t]*Power[(1-t z*a),-R/a],{t,0,Infinity},Assumptions->a<0]
TraditionalForm[%[[1]]]
Series[%,{z,0,zcfupper},Assumptions->%%[[2]]] // FS

zcfupper=12;
Series[-(((E^(-(1/(a z)))) ExpIntegralE[(R/a),-(1/(a z))])/(a z)),{z,0,zcfupper}] // FS
Series[(((E^(1/(a z))) ExpIntegralE[-(R/a),(1/(a z))])/(-a z)),{z,0,zcfupper}] // FS

Verify several more cases of these regularized OGF sums:

printHeaderFn=PrintNBText[StringForm["[ ========== : (α,R) := (`1`, `2`) : ==========]",#1,#2],Green,LightGreen,FontSize->24]&;
getGenReguarizedOGF[aval_,rval_,scfupper_:10]:=Module[{bogfz},
printHeaderFn[aval,rval];
bogfz=Sum[Power[a,n]*Pochhammer[1-r/a,n]*Power[z,n]/.(a->aval)/.(r->rval),{n,0,Infinity},Regularization->"Borel"];
Print[bogfz];
Print[Normal[Series[bogfz,{z,0,scfupper},Assumptions->Floor[Arg[z]/(2 Pi)]==0]]];
Print[Sum[AlphaFactorial[aval,aval n-rval]*Power[z,n],{n,0,scfupper}]];
]

scfupper=10;avrvPairs={{1,0},{1,-1},{2,0},{2,-1},{3,0},{3,1},{3,2}};
getGenReguarizedOGFBatchFn=getGenReguarizedOGF[#1,#2,scfupper]&;
Map[getGenReguarizedOGFBatchFn@@(#1)&,avrvPairs]

▶▶ Definitions of the generalized convergent functions:

Special cases of the generalized convergent functions:
The generalized product sequence convergent function expansions :

hupper=6;
Table[{Index->h, CF[{ConvFnH->h,Collect[Conv[h,a,R, z], z^_ ,Factor],FS[Collect[Conv[h,a,R, z], z^_ ,Factor]]}]}, {h,0,hupper}] // TF

Particular Special Cases of the Convergent Functions generating the α-factorial functions when α:=1,2,3:

hupper=6;
getConvFnData[h_,convFnParamsList_]:=Flatten[Map[{AlphaParam->#1[[1]],RParam->#1[[2]],FS[Conv[h,#1[[1]],#1[[2]], z]],Factor[Conv[h,#1[[1]],#1[[2]], z]]}&,convFnParamsList]]
Table[{Index->h, CF[getConvFnData[h,{{1,1}}]], Index->h,CF[getConvFnData[h,{{2,1},{2,2}}]], Index->h,CF[getConvFnData[h,{{3,1},{3,2},{3,3}}]]}, {h,1,hupper}] // TF

Series Expansions of the Generalized Convergent Functions,(Subscript[Conv, h])(α,R;z):
Approximate series generating the generalized products:

{scfupper,convhlower,convhupper}={12,2,6};
Table[{Index->h,CF[{FS[Series[Conv[h,a,R,z],{z,0,scfupper}]],getMarkedSeriesData[FS[Series[Conv[h,a,R,z],{z,0,scfupper}]],pn[#1,a,R]&]}]},{h,convhlower,convhupper}] // TF

Convergent function series enumerating special cases of the α-factorial functions:

localPrintHeaderFn[alpha_,r_,phSymbFrac_]:=PrintNBText[ToString[StringForm["[α = `1`, r = `2`, (`3`)_n]",alpha,r,InputForm[phSymbFrac]]]]
getSpecialCaseAlphaFacfFnConvFnData[h_,alpha_,rval_,phSymbolFraction_]:=Module[{phSymbolConvSeries,alphaFactFnConvSeries,expectedSeriesSum,expectedSeriesSumV2},
phSymbolConvSeries=Series[Conv[hval,alpha,phSymbolFraction, alpha z],{z,0,h}];
alphaFactFnConvSeries=Series[Conv[hval,alpha,rval, z],{z,0,h}];
expectedSeriesSum=Sum[AlphaFactorial[alpha,alpha n-rval]*Power[z,n],{n,0,h}];
expectedSeriesSumV2=Sum[Power[alpha,n]*Pochhammer[phSymbolFraction,n]*Power[z,n],{n,0,h}];
localPrintHeaderFn[alpha,rval,phSymbolFraction];
Map[Print,{phSymbolConvSeries,alphaFactFnConvSeries,expectedSeriesSum,expectedSeriesSumV2}];
]

convh=6;
PrintNBNewline["α = 1"]
Series[Conv[hval,1,1, z],{z,0,hval}]
Sum[Factorial[n]*Power[z,n],{n,0,hval}]
Series[Conv[hval,1,2, z],{z,0,hval}]
Sum[Factorial[n+1]*Power[z,n],{n,0,hval}]

convh=6;spCaseConvFnSeriesParams={{1,1,1},{1,1,2},{2,1,1/2},{2,2,1},{3,1,2/3},{3,2,1/3},{3,3,1}};
Map[getSpecialCaseAlphaFacfFnConvFnData@@Prepend[#1,convh]&,spCaseConvFnSeriesParams];

The first several cases of the convergent numerator functions,(Subscript[FP, h])(α,R;z):
Tables of the numerator functions gathered by powers of z:

hupper=6;
Table[{Index->h, Collect[FP[h,a,R, z], z^_ ,Factor]}, {h,0,hupper}] // TF

The first several cases of the convergent denominator functions,(Subscript[FQ, h])(α,R;z):
Tables of the denominator functions gathered by powers of z:

hupper=6;
Table[{Index->h, Collect[FQ[h,a,R, z], z^_ ,Factor]}, {h,0,hupper}] // TF

Verify the noted expansions of the sequence by the special functions before we prove these results in Section 5:

hupper=12;
Table[{Index->h, Collect[FQ[ h,a,R, z]-Power[a z,h]*HypergeometricU[-h,R/a,1/(a z)], z^_ ,Factor], Collect[FQ[ h,a,R, z]-Power[-a z,h]*Pochhammer[R/a,h]*Hypergeometric1F1[-h,R/a,1/(a z)], z^_ ,Factor], Collect[FQ[ h,a,R, z]-Power[-a z,h]*Factorial[h]*LaguerreL[h,R/a-1,1/(a z)], z^_ ,Factor]}, {h,0,hupper}] // TF

▶ §2: Examples of the new results in the article:

▶▶ Sequence generating function examples:

▶▶▶ Verify the first few examples of the arithmetic progression sequences cited in the introduction:

CheckSeqExample[seqText_,a_,d1_,m1_,d2_,nupper_:6]:={seqText,TraditionalForm[HoldForm[m1 AlphaFact[a,a n+d1]]],Table[m1*AlphaFactorial[a,a n+d1],{n,1,nupper}],Table[SeriesCoefficient[Conv[n,-a,a n+d1,z],{z,0,n}],{n,1,nupper}],TraditionalForm[Power[a,n]*Pochhammer[d2/a,n]],Table[Power[a,n]*Pochhammer[d2/a,n],{n,1,nupper}],Table[SeriesCoefficient[Conv[n,a,d2,z],{z,0,n}],{n,1,nupper}]}
FormatCheckSeqExamples[exData_]:=Text@Grid[Prepend[exData,{"Sequence #","SeqFn","Data","ConvGF Data","SeqFn","Data","ConvGF Data"}],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Center,Left,Left,Center,Left,Left}},Dividers->{{True,True,False,False,True,False,False,True}}]

nupper=6;
exData={
CheckSeqExample["A00142",1,0,1,1,nupper],
CheckSeqExample["A001147",2,0,1,2,nupper],
CheckSeqExample["A000165",2,-1,1,1,nupper],

CheckSeqExample["A032031",3,0,1,3,nupper],
CheckSeqExample["A008544",3,-1,1,2,nupper],
CheckSeqExample["A007559",3,-2,1,1,nupper],

CheckSeqExample["A047053",4,0,1,4,nupper],
CheckSeqExample["A007696",4,1,1,5,nupper],
CheckSeqExample["A000407",4,2,1/2,6,nupper],
CheckSeqExample["A034176",4,3,1/3,7,nupper]
};
exData // FormatCheckSeqExamples

▶▶▶ Verify the next few examples of the α-factorial function sequences cited in the introduction:

CheckSeqExampleV2[seqText_,a_,cfOffset_,nupper_:6]:={seqText,TraditionalForm[HoldForm[AlphaFact[a,n]]],Table[AlphaFactorial[a,n],{n,1,nupper}],Table[SeriesCoefficient[Conv[n,-a, n,z],{z,0,Floor[(n+cfOffset)/a]}],{n,1,nupper}]}
FormatCheckSeqExamplesV2[exData_]:=Text@Grid[Prepend[exData,{"Sequence #","SeqFn","Data","ConvGF Data"}],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Center,Left,Left}},Dividers->{{True,True,False,False,True}}]

nupper=15;
exData={
CheckSeqExampleV2["A006882",2,1,nupper],
CheckSeqExampleV2["A007661",3,2,nupper],
CheckSeqExampleV2["A007662",4,3,nupper],
CheckSeqExampleV2["A085157",5,4,nupper],
CheckSeqExampleV2["A085158",6,5,nupper]
};
exData // FormatCheckSeqExamplesV2

▶▶▶ Verify special cases of the last convergent-based generating function identities for the α-factorial functions, (Subscript[(n+1-α)!, (α)]) and (Subscript[n!, (α)]):

alphaupper=5;nupper=18;
Table[terms[alpha,n]->{AlphaFactorial[alpha,n+1-alpha],If[n+1-alpha≥1,SeriesCoefficient[(1-z^(alpha))/(1-z)*Conv[n+1-alpha,-alpha,n+1-alpha,z^(alpha)],{z,0,n}],1]},{n,1,nupper},{alpha,1,alphaupper}] // TF

alphaupper=5;nupper=18;
Table[terms[alpha,n]->{AlphaFactorial[alpha,n],SeriesCoefficient[(1-z^(alpha))/(1-z)*Conv[n,-alpha,n,z^(alpha)],{z,0,n+alpha-1}]},{n,1,nupper},{alpha,1,alphaupper}] // TF

▶▶▶ Generating function identities enumerating the binomial-coefficient-related sequences of (((4 n)!)/((2 n)!))and (Binomial[4 n, 2 n]):

Sum[Power[z,n]/Factorial[2 n],{n,0,Infinity}] // FS // Factor
FS[%/.(z->x1)] // Factor

nupper=6;
Table[{Index->n,Factorial[4 n]/Factorial[2 n],Power[4,3n]*Pochhammer[1/4,n]*Pochhammer[3/4,n],Power[4,n]*AlphaFactorial[4,4n-3]*AlphaFactorial[4,4n-1],SeriesCoefficient[Conv[n,4,3,4*z/x1]*Conv[n,4,1,x1],{z,0,n},{x1,0,0}],SeriesCoefficient[Conv[n+1,-4,4n-3,4z/x1]*Conv[n+1,-4,4n-1,x1],{z,0,n},{x1,0,0}]},{n,0,nupper}] // TF

nupper=6;
Table[{Index->n,Binomial[4n,2n],Power[4,3n]*Pochhammer[1/4,n]*Pochhammer[3/4,n]/Factorial[2n],SeriesCoefficient[Conv[n,4,3,4*z/x2]*Conv[n,4,1,x2/x1]*(Cosh[(Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n+1,-4,4n-3,4z/x2]*Conv[n+1,-4,4n-1,x2/x1]*(Cosh[(Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶ Examples of new congruences for the α-factorial functions:

▶▶▶ Congruences for the α-factorial functions modulo 2:

Compute the generalized (modulo 2) results
Compute the right-hand-side congruences directly from the generalized convergent function, (Subscript[Conv, 2])(±α,R;z):

hval=2;
convFn=FS[Conv[hval,a, R, z]];
scfFn=SeriesCoefficient[convFn, {z,0,n}, Assumptions->n≥0] // FS
FS[(scfFn)/.(a->(ToExpression["$\\alpha$",TeXForm]))] // TeXForm

hval=2;
convFn=FS[Conv[hval,-a, R, z]];
scfFn=SeriesCoefficient[convFn, {z,0,n}, Assumptions->n≥0] // FS
FS[(scfFn)/.(a->(ToExpression["$\\alpha$",TeXForm]))] // TeXForm

Compute the right-hand-side congruences directly from the generalized convergent function, (Subscript[Conv, 2])(-α,n;z):

hval=2;
convFn=FS[Conv[hval,a, R, z]];
scfFn=SeriesCoefficient[convFn, {z,0,n}, Assumptions->n≥0] // FS;
scfFn2=FS[scfFn/.(a->-a)/.(n->Floor[(n-1)/a]+1)/.(R->n)]
FS[(scfFn2)/.(a->(ToExpression["$\\alpha$",TeXForm]))] // TeXForm

Tables of the generalized result (modulo 2) for several specific choices of α:

{amin,amax}={1,6};
sfn=((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))));
Table[{IndexAlpha->alpha,FS[(sfn)/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->alpha)]},{alpha,amin,amax}] // TF

aval=1;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

aval=2;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

aval=3;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

aval=4;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

aval=5;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

aval=6;nupper=24;
safn=FS[((((-a+(Sqrt[a (a-R)])) (((-a-(Sqrt[a (a-R)])+R))^n)+(a+(Sqrt[a (a-R)])) (((-a+(Sqrt[a (a-R)])+R))^n))/(2 (Sqrt[a (a-R)]))))/.(n->Floor[(n-1)/a]+1)/.(R->n)/.(a->aval)]
Table[{Index->n,
CF[{Alpha[α]->aval,FnMod->2,Mod[AlphaFactorial[aval, n],2,0], PolynomialMod[FS[safn],2]}], CF[{Alpha[α]->aval,FnMod[2*α]->2*aval,Mod[AlphaFactorial[aval, n], 2*aval, 0], PolynomialMod[FS[safn], 2*aval]}], 
CF[{Alpha[α]->aval,FnMod[α]->aval,Mod[AlphaFactorial[aval, n], aval, 0], PolynomialMod[FS[safn], aval]}], 
CF[{Alpha[α]->aval,FnMod[Power[α,2]]->aval^2,Mod[AlphaFactorial[aval, n], aval^2, 0], PolynomialMod[FS[safn], aval^2]}]}, {n, aval+1, nupper}] // TF

▶▶▶ Congruences for the α-factorial functions modulo 3:

hval=3;
convFn=FS[Conv[hval,a, R, z]]
SeriesCoefficient[convFn, {z, 0, n}, Assumptions->n≥0] // Simplify;
FS[(%)/.(Root[reqn_, ri_]->r[ri])]

rootExpr=FS[(((6 (a^2)+a (4 R-6 r[1])+(((R-r[1]))^2)) ((r[1])^n))/((r[1]-r[2]) (r[1]-r[3])))+(((6 (a^2)+a (4 R-6 r[3])+(((R-r[3]))^2)) ((r[3])^n))/((-r[1]+r[3]) (-r[2]+r[3])))+(((6 (a^2)+a (4 R-6 r[2])+(((R-r[2]))^2)) ((r[2])^n))/((r[2]-r[1]) (r[2]-r[3])))];
FS[(rootExpr)/.(R->n)/.(a->-a)]
(%%)/.(r[ri_]->HoldForm[rootri[ri,a,R]])

rootri[i_,a_,R_]:=Root[(-2 (a^2) R-3 a (R^2)-(R^3)+(6 (a^2)+9 a R+3 (R^2)) #1+(-6 a-3 R) ((#1)^2)+((#1)^3))&,i]
R3[a_,n_,R_]:=ReleaseHold[(((6 (a^2)+a (4 R-6 rootri[1,a,R])+(((R-rootri[1,a,R]))^2)) ((rootri[1,a,R])^n))/((rootri[1,a,R]-rootri[2,a,R]) (rootri[1,a,R]-rootri[3,a,R])))+(((6 (a^2)+a (4 R-6 rootri[2,a,R])+(((R-rootri[2,a,R]))^2)) ((rootri[2,a,R])^n))/((-rootri[1,a,R]+rootri[2,a,R]) (rootri[2,a,R]-rootri[3,a,R])))+(((6 (a^2)+a (4 R-6 rootri[3,a,R])+(((R-rootri[3,a,R]))^2)) ((rootri[3,a,R])^n))/((-rootri[1,a,R]+rootri[3,a,R]) (-rootri[2,a,R]+rootri[3,a,R])))]

alphaupper=8;nupper=10;
Table[afact[alpha,n]->{Mod[AlphaFactorial[alpha,n],3,0],Mod[FS[R3[-alpha,Floor[(n-1+alpha)/alpha],n]],3,0],Mod[AlphaFactorial[alpha,n],3 alpha,0],Mod[FS[R3[-alpha,Floor[(n-1+alpha)/alpha],n]],3alpha,0]},{n,1,nupper},{alpha,1,alphaupper}] // TF

▶▶▶ Congruences for the α-factorial functions modulo 4:

hval=4;
convFn=FS[Conv[hval,a, R, z]]
SeriesCoefficient[convFn, {z, 0, n}, Assumptions->n≥0] // Simplify;
FS[(%)/.(Root[reqn_, ri_]->r[ri])]

rootExpr=FS[(((-24 (a^3)-18 (a^2) (R-2 r[1])-a (7 R-12 r[1]) (R-r[1])-(((R-r[1]))^3)) ((r[1])^n))/((r[1]-r[2]) (r[1]-r[3]) (r[1]-r[4])))+(((-24 (a^3)-18 (a^2) (R-2 r[2])-a (7 R-12 r[2]) (R-r[2])-(((R-r[2]))^3)) ((r[2])^n))/((-r[1]+r[2]) (r[2]-r[3]) (r[2]-r[4])))+(((-24 (a^3)-18 (a^2) (R-2 r[3])-a (7 R-12 r[3]) (R-r[3])-(((R-r[3]))^3)) ((r[3])^n))/((-r[1]+r[3]) (-r[2]+r[3]) (r[3]-r[4])))+(((-24 (a^3)-18 (a^2) (R-2 r[4])-a (7 R-12 r[4]) (R-r[4])-(((R-r[4]))^3)) ((r[4])^n))/((-r[1]+r[4]) (-r[2]+r[4]) (-r[3]+r[4])))];
FS[(rootExpr)/.(R->n)/.(a->-a)]
(%%)/.(r[ri_]->HoldForm[rootri[ri,a,R]])

rootri[i_,a_,R_]:=Root[(6 (a^3) R+11 (a^2) (R^2)+6 a (R^3)+(R^4)+(-24 (a^3)-44 (a^2) R-24 a (R^2)-4 (R^3)) #1+(36 (a^2)+30 a R+6 (R^2)) ((#1)^2)+(-12 a-4 R) ((#1)^3)+((#1)^4))&,i]
R4[a_,n_,R_]:=ReleaseHold[(((-24 (a^3)-18 (a^2) (R-2 rootri[1,a,R])-a (7 R-12 rootri[1,a,R]) (R-rootri[1,a,R])-(((R-rootri[1,a,R]))^3)) ((rootri[1,a,R])^n))/((rootri[1,a,R]-rootri[2,a,R]) (rootri[1,a,R]-rootri[3,a,R]) (rootri[1,a,R]-rootri[4,a,R])))+(((-24 (a^3)-18 (a^2) (R-2 rootri[2,a,R])-a (7 R-12 rootri[2,a,R]) (R-rootri[2,a,R])-(((R-rootri[2,a,R]))^3)) ((rootri[2,a,R])^n))/((-rootri[1,a,R]+rootri[2,a,R]) (rootri[2,a,R]-rootri[3,a,R]) (rootri[2,a,R]-rootri[4,a,R])))+(((-24 (a^3)-18 (a^2) (R-2 rootri[3,a,R])-a (7 R-12 rootri[3,a,R]) (R-rootri[3,a,R])-(((R-rootri[3,a,R]))^3)) ((rootri[3,a,R])^n))/((-rootri[1,a,R]+rootri[3,a,R]) (-rootri[2,a,R]+rootri[3,a,R]) (rootri[3,a,R]-rootri[4,a,R])))+(((-24 (a^3)-18 (a^2) (R-2 rootri[4,a,R])-a (7 R-12 rootri[4,a,R]) (R-rootri[4,a,R])-(((R-rootri[4,a,R]))^3)) ((rootri[4,a,R])^n))/((-rootri[1,a,R]+rootri[4,a,R]) (-rootri[2,a,R]+rootri[4,a,R]) (-rootri[3,a,R]+rootri[4,a,R])))]

alphaupper=8;nupper=10;
Table[afact[alpha,n]->{Mod[AlphaFactorial[alpha,n],4,0],Mod[FS[R4[-alpha,Floor[(n-1+alpha)/alpha],n]],4,0],Mod[AlphaFactorial[alpha,n],4 alpha,0],Mod[FS[R4[-alpha,Floor[(n-1+alpha)/alpha],n]],4 alpha,0]},{n,1,nupper},{alpha,1,alphaupper}] // TF

▶▶▶ Congruences for the α-factorial functions modulo 5:

hval=5;
convFn=FS[Conv[hval,a, R, z]]
SeriesCoefficient[convFn, {z, 0, n}, Assumptions->n≥0] // Simplify;
FS[(%)/.(Root[reqn_, ri_]->r[ri])]

rootExpr=FS[((((r[1])^n) (120 (a^4)+48 (a^3) (2 R-5 r[1])+a (11 R-20 r[1]) (((R-r[1]))^2)+(((R-r[1]))^4)+2 (a^2) (23 (R^2)-79 R r[1]+60 ((r[1])^2))))/((r[1]-r[2]) (r[1]-r[3]) (r[1]-r[4]) (r[1]-r[5])))+((((r[2])^n) (120 (a^4)+48 (a^3) (2 R-5 r[2])+a (11 R-20 r[2]) (((R-r[2]))^2)+(((R-r[2]))^4)+2 (a^2) (23 (R^2)-79 R r[2]+60 ((r[2])^2))))/((-r[1]+r[2]) (r[2]-r[3]) (r[2]-r[4]) (r[2]-r[5])))+((((r[3])^n) (120 (a^4)+48 (a^3) (2 R-5 r[3])+a (11 R-20 r[3]) (((R-r[3]))^2)+(((R-r[3]))^4)+2 (a^2) (23 (R^2)-79 R r[3]+60 ((r[3])^2))))/((-r[1]+r[3]) (-r[2]+r[3]) (r[3]-r[4]) (r[3]-r[5])))+((((r[4])^n) (120 (a^4)+48 (a^3) (2 R-5 r[4])+a (11 R-20 r[4]) (((R-r[4]))^2)+(((R-r[4]))^4)+2 (a^2) (23 (R^2)-79 R r[4]+60 ((r[4])^2))))/((-r[1]+r[4]) (-r[2]+r[4]) (-r[3]+r[4]) (r[4]-r[5])))+((((r[5])^n) (120 (a^4)+48 (a^3) (2 R-5 r[5])+a (11 R-20 r[5]) (((R-r[5]))^2)+(((R-r[5]))^4)+2 (a^2) (23 (R^2)-79 R r[5]+60 ((r[5])^2))))/((-r[1]+r[5]) (-r[2]+r[5]) (-r[3]+r[5]) (-r[4]+r[5])))];
FS[(rootExpr)/.(R->n)/.(a->-a)]
(%%)/.(r[ri_]->HoldForm[rootri[ri,a,R]])

rootri[i_,a_,R_]:=Root[(-24 (a^4) R-50 (a^3) (R^2)-35 (a^2) (R^3)-10 a (R^4)-(R^5)+(120 (a^4)+250 (a^3) R+175 (a^2) (R^2)+50 a (R^3)+5 (R^4)) #1+(-240 (a^3)-260 (a^2) R-90 a (R^2)-10 (R^3)) ((#1)^2)+(120 (a^2)+70 a R+10 (R^2)) ((#1)^3)+(-20 a-5 R) ((#1)^4)+((#1)^5))&,i]
R5[a_,n_,R_]:=ReleaseHold[(((rootri[1,a,R])^n) (120 (a^4)+48 (a^3) (2 R-5 rootri[1,a,R])+a (11 R-20 rootri[1,a,R]) (((R-rootri[1,a,R]))^2)+(((R-rootri[1,a,R]))^4)+2 (a^2) (23 (R^2)-79 R rootri[1,a,R]+60 ((rootri[1,a,R])^2))))/((rootri[1,a,R]-rootri[2,a,R]) (rootri[1,a,R]-rootri[3,a,R]) (rootri[1,a,R]-rootri[4,a,R]) (rootri[1,a,R]-rootri[5,a,R]))+(((rootri[2,a,R])^n) (120 (a^4)+48 (a^3) (2 R-5 rootri[2,a,R])+a (11 R-20 rootri[2,a,R]) (((R-rootri[2,a,R]))^2)+(((R-rootri[2,a,R]))^4)+2 (a^2) (23 (R^2)-79 R rootri[2,a,R]+60 ((rootri[2,a,R])^2))))/((-rootri[1,a,R]+rootri[2,a,R]) (rootri[2,a,R]-rootri[3,a,R]) (rootri[2,a,R]-rootri[4,a,R]) (rootri[2,a,R]-rootri[5,a,R]))+(((rootri[3,a,R])^n) (120 (a^4)+48 (a^3) (2 R-5 rootri[3,a,R])+a (11 R-20 rootri[3,a,R]) (((R-rootri[3,a,R]))^2)+(((R-rootri[3,a,R]))^4)+2 (a^2) (23 (R^2)-79 R rootri[3,a,R]+60 ((rootri[3,a,R])^2))))/((-rootri[1,a,R]+rootri[3,a,R]) (-rootri[2,a,R]+rootri[3,a,R]) (rootri[3,a,R]-rootri[4,a,R]) (rootri[3,a,R]-rootri[5,a,R]))+(((rootri[4,a,R])^n) (120 (a^4)+48 (a^3) (2 R-5 rootri[4,a,R])+a (11 R-20 rootri[4,a,R]) (((R-rootri[4,a,R]))^2)+(((R-rootri[4,a,R]))^4)+2 (a^2) (23 (R^2)-79 R rootri[4,a,R]+60 ((rootri[4,a,R])^2))))/((-rootri[1,a,R]+rootri[4,a,R]) (-rootri[2,a,R]+rootri[4,a,R]) (-rootri[3,a,R]+rootri[4,a,R]) (rootri[4,a,R]-rootri[5,a,R]))+(((rootri[5,a,R])^n) (120 (a^4)+48 (a^3) (2 R-5 rootri[5,a,R])+a (11 R-20 rootri[5,a,R]) (((R-rootri[5,a,R]))^2)+(((R-rootri[5,a,R]))^4)+2 (a^2) (23 (R^2)-79 R rootri[5,a,R]+60 ((rootri[5,a,R])^2))))/((-rootri[1,a,R]+rootri[5,a,R]) (-rootri[2,a,R]+rootri[5,a,R]) (-rootri[3,a,R]+rootri[5,a,R]) (-rootri[4,a,R]+rootri[5,a,R]))]

alphaupper=8;nupper=10;
Table[afact[alpha,n]->{Mod[AlphaFactorial[alpha,n],5,0],Mod[FS[R5[-alpha,Floor[(n-1+alpha)/alpha],n]],5,0],Mod[AlphaFactorial[alpha,n],5 alpha,0],Mod[FS[R5[-alpha,Floor[(n-1+alpha)/alpha],n]],5 alpha,0]},{n,1,nupper},{alpha,1,alphaupper}] // TF

▶▶ Examples of the new congruences for the Stirling numbers modulo 2:

Examples of the new Stirling number Congruences expanded by the binomial coefficients modulo 2:
[({{n}, {m}})] ≡ (Binomial[(Floor[(n/2)]), m-(Ceiling[(n/2)])]) = [(x^m)]x(x+1) ... (x+n-1)  (mod 2) = [(x^m)]( (x^(Ceiling[(n/2)])) (((x+1))^(Floor[(n/2)])))

Examples of the power series expansion of the generalized convergent functions with respect to R:

convh=2;rcfupper=6;
convhFn=FS[Conv[convh,1,R,z]]
Series[convhFn,{R,0,rcfupper}]

{convh,mlower,mupper}={2,0,6};
Table[{LowerCfIndex->m,FS[SeriesCoefficient[Conv[convh,1,R,z],{R,0,m},{z,0,n}]]},{m,mlower,mupper}] // TF

Compute tables to verify the results cited in the examples from the introduction:

p2nm[n_,m_]:=Which[
m==1,Power[2,n]/4,
m==2,3/16*Power[2,n]*(n-1),
m==3,Power[2,n-7](9n-20)(n-1),
m==4,Power[2,n-9]*(3n-10)(3n-7)(n-1),
m==5,Power[2,n-13]*(27 n^3-279 n^2+934n-1008)*(n-1),
m==6,Power[2,n-15]/5*(9 n^2-71n+120)*(3n-14)(3n-11)*(n-1),
True,0
]
p2nmCongFn[n_,m_]:=Which[
n<m,0,
n==m,1,
n>m,p2nm[n,m]
]

nupper=18;modOffset=-1;
Table[cong[m,n]->{Mod[S1[n,m],2,modOffset],Mod[SeriesCoefficient[Power[x,Ceiling[n/2]]*Power[x+1,Floor[n/2]],{x,0,m}],2,modOffset],Mod[Binomial[Floor[n/2],m-Ceiling[n/2]],2,modOffset],Mod[p2nmCongFn[n,m],2,modOffset]},{n,0,nupper},{m,1,6}] // TF

▶▶ Rational generating functions for the harmonic number sequences:

scn[convp_,m_,n_]:=scn[convp,m,n]=SeriesCoefficient[Conv[convp,1,R,z],{R,0,m},{z,0,n},Assumptions->n≥0]
getRationalGF[cfFn_,z_,nupper_,nmin_:4]:=Module[{fsfData,linrec,denom,num,coeffs,gfz},
fsfData=Table[cfFn[n],{n,0,nupper}];
linrec=FindLinearRecurrence[fsfData];
denom=(-1+Sum[(linrec)[[i]]*Power[z,i],{i,1,Length[linrec]}]) // Factor;
num=Sum[a[i]*Power[z,i],{i,0,Length[linrec]+nmin}];
coeffs=Table[SeriesCoefficient[num/denom,{z,0,n}]==cfFn[n],{n,0,Length[linrec]+nmin}] // Solve;
gfz=Factor[(num/denom)/.(coeffs)][[1]];
Return[gfz];
]

cfFnV1[convp_,n_]:=(scn[convp,2,n]^2-2*scn[convp,1,n]*scn[convp,3,n])
cfFnV2[convp_,n_]:=(scn[convp,2,n]^3-3*scn[convp,1,n]*scn[convp,2,n]*scn[convp,3,n]+3*(scn[convp,1,n]^2)*scn[convp,4,n])
cfFnV3[convp_,n_]:=(scn[convp,2,n]^4-4*scn[convp,1,n]*(scn[convp,2,n]^2)*scn[convp,3,n]+4*(scn[convp,1,n]^2)*scn[convp,2,n]*scn[convp,4,n]+2*(scn[convp,1,n]^2)*(scn[convp,3,n]^2)-4*(scn[convp,1,n]^3)*scn[convp,5,n])

gfSimpFn={ConvP->convp,ROrder->First[#2]+1,ConvFnGFDenom->Factor[Denominator[FS[#1]]],ConvFnGFApart->Apart[FS[#1]],ConvFnGFApartTeXForm->TeXForm[Apart[FS[#1]]],ConvFnGF->Factor[#1],ConvFnGFTeXForm->TeXForm[Factor[#1]],ConvFnGFV2->FS[#1],ConvFnGFSeries->Series[Factor[#1],{z,0,12}]}&;

printRationalHNum1GFs[convfnh_,rpow_,denomPow_,nupper_,modOffset_:-1]:=Module[{sc,numfn,denomfn,convFnData,gfzv2,gfzv1,gfzv0},
sc=SeriesCoefficient[Conv[convfnh,1,R,z],{R,0,rpow}] // FS;
numfn=Factor[Numerator[sc]];
denomfn=Factor[PE[Power[Denominator[sc],1/(rpow)]]];
convFnData={{ConvFn,sc,Factor[sc]},{ConvNumFn,numfn},{ConvDenomFn,denomfn},{ConvDenomPowFn,denomPow}};
Print[TF[convFnData]];
Print[TF[Map[{OverZPow->#1,Apart[FS[sc]/Power[z,#1]]}&,Reverse[Range[0,2]]]]];
Print[TF[Map[{OverZPow->#1,Collect[Apart[FS[sc]/Power[z,#1]],(denomPow)^_,Factor]}&,Reverse[Range[0,2]]]]];
{gfzv2,gfzv1,gfzv0}=Map[Apart[FS[sc]/Power[z,#1]]&,Range[0,2]];
Print[TF[Table[{Index->n,Mod[(n!)*HarmonicNumber[n,1],convfnh,modOffset],Mod[SeriesCoefficient[gfzv2,{z,0,n+1}],convfnh,modOffset],Mod[SeriesCoefficient[gfzv1,{z,0,n}],convfnh,modOffset],Mod[SeriesCoefficient[gfzv0,{z,0,n-1}],convfnh,modOffset]},{n,0,nupper}]]];
]
printRationalHNum23GFs[convp_,cfnupper_,modOffset_:-1]:=Module[{gfzv1,gfzv2,modCoeffsTbl},
gfzv1=getRationalGF[cfFnV1[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv1,{1}]],"\n"];
gfzv2=getRationalGF[cfFnV2[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv2,{2}]],"\n"];
modCoeffsTbl=Table[{Index->n,Mod[Power[(n)!,2]*HarmonicNumber[n,2],convp,modOffset],Mod[SeriesCoefficient[gfzv1,{z,0,n}],convp,modOffset],
Index->n,Mod[Power[(n)!,3]*HarmonicNumber[n,3],convp,modOffset],Mod[SeriesCoefficient[gfzv2,{z,0,n}],convp,modOffset]},{n,0,Min[10,5+2*convp]}];
Print[TF[modCoeffsTbl]];
]

Compute the congruence expansions modulo 2:

convp=2;cfnupper=50;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 3:

convp=3;cfnupper=50;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

Compute the congruence expansions  for the first-order sequence modulo 4:

convfnh=4;rpow=2;nupper=25;modOffset=-1;
denomPow=(-1+12 z-36 (z^2)+24 (z^3));
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

▶▶ Variants of Wilson’s and Clement’s theorem: 
       Expansions of the two congruences for the twin prime pairs:

Example:Expansions of two congruence results characterizing the twin prime pairs,(2n+1,2n+3):
Compute cases of the first congruence:

pupper=100;
Table[Map[PrimePairCondFn[2n+1,PrimeQ[(#1+2)]&],{Index->n,CF[{IsPrime[2n+1]->PrimeQ[2n+1],IsPrime[2n+3]->PrimeQ[2n+3],IsTwinPrimePair[2n+1,2n+3]->PrimeQ[2n+1]&&PrimeQ[2n+3]}],Mod[2*Power[Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]+Power[-1,n]*(10n+7),(2n+1)(2n+3),-1]}],{n,1,pupper}] // TF

Compute cases of the second congruence:

pupper=100;
Table[Map[PrimePairCondFn[2n+1,PrimeQ[(#1+2)]&],{Index->n,CF[{IsPrime[2n+1]->PrimeQ[2n+1],IsPrime[2n+3]->PrimeQ[2n+3],IsTwinPrimePair[2n+1,2n+3]->PrimeQ[2n+1]&&PrimeQ[2n+3]}],Mod[4*Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2 n}]+4+2*n+1,(2n+1)(2n+3),-1]}],{n,1,pupper}] // TF

Compute cases of both congruences for comparison together:

pupper=100;
Table[Map[PrimePairCondFn[2n+1,PrimeQ[(#1+2)]&],{Index->n,CF[{IsPrime[2n+1]->PrimeQ[2n+1],IsPrime[2n+3]->PrimeQ[2n+3],IsTwinPrimePair[2n+1,2n+3]->PrimeQ[2n+1]&&PrimeQ[2n+3]}],Mod[2*Power[Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]+Power[-1,n]*(10n+7),(2n+1)(2n+3),-1],Mod[4*Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2 n}]+4+2*n+1,(2n+1)(2n+3),-1]}],{n,1,pupper}] // TF

▶▶ Examples of the congruences for the Wilson primes:

WilsonPrimePrimeCondFn[m_]:=Which[
PrimeQ[m]&&IntegerQ[(Factorial[m-1]+1)/(m^2)],Style[#1,Bold,Background->Lighter[LightGreen],FontColor->Darker[Green]]&,
PrimeQ[m],Style[#1,Bold,Background->Lighter[LightBlue],FontColor->Darker[Blue]]&,
True,(#1)&
]

WilsonPrimeCongSumV1[n_]:=Sum[Power[-1,i]/Factorial[i]*Power[Pochhammer[-n^2,i],2]*Factorial[n-1-i],{i,0,n-1}]
WilsonPrimeCongSumV2[n_]:=Sum[(Binomial[n^2,i]^2)*Power[-1,i]*(i!)*((n-1-i)!),{i,0,n-1}]
WilsonPrimeCongSumV3[n_]:=Sum[Binomial[n^2,i]*FallingFactorial[n^2-n,i]*Power[-1,n-1-i]*FallingFactorial[n-1,n-1-i],{i,0,n-1}]
ChkIdentV3V2[n_]:=ChkIdentV3V2[n]=Sum[Sum[Binomial[n^2,k]*Binomial[n^2,i]*Binomial[m,s]*S1[k,m]*StirlingS2[s,i]*Power[-1,n-1-k]*Pochhammer[1-n,n-1-k]*Power[-n,m-s]*Factorial[i],{k,0,n-1},{m,0,k}],{s,0,n-1},{i,0,s}]
ChkIdentV4V2[n_]:=ChkIdentV4V2[n]=Sum[Sum[Binomial[n^2,k]*Binomial[m,s]*Binomial[i,v]*Binomial[n^2+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,i-v]*Power[-n,m-s]*FallingFactorial[n-1,n-1-k]*Factorial[i],{k,0,n-1},{m,0,k}],{s,0,n-1},{i,0,s},{v,0,i}]

Compute tables of the first two congruence sums:

numPrimes=50;modOffset=-1;
WPrimes={5,13,563};PrimesList=Union[Table[Prime[m],{m,1,numPrimes}],WPrimes];
Table[Map[WilsonPrimePrimeCondFn[n],{Index->n,MemberQ[WPrimes,n],Mod[WilsonPrimeCongSumV1[n]+1,n^2,modOffset],Index->n,Mod[(n-1)!,n^2,modOffset],Mod[WilsonPrimeCongSumV2[n],n^2,modOffset],Mod[WilsonPrimeCongSumV3[n],n^2,-1]}],{n,PrimesList}] // TF

Compute tables of the last multiple sum congruences:

numPrimes=10;modOffset=-1;
WPrimes={5,13};PrimesList=Union[Table[Prime[m],{m,1,numPrimes}],WPrimes];
Table[Map[WilsonPrimePrimeCondFn[n],{Index->n,Mod[(n-1)!,n^2,modOffset],Mod[ChkIdentV3V2[n],n^2,modOffset],Mod[ChkIdentV4V2[n],n^2,modOffset],PrintTemporary[n," of ", Max[PrimesList]]}],{n,PrimesList}] // TF

Compute tables of all three congruences together for comparison:

numPrimes=11;modOffset=-1;
WPrimes={5,13};PrimesList=Union[Table[Prime[m],{m,1,numPrimes}],WPrimes];
Table[Map[WilsonPrimePrimeCondFn[n],{Index->n,MemberQ[WPrimes,n],Mod[WilsonPrimeCongSumV1[n]+1,n^2,modOffset],Index->n,Mod[(n-1)!,n^2,modOffset],Mod[WilsonPrimeCongSumV2[n],n^2,modOffset],Mod[WilsonPrimeCongSumV3[n],n^2,-1],Index->n,Mod[(n-1)!,n^2,modOffset],Mod[ChkIdentV3V2[n],n^2,modOffset],Mod[ChkIdentV4V2[n],n^2,modOffset],PrintTemporary[n," of ", Max[PrimesList]]}],{n,PrimesList}] // TF

▶▶ Convergent function identities generating the single factorial function squares:

Convergent Generating Function Identities for the Factorial Square Powers:

pupper=25;
Table[{Index->p,PrimeQ[p],PrimeQ[p]&&(Mod[p,4,0]==1),Mod[Factorial[(p-1)/2]^2,p,-1],Index->p,Factorial[(p-1)/2]^2,SeriesCoefficient[Conv[p,-1,(p-1)/2,x]*Conv[p,-1,(p-1)/2,z/x],{x,0,0},{z,0,(p-1)/2}],SeriesCoefficient[Conv[p,-2,p-1,x]*Conv[p,-2,p-1,z/4/x],{x,0,0},{z,0,(p-1)/2}],SeriesCoefficient[Conv[p,-1,(p-1)/2,x]*Conv[p,-2,p-1,z/2/x],{x,0,0},{z,0,(p-1)/2}],SeriesCoefficient[Conv[p,-2,p-1,x/2]*Conv[p,-1,(p-1)/2,z/x],{x,0,0},{z,0,(p-1)/2}],PrintTemporary[p," of ",pupper]},{p,3,pupper,2}] // TF

Examples of the fractional series expansions mentioned in the introduction:

nupper=10;
getConvFnFractionalSeriesData[n_,xcfMin_:1,xcfMax_:3]:=Table[CF[{CoeffOfXPow->m,Expand[SeriesCoefficient[Conv[n+1,1,1,z/x]*Conv[n+1,1,1,x],{x,0,m}]],Factor[SeriesCoefficient[Conv[n+1,1,1,z/x]*Conv[n+1,1,1,x],{x,0,m}]]}],{m,xcfMin,xcfMax}]
Table[Flatten[{Index->n,getConvFnFractionalSeriesData[n,1,3],CF[{ConvFnSeriesData[n],Series[Conv[n+1,1,1, z/x]*Conv[n+1,1,1,x],{x,0,5}],Series[Conv[n+1,1,1, z/x]*Conv[n+1,-1,n,x],{x,0,5}]}]}],{n,0,nupper}] // TF

Compare the previous coefficients with a few tables of the (generalized) harmonic number sequences:

Table[hn[r,n]->HarmonicNumber[n,r],{n,0,10},{r,1,6}] // TF

Table[hn[r,n]->Hn[1,n,r],{n,0,10},{r,1,6}] // TF

Table[hn[r,n]->Hn[2,1,n,r,1],{n,0,10},{r,1,6}] // TF

Table[hn[r,n]->Hn[3,2,n,r,1],{n,0,10},{r,1,6}] // TF

▶▶ Expansions of the necessary condition from Wolstenholme’s theorem:

Compute some example convergent function series:

nupper=6;scfupper=6;
Table[{Index->n,CF[{SeriesExpV1[n],Series[FS[Conv[n,-1,n-1,z/x]*(-Log[1-x]/(1-x))],{x,0,scfupper}],SeriesExpV2[n],Series[FS[Conv[n,1,1,z/x]*(-Log[1-x]/(1-x))],{x,0,scfupper}]}]},{n,3,nupper}] // TF

Tables to verify the first cases of these identities for the necessary condition:

nupper=12;
Table[{Index->n,S1[n,2],Factorial[n-1]*HarmonicNumber[n-1,1],SeriesCoefficient[FS[Conv[n,-1,n-1,z/x]*(-Log[1-x]/(1-x))],{x,0,0},{z,0,n-1}],SeriesCoefficient[FS[Conv[n,1,1,z/x]*(-Log[1-x]/(1-x))],{z,0,n-1},{x,0,0}]},{n,3,nupper}] // TF

▶▶ Examples of the semi-polynomial congruence expansions for the central binomial coefficients:

(See also the extended cases of the congrunec computations in the Section 7 listings expanded below.)

nupper=12;
Table[{Index->n,{PolynomialMod[Binomial[2n,n],2n+1],Mod[PolynomialMod[FE[Sum[Binomial[2x+1,i]*Power[2,i]*Pochhammer[-1/2-2x,i]*Pochhammer[1/2,n-i]*Power[2,2n]/Factorial[n],{i,0,n}]]/.(x->x),2x+1],2n+1,0],Mod[PolynomialMod[FE[Sum[Binomial[2x+1,i]*Power[-2,i]*FallingFactorial[1/2+2x,i]*Pochhammer[1/2,n-i]*Power[2,2n]/Factorial[n],{i,0,n}]]/.(x->x),2x+1],2n+1,0]}==ConstantArray[PolynomialMod[Binomial[2n,n],2n+1],3],PolynomialMod[Binomial[2n,n],2n+1],PrintTemporary[n," of ", nupper]},{n,3,nupper}] // TF

nupper=12;
Table[{Index->n,{PolynomialMod[Binomial[2n,n],n^p],PolynomialMod[Power[2,n]*Factorial2[2n-1]/Factorial[n],n^p],PolynomialMod[FE[Sum[Binomial[x^p,i]*Binomial[2n-2i,n-i]*Pochhammer[1/2-x^p,i]*Power[8,i]*Factorial[n-i]/Factorial[n],{i,0,n}]],x^p],PolynomialMod[FE[Sum[Binomial[x^p,i]*Power[-1,n-i]*Pochhammer[1/2+n-x^p,i]*Pochhammer[1/2-n,n-i]*Power[2,2n]*Power[-2,i],{i,0,n}]/Factorial[n]],x^p]}===ConstantArray[PolynomialMod[Binomial[2n,n],n^p],4],PolynomialMod[Binomial[2n,n],n^p],PrintTemporary[n," of ", nupper]},{n,3,nupper}] // TF

▶▶ Examples of congruences for the double and triple factorial functions:

getModHTableV1[n_,h_,modOffset_:-1]:=Table[CF[{FnMod->ToString[StringForm["`1`×`2`^{`3`}",h,2,s]],Mod[Factorial2[2n-1],h*Power[2,s],modOffset],Mod[Sum[Binomial[h,i]*Power[2,n]*Power[-2,(s+1)*i]*Pochhammer[1/2-h,i]*Pochhammer[1/2,n-i],{i,0,n}],h*Power[2,s],modOffset],Mod[Sum[Binomial[h,i]*Power[-2,n]*Power[2,(s+1)*i]*Pochhammer[1/2+n-h,i]*Pochhammer[1/2-n+i,n-i],{i,0,n}],h*Power[2,s],modOffset]}],{s,0,h}]

hupper=6;nupper=10;modOffset=-1;
Table[{ModIndexHN[h,n],Flatten[getModHTableV1[n,h,modOffset]]},{n,1,nupper},{h,2,hupper}] // TF

getModHTableV2[n_,h_,modOffset_:-1]:=Table[CF[{FnMod->ToString[StringForm["`1`×`2`^{`3`}",h,3,s]],Mod[AlphaFactorial[3,3n-1],h*Power[3,s],modOffset],Mod[Sum[Binomial[h,i]*Power[3,n]*Power[-3,(s+1)*i]*Pochhammer[1/3-h,i]*Pochhammer[2/3,n-i],{i,0,n}],h*Power[3,s],modOffset],Mod[Sum[Binomial[h,i]*Power[-3,n]*Power[3,(s+1)*i]*Pochhammer[1/3+n-h,i]*Pochhammer[1/3-n+i,n-i],{i,0,n}],h*Power[3,s],modOffset]}],{s,0,h}]

hupper=6;nupper=10;modOffset=-1;
Table[{ModIndexHN[h,n],Flatten[getModHTableV2[n,h,modOffset]]},{n,1,nupper},{h,2,hupper}] // TF

getModHTableV3[n_,h_,modOffset_:-1]:=Table[CF[{FnMod->ToString[StringForm["`1`×`2`^{`3`}",h,3,s]],Mod[AlphaFactorial[3,3n-2],h*Power[3,s],modOffset],Mod[Sum[Binomial[h,i]*Power[3,n]*Power[-3,(s+1)*i]*Pochhammer[2/3-h,i]*Pochhammer[1/3,n-i],{i,0,n}],h*Power[3,s],modOffset],Mod[Sum[Binomial[h,i]*Power[-3,n]*Power[3,(s+1)*i]*Pochhammer[2/3+n-h,i]*Pochhammer[2/3-n+i,n-i],{i,0,n}],h*Power[3,s],modOffset]}],{s,0,h}]

hupper=6;nupper=10;modOffset=-1;
Table[{ModIndexHN[h,n],Flatten[getModHTableV3[n,h,modOffset]]},{n,1,nupper},{h,2,hupper}] // TF

▶ §4: Alternate exact expansions of the convergent functions:

▶▶ Convergent function recurrences involving the denominator function sequences:

Recurrence relations satisfied by the convergent functions in terms of the denominator functions, (Subscript[FQ, h])(α,R;z):

hupper=12;
Table[{Index->h,FS[Conv[h,a,R,z]]-FS[Together[Conv[h-1,a,R,z]+Power[a,h-1]*Factorial[h-1]*pn[h-1,a,R]*Power[z,2 (h-1)]/FQ[h,a,R,z]/FQ[h-1,a,R,z]]],FS[Conv[h,a,R,z]]},{h,1,hupper}] // TF

hupper=12;kupper=8;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Conv[h-k,a,R,z]+Sum[Power[a,h-1-i]*Factorial[h-1-i]*pn[h-1-i,a,R]*Power[z,2 (h-1-i)]/FQ[h-i,a,R,z]/FQ[h-1-i,a,R,z],{i,0,k-1}]]]},{k,1,kupper},{h,k,hupper}] // TF

hupper=12;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[Power[a,h-1-i]*Factorial[h-1-i]*pn[h-1-i,a,R]*Power[z,2 (h-1-i)]/FQ[h-i,a,R,z]/FQ[h-1-i,a,R,z],{i,0,h-1}]]]},{h,1,hupper}] // TF

▶▶ Convergent function recurrences involving the reciprocals of the Laguerre polynomial sequences:

Recurrence relations satisfied by the convergent functions expanded in terms of the Laguerre polynomial sequences:

hupper=10;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[1/(-a*z)*Binomial[R/a+i-2,i-1]/(i)/LaguerreL[i,R/a-1,1/(a z)]/LaguerreL[i-1,R/a-1,1/(a z)],{i,1,h}]]]},{h,1,hupper}] // TF

hupper=10;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[1/(-a*z)*Binomial[R/a+i-1,i]/(i+1)/LaguerreL[i,R/a-1,1/(a z)]/LaguerreL[i+1,R/a-1,1/(a z)],{i,0,h-1}]]]},{h,1,hupper}] // TF

▶▶ Convergent function recurrences involving Kummer’s confluent hypergeometric function:

Compute the component formulas in the statement of Halpen's product rule for these cases:

Sum[FE[Binomial[h,k]*Power[-a z,h-k]*Factorial[R/a+h-1]/Factorial[R/a+k-1]],{k,0,h}]

FS[Power[-a z,2(h-1-i)]*Factorial[h-1-i]*Pochhammer[R/a,h-i-1]/(Power[-a z,h-i]*Pochhammer[R/a,h-i]*Hypergeometric1F1[-(h-i),(R/a),(1/(a z))])/(Power[-a z,h-i-1]*Pochhammer[R/a,h-i-1]*Hypergeometric1F1[-(h-i-1),(R/a),(1/(a z))])]

Recurrence relations  expanded in in terms of these formulas:

hupper=6;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[Power[-a z,2(h-1-i)]*Factorial[h-1-i]*Pochhammer[R/a,h-i-1]/(Power[-a z,h-i]*Pochhammer[R/a,h-i]*Hypergeometric1F1[-(h-i),(R/a),(1/(a z))])/(Power[-a z,h-i-1]*Pochhammer[R/a,h-i-1]*Hypergeometric1F1[-(h-i-1),(R/a),(1/(a z))]),{i,0,h-1}]]],FS[Together[Sum[-((Gamma[h-i])/(a z Hypergeometric1F1[-h+i,(R/a),(1/(a z))] Hypergeometric1F1[1-h+i,(R/a),(1/(a z))] Pochhammer[(R/a),h-i])),{i,0,h-1}]]]},{h,1,hupper}] // TF

hupper=8;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Conv[h-k,a,R,z]+Sum[-((Gamma[h-i])/(a z Hypergeometric1F1[-h+i,(R/a),(1/(a z))] Hypergeometric1F1[1-h+i,(R/a),(1/(a z))] Pochhammer[(R/a),h-i])),{i,0,k-1}]]]},{h,1,hupper},{k,1,h-1}] // TF

hupper=8;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[-((Factorial[i-1]/(a z))/(FS[Hypergeometric1F1[1-i,(R/a),(1/(a z))] Hypergeometric1F1[-i,(R/a),(1/(a z))]] Pochhammer[(R/a),i])),{i,1,h}]]]},{h,1,hupper}] // TF

hupper=8;
Table[diff[k,h]->{FS[Conv[h,a,R,z]]-FS[Together[Sum[Power[Binomial[R/a+i-1,i-1],-1]((1/(-R z))/(FS[Hypergeometric1F1[1-i,(R/a),(1/(a z))] Hypergeometric1F1[-i,(R/a),(1/(a z))]])),{i,1,h}]]]},{h,1,hupper}] // TF

▶ §5: Properties of the generalized convergent functions:

▶▶ The convergent denominator function sequences:

▶▶▶ Tables to verify the recurrence relation formulas:

{hupper,smin,smax}={8,0,8};
Table[rdiff[h, s]->{FQ[h,a, a*s, z]-FQ[h+s-1,a, a*(2-s), z]}, {h, 0, hupper}, {s, smin, smax}] // Simplify // TF

{hupper,smin,smax}={8,-12,12};
Table[rdiff[h, s]->{(FQ[h,a, a*s, z]-FQ[h+s-1,a, a*(2-s), z])*KroneckerDelta[s≥1-h, True]}, {h, 0, hupper}, {s, smin, smax}] // Simplify // TF

hupper=12;
Table[{Index->h, Simplify[(R+(h-1)*a)*z*FQ[h, a, R-a, z]+((a-R)*z-1)*FQ[ h, a, R,z]+(1)*FQ[h,a, R+a, z]], Simplify[(1)*FQ[h, a, R, z]+(a*h*z)*FQ[h-1, a, R, z]+(-1)*FQ[h, a, R-a, z]], Simplify[(R+a*h)*z*FQ[h, a, R, z]+(1)*FQ[h+1,a, R, z]+(-1)*FQ[h, a, R+a, z]], Simplify[(1-a*h*z)*FQ[h, a, R, z]+(-1)*FQ[h, a, R+a, z]+(-(a*z)*(R+(h-1)*a)*h*z)*FQ[h-1,a, R, z]], Simplify[(1-(h+1)*a*z)*FQ[ h, a, R,z]+(-1)*FQ[h+1, a, R, z]-(R+(h-1)*a)*z*FQ[h, a, R-a, z]], Simplify[((1-h)*a*z)*FQ[h-2, a, R+2*a, z]+(1-R*z)*FQ[h-1, a, R+a, z]+(-1)*FQ[h, a, R, z]+KroneckerDelta[h,0]], Simplify[((h-1)*a*z)*FQ[h-2, a, R+2*a, z]-(1-R*z)*FQ[h-1, a, R+a, z]+(1)*FQ[h, a, R, z]-KroneckerDelta[h,0]]}, {h, 0,hupper}] // TF

▶▶▶ Addition theorems:

hupper=8;
Table[fqdiff[h]->{Simplify[FQ[h,a, R, z-w]]-Simplify[Sum[Pochhammer[-h, n]*Power[-w,n]*Power[(z-w),h-n]/Power[z,h]/Factorial[n]*FQ[h-n,a, R+n*a, z], {n, 0, h}]],Simplify[FQ[h,a, R, z-w]]}, {h, 0, hupper}] // Simplify // TF

hupper=8;
Table[fqdiff[h]->{Simplify[FQ[h,a, R, z-w]]-Simplify[Sum[Pochhammer[-h, n]*Pochhammer[1-h-R/a, n]*Power[a w,n]/Factorial[n]*FQ[ h-n, a, R,z], {n, 0, h}]],Simplify[FQ[h,a, R, z-w]]}, {h, 0, hupper}] // Simplify // TF

hupper=8;
Table[fqdiff[h]->{Simplify[FQ[h,a, R, z-w]]-Simplify[FE[Sum[Binomial[h,n]*Binomial[h+R/a-1,n]*Power[a w,n]*Factorial[n]*FQ[ h-n, a, R,z], {n, 0, h}]]],Simplify[FQ[h,a, R, z-w]]}, {h, 0, hupper}] // Simplify // TF

▶▶▶ Multiplication theorems:

hupper=8;
Table[fqdiff[h]->{FS[FQ[h,a, R, z w]]-
                 FS[Sum[Pochhammer[-h, n]*Power[w-1,n]*Power[w,h-n]/Factorial[n]*FQ[h-n, a, R+n*a,z], {n, 0, h}]],
                 FS[FQ[h,a, R, z w]]}, {h,0,hupper}] // TF

hupper=8;
Table[fqdiff[h]->{FS[FQ[h,a, R, z w]]-
                 FS[Sum[Pochhammer[-h, n]*Pochhammer[1-h-R/a, n]*Power[a z,n]*Power[1-w,n]/Factorial[n]*FQ[h-n,a, R, z], {n, 0, h}]],
                 FS[FQ[h,a, R, z w]]}, {h, 0, hupper}] // Simplify // TF

hupper=8;
Table[fqdiff[h]->{FS[FQ[h,a, R, z w]]-
                 FS[FE[Sum[Binomial[h,n]*Binomial[n-h-R/a,n]*Power[a z*(w-1),n]*Factorial[n]*FQ[ h-n, a, R,z], {n, 0, h}]]],
                 FS[FQ[h,a, R, z w]]}, {h, 0, hupper}] // Simplify // TF

▶▶ The convergent numerator function sequences:

▶▶▶ Compute special cases of the first two formula expansions:

Erasing Operator/Coefficients of z^k:

hupper=12;nupper=16;
Table[mod[h,s,n]->{FS[Chn[h,n,a,R]]-FS[If[n<h,Sum[Binomial[h,i]*Power[-1,i]*pn[i,-a,R+(h-1)*a]*pn[n-i,a,R],{i,0,n}],0]],FS[Chn[h,n,a,R]]-FS[If[n<h,Sum[Binomial[h,i]*Power[a,n]*Pochhammer[1-h-R/a,i]*Pochhammer[R/a,n-i],{i,0,n}],0]]},{n,0,nupper},{h,3,hupper}] // TF

▶▶▶ Computations of the first five identities expanding the auxiliary sequences, (Subscript[C, h,n])(α,R), and table listings:

Generate special cases of the Table formulas
Special Cases of the auxiliary numerator subsequences,(Subscript[C, h,n])(α,R)
(See the tables in the last appendix section of this notebook.)

First Expansion of(Subscript[C, h,n])(α,R)
(Subscript[C, h,n])(α,R) =(∑_(s=0)^n)((∑_(k=0)^n)(∑_(m=0)^k)(((-1))^m) (a^n) (h^s) (Binomial[h, k]) (Binomial[m, s]) [({{k}, {m}})] ((((R/a)-1))^(m-s)) (Pochhammer[(R/a), n-k]))

Clear[ChnIdentV1]
ChnIdentV1[h_,n_,a_,R_]:=ChnIdentV1[h,n,a,R]=Sum[Sum[Binomial[h,k] Binomial[m,s] S1[k,m]*Power[-1,m]*Power[a,n]*Pochhammer[R/a,n-k]*Power[R/a-1,m-s]*Power[h,s],{k,0,n},{m,0,k}],{s,0,n}]

hupper=16;
nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[ChnIdentV1[h,n,a,R]]},{h,2,hupper},{n,0,h}] // TF

(Subscript[C, h,n])(α,R) =(∑_(s=0)^n)(∑_(i=0)^s)((∑_(k=0)^n)(∑_(m=0)^k)(((-1))^m) i! (a^n) (Binomial[h, i]) (Binomial[h, k]) (Binomial[m, s]) {({{s}, {i}})} [({{k}, {m}})] ((((R/a)-1))^(m-s)) (Pochhammer[(R/a), n-k]))

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]S1[k,m]*StirlingS2[s,i]*Power[-1,m]*Power[a,n]*Power[R/a-1,m-s]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]]},{h,2,hupper},{n,0,h}] // TF

Second Expansion of(Subscript[C, h,n])(α,R)
(Subscript[C, h,n])(α,R) =(∑_(s=0)^n)(∑_(t=0)^s)((∑_(k=0)^n)(∑_(m=0)^k)(((-1))^m) (R^s) (a^(n-s)) (Binomial[h, k]) (Binomial[m, t]) (((h-1))^(m-t))  [({{k}, {m}})] [({{n-k}, {s-t}})])

Clear[ChnIdentV2]
ChnIdentV2[h_,n_,a_,R_]:=ChnIdentV2[h,n,a,R]=Sum[Sum[Binomial[h,k] Binomial[m,t] S1[k,m]*S1[n-k,s-t]*Power[-1,m]*Power[a,n-s]*Power[h-1,m-t]*Power[R,s],{k,0,n},{m,0,k}],{s,0,n},{t,0,s}]

hupper=16;
nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[ChnIdentV2[h,n,a,R]]},{h,2,hupper},{n,0,h}] // TF

Third Expansion of(Subscript[C, h,n])(α,R)
(Subscript[C, h,n])(α,R) =(∑_(s=0)^n)(∑_(i=0)^s)((∑_(k=0)^n)(∑_(m=0)^k)(((-1))^m) i! (a^n) (Binomial[h, i]) (Binomial[h, k]) (Binomial[m, s]) {({{s}, {i}})} [({{k}, {m}})] ((((R/a)-1))^(m-s)) (Pochhammer[(R/a), n-k]))

Clear[ChnIdentV3]
ChnIdentV3[h_,n_,a_,R_]:=ChnIdentV3[h,n,a,R]=Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]S1[k,m]*StirlingS2[s,i]*Power[-1,m]*Power[a,n]*Power[R/a-1,m-s]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[ChnIdentV3[h,n,a,R]]},{h,2,hupper},{n,0,h}] // TF

Fourth Expansion of(Subscript[C, h,n])(α,R)
(Subscript[C, h,n])(α,R) =(∑_(s=0)^n)(∑_(i=0)^s)(∑_(v=0)^i)((∑_(k=0)^n)(∑_(m=0)^k)i! (Binomial[h, k]) (Binomial[h+v, v]) (Binomial[i, v]) (Binomial[m, s]) (((-1))^(i+m-v)) {({{s}, {i}})}[({{k}, {m}})] (a^(-m+n+s)) (((R-a))^(m-s)) (Pochhammer[(R/a), n-k]))

Clear[ChnIdentV4]
ChnIdentV4[h_,n_,a_,R_]:=ChnIdentV4[h,n,a,R]=Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[a,n]*Power[R/a-1,m-s]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[ChnIdentV4[h,n,a,R]]},{h,2,hupper},{n,0,h}] // TF

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[a,n+s-m]*Power[R-a,m-s]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]]},{h,2,hupper},{n,0,h}] // TF

Fifth Expansion of(Subscript[C, h,n])(α,R)
(Subscript[C, h,n])(α,R) =(∑_(i=0)^n) (∑_(s=0)^n)(∑_(t=0)^s)((∑_(k=0)^n)(∑_(m=0)^k)(Binomial[h, k]) (Binomial[m, t]) (((h-1))^(m-t)) (((-1))^(-i+m+s)) {({{s}, {i}})} [({{k}, {m}})] [({{n-k}, {s-t}})]) × (a^n) (Pochhammer[(R/a), i])

Clear[ChnIdentV5]
ChnIdentV5[h_,n_,a_,R_]:=ChnIdentV5[h,n,a,R]=Sum[Sum[Sum[Binomial[h,k] Binomial[m,t] S1[k,m]*S1[n-k,s-t]*S2[s,i]*Power[-1,m+s-i]*Power[h-1,m-t],{k,0,n},{m,0,k}],{s,0,n},{t,0,s}]*Power[a,n]*Pochhammer[R/a,i],{i,0,n}]

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Chn[h,n,a,R]]-FS[ChnIdentV5[h,n,a,R]]},{h,2,hupper},{n,0,h}] // TF

▶▶▶ Generate particular cases of the polynomial identities for the sequence,  (Subscript[C, h,n])(α,R), with respect to h:

Compute cases of the polynomials only in h:

getStirlingNumberPolySum[n_,i_,h_]:=FE[Sum[Sum[Binomial[h,k] Binomial[m,t] S1[k,m]*S1[n-k,s-t]*S2[s,i]*Power[-1,m+s-i]*Power[h-1,m-t],{k,0,n},{m,0,k}],{s,0,n},{t,0,s}]]
m[n_,h_]:=Product[h-n+j,{j,0,Floor[(n-1)/2]}]
knownFactorsV2[n_,i_]:=(Power[-1,n]/Factorial[n]*Binomial[n,i])
knownFactorsV3[n_,i_]:=(Power[-1,n]/Factorial[n]*Binomial[n,i]*m[n,h])

hupper=6;nupper=hupper;
Table[cfs[i,n]->{Factor[getStirlingNumberPolySum[n,i,h]]},{n,0,nupper},{i,0,nupper}] // TF

hupper=6;nupper=hupper;
Table[cfs[i,n]->{Factor[FE[If[n≥i,getStirlingNumberPolySum[n,i,h]/(knownFactorsV2[n,i]),0]]]},{n,0,nupper},{i,0,nupper}] // TF

hupper=6;nupper=hupper;
Table[{Index->n,m[n,h]},{n,0,nupper}] // TF

hupper=10;nupper=hupper;
Table[cfs[i,n]->{Factor[FE[If[n≥i,getStirlingNumberPolySum[n,i,h]/(knownFactorsV3[n,i]),0]]]},{n,0,nupper},{i,0,nupper}] // TF

▶▶▶ Verify the stated identities expanding the sequences, (Subscript[R, h,k])(α,z):

Generate special cases of the Table formulas
Special Cases of the auxiliary numerator subsequences,(Subscript[R, h,k])(α,z),in the following forms
(((-1))^(h-k)) (z^(k-h)) × (Subscript[R, h,h-k])(α,z)and k!×(((-1))^(h-k)) (z^(k-h)) × (Subscript[R, h,h-k])(α,z)
(See the tables in the last appendix section of this notebook.)

First stated expansion of(Subscript[R, h,k])(α,z):

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Rhk[h,k,a,R]]-FS[Sum[Sum[Binomial[h,i] Binomial[m,t] S1[i,m]*S1[n-i,k-t]*Power[-1,m]*Power[a,n-k]*Power[h-1,m-t]*Power[z,n],{n,0,h-1},{i,0,n},{m,0,i}],{t,0,k}]]},{h,2,hupper},{k,0,h}] // TF

Second stated expansion of(Subscript[R, h,k])(α,z):

hupper=16;nupper=hupper;
Table[cfs[h,n]->{FS[Rhk[h,k,a,R]]-FS[Sum[Binomial[h,i] Binomial[m,t]*Binomial[h-1,p] S1[i,m]*S1[n-i,k-t]*StirlingS2[m-t,p]*Power[-1,m]*Power[a,n-k]*Factorial[p]*Power[z,n],{n,0,h-1},{i,0,n},{m,0,i},{t,0,k},{p,0,m-t}]]},{h,2,hupper},{k,0,h}] // TF

▶ §6: Applications and motivating examples:

▶▶ New congruences for the Stirling numbers of the first kind:

▶▶▶ Compute the Stirling and α-factorial coefficient triangles from the series expansions of (Subscript[Conv, h])(α,R;z) over R and z:

Verify the formal coefficient identities for [({{n}, {k}})]  (Subscript[and[({{n}, {k}})], α])
Tables of the coefficient triangles computed from the coefficients of R and z
in(Subscript[Conv, h])(1,R;z)for the Stirling numbers and
in(Subscript[Conv, h])(α,R+1;z) for the generalized triangle cases:

Modulo 2:

modh=2;nmupper=12;modOffset=-1;
Table[s1[n,m]->{Mod[S1[n,m],modh,modOffset],Mod[SeriesCoefficient[Conv[modh,1,R,z],{R,0,m},{z,0,n}],modh,modOffset]},{n,1,nmupper},{m,1,nmupper}] // TF

modh=2;nmupper=12;
Table[s1[n,m]->{PolynomialMod[Fcf[a,n,m],modh],PolynomialMod[SeriesCoefficient[Conv[modh,a,R+1,z],{R,0,m-1},{z,0,n-1}],modh]},{n,1,nmupper},{m,1,nmupper}] // TF

Modulo 3:

modh=3;nmupper=12;modOffset=-1;
Table[s1[n,m]->{Mod[S1[n,m],modh,modOffset],Mod[SeriesCoefficient[Conv[modh,1,R,z],{R,0,m},{z,0,n}],modh,modOffset]},{n,1,nmupper},{m,1,nmupper}] // TF

modh=3;nmupper=12;
Table[s1[n,m]->{PolynomialMod[Fcf[a,n,m],modh],PolynomialMod[SeriesCoefficient[Conv[modh,a,R+1,z],{R,0,m-1},{z,0,n-1}],modh]},{n,1,nmupper},{m,1,nmupper}] // TF

Modulo 4:

modh=4;nmupper=12;modOffset=-1;
Table[s1[n,m]->{Mod[S1[n,m],modh,modOffset],Mod[SeriesCoefficient[Conv[modh,1,R,z],{R,0,m},{z,0,n}],modh,modOffset]},{n,1,nmupper},{m,1,nmupper}] // TF

modh=4;nmupper=12;
Table[s1[n,m]->{PolynomialMod[Fcf[a,n,m],modh],PolynomialMod[SeriesCoefficient[Conv[modh,a,R+1,z],{R,0,m-1},{z,0,n-1}],modh]},{n,1,nmupper},{m,1,nmupper}] // TF

Modulo 5:

modh=5;nmupper=12;modOffset=-1;
Table[s1[n,m]->{Mod[S1[n,m],modh,modOffset],Mod[SeriesCoefficient[Conv[modh,1,R,z],{R,0,m},{z,0,n}],modh,modOffset]},{n,1,nmupper},{m,1,nmupper}] // TF

modh=5;nmupper=12;
Table[s1[n,m]->{PolynomialMod[Fcf[a,n,m],modh],PolynomialMod[SeriesCoefficient[Conv[modh,a,R+1,z],{R,0,m-1},{z,0,n-1}],modh]},{n,1,nmupper},{m,1,nmupper}] // TF

Examples of special case series in z for the Stirling numbers obtained from (theh^th)convergent functions:
Series expansions modulo 2,3,4,5, and 6:

{convhlower,convhupper,scfupper}={2,6,3};
getConvSeriesDataList[convh_]:=Map[#1[FS[Conv[convh,1,R,z]]]&,{#&,Collect[Expand[Normal[Series[#,{R,0,scfupper}]]],R^_,Factor]&,Collect[Expand[Normal[Series[#,{z,0,2*convh+1}]]],z^_,Factor]&}]
Table[{ConvHIndex->convh,CF[getConvSeriesDataList[convh]]},{convh,convhlower,convhupper}] // TF

▶▶▶ Congruences for the Stirling numbers modulo 2:

Series expansions of the convergent function in powers of R:

{modh,seriesRUpper}={2,6};
FS[Conv[modh,1,R,z]]
Series[%,{R,0,seriesRUpper}]

Compute several particular cases of the series coefficients:

getS1CoeffModData[modh_,m_,n_,simpFnsList_]:=Module[{scfFull,scfPartialTerms,rData},
scfFull=SeriesCoefficient[Conv[modh,m,R,z],{R,0,m},{z,0,n}];
scfPartialTerms=SeriesCoefficient[Conv[modh,m,R,z],{R,0,m},{z,0,n},Assumptions->n>m];
rData={S1ModMFullV1[m],scfFull,S1ModMV2[m],scfPartialTerms,Map[#1[scfPartialTerms]&,simpFnsList]};
Return[Flatten[rData]];
]

modh=2;mupper=10;
simpFnsList={Factor,FS,Collect[Expand[#],n^_,FS]&};
Table[{Index->m,CF[getS1CoeffModData[modh,m,n,simpFnsList]]},{m,1,mupper}] // TF

Compute tables to verify special cases of these congruences:

p2nm[n_,m_]:=Which[
m==1,Power[2,n]/4,
m==2,3/16*Power[2,n]*(n-1),
m==3,Power[2,n-7](9n-20)(n-1),
m==4,Power[2,n-9]*(3n-10)(3n-7)(n-1),
m==5,Power[2,n-13]*(27 n^3-279 n^2+934n-1008)*(n-1),
m==6,Power[2,n-15]/5*(9 n^2-71n+120)*(3n-14)(3n-11)*(n-1),
m==7,(1/15) (2^(-18+n)) (-1+n) (-411840+494792 n-229630 (n^2)+51705 (n^3)-5670 (n^4)+243 (n^5)),
m==8,(1/35) (2^(-20+n)) (-6+n) (-5+n) (-1+n) (120120-112582 n+36873 (n^2)-5022 (n^3)+243 (n^4)),
m==9,(1/105) (2^(-25+n)) (-1+n) (-326726400+454695280 n-261810612 (n^2)+81223688 (n^3)-14717115 (n^4)+1562085 (n^5)-90153 (n^6)+2187 (n^7)),
m==10,(1/105) (2^(-27+n)) (-1+n) (-22+3 n) (-19+3 n) (2970240-3487048 n+1614466 (n^2)-379279 (n^3)+47925 (n^4)-3105 (n^5)+81 (n^6)),
True,"Error!"
]
p2nmCongFn[n_,m_]:=Which[
n<m,0,
n==m,1,
n>m,p2nm[n,m]
]

modh=2;modOffset=-1;
nupper=18;mupper=10;
Table[cong[m,n]->{Mod[S1[n,m],modh,
modOffset],Mod[SeriesCoefficient[Power[x,Ceiling[n/2]]*Power[x+1,Floor[n/2]],{x,0,m}],modh,modOffset],Mod[Binomial[Floor[n/2],m-Ceiling[n/2]],modh,modOffset],Mod[p2nmCongFn[n,m],modh,modOffset]},{n,0,nupper},{m,1,mupper}] // TF

▶▶▶ Congruences for the Stirling numbers modulo 3:

Series expansions of the convergent function in powers of R:

{modh,seriesRUpper}={3,6};
FS[Conv[modh,1,R,z]]
Series[%,{R,0,seriesRUpper}]

Reflected denominator roots:

(z^2)*(((1-6 z+6 (z^2))/.(z->1/z))) // Expand
Solve[%==0]

Compute several particular cases of the series coefficients:

modh=3;mupper=4;
rootSubsts={3-(Sqrt[3])->r[1],3+(Sqrt[3])->r[2]};
simpFnsList={(#/.rootSubsts)&,Factor[#/.rootSubsts]&,FS[#]/.rootSubsts&,Collect[Expand[FS[#]/.rootSubsts],r[_]^_,Collect[#1,n^_,FS]&]&,Collect[Expand[FS[#]/.rootSubsts],r[_]^_,Collect[#1,Sqrt[3],Factor]&]&,Collect[Expand[FS[#]/.rootSubsts],n^_,Collect[#1,Sqrt[3],Factor]&]&};
Table[{Index->m,CF[getS1CoeffModData[modh,m,n,simpFnsList]]},{m,1,mupper}] // TF

Compute tables to verify special cases of these congruences:

p3nm[n_,m_,j_]:=Which[
m==1,(9-5*j*Sqrt[3])/36,
m==2,((44n-41)+(24-25n)*j*Sqrt[3])/216,
m==3,((1299 n^2-3837 n+2412)+(-745 n^2+2217 n-1418)*j*Sqrt[3])/15552,
m==4,((6409 n^3-38778 n^2+70901 n-37092)-(3690 n^3-22374 n^2+41088 n-21708)*j*Sqrt[3])/279936,
True,"ERROR!"
]
p3nmCongFn[n_,m_]:=Which[
n<m,0,
n==m,1,
n>m,Sum[Expand[p3nm[n,m,j]*Power[3+j*Sqrt[3],n]],{j,{-1,1}}]
]

modh=3;modOffset=0;
nupper=18;mupper=4;
Table[cong[m,n]->{Mod[S1[n,m],modh,modOffset],Mod[SeriesCoefficient[Power[x,Ceiling[n/3]]Power[x+1,Ceiling[(n-1)/3]]Power[x+2,Floor[n/3]],{x,0,m}],modh,modOffset],Mod[Sum[Binomial[Ceiling[(n-1)/3],k]Binomial[Floor[n/3],m-k-Ceiling[n/3]]*Power[2,Ceiling[n/3]+Floor[n/3]-(m-k)],{k,0,m}],modh,modOffset],Mod[p3nmCongFn[n,m],modh,modOffset]},{n,0,nupper},{m,1,mupper}] // TF

▶▶ New congruence properties and rational generating functions for the r-order harmonic number sequences:

▶▶▶ Rational generating functions for the first-order harmonic numbers:

printRationalHNum1GFs[convfnh_,rpow_,denomPow_,nupper_,modOffset_:-1]:=Module[{sc,numfn,denomfn,convFnData,gfzv2,gfzv1,gfzv0},
sc=SeriesCoefficient[Conv[convfnh,1,R,z],{R,0,rpow}] // FS;
numfn=Factor[Numerator[sc]];
denomfn=Factor[PE[Power[Denominator[sc],1/(rpow)]]];
convFnData={{ConvFn,sc,Factor[sc]},{ConvNumFn,numfn},{ConvDenomFn,denomfn},{ConvDenomPowFn,denomPow}};
Print[TF[convFnData]];
Print[TF[Map[{OverZPow->#1,Apart[FS[sc]/Power[z,#1]]}&,Reverse[Range[0,2]]]]];
Print[TF[Map[{OverZPow->#1,Collect[Apart[FS[sc]/Power[z,#1]],(denomPow)^_,Factor]}&,Reverse[Range[0,2]]]]];
{gfzv2,gfzv1,gfzv0}=Map[Apart[FS[sc]/Power[z,#1]]&,Range[0,2]];
Print[TF[Table[{Index->n,Mod[(n!)*HarmonicNumber[n,1],convfnh,modOffset],Mod[SeriesCoefficient[gfzv2,{z,0,n+1}],convfnh,modOffset],Mod[SeriesCoefficient[gfzv1,{z,0,n}],convfnh,modOffset],Mod[SeriesCoefficient[gfzv0,{z,0,n-1}],convfnh,modOffset]},{n,0,nupper}]]];
]

Congruences modulo 2:

convfnh=2;rpow=2;nupper=25;modOffset=-1;
denomPow=(-1+2 z);
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

Congruences modulo 3:

convfnh=3;rpow=2;nupper=25;modOffset=-1;
denomPow=(1-6 z+6 (z^2));
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

Congruences modulo 4:

convfnh=4;rpow=2;nupper=25;modOffset=-1;
denomPow=(-1+12 z-36 (z^2)+24 (z^3));
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

Congruences modulo 5:

convfnh=5;rpow=2;nupper=25;modOffset=-1;
denomPow=(1-20 z+120 (z^2)-240 (z^3)+120 (z^4));
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

Congruences modulo 6:

convfnh=6;rpow=2;nupper=25;modOffset=-1;
denomPow=(-1+30 z-300 (z^2)+1200 (z^3)-1800 (z^4)+720 (z^5));
printRationalHNum1GFs[convfnh,rpow,denomPow,nupper,modOffset]

▶▶▶ Rational generating functions for the second-order and third-order harmonic numbers:

scn[convp_,m_,n_]:=scn[convp,m,n]=SeriesCoefficient[Conv[convp,1,R,z],{R,0,m},{z,0,n},Assumptions->n≥0]
getRationalGF[cfFn_,z_,nupper_,nmin_:4]:=Module[{fsfData,linrec,denom,num,coeffs,gfz},
fsfData=Table[cfFn[n],{n,0,nupper}];
linrec=FindLinearRecurrence[fsfData];
denom=(-1+Sum[(linrec)[[i]]*Power[z,i],{i,1,Length[linrec]}]) // Factor;
num=Sum[a[i]*Power[z,i],{i,0,Length[linrec]+nmin}];
coeffs=Table[SeriesCoefficient[num/denom,{z,0,n}]==cfFn[n],{n,0,Length[linrec]+nmin}] // Solve;
gfz=Factor[(num/denom)/.(coeffs)][[1]];
Return[gfz];
]

cfFnV1[convp_,n_]:=(scn[convp,2,n]^2-2*scn[convp,1,n]*scn[convp,3,n])
cfFnV2[convp_,n_]:=(scn[convp,2,n]^3-3*scn[convp,1,n]*scn[convp,2,n]*scn[convp,3,n]+3*(scn[convp,1,n]^2)*scn[convp,4,n])
cfFnV3[convp_,n_]:=(scn[convp,2,n]^4-4*scn[convp,1,n]*(scn[convp,2,n]^2)*scn[convp,3,n]+4*(scn[convp,1,n]^2)*scn[convp,2,n]*scn[convp,4,n]+2*(scn[convp,1,n]^2)*(scn[convp,3,n]^2)-4*(scn[convp,1,n]^3)*scn[convp,5,n])

gfSimpFn={ConvP->convp,ROrder->First[#2]+1,ConvFnGFDenom->Factor[Denominator[FS[#1]]],ConvFnGFApart->Apart[FS[#1]],ConvFnGFApartTeXForm->TeXForm[Apart[FS[#1]]],ConvFnGF->Factor[#1],ConvFnGFTeXForm->TeXForm[Factor[#1]],ConvFnGFV2->FS[#1],ConvFnGFSeries->Series[Factor[#1],{z,0,12}]}&;

printRationalHNum23GFs[convp_,cfnupper_,modOffset_:-1]:=Module[{gfzv1,gfzv2,modCoeffsTbl},
gfzv1=getRationalGF[cfFnV1[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv1,{1}]],"\n"];
gfzv2=getRationalGF[cfFnV2[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv2,{2}]],"\n"];
modCoeffsTbl=Table[{Index->n,Mod[Power[(n)!,2]*HarmonicNumber[n,2],convp,modOffset],Mod[SeriesCoefficient[gfzv1,{z,0,n}],convp,modOffset],
Index->n,Mod[Power[(n)!,3]*HarmonicNumber[n,3],convp,modOffset],Mod[SeriesCoefficient[gfzv2,{z,0,n}],convp,modOffset]},{n,0,Min[10,5+2*convp]}];
Print[TF[modCoeffsTbl]];
]

Compute the congruence expansions modulo 2:

convp=2;cfnupper=50;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 3:

convp=3;cfnupper=50;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 4:

convp=4;cfnupper=150;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 5:

convp=5;cfnupper=200;modOffset=-1;
printRationalHNum23GFs[convp,cfnupper,modOffset]

▶▶▶ Computational routines to generate further cases of the rational generating functions for the second-order, third-order, and fourth-order harmonic number sequences:

scn[convp_,m_,n_]:=scn[convp,m,n]=SeriesCoefficient[Conv[convp,1,R,z],{R,0,m},{z,0,n},Assumptions->n≥0]
getRationalGF[cfFn_,z_,nupper_,nmin_:4]:=Module[{fsfData,linrec,denom,num,coeffs,gfz},
fsfData=Table[cfFn[n],{n,0,nupper}];
linrec=FindLinearRecurrence[fsfData];
denom=(-1+Sum[(linrec)[[i]]*Power[z,i],{i,1,Length[linrec]}]) // Factor;
num=Sum[a[i]*Power[z,i],{i,0,Length[linrec]+nmin}];
coeffs=Table[SeriesCoefficient[num/denom,{z,0,n}]==cfFn[n],{n,0,Length[linrec]+nmin}] // Solve;
gfz=Factor[(num/denom)/.(coeffs)][[1]];
Return[gfz];
]

cfFnV1[convp_,n_]:=(scn[convp,2,n]^2-2*scn[convp,1,n]*scn[convp,3,n])
cfFnV2[convp_,n_]:=(scn[convp,2,n]^3-3*scn[convp,1,n]*scn[convp,2,n]*scn[convp,3,n]+3*(scn[convp,1,n]^2)*scn[convp,4,n])
cfFnV3[convp_,n_]:=(scn[convp,2,n]^4-4*scn[convp,1,n]*(scn[convp,2,n]^2)*scn[convp,3,n]+4*(scn[convp,1,n]^2)*scn[convp,2,n]*scn[convp,4,n]+2*(scn[convp,1,n]^2)*(scn[convp,3,n]^2)-4*(scn[convp,1,n]^3)*scn[convp,5,n])

gfSimpFn={ConvP->convp,ROrder->First[#2]+1,ConvFnGFDenom->Factor[Denominator[FS[#1]]],ConvFnGFApart->Apart[FS[#1]],ConvFnGFApartTeXForm->TeXForm[Apart[FS[#1]]],ConvFnGF->Factor[#1],ConvFnGFTeXForm->TeXForm[Factor[#1]],ConvFnGFV2->FS[#1],ConvFnGFSeries->Series[Factor[#1],{z,0,12}]}&;

printRationalHNum234GFs[convp_,cfnupper_,modOffset_:-1]:=Module[{gfzv1,gfzv2,gfzv3,modCoeffsTbl},
gfzv1=getRationalGF[cfFnV1[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv1,{1}]],"\n"];
gfzv2=getRationalGF[cfFnV2[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv2,{2}]],"\n"];
gfzv3=getRationalGF[cfFnV3[convp,#1]&,z,cfnupper]/z;
Print[CF[gfSimpFn[gfzv2,{3}]],"\n"];
modCoeffsTbl=Table[{Index->n,Mod[Power[(n)!,2]*HarmonicNumber[n,2],convp,modOffset],Mod[SeriesCoefficient[gfzv1,{z,0,n}],convp,modOffset],
Index->n,Mod[Power[(n)!,3]*HarmonicNumber[n,3],convp,modOffset],Mod[SeriesCoefficient[gfzv2,{z,0,n}],convp,modOffset],
Index->n,Mod[Power[(n)!,4]*HarmonicNumber[n,4],convp,modOffset],Mod[SeriesCoefficient[gfzv3,{z,0,n}],convp,modOffset]},{n,0,Min[10,5+2*convp]}];
Print[TF[modCoeffsTbl]];
]

Compute the congruence expansions modulo 2:

convp=2;cfnupper=50;modOffset=-1;
printRationalHNum234GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 3:

convp=3;cfnupper=125;modOffset=-1;
printRationalHNum234GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 4:

convp=4;cfnupper=250;modOffset=-1;
printRationalHNum234GFs[convp,cfnupper,modOffset]

Compute the congruence expansions modulo 5:

convp=5;cfnupper=300;modOffset=-1;
printRationalHNum234GFs[convp,cfnupper,modOffset]

▶▶ Generalized cases of the congruence formulas for the α-factorial function sequences:

The special case results for the α-factorial functions given in the introduction:
See the expansions given in Section 2 of the introduction above.

Tables of Reflected Numerator Polynomials: 
The reflected numerator polynomials are defined by 
(OverTilde[FP])(α,R,z) := (z^(h-1)) FP(α,R,(1/z))
(See the tables in the last section of this notebook below.)

Generating the Congruences Modulo p (and pα) Tables for p:=2,3,4,5 and α∈{1,2,3,4}
(See the appendix section at the end of the notebook for generating these table listings.)

Compute Additional Tables to Verify the Generalized Congruences for the α-Factorial Functions (mod p (α^i))
(See the appendix section at the end of the notebook for generating the table listings.)

The following code is also used to compute some of these extended tables:

RpConvFn[p_,alpha_,n_]:=SeriesCoefficient[Conv[p,-alpha,n,z],{z,0,Floor[(n+alpha-1)/alpha]}]
getCongruenceRow[p_,alpha_,n_]:=Flatten[Prepend[Table[{Mod[AlphaFactorial[alpha,n],p*Power[alpha,i],0],Mod[RpConvFn[p,alpha,n],p*Power[alpha,i],0]},{i,0,p}],{p,alpha,n,AlphaFactorial[alpha,n],RpConvFn[p,alpha,n]}]]

getModString[modulo_]:=ToString[StringForm["(`1`)",modulo]]
getCongruenceRowHeader[p_,alpha_]:=Module[{tblHeaderCols,tblFnValueCols,computedFnModLabels,fullTblHeaderData},
tblHeaderCols={ToString[StringForm["p ↦ `1`",p]],ToString[StringForm["α ↦ `1`",alpha]],n};
tblFnValueCols={"(Subscript[n!, (α)])","(Subscript[(OverTilde[R]), p]^((α)))(n)"};
computedFnModLabels=Table[{"(Subscript[n!, (α)]) " <> getModString[p*Power[alpha,i]],"(Subscript[(OverTilde[R]), p]^((α)))(n) " <> getModString[p*Power[alpha,i]]},{i,0,p}];
fullTblHeaderData=Flatten[{tblHeaderCols,tblFnValueCols,computedFnModLabels}];
fullTblHeaderData=Map[Style[#1,Bold]&,fullTblHeaderData];
Return[fullTblHeaderData];
]
getCongruenceRow[p_,alpha_,n_]:=Flatten[Prepend[Table[{Mod[AlphaFactorial[alpha,n],p*Power[alpha,i],0],Mod[RpConvFn[p,alpha,n],p*Power[alpha,i],0]},{i,0,p}],{p,alpha,n,AlphaFactorial[alpha,n],RpConvFn[p,alpha,n]}]]

Clear[TableGrid]
TableGrid[table_,maxCols_:10]:=Text@Grid[table,Background->{{LightCyan,Green,Lighter[Blue,0.8],LightGreen,LightPurple}},Frame->True,Alignment->{{Center,Center,Center,Left,Left,Center,Center,Center,Center}},Dividers->{Flatten[{True,True,True,True,True,True,False,True,Table[{False,True},{c,1,maxCols}]}]},Frame->All]

{pval,alphamin,alphamax,nupper}={2,2,5,16};
Flatten[Table[Prepend[Table[getCongruenceRow[pval,alpha,n],{n,1,nupper+2*pval-1}],getCongruenceRowHeader[pval,alpha]],{alpha,alphamin,alphamax}],1] // TableGrid

{pval,alphamin,alphamax,nupper}={3,2,5,16};
Flatten[Table[Prepend[Table[getCongruenceRow[pval,alpha,n],{n,1,nupper+2*pval-1}],getCongruenceRowHeader[pval,alpha]],{alpha,alphamin,alphamax}],1] // TableGrid

{pval,alphamin,alphamax,nupper}={4,2,5,24};
Flatten[Table[Prepend[Table[getCongruenceRow[pval,alpha,n],{n,1,nupper+2*pval-1}],getCongruenceRowHeader[pval,alpha]],{alpha,alphamin,alphamax}],1] // TableGrid

{pval,alphamin,alphamax,nupper}={5,2,5,18};
Flatten[Table[Prepend[Table[getCongruenceRow[pval,alpha,n],{n,1,nupper+2*pval-1}],getCongruenceRowHeader[pval,alpha]],{alpha,alphamin,alphamax}],1] // TableGrid

▶▶ Examples of the hybrid rational generating function constructions:

▶▶▶ Generating the central binomial coefficients:

Generating the Central Binomial Coefficients,(Binomial[2 n, n]):

nupper=12;
Table[{Index->n,Binomial[2 n,n],Power[2,n]*Factorial2[2n-1]/Factorial[n],Power[2,n]*pn[n-1,-2,2n-1]/Factorial[n],Power[2,2 n]*Pochhammer[1/2,n]/Factorial[n],Index->n,SeriesCoefficient[FS[Exp[2x]/x*Conv[n,-2,2n-1,z/x]],{z,0,n-1},{x,0,0}],SeriesCoefficient[FS[Exp[2x]*Conv[n,-2,2n-1,z/x]],{z,0,n-1},{x,0,1}],SeriesCoefficient[FS[Exp[2x]*Conv[n,2,1,z/x]],{z,0,n},{x,0,0}]},{n,0,nupper}] // TF // Expand

Sum[Power[z,n]/(Factorial[n]^2),{n,0,Infinity}]
Factor[(%)/.(z->x1)]

nupper=10;
Table[{Index->n,Binomial[2n,n],Power[2,2n]*Pochhammer[1,n]*Pochhammer[1/2,n]/(Factorial[n]^2),AlphaFactorial[2,2n]*AlphaFactorial[2,2n-1]/(Factorial[n]^2),
Index->n,SeriesCoefficient[Conv[n,2,2,z/x2]*Conv[n,2,1,x2/x1]*(BesselI[0,2 (Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,-2,2n,z/x2]*Conv[n,-2,2n-1,x2/x1]*(BesselI[0,2 (Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Paired binomial coefficient products:

Generating the Binomial Coefficient Products,(Binomial[3n, n]) ×(Binomial[2n, n]):

Sum[Power[z,n]/(Factorial[n]^2),{n,0,Infinity}]
Factor[(%)/.(z->x1)]
Sum[Power[z,n]/(Factorial[n]^3),{n,0,Infinity}] // FS

nupper=10;
Table[{Index->n,Binomial[3n,3]*Binomial[2n,n],Power[3,3n]*Pochhammer[1/3,n]*Pochhammer[2/3,n]/(Factorial[n]^2),Power[3,n]*AlphaFactorial[3,3n-1]*AlphaFactorial[3,3n-2]/(Factorial[n]^2),
Index->n,SeriesCoefficient[Conv[n,3,1,3*z/x2]*Conv[n,3,2,x2/x1]*(BesselI[0,2 (Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,-3,3n-1,3*z/x2]*Conv[n,-3,3n-2,x2/x1]*(BesselI[0,2 (Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Footnote: Computations of the special case modified exponential series generating function sums:

Sum explicit special cases of the exponential series generating functions, (Subscript[(OverHat[E]), a])(z) := (∑_(n≥0))((z^n)/((an)!)) = (1/a)×( (∑_(0≤m< a))exp((z^(1/a)) (Subscript[ω, a]^m))),for a∈{2,3,4} where (Subscript[ω, a]):= exp(((2 π \[ScriptDotlessI])/a)) denotes the primitive (a^th) root of unity:

Sum[Power[z,n]/Factorial[2 n],{n,0,Infinity}] // FS // Factor
FS[%/.(z->x1)] // Factor
Sum[Power[z,n]/Factorial[3 n],{n,0,Infinity}] // FS
FS[%/.(z->x1)] // Factor
Sum[Power[z,n]/Factorial[4 n],{n,0,Infinity}] // FS
FS[%/.(z->x1)] // Factor

Powers of the roots of unity in the previous exponential series generating function formulas:

Exp[2*Pi*I/3] // FE // CE
FactorTerms[%]
Exp[2*Pi*I/3*2] // FE // CE
FactorTerms[%]
Exp[2*Pi*I/4] // FE // CE
FactorTerms[%]

▶▶▶ Generating the special case factorial function ratios and binomial coefficient identities:

Related Identitied for Generating the Binomial Coefficients,(Binomial[4n, 2n]), (Binomial[6n, 3n]) ,and(Binomial[8n, 4n]):

Convergent-based generating functions for the identities:
(((4 n)!)/((2 n)!))=(4^(3 n)) (Pochhammer[(1/4), n]) (Pochhammer[(3/4), n])      and         (Binomial[4 n, 2 n])=(((4^(3 n)) (Pochhammer[(1/4), n]) (Pochhammer[(3/4), n]))/((2 n)!))

Sum[Power[z,n]/Factorial[2 n],{n,0,Infinity}] // FS // Factor
FS[%/.(z->x1)] // Factor

nupper=6;
Table[{Index->n,Factorial[4 n]/Factorial[2 n],Power[4,3n]*Pochhammer[1/4,n]*Pochhammer[3/4,n],Power[4,n]*AlphaFactorial[4,4n-3]*AlphaFactorial[4,4n-1],SeriesCoefficient[Conv[n,4,3,4*z/x1]*Conv[n,4,1,x1],{z,0,n},{x1,0,0}],SeriesCoefficient[Conv[n+1,-4,4n-3,4z/x1]*Conv[n+1,-4,4n-1,x1],{z,0,n},{x1,0,0}]},{n,0,nupper}] // TF

nupper=6;
Table[{Index->n,Binomial[4n,2n],Power[4,3n]*Pochhammer[1/4,n]*Pochhammer[3/4,n]/Factorial[2n],SeriesCoefficient[Conv[n,4,3,4*z/x2]*Conv[n,4,1,x2/x1]*(Cosh[(Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n+1,-4,4n-3,4z/x2]*Conv[n+1,-4,4n-1,x2/x1]*(Cosh[(Sqrt[x1])]),{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

Convergent-based generating functions for the identities:
(((6 n)!)/((3 n)!))=(1728^n) (Pochhammer[(1/6), n]) (Pochhammer[(1/2), n]) (Pochhammer[(5/6), n])      and         (Binomial[6 n, 3 n])=(((1728^n) (Pochhammer[(1/6), n]) (Pochhammer[(1/2), n]) (Pochhammer[(5/6), n]))/((3 n)!))

nupper=6;
Table[{Index->n,Factorial[6 n]/Factorial[3 n],Power[1728,n]*Pochhammer[1/6,n]*Pochhammer[1/2,n]*Pochhammer[5/6,n],SeriesCoefficient[Conv[n,6,5,24*z/x2]*Conv[n,2,1,x2/x1]*Conv[n,6,1,x1],{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

Sum[Power[z,n]/Factorial[3 n],{n,0,Infinity}] // FS // Factor
FS[%/.(z->x1)] // Factor

nupper=6;
Table[{Index->n,Factorial[6 n]/Factorial[3 n],Power[1728,n]*Pochhammer[1/6,n]*Pochhammer[1/2,n]*Pochhammer[5/6,n],Power[8,n]*AlphaFactorial[6,6n-5]*AlphaFactorial[6,6n-3]*AlphaFactorial[6,6n-1],SeriesCoefficient[Conv[n,6,5,24*z/x2]*Conv[n,2,1,x2/x1]*Conv[n,6,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,6,5,8*z/x2]*Conv[n,6,3,x2/x1]*Conv[n,6,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,-6,6n-5,8*z/x2]*Conv[n,-6,6n-3,x2/x1]*Conv[n,-6,6n-1,x1],{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=6;
Table[{Index->n,Binomial[6 n,3n],Power[1728,n]*Pochhammer[1/6,n]*Pochhammer[1/2,n]*Pochhammer[5/6,n]/Factorial[3n],SeriesCoefficient[Conv[n,6,5,8*z/x3]*Conv[n,6,3,x3/x2]*Conv[n,6,1,x2/x1]*((1/3) (E^(-((x1^(1/3))/2))) ((E^((3 (x1^(1/3)))/2))+2 Cos[(1/2) (Sqrt[3]) (x1^(1/3))])),{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,-6,6n-5,8*z/x3]*Conv[n,-6,6n-3,x3/x2]*Conv[n,-6,6n-1,x2/x1]*((1/3) (E^(-((x1^(1/3))/2))) ((E^((3 (x1^(1/3)))/2))+2 Cos[(1/2) (Sqrt[3]) (x1^(1/3))])),{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

Convergent-based generating functions for the identities:
(((8 n)!)/((4 n)!))=(2^(16 n)) (Pochhammer[(1/8), n]) (Pochhammer[(3/8), n]) (Pochhammer[(5/8), n]) (Pochhammer[(7/8), n])      and         (Binomial[8 n, 4 n])=(((2^(16 n)) (Pochhammer[(1/8), n]) (Pochhammer[(3/8), n]) (Pochhammer[(5/8), n]) (Pochhammer[(7/8), n]))/((4 n)!))

Sum[Power[z,n]/Factorial[4 n],{n,0,Infinity}] // FS // Factor
FS[%/.(z->x1)] // Factor

nupper=6;
Table[{Index->n,Factorial[8 n]/Factorial[4 n],Power[2,16n]*Pochhammer[1/8,n]*Pochhammer[3/8,n]*Pochhammer[5/8,n]*Pochhammer[7/8,n],Power[2,4 n]*AlphaFactorial[8,8n-7]*AlphaFactorial[8,8n-5]*AlphaFactorial[8,8n-3]*AlphaFactorial[8,8n-1],SeriesCoefficient[Conv[n,8,7,16*z/x3]*Conv[n,8,5,x3/x2]*Conv[n,8,3,x2/x1]*Conv[n,8,1,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=6;
Table[{Index->n,Binomial[8n,4n],Power[2,16n]*Pochhammer[1/8,n]*Pochhammer[3/8,n]*Pochhammer[5/8,n]*Pochhammer[7/8,n]/Factorial[4 n],SeriesCoefficient[Conv[n,8,7,16*z/x4]*Conv[n,8,5,x4/x3]*Conv[n,8,3,x3/x2]*Conv[n,8,1,x2/x1]*((1/2) (Cos[(x1^(1/4))]+Cosh[(x1^(1/4))])),{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Initial examples of the convergent-based generating function identities enumerating the subfactorial function (sequence of derangements):

!n ===Subfactorial(n) :=  n! ×( (∑_(k=0)^n)((((-1))^k)/(k!))) = ((n!)/(0!))-((n!)/(1!))+...+(((((-1))^n)n!)/(n!))
(See also the convergent generating function expansions of the series for the identities in the previous section):

nupper=10;
Table[{Index->n,Subfactorial[n],Factorial[n]*SeriesCoefficient[Exp[-x]/(1-x),{x,0,n}],
Index->n,Factorial[n]*Sum[Power[-1,k]/Factorial[k],{k,0,n}],SeriesCoefficient[Conv[n,1,1,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,-1,n,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

Note that a known EGF for the subfactorial function is given by: (Subscript[(OverHat[D]), superfactorial])(z) = ((e^(-z))/(1-z))
First perform the Laplace-Borel transform (or corresponding regularized sums for the sequence OGF) by integrating over the previous EGF, 
and then compare to the previous results for the regularized sum generating functions from the introduction:

Integrate[Exp[-t]/(1+t x),{t,0,Infinity}]
Integrate[Exp[-t]/(1-t x),{t,0,Infinity}]
Integrate[Exp[-t]*Exp[-t x]/(1-t x),{t,0,Infinity}]

scfupper=12;
Series[-(((E^(-1/x)) Gamma[0,-(1/x)])/x),{x,0,scfupper}]
Sum[Factorial[n]*Power[z,n],{n,0,scfupper}]
Series[((-1/x)(E^(-(1+1/x))) Gamma[0,-(1+(1/x))]),{x,0,scfupper}]
Sum[Subfactorial[n]*Power[z,n],{n,0,scfupper}]

▶▶ Expansions of arithmetic progressions of the single factorial function:

▶▶▶ Verify the Expansions by Multiplication Formulas for the Pochhammer Symbol:

The multiplication formula expansions of the Pochhammer symbol:

aupper=6;rupper=6;nupper=12;
Table[facts[a,r,n]->{{Factorial[a n+r]-Product[AlphaFactorial[a,a n+r-j],{j,0,a-1}]},{Factorial[a n+r]-Factorial[r]*Power[a,a n]*Product[Pochhammer[(j+r+1)/a,n],{j,0,a-1}]},{Factorial[a n+r]-Factorial[r]*Power[a,a n]*Product[Pochhammer[1+(r-j)/a,n],{j,0,a-1}]}},{n,1,nupper},{a,2,aupper},{r,0,rupper}] // TF

Another example of a product-based identity expanding the single factorial function, (αn)!,by products of sums over the generalized coefficients:

nupper=12;alphaupper=6;
Table[aprog[a,n]->{Factorial[a n]-Product[Sum[Fcf[a,n+1,m+1]*Power[-1,n-m]*Power[a n+1-i,m],{m,0,n}],{i,0,a-1}]},{n,1,nupper},{a,1,alphaupper}] // TF

▶▶▶ Double factorial function expansion cases (a := 2):

nupper=10;
Table[{Index->n,Factorial[2 n],SeriesCoefficient[Conv[n,-1,n,2 z/x]*Conv[n,-2,2n-1,x],{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,1,x],{z,0,n},{x,0,0}],Index->n,Factorial[2 n+1],SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,1,x],{z,0,n},{x,0,1}],SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,3,x],{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,Factorial[2 n]-SeriesCoefficient[Conv[n,-1,n,2 z/x]*Conv[n,-2,2n-1,x],{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,1,x],{z,0,n},{x,0,0}],Index->n,Factorial[2 n+1]-SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,3,x],{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,1,1,2 z/x]*Conv[n,2,1,x],{z,0,n},{x,0,1}]},{n,0,nupper}] // TF

▶▶▶ Triple factorial function expansion cases (a := 3):

The triple factorial function and Pochhammer symbol expansions generated by the identities stated in the article:

nupper=10;
Table[{Index->n,Factorial[3 n],Power[3,3 n]*Pochhammer[1,n]*Pochhammer[1/3,n]*Pochhammer[2/3,n],AlphaFactorial[3,3 n]*AlphaFactorial[3,3 n-1]*AlphaFactorial[3,3 n-2],SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,2,x2/x1]*Conv[n,3,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+1],Power[3,3 n]*Pochhammer[1,n]*Pochhammer[2/3,n]*Pochhammer[4/3,n],AlphaFactorial[3,3 n]*AlphaFactorial[3,3 n+1]*AlphaFactorial[3,3 n-1],Factorial[3 n+1]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,4,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+2],2*Power[3,3 n]*Pochhammer[1,n]*Pochhammer[5/3,n]*Pochhammer[4/3,n],AlphaFactorial[3,3 n]*AlphaFactorial[3,3 n+1]*AlphaFactorial[3,3 n+2],Factorial[3 n+2]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,1,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,1},{x1,0,0}]},{n,0,nupper}] // TF

Compute additional cases of the convergent function identities for these arithmetic progression sequences:

nupper=10;
Table[{Index->n,Factorial[3 n]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,2,x2/x1]*Conv[n,3,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+1]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,4,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+2]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,4,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,0},{x1,0,1}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,Factorial[3 n]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,2,x2/x1]*Conv[n,3,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+1]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,4,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+2]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,4,x2/x1]*Conv[n,3,2,x1],{z,0,n},{x2,0,0},{x1,0,1}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,Factorial[3 n]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,2,x2/x1]*Conv[n,3,1,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+1]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,3,2,x2/x1]*Conv[n,3,4,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+2]-SeriesCoefficient[2*Conv[n,1,1,3 z/x2]*Conv[n,3,5,x2/x1]*Conv[n,3,4,x1],{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,Factorial[3 n]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,-3,3 n-1,x2/x1]*Conv[n,-3,3 n-2,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+1]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,-3,3 n-1,x2/x1]*Conv[n,-3,3 n+1,x1],{z,0,n},{x2,0,0},{x1,0,0}],Index->n,Factorial[3 n+2]-SeriesCoefficient[Conv[n,1,1,3 z/x2]*Conv[n,-3,3 n+2,x2/x1]*Conv[n,-3,3 n+1,x1],{z,0,n},{x2,0,1},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Quadruple factorial function expansion cases (a := 4):

Pochhammer symbol expansions of these arithmetic progression sequences:

nupper=6;
Table[{Index->n,Factorial[4 n],Power[4,4 n]*Factorial[n]*Pochhammer[3/4,n]*Pochhammer[1/2,n]*Pochhammer[1/4,n],Index->n,Factorial[4 n+1],Power[4,4 n]*Factorial[n]*Pochhammer[3/4,n]*Pochhammer[1/2,n]*Pochhammer[5/4,n],Index->n,Factorial[4 n+2],Power[4,n]*Factorial[n]*Power[4,n]*Pochhammer[(3)/4,n]*(Power[4,n]*Pochhammer[6/4,n]*2)*Power[4,n]*Pochhammer[5/4,n],Index->n,Factorial[4 n+3],(6*Power[4,n]*Factorial[n]*Power[4,n]*Pochhammer[(7)/4,n]*(Power[4,n]*Pochhammer[6/4,n])*Power[4,n]*Pochhammer[5/4,n])},{n,0,nupper}] // TF

Compute the coefficients generated by several other of the arithmetic progression sequences, (an+r)!, when a := 4:

nupper=6;
Table[{Index->n,Factorial[4 n+2],AlphaFactorial[4,4 n]*AlphaFactorial[4,4 n-1]*AlphaFactorial[4,4(n+1)-2]*AlphaFactorial[4,4(n+1)-3],Index->n,Factorial[4 n],SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[4 n+1],SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,1}],Index->n,Factorial[4 n+2],SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,1},{x1,0,0}],Index->n,Factorial[4 n+3],SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,1},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=12;
Table[{Index->n,Factorial[4 n+2]-AlphaFactorial[4,4 n]*AlphaFactorial[4,4 n-1]*AlphaFactorial[4,4(n+1)-2]*AlphaFactorial[4,4(n+1)-3],Index->n,Factorial[4 n]-SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[4 n+1]-SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,1}],Index->n,Factorial[4 n+2]-SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,1},{x1,0,0}],Index->n,Factorial[4 n+3]-SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,1},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=12;
Table[{Index->n,Factorial[4 n+2]-AlphaFactorial[4,4 n]*AlphaFactorial[4,4 n-1]*AlphaFactorial[4,4(n+1)-2]*AlphaFactorial[4,4(n+1)-3],Index->n,Factorial[4 n+2]-2*Power[4,n]*Factorial[n]*Power[4,n]*Pochhammer[(3)/4,n]*(Power[4,n]*Pochhammer[6/4,n])*Power[4,n]*Pochhammer[5/4,n],Index->n,Factorial[4 n+2]-SeriesCoefficient[2*Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,6,x2/x1]*Conv[n,4,5,x1],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[4 n+2]-SeriesCoefficient[Conv[n,1,1,4z/x3]*Conv[n,4,3,x3/x2]*Conv[n,4,2,x2/x1]*Conv[n,4,1,x1],{z,0,n},{x3,0,0},{x2,0,1},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Quintuple factorial function expansion cases (a := 5):

Pochhammer symbol expansions of these arithmetic progression sequences:

nupper=6;
Table[{Index->n,Factorial[5 n],Power[5,5 n]*Factorial[n]*Pochhammer[4/5,n]*Pochhammer[3/5,n]*Pochhammer[2/5,n]*Pochhammer[1/5,n],Index->n,Factorial[5 n+1],Power[5,5 n]*Factorial[n]*Pochhammer[4/5,n]*Pochhammer[3/5,n]*Pochhammer[2/5,n]*Pochhammer[6/5,n],Index->n,Factorial[5 n+2],2*Power[5,5 n]*Factorial[n]*Pochhammer[4/5,n]*Pochhammer[3/5,n]*Pochhammer[7/5,n]*Pochhammer[6/5,n],Index->n,Factorial[5 n+3],6*Power[5,5 n]*Factorial[n]*Pochhammer[4/5,n]*Pochhammer[8/5,n]*Pochhammer[7/5,n]*Pochhammer[6/5,n],Index->n,Factorial[5 n+4],24*Power[5,5 n]*Factorial[n]*Pochhammer[9/5,n]*Pochhammer[8/5,n]*Pochhammer[7/5,n]*Pochhammer[6/5,n]},{n,0,nupper}] // TF

Convergent-based generating function identities for the single factorial function sequences when a:=5:

nupper=6;
Table[{Index->n,Factorial[5 n+3],AlphaFactorial[5,5 n]*AlphaFactorial[5,5 n-1]*AlphaFactorial[5,5(n+1)-2]*AlphaFactorial[5,5(n+1)-3]*AlphaFactorial[5,5(n+1)-4],Index->n,Factorial[5 n],SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[5 n+1],SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,1}],Index->n,Factorial[5 n+2],SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,1},{x1,0,0}],Index->n,Factorial[5 n+3],SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,1},{x2,0,0},{x1,0,0}],Index->n,Factorial[5 n+4],SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,1},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=12;
Table[{Index->n,Factorial[5 n+3]-AlphaFactorial[5,5 n]*AlphaFactorial[5,5 n-1]*AlphaFactorial[5,5(n+1)-2]*AlphaFactorial[5,5(n+1)-3]*AlphaFactorial[5,5(n+1)-4],Index->n,Factorial[5 n+3]-SeriesCoefficient[6*Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,8,x3/x2]*Conv[n,5,7,x2/x1]*Conv[n,5,6,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[5 n]-SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,0}],Index->n,Factorial[5 n+1]-SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,0},{x1,0,1}],Index->n,Factorial[5 n+2]-SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,0},{x2,0,1},{x1,0,0}],Index->n,Factorial[5 n+3]-SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,0},{x3,0,1},{x2,0,0},{x1,0,0}],Index->n,Factorial[5 n+4]-SeriesCoefficient[Conv[n,1,1,5z/x4]*Conv[n,5,4,x4/x3]*Conv[n,5,3,x3/x2]*Conv[n,5,2,x2/x1]*Conv[n,5,1,x1],{z,0,n},{x4,0,1},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶ Superfactorial functions:

▶▶▶ Generating the ordinary superfactorial function sequence case:

Computing the superfactorial sequence, (Subscript[S, 1,0])(n),and the Barnes G-Function,G(n+2),for integers n≥2:
Tables of the sequence values:

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[BarnesG[n+2]]],BarnesG[n+2],TraditionalForm[HoldForm[Product[k!,{k,1,n}]]],Product[k!,{k,1,n}]},{n,0,nupper}] // TF

Generating function identities to enumerate the superfactorial function sequence,(Subscript[S, 1])(n)==G(n+2):

n=4;Print[fn[x,##]&@@Reverse[Append[Table[{x[j],0,-1},{j,0,n-2}],{x[n],0,n}]]];Clear[n]

nupper=10;
Table[{Index->n,TraditionalForm[HoldForm[BarnesG[n+2]]],BarnesG[n+2],SeriesCoefficient[Product[Conv[n,-1,n-i,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,-1,1,x[1]],##]&@@Reverse[Append[Table[{x[j],0,-1},{j,1,n-1}],{x[n],0,n}]],SeriesCoefficient[Product[Conv[n,-1,n-i,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,-1,1,x[1]],##]&@@Append[Table[{x[j],0,-1},{j,1,n-1}],{x[n],0,n}],SeriesCoefficient[Product[Conv[n,1,1,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,1,1,x[1]],##]&@@Reverse[Append[Table[{x[j],0,-1},{j,1,n-1}],{x[n],0,n}]]},{n,2,nupper}] // TF

Listings of some particular cases of the simplified convergent function products from the previous tables:

nupper=5;
Table[{Index->n,TraditionalForm[HoldForm[BarnesG[n+2]]],BarnesG[n+2],CF[{ProductGFFormV1[n],FS[Product[Conv[n+1,-1,n-i,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n+1,-1,1,x[1]]],ProductGFFormV2[n],FS[Product[Conv[n,1,1,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,1,1,x[1]]]}]},{n,2,nupper}] // TF

▶▶▶ Generating the generalized cases of the superfactorial function sequence products:

Computing the generalized superfactorial sequences, (Subscript[S, α,r])(n),for integers n≥2from the convergent function generating functions expanded in the article:

nupper=8;alphaupper=6; 
Table[sfprod[a,d,n]->{({Product[AlphaFactorial[a,a j-d],{j,1,n}],SeriesCoefficient[Product[Conv[n,-a,a(n-i)-d,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,-a,a-d,x[1]],##]&@@Reverse[Append[Table[{x[j],0,-1},{j,1,n-1}],{x[n],0,n}]],SeriesCoefficient[Product[Conv[n,a,a-d,x[n-i]/x[n-i-1]],{i,0,n-2}]*Conv[n,a,a-d,x[1]],##]&@@Reverse[Append[Table[{x[j],0,-1},{j,1,n-1}],{x[n],0,n}]]}===ConstantArray[Product[AlphaFactorial[a,a j-d],{j,1,n}],3]),Product[AlphaFactorial[a,a j-d],{j,1,n}]},{n,1,nupper},{a,2,alphaupper},{d,0,a-1}] // TF

The noted identity for(Subscript[(α n)!, (α)]) =(α^n)n! 
(where 1+2+⋯+n = (Binomial[n+1, 2])):

nupper=10;alphaupper=6;
Table[sfdiffs[a,n]->{Product[AlphaFactorial[a,a j],{j,1,n}]-Power[a,Binomial[n+1,2]]*Product[Factorial[j],{j,1,n}]},{n,1,nupper},{a,1,alphaupper}] // TF

▶▶▶ Identities for special cases of the α-factorial products involving the Barnes G-function:

Some of the known special case product cases simplified with Mathematica:

{BarnesG[2-1/2],Gamma[1/2]}

Product[Factorial2[2 j-1],{j,1,n}]
Product[Power[2,j]*Gamma[j+1/2]/Gamma[1/2],{j,1,n}]
TraditionalForm[%]

Product[Power[4,j]*Gamma[j+2/4]/Gamma[2/4],{j,1,n}] // FS
TraditionalForm[%]

Identities for the binomial coefficient and Pochhammer symnol products for the generalized sequences:

nupper=10;alphaupper=6;
Table[sfprod[a,d,n]->{(FS[{Product[AlphaFactorial[a,a j-d],{j,1,n}],Product[Power[a,j]*Pochhammer[1-d/a,j],{j,1,n}],Product[Power[a,j]*Gamma[j+1-d/a]/Gamma[1-d/a],{j,1,n}],Power[a,Binomial[n+1,2]]*Product[Binomial[j-d/a,j]*Factorial[j],{j,1,n}],Power[a,Binomial[n+1,2]]*BarnesG[n+2]*Product[Binomial[j-d/a,-d/a],{j,1,n}],Power[a,Binomial[n+1,2]]*Product[Binomial[j-d/a,j]*Factorial[j],{j,1,n}]}]===ConstantArray[Product[AlphaFactorial[a,a j-d],{j,1,n}],6]),Product[AlphaFactorial[a,a j-d],{j,1,n}]},{a,2,alphaupper},{d,0,a-1},{n,1,nupper}] // TF

Triple factorial product identities:

Product[Power[3,j]*Gamma[j+2/3]/Gamma[2/3],{j,1,n}] // FS
Product[Power[3,j]*Gamma[j+1/3]/Gamma[1/3],{j,1,n}] // FS
{FE[FS[(BarnesG[5/3]/BarnesG[8/3])/(1/Gamma[5/3])]],N[(BarnesG[5/3]/BarnesG[8/3])/(1/Gamma[5/3])]}

Quadruple factorial product identities:

Product[Power[4,j]*Gamma[j+3/4]/Gamma[3/4],{j,1,n}]
Product[Power[4,j]*Gamma[j+2/4]/Gamma[2/4],{j,1,n}] // FS
Product[Power[4,j]*Gamma[j+1/4]/Gamma[1/4],{j,1,n}]
Table[{nval,((2^((-1+n) n)) ((BarnesG[(5/4)])^(-1+n)) ((BarnesG[(9/4)])^(-n)) BarnesG[(5/4)+n])/.(n->nval),N[((2^((-1+n) n)) ((BarnesG[(5/4)])^(-1+n)) ((BarnesG[(9/4)])^(-n)) BarnesG[(5/4)+n])/.(n->nval)]},{nval,1,4}]

Quintuple factorial product identities:

Product[Power[5,j]*Gamma[j+4/5]/Gamma[4/5],{j,1,n}]
Product[Power[5,j]*Gamma[j+3/5]/Gamma[3/5],{j,1,n}]
Product[Power[5,j]*Gamma[j+2/5]/Gamma[2/5],{j,1,n}]
Product[Power[5,j]*Gamma[j+1/5]/Gamma[1/5],{j,1,n}]

Verify the inductive guesses at the formulas for the generalized superfactorial products,(Subscript[S, α,d])(n),numerically:

nupper=6;alphaupper=5;
Table[sfdiffs[a,n,d]->{Product[AlphaFactorial[a,a j-d],{j,1,n}],N[Power[a,Binomial[n,2]]*Power[(a-d),n]*Power[BarnesG[2-d/a],n-1]*Power[BarnesG[3-d/a],-n]*BarnesG[n+2-d/a]]},{n,1,nupper},{a,1,alphaupper},{d,1,a-1}] // TF

nupper=6;alphaupper=5;
Table[sfdiffs[a,n,d]->{Product[AlphaFactorial[a,a j-d],{j,1,n}],N[Power[a,Binomial[n,2]]*Power[(a-d),n]*Power[Gamma[2-d/a],-n]*BarnesG[n+2-d/a]/BarnesG[2-d/a]]},{n,1,nupper},{a,1,alphaupper},{d,1,a-1}] // TF

nupper=10;alphaupper=6;
Table[sfdiffs[a,n,d]->{N[Product[AlphaFactorial[a,a j-d],{j,1,n}]]/N[Power[a,Binomial[n,2]]*Power[(a-d)/Gamma[2-d/a],n]*BarnesG[n+2-d/a]/BarnesG[2-d/a]]},{n,1,nupper},{a,1,alphaupper},{d,1,a-1}] // TF

▶▶ Enumerating sums of factorial-related sequences:

▶▶▶ Left factorials:

Tables to verify the convergent-based generating function identities enumerating the sequence of "left factorials" defined by the following sums: 
L[n!]:=(∑_(k=1)^n)k!         and/or          (∑_(k=0)^n)k!     and/or        (∑_(k=0)^(n-1))k!

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[Sum[Factorial[k],{k,1,n}]]],Sum[Factorial[k],{k,1,n}],SeriesCoefficient[1/(1-z)*(Conv[n+1,1,1,z]-1),{z,0,n}],Index->n,TraditionalForm[HoldForm[Sum[Factorial[k],{k,0,n}]]],Sum[Factorial[k],{k,0,n}],SeriesCoefficient[1/(1-z)*Conv[n+1,1,1,z],{z,0,n}],Index->n,TraditionalForm[HoldForm[Sum[Factorial[k],{k,0,n-1}]]],Sum[Factorial[k],{k,0,n-1}],SeriesCoefficient[z/(1-z)*Conv[n+1,1,1,z],{z,0,n}]},{n,0,nupper}] // TF

▶▶▶ Alternating factorials:

Tables to verify the convergent-based generating function identities enumerating the sequence of "alternating factorials" defined by the following sums: 
af(n):=(∑_(k=1)^n) (((-1))^(n-k)) ×k!         and/or         (∑_(k=0)^n) (((-1))^(n-k)) ×k!

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[Sum[Power[-1,n-k]*Factorial[k],{k,1,n}]]],Sum[Power[-1,n-k]*Factorial[k],{k,1,n}],SeriesCoefficient[1/(1+z)*(Conv[n+1,1,1,z]-1),{z,0,n}],Index->n,TraditionalForm[HoldForm[Sum[Power[-1,n-k]*Factorial[k],{k,0,n}]]],Sum[Power[-1,n-k]*Factorial[k],{k,0,n}],SeriesCoefficient[1/(1+z)*Conv[n+1,1,1,z],{z,0,n}]},{n,0,nupper}] // TF

▶▶▶ Generating the sums, (Subscript[sf, 2])(n), and the alternate identity for the sequence:

Tables to verify the convergent-based generating function identities enumerating the sequence of (Subscript[sf, 2])(n) defined by the following sums: 
(Subscript[sf, 2])(n) :=(∑_(k=1)^n)k×k! =(n+1)!-1

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[n*Factorial[n]]],n*Factorial[n],SeriesCoefficient[(x/Power[1-x,2])*Conv[n+1,1,1,z/x],{z,0,n},{x,0,0}],Index->n,TraditionalForm[HoldForm[Sum[k*Factorial[k],{k,0,n}]]],Sum[k*Factorial[k],{k,0,n}],SeriesCoefficient[1/(1-z)*(x/Power[1-x,2])*Conv[n+1,1,1,z/x],{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

Tables to verify the convergent-based generating function identities for the following alternate identity for the sums, (Subscript[sf, 2])(n):
(Subscript[sf, 2])(n) =(n+1)!-1 = (n+1)! × (∑_(k=0)^n)(k/((k+1)!))
where the OGF for the inner sum terms is given by 
(∑_(k=0)^∞)(k/((k+1)!))× (x^k) = ((1+(e^x) (-1+x))/x)

Sum[k/Factorial[k+1]*Power[x,k],{k,0,Infinity}] // FS

nupper=12;
Table[{Index->n,TraditionalForm[HoldForm[Sum[k*Factorial[k],{k,0,n}]]],Sum[k*Factorial[k],{k,0,n}],SeriesCoefficient[Conv[n+2,-1,n+1,z/x]*(1/(1-x)/x-Exp[x]/x),{x,0,0},{z,0,n}],SeriesCoefficient[Conv[n+2,-1,n+1,z/x]*(1/(1-x)/x-Exp[x]/x),{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n+1,1,1,z/x]*(1/(1-x)/x-Exp[x]/x),{z,0,n+1},{x,0,-1}],SeriesCoefficient[Conv[n+1,1,1,z/x]*(1/(1-x)-Exp[x]),{z,0,n+1},{x,0,0}]},{n,0,nupper}] // TF

▶▶▶ Squares of the single, double, and triple factorial functions:

nupper=6;
Table[{Index->n,TraditionalForm[HoldForm[Factorial[n]^2]],Factorial[n]^2,SeriesCoefficient[Conv[n,1,1,x]*Conv[n,1,1,z/x]+1,{z,0,n},{x,0,0}],Index->n,TraditionalForm[HoldForm[Sum[Factorial[k]^2,{k,0,n}]]],Sum[Factorial[k]^2,{k,0,n}],SeriesCoefficient[1/(1-z)*Conv[n,1,1,x]*Conv[n,1,1,z/x]+1,{z,0,n},{x,0,0}],Index->n,TraditionalForm[HoldForm[Sum[Factorial[k]^2,{k,1,n}]]],Sum[Factorial[k]^2,{k,1,n}],SeriesCoefficient[1/(1-z)*(Conv[n,1,1,x]*Conv[n,1,1,z/x]-1)+1,{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,TraditionalForm[HoldForm[Factorial2[n]^2]],Factorial2[n]^2,SeriesCoefficient[Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+z*Conv[n+1,2,3,x]*Conv[n+1,2,3,z^2/x],{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+1/z*Conv[n+1,2,1,x]*Conv[n+1,2,1,z^2/x],{z,0,n},{x,0,0}],
Index->n,TraditionalForm[HoldForm[Sum[Factorial2[k]^2,{k,0,n}]]],Sum[Factorial2[k]^2,{k,0,n}],SeriesCoefficient[1/(1-z)*(Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+1/z*Conv[n+1,2,1,x]*Conv[n+1,2,1,z^2/x]-1),{z,0,n},{x,0,0}],SeriesCoefficient[1/(1-z)*(Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+z*Conv[n+1,2,3,x]*Conv[n+1,2,3,z^2/x]),{z,0,n},{x,0,0}],SeriesCoefficient[1/(1-z)*(Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+z*Conv[n+1,2,3,x]*Conv[n+1,2,3,z^2/x]),{z,0,n},{x,0,0}],Index->n,TraditionalForm[HoldForm[Sum[Factorial2[k]^2,{k,1,n}]]],Sum[Factorial2[k]^2,{k,1,n}],SeriesCoefficient[1/(1-z)*(Conv[n+1,2,2,x]*Conv[n+1,2,2,z^2/x]+z*Conv[n+1,2,3,x]*Conv[n+1,2,3,z^2/x]-1),{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

nupper=10;
Table[{Index->n,AlphaFactorial[3,n]^2,SeriesCoefficient[(Conv[n+1,3,3,x]*Conv[n+1,3,3,z^3/x]+1/(z^1)*Conv[n+1,3,2,x]*Conv[n+1,3,2,z^3/x]+1/(z^2)*Conv[n+1,3,1,x]*Conv[n+1,3,1,z^3/x]),{z,0,n},{x,0,0}],
Index->n,Sum[AlphaFactorial[3,k]^2,{k,-2,n}],SeriesCoefficient[(z^0)/(1-z)*(Conv[n+1,3,3,x]*Conv[n+1,3,3,z^3/x]+1/z*Conv[n+2,3,2,x]*Conv[n+2,3,2,z^3/x]+1/(z^2)*Conv[n+1,3,1,x]*Conv[n+1,3,1,z^3/x]),{z,0,n},{x,0,0}],
Index->n,Sum[AlphaFactorial[3,k]^2,{k,0,n}],SeriesCoefficient[1/(1-z)*(Conv[n+3,3,3,x]*Conv[n+3,3,3,z^3/x]+(z^1)*Conv[n+3,3,4,x]*Conv[n+3,3,4,z^3/x]+(z^2)*Conv[n+3,3,5,x]*Conv[n+3,3,5,z^3/x]),{z,0,n},{x,0,0}],
Index->n,Sum[AlphaFactorial[3,k]^2,{k,0,n}],SeriesCoefficient[1/(1-z)*(Conv[n+1,3,3,x]*Conv[n+1,3,3,z^3/x]+1/z*Conv[n+2,3,2,x]*Conv[n+2,3,2,z^3/x]+1/(z^2)*Conv[n+1,3,1,x]*Conv[n+1,3,1,z^3/x]-1/z-1/(z^2)),{z,0,n},{x,0,0}],SeriesCoefficient[1/(1-z)*(Conv[n+1,3,3,x]*Conv[n+1,3,3,z^3/x]+1/z*Conv[n+2,3,2,x]*Conv[n+2,3,2,z^3/x]+1/(z^2)*Conv[n+1,3,1,x]*Conv[n+1,3,1,z^3/x]-1-1/z),{z,0,n},{x,0,0}],
Index->n,Sum[AlphaFactorial[3,k]^2,{k,1,n}],SeriesCoefficient[1/(1-z)*(Conv[n+1,3,3,x]*Conv[n+1,3,3,z^3/x]+1/z*Conv[n+2,3,2,x]*Conv[n+2,3,2,z^3/x]+1/(z^2)*Conv[n+1,3,1,x]*Conv[n+1,3,1,z^3/x]-1-1/z-1/(z^2)),{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

▶▶▶ Cubes of the single and double factorial functions:

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[Factorial[n]^3]],Factorial[n]^3,SeriesCoefficient[Conv[n,1,1,z/x2]*Conv[n,1,1,x2/x1]*Conv[n,1,1,x1]+1,{z,0,n},{x2,0,0},{x1,0,0}],TraditionalForm[HoldForm[Sum[Factorial[k]^3,{k,0,n}]]],Sum[Factorial[k]^3,{k,0,n}],SeriesCoefficient[1/(1-z)*Conv[n,1,1,z/x2]*Conv[n,1,1,x2/x1]*Conv[n,1,1,x1]+1,{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,TraditionalForm[HoldForm[Factorial2[n]^3]],Factorial2[n]^3,SeriesCoefficient[Conv[n,2,2,z^2/x2]*Conv[n,2,2,x2/x1]*Conv[n,2,2,x1]+1/z*Conv[n,2,1,z^2/x2]*Conv[n,2,1,x2/x1]*Conv[n,2,1,x1]+1,{z,0,n},{x2,0,0},{x1,0,0}],TraditionalForm[HoldForm[Sum[Factorial2[k]^3,{k,0,n}]]],Sum[Factorial2[k]^3,{k,0,n}],SeriesCoefficient[1/(1-z)*(Conv[n,2,2,z^2/x2]*Conv[n,2,2,x2/x1]*Conv[n,2,2,x1]+1/z*Conv[n,2,1,z^2/x2]*Conv[n,2,1,x2/x1]*Conv[n,2,1,x1]-1/z-1*0)+2,{z,0,n},{x2,0,0},{x1,0,0}],
Index->n,TraditionalForm[HoldForm[Sum[Factorial2[k]^3,{k,1,n}]]],Sum[Factorial2[k]^3,{k,1,n}],SeriesCoefficient[1/(1-z)*(Conv[n,2,2,z^2/x2]*Conv[n,2,2,x2/x1]*Conv[n,2,2,x1]+z*Conv[n,2,3,z^2/x2]*Conv[n,2,3,x2/x1]*Conv[n,2,3,x1]-1)+1,{z,0,n},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶▶ Enumerating more challenging cases of the double-factorial-related combinatorial sums from the references:

Compute generating functions for the inner, non-double-factorial terms in the sum:

Sum[k/Factorial[k-1]*Power[x,k],{k,0,Infinity}]
GeneratingFunction[k/Factorial[k-1],k,x]

nkupper=8;
Table[{Index->k,(k+1)/Factorial[k]*Factorial2[2 k-1],Collect[Normal[Series[SeriesCoefficient[Conv[k+1,2,1,z/x]*(x+1)*Exp[x],{z,0,k},{x,0,0}],{z,0,k+2},{x,0,6}]],z^_,Expand],Index->k,(k+1)/Factorial[k]*Factorial2[2 k-1],SeriesCoefficient[Conv[2 k,-2,2 k-1,x]*(z/x+1)*Exp[z/x],{z,0,k},{x,0,0}]},{k,1,nkupper}] // TF

Enumerate the complete sum by another application of the convergent function generating function methods:

nkupper=8;
Table[{Index->n,Factorial2[2 n-1],Factorial[n-1]*SeriesCoefficient[x[2]/(1-x[2])Conv[n,2,1,x[2]/x[1]]*(x[1]+1)*Exp[x[1]],{x[2],0,n},{x[1],0,0}]},{n,1,nkupper}] // TF

nkupper=8;
Table[{Index->n,Factorial2[2 n-1],SeriesCoefficient[Conv[n,1,1,x[3]/x[2]]/(1-x[2])Conv[n,2,1,x[2]/x[1]]*(x[1]+1)*Exp[x[1]],{x[3],0,n-1},{x[2],0,0},{x[1],0,0}]},{n,1,nkupper}] // TF

▶▶▶ Expansions of generating functions for other subfactorial function identities:

nupper=12;
Table[{Index->n,Subfactorial[n],SeriesCoefficient[Power[x+z,n]/(1+z)*Conv[n,1,1,x],{x,0,n},{z,0,n}],Index->n,Subfactorial[n],SeriesCoefficient[Exp[x3-x2+x1+x1]/(1+x1)*Conv[n,1,1,z/x3]*Conv[n,1,1,x3/x1/x2],{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,1,nupper}] // TF

nupper=12;
Table[{Index->n,Subfactorial[n],Factorial[n]*Sum[Power[-1,k]/Factorial[k],{k,0,n}],SeriesCoefficient[Conv[n,1,1,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,-1,n,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}],
Index->n,Factorial[n]*Sum[Power[-1,k]/Factorial[k],{k,0,n}],SeriesCoefficient[(z^2+z^3)*D[Conv[n,1,1,z/x]*Exp[-x]/(1-x),{z,1}]+(z^2)*Conv[n,1,1,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}],SeriesCoefficient[Conv[n,-1,n,z/x]*Exp[-x]/(1-x),{z,0,n},{x,0,0}],
Index->n,SeriesCoefficient[(z^2)*D[Conv[n,1,1,z/x]*Exp[-x]/(1-x),{z,1}]+(z)*Conv[n,1,1,z/x]*Exp[-x]/(1-x)+1/(1+z),{z,0,n},{x,0,0}]},{n,0,nupper}] // TF

nupper=12;
Table[{Index->n,Subfactorial[n],Factorial[n]*Sum[Power[-1,k]/Factorial[k],{k,0,n}],n!*(1-SeriesCoefficient[Conv[n,1,1,x3/(x2 x1)]*Exp[x2]*(Exp[x3]-1)*Exp[-x1]/(1-x1),{x3,0,n},{x2,0,0},{x1,0,0}]),n!-SeriesCoefficient[Conv[n,1,1,z/x3]*Conv[n,1,1,x3/(x2 x1)]*Exp[x2]*(Exp[x3]-1)*Exp[-x1]/(1-x1),{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}],SeriesCoefficient[Conv[n,1,1,z/x3](1/(1-x3)-Conv[n,1,1,x3/(x2 x1)]*Exp[x2]*(Exp[x3]-1)*Exp[-x1]/(1-x1))+1,{z,0,n},{x3,0,0},{x2,0,0},{x1,0,0}]},{n,0,nupper}] // TF

▶▶ Generating several generalized variants of the sums of powers sequences by convergent function transformations:

▶▶▶ Computations of the first identities for enumerating the sequences,(m^p)-1:

The right-hand-side exponential generating function for the sequences, (m^p)-1, with respect to p:

GeneratingFunction[Sum[Power[m-1,p-k]/Factorial[k]/Factorial[p-k],{k,0,p-1}]*p,p,x] // FS // Factor

The first convergent-based generating function identities enumerating this sequence:

nupper=8;
Table[{Index->p,SeriesCoefficient[Conv[p,-1,p-1,z/x]*(-((E^x)-(E^(m x)) m)),{x,0,0},{z,0,p-1}],SeriesCoefficient[Conv[p,-1,p-1,z/x]*(-((E^x)-(E^(m x)) m)),{x,0,0}]},{p,0,nupper}] // TF

nupper=8;
Table[{Index->p,SeriesCoefficient[Conv[p,1,1,z/x]*(-((E^x)-(E^(m x)) m)),{z,0,p-1},{x,0,0}],SeriesCoefficient[Conv[p,1,1,z/x]*(-((E^x)-(E^(m x)) m)),{z,0,p-1}],Series[SeriesCoefficient[Conv[p,1,1,z/x]*(-((E^x)-(E^(m x)) m)),{z,0,p-1}],{x,0,p}]},{p,0,nupper}] // TF

▶▶▶ Examples of the generalized sums of powers sequences enumerated by the convergent-based generating function constructions given below:

pupper=6;
Table[{Index->p,Factor[Spn[p,1,0,1,n+1]],Index->p,Collect[Expand[Spn[p,1,0,u,n+1]],n^_,FS]},{p,1,pupper}] // TF

pupper=4;
Table[{Index->p,Collect[Expand[Spn[p,a,b,1,n+1]],n^_,Factor],Index->p,Collect[Expand[Spn[p,a,b,u,n+1]],n^_,FS]},{p,1,pupper}] // TF

Compare with the noted expansions of the Bernoulli and Euler polynomial sequences from the reference:

pupper=4;
Table[{Index->p,Collect[Expand[Spn[p,a,b,1,n+1]],n^_,Factor],Collect[Expand[Power[a,p]*(BernoulliB[p+1,n+1+b/a]-BernoulliB[p+1,b/a])/(p+1)],n^_,Factor]},{p,1,pupper}] // TF

pupper=4;
Table[{Index->p,Collect[Expand[Spn[p,a,b,-1,n+1]],n^_,FS],Collect[Expand[Power[a,p]/2*(Power[-1,n]*EulerE[p,n+1+b/a]+EulerE[p,b/a])],n^_,FS]},{p,1,pupper}] // TF

▶▶▶ Generating function identities for the sequences, (Subscript[S, p])(n), and the series defined by (Subscript[(OverTilde[B]), 1])(w,x):

Series expansions of the inner sum generating functions over x:

Sum[-((E^x)-(E^(m x)) m),{m,0,n}] // FS
Collect[Expand[%],{n,n^_},FS]
Series[%,{x,0,4}]
Collect[Normal[%],x^_,Factor]

Compute the sums for the two-variable generating functions cases of (Subscript[(OverTilde[B]), 1])(w,x):

Sum[-((E^x)-(E^(m x)) m),{m,0,n}] // FS
Collect[Expand[%],{n,n^_},FS]
Sum[(%)*Power[w,n],{n,0,Infinity}]
gfexp=FS[%]
Collect[Numerator[%],Exp[_],FS]
Collect[%,w^_,FS]
Apart[gfexp]

Expand the next convergent-based generating function identities enumerating these sequences:

pupper=4;nupper=8;
gfexp=(-(((E^x) (1+w (-1+w+(E^x) (-2+(E^x) w))))/((((-1+w))^2) (((-1+(E^x) w))^2))));
Table[spn[p,n]->{Spn[p,1,0,1,n+1],Expand[SeriesCoefficient[Conv[p,-1,p-1,z/x]*(gfexp),{w,0,n},{x,0,0},{z,0,p-1}]+n+1],Expand[SeriesCoefficient[Conv[p,1,1,z/x]*(gfexp),{w,0,n},{z,0,p-1},{x,0,0}]+n+1]},{n,0,nupper},{p,1,nupper}] // TF

nupper=8;
Table[{Index->p,Factor[Sum[Power[k,p],{k,1,n}]],Factor[Expand[SeriesCoefficient[Conv[p+1,-1,p-1,z/x]*((((E^x)-(E^((1+n) x)))/(((-1+(E^x)))^2))+(E^x) (-1+((E^(n x))/(-1+(E^x)))) n),{x,0,0},{z,0,p-1}]+n]]},{p,1,nupper}] // TF

▶▶▶ Generating function identities for the generalized sequence functions, (Subscript[S, p])(u,n), and the series defined by (Subscript[(OverTilde[B]), u])(w,x):

Series expansions of the inner sum generating functions over x:

Sum[-((E^x)-(E^(m x)) m)*Power[u,m],{m,0,n}] // FS
Collect[Expand[%],{n,n^_},FS]
Series[%,{x,0,4}];
Collect[Normal[%],x^_,FS]

Compute the sums for the two-variable generating functions cases of (Subscript[(OverTilde[B]), u])(w,x):

Sum[-((E^x)-(E^(m x)) m)*Power[u,m],{m,0,n}] // FS
Collect[Expand[%],{n,n^_},FS]
Sum[(%)*Power[w,n],{n,0,Infinity}]
gfexp=FS[%]
Collect[Numerator[%],Exp[_],Factor]
Collect[%,w^_,Factor]
Apart[gfexp]

Expand the next convergent-based generating function identities enumerating these sequences:

pupper=4;nupper=8;
gfexp=(-(((E^x) (1-u w-2 (E^x) u w+(u^2) (w^2)+(E^(2 x)) (u^2) (w^2)))/((-1+w) (-1+u w) (((-1+(E^x) u w))^2))));
Table[spn[p,n]->{FS[Spn[p,1,0,u,n+1]-Expand[SeriesCoefficient[Conv[p,-1,p-1,z/x]*(gfexp),{w,0,n},{x,0,0},{z,0,p-1}]+(((-1+(u^(1+n)))/(-1+u)))]],FS[Spn[p,1,0,u,n+1]-Expand[SeriesCoefficient[Conv[p,1,1,z/x]*(gfexp),{w,0,n},{z,0,p-1},{x,0,0}]+(((-1+(u^(1+n)))/(-1+u)))]]},{n,0,nupper},{p,1,nupper}] // TF

pupper=4;nupper=8;
Table[spn[p,n]->{FS[Sum[Power[k,p]*Power[u,k],{k,0,n}]]-FS[Expand[SeriesCoefficient[Conv[p,-1,p-1,z/x]*(((((E^((1+n) x)) n )/(-1+(E^x) u)))*Power[u,n+1]+(-((E^x)/(-1+u))-((E^((1+n) x))/(((-1+(E^x) u))^2)))*Power[u,n+1]+((E^x) ((1/(-1+u))+(u/(((-1+(E^x) u))^2))))),{x,0,0},{z,0,p-1}]+1*(((-1+(u^(1+n)))/(-1+u)))]],FS[Sum[Power[k,p]*Power[u,k],{k,0,n}]]-FS[Expand[SeriesCoefficient[Conv[p,-1,p-1,z/x]*((1/(1-u)+((Exp[n x] n )/((E^x) u-1))-((E^((n) x))/((((E^x) u-1))^2)))*Power[u,n+1]*Exp[x]+((E^x) ((1/(-1+u))+(u/(((-1+(E^x) u))^2))))),{x,0,0},{z,0,p-1}]+1*(((-1+(u^(1+n)))/(-1+u)))]],FS[Sum[Power[k,p]*Power[u,k],{k,0,n}]]-FS[Expand[SeriesCoefficient[Conv[p,1,1,z/x]*(((((E^((1+n) x)) n )/(-1+(E^x) u)))*Power[u,n+1]+(-((E^x)/(-1+u))-((E^((1+n) x))/(((-1+(E^x) u))^2)))*Power[u,n+1]+((E^x) ((1/(-1+u))+(u/(((-1+(E^x) u))^2))))),{z,0,p-1},{x,0,0}]+1*(((-1+(u^(1+n)))/(-1+u)))]]},{n,0,nupper},{p,1,nupper}] // TF

▶▶▶ Generating function identities for the even more generalized sequences, (Subscript[S, p])(a,b;u,n), and the series defined by (Subscript[(OverTilde[B]), a,b,u])(w,x):

Compute the sums for the two-variable generating functions cases of (Subscript[(OverTilde[B]), 1])(w,x):

Sum[(-(E^x)+(E^((b+a m) x)) (b+a m))*Power[u,m],{m,0,n}] // FS
Collect[Expand[%],{n,n^_},FS]
Sum[(%)*Power[w,n],{n,0,Infinity}];
fssum=FS[%]
Collect[Numerator[%],Exp[_],FS]
Collect[%,w^_,FS]
Apart[fssum]
Collect[Expand[Apart[fssum]],{w,w^_},FS];

StandardForm[-((b (E^(b x)))/((-1+w) (((-1+(E^(a x)) u w))^2)))-((a (E^((a+b) x)) u w)/((-1+w) (((-1+(E^(a x)) u w))^2)))+((b (E^((a+b) x)) u w)/((-1+w) (((-1+(E^(a x)) u w))^2)))-((E^x)/((-1+w) (-1+u w) (((-1+(E^(a x)) u w))^2)))+((2 (E^(x+a x)) u w)/((-1+w) (-1+u w) (((-1+(E^(a x)) u w))^2)))-(((E^(x+2 a x)) (u^2) (w^2))/((-1+w) (-1+u w) (((-1+(E^(a x)) u w))^2)))]
TeXForm[%]

Expand the next convergent-based generating function identities enumerating these sequences:

pupper=4;nupper=8;
Table[Spn[p,n]->{FS[Sum[Power[a k+b,p]*Power[u,k],{k,0,n-1}]]-FS[Expand[SeriesCoefficient[Conv[p,-1,p-1,z/x]*((-(E^x)+b (E^(b x))+(-b (E^(b x))+(a-b) (E^((a+b) x))+2 (E^(x+a x))) u w+((-a+b) (E^((a+b) x))-(E^(x+2 a x))) (u^2) (w^2))/((-1+w) (-1+u w) (((-1+(E^(a x)) u w))^2))),{x,0,0},{z,0,p-1},{w,0,n-1}]+(((-1+(u^n))/(-1+u)))]],FS[Sum[Power[a k+b,p]*Power[u,k],{k,0,n-1}]]-FS[Expand[SeriesCoefficient[Conv[p,1,1,z/x]*((-(E^x)+b (E^(b x))+(-b (E^(b x))+(a-b) (E^((a+b) x))+2 (E^(x+a x))) u w+((-a+b) (E^((a+b) x))-(E^(x+2 a x))) (u^2) (w^2))/((-1+w) (-1+u w) (((-1+(E^(a x)) u w))^2))),{z,0,p-1},{x,0,0},{w,0,n-1}]+(((-1+(u^n))/(-1+u)))]]},{n,0,nupper},{p,1,nupper}] // TF

▶▶▶ Comparisons to known sequence formulas and special generating functions:

Some comparisons of the known more complicated OGF sums for the sequence versus the corresponding EGF terms with respect to the parameter p:

ogfSumTerm=Sum[Power[k,m]*Power[u,k]*Power[z,m],{m,0,Infinity}] // FS
Sum[(ogfSumTerm)/.(u->1),{k,0,n}] // FS
Sum[(ogfSumTerm),{k,0,n}] // FS

egfSumTerm=Sum[Power[k,m]*Power[u,k]*Power[z,m]/Factorial[m],{m,0,Infinity}] // FS
Sum[(egfSumTerm)/.(u->1),{k,0,n}] // FS
Sum[(egfSumTerm),{k,0,n}] // FS

ogfSumTerm=Sum[Power[a k+b,m]*Power[u,k]*Power[z,m],{m,0,Infinity}] // FS
Sum[(ogfSumTerm)/.(u->1),{k,0,n}] // FS
Sum[(ogfSumTerm),{k,0,n}] // FS

egfSumTerm=Sum[Power[a k+b,m]*Power[u,k]*Power[z,m]/Factorial[m],{m,0,Infinity}] // FS
Sum[(egfSumTerm)/.(u->1),{k,0,n}] // FS
Sum[(egfSumTerm),{k,0,n}] // FS

Identities involving the Bernoulli numbers and first-order Eulerian number triangle:

nupper=6;pupper=6;
Table[sums[p,n]->{Spn[p,n+1],Sum[Binomial[p+1,s]*BernoulliB[s]*Power[n+1,p+1-s]/(p+1),{s,0,p}],SeriesCoefficient[Sum[EulerianE1[p,i]*Power[z,i+1]/Power[1-z,p+2],{i,0,p}],{z,0,n}],Factorial[p]*SeriesCoefficient[z*Exp[w]/(1-z)/(1-z Exp[w]),{z,0,n},{w,0,p}]},{n,0,nupper},{p,1,pupper}] // TF

nupper=12;pupper=8;
Table[sums[p,n]->ConstantArray[Spn[p,n+1],3]-{Sum[Binomial[p+1,s]*BernoulliB[s]*Power[n+1,p+1-s]/(p+1),{s,0,p}],SeriesCoefficient[Sum[EulerianE1[p,i]*Power[z,i+1]/Power[1-z,p+2],{i,0,p}],{z,0,n}],Factorial[p]*SeriesCoefficient[z*Exp[w]/(1-z)/(1-z Exp[w]),{z,0,n},{w,0,p}]},{n,0,nupper},{p,1,pupper}] // TF

Other identities enumerating the more general sequence cases,(Subscript[S, p])(u,n),by known identities and sequence generating functions:

nupper=6;pupper=4;
Table[sums[p,n]->{Factor[Spn[p,u,n]],Factor[Sum[StirlingS2[p,j]*Power[u,j]*D[1/(1-u)-Power[u,n+1]/(1-u),{u,j}],{j,0,p}]],Factor[SeriesCoefficient[Sum[StirlingS2[p,j]*Power[u z,j]*Factorial[j]/Power[1-u z,j+1]/(1-z),{j,0,p}],{z,0,n}]],Factor[Factorial[p]*SeriesCoefficient[u*z*Exp[w]/(1-z)/(1-u z Exp[w]),{z,0,n},{w,0,p}]]},{n,0,nupper},{p,1,pupper}] // TF

nupper=12;pupper=8;
Table[sums[p,n]->ConstantArray[Factor[Spn[p,u,n]],3]-{Factor[Sum[StirlingS2[p,j]*Power[u,j]*D[1/(1-u)-Power[u,n+1]/(1-u),{u,j}],{j,0,p}]],Factor[SeriesCoefficient[Sum[StirlingS2[p,j]*Power[u z,j]*Factorial[j]/Power[1-u z,j+1]/(1-z),{j,0,p}],{z,0,n}]],Factor[Factorial[p]*SeriesCoefficient[u*z*Exp[w]/(1-z)/(1-u z Exp[w]),{z,0,n},{w,0,p}]]},{n,0,nupper},{p,1,pupper}] // TF

▶▶ Approximate generating function identities for sequences of binomials:

Several expansions of the peeled-off, or removed, uppermost-indexed sum terms:

mupper=10;
Table[{Index->m,FE[Binomial[p,p-m+1]],FS[FE[Sum[Binomial[p,p+1-i],{i,1,m}]]],Factor[FE[Sum[Binomial[p,p+1-i],{i,1,m}]]/.(p->p+m+1)]},{m,1,mupper}] // TF

Enumerate the (p^th) power sequences, (2^p)-1, by these finite sums:

pupper=10;rupper=6;
Table[sums[p,r]->{Power[2,p]-1,FS[FE[Sum[Binomial[p,p+1-i],{i,1,r}]]]+Factorial[p-r-1]*Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k],{k,0,p-r-1}]},{p,0,pupper},{r,1,rupper}] // TF

Enumerate the (p^th) power sequences, (m^p)-1, by these finite sums:

pupper=10;rupper=5;
Table[sums[p,r]->{Power[m,p]-1,Expand[FS[FE[Sum[Binomial[p,p+1-i]*Power[m-1,p+1-i],{i,0,r}]]]+Factorial[p-r-1]*Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[m-1,k+1],{k,0,p-r-1}]]},{r,1,rupper},{p,r,pupper+r}] // TF

The second set of motivating examples:

getPthPartialGFExpansions[r_,m_,x_,collectByMVar_]:=Module[{initTermsGF,simplifyITGFFnsList,itGFSimpList,remTermsGF,simplifyRTGFFnsList,rtGFSimpList},
initTermsGF=FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[m-1,p+1-i],{i,0,r}]]/.(p->p+r+1),p,x]];
simplifyITGFFnsList={#1&,simplifySumOfTerms[#1,Factor]&,simplifySumOfTerms[#1,FS]&};
itGFSimpList=Map[#1[Apart[FS[(initTermsGF)]]]&,simplifyITGFFnsList];
remTermsGF=GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[m-1,k+1],{k,0,p-r-1}]],p,x];
simplifyRTGFFnsList={Factor,FS,Collect[#1,collectByMVar^_,FS]&,Collect[#1,x^_,FS]&,Collect[#1,Exp[_],Collect[#,x^_,FS]&]&,Collect[#1,Exp[_],Collect[#,x^_,Factor]&]&};
rtGFSimpList=Map[#1[remTermsGF]&,simplifyRTGFFnsList];
Return[Flatten[{InitialTermsGF[r],initTermsGF,itGFSimpList,RemainingTermsEGF[r],remTermsGF,SimplifiedRemainingTermsEGFs[r],rtGFSimpList}]];
]

Compute generating functions for the sequences, (m^p)-1:

rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,m]]},{r,1,rupper}] // TF

Compute generating functions for the sequences, (((s+1))^p)-1:

rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,mval,x,x]]},{r,1,rupper}] // TF;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,x]]/.(m->mval)},{r,1,rupper}] // TF

Compute generating functions for the sequences, (2^p)-1:

mval=2;rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,mval,x,x]]},{r,1,rupper}] // TF;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,x]]/.(m->mval)},{r,1,rupper}] // TF

Compute generating functions for the sequences, (3^p)-1:

mval=3;rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,mval,x,x]]},{r,1,rupper}] // TF;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,x]]/.(m->mval)},{r,1,rupper}] // TF

Compute generating functions for the sequences, (4^p)-1:

mval=4;rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,mval,x,x]]},{r,1,rupper}] // TF;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,x]]/.(m->mval)},{r,1,rupper}] // TF

Compute generating functions for the sequences, (5^p)-1:

mval=5;rupper=4;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,mval,x,x]]},{r,1,rupper}] // TF;
Table[{InitSumIndexR->r,CF[getPthPartialGFExpansions[r,m,x,x]]/.(m->mval)},{r,1,rupper}] // TF

▶ §7: Expansions of exact formulas and congruence properties obtained from finite difference equations:

▶▶ Formulas from the proposition: [TODO]

▶▶▶ Congruence properties for the generalized product sequence cases, (Subscript[p, n])(α,R), modulo h (and h (α^r)):  [TODO]

nupper=12;hupper=8;
Table[mods[h,n,a]->{FS[PolynomialMod[pn[n,a,R],h]]-FS[PolynomialMod[Sum[Binomial[h,k]*Power[-1,k+1]*pn[k,-a,R+(h-1)*a]*pn[n-k,a,R],{k,1,n}]+If[h>n,ChnV2[h,n,a,R],0],h]]},{n,1,nupper},{h,2,hupper}] // TF

▶▶▶ Exact finite sum expansion identities:

nupper=12;hupper=8;
Table[mods[h,n,a]->{FS[pn[n,a,R]]-FS[Sum[Binomial[n,k+1]*Power[-1,k]*pn[k+1,-a,R+(n-1)*a]*pn[n-1-k,a,R],{k,0,n-1}]+KroneckerDelta[n,0]]},{n,0,nupper},{h,2,hupper}] // TF

nupper=12;hupper=8;
Table[mods[h,n,r]->{FS[pn[n,a,R]]-FS[Sum[Binomial[n+r,k+1]*Power[-1,k]*pn[k+1,-a,R+(n-1+r)*a]*pn[n-1-k,a,R],{k,0,n-1}]+ChnV2[n+r,n,a,R]]},{n,0,nupper},{h,2,hupper},{r,1,3}] // TF

▶▶ Example: Binomial-coefficient-related convolution formulas: (TODO)

Clear[ModFn,BinomCvlIdentsLHSV123,BinomCvlIdentsLHSV4,BinomCvlIdentsRHSV1,BinomCvlIdentsRHSV2,BinomCvlIdentsRHSV3,BinomCvlIdentsRHSV4]

ModFn[input_,h_]:=PolynomialMod[input,h,CoefficientDomain->Integers]

BinomCvlIdentsLHSV123[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsLHSV123[n,p,r,a,b,g,s]=ModFn[FS[FE[Binomial[(b n+g)/a,n-s]*Power[-a,n-s]*Factorial[n-s]]],p*Power[a,r]]
BinomCvlIdentsLHSV4[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsLHSV4[n,p,r,a,b,g,s]=ModFn[FS[FE[Binomial[(b n+g)/a+n-s-1,n-s]*Power[a,n-s]*Factorial[n-s]]],p*Power[a,r]]

BinomCvlIdentsRHSV1[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsRHSV1[n,p,r,a,b,g,s]=FE[Sum[Binomial[p,k]*Power[-a,n-s+k*(r+1)]*Binomial[-(b n+g)/a+(p-1),k]*Factorial[k]*Binomial[(b n+g)/a,n-s-k]*Factorial[n-s-k],{k,0,n-s}]]
BinomCvlIdentsRHSV2[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsRHSV2[n,p,r,a,b,g,s]=FE[Sum[Binomial[p,k]*Power[-a,n-s+k*(r+1)]*Binomial[(b n+g)/a-(p-1),k]*Power[-1,k]*Factorial[k]*Binomial[(b n+g)/a,n-s-k]*Factorial[n-s-k],{k,0,n-s}]]
BinomCvlIdentsRHSV3[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsRHSV3[n,p,r,a,b,g,s]=FE[Sum[Binomial[p,k]*Power[-a,n-s+k*(r+1)]*Binomial[(b n+g)/a+(p-1),k]*Power[-1,k*r]*Factorial[k]*Binomial[(b n+g)/a,n-s-k]*Factorial[n-s-k],{k,0,n-s}]]
BinomCvlIdentsRHSV4[n_,p_,r_,a_,b_,g_,s_:0]:=BinomCvlIdentsRHSV4[n,p,r,a,b,g,s]=FE[Sum[Binomial[p,k]*Power[a,n-s+k*(r+1)]*Binomial[(b n+g)/a+(p-1),k]*Factorial[k]*Binomial[(b n+g)/a+n-s-k-1,n-s-k]*Factorial[n-s-k],{k,0,n-s}]]

nupper=12;pupper=8;
{ablower,abupper,glower,gupper}={1,6,-3,3};
Table[sum[p,n,r,a,b,g]->{FS[ModFn[BinomCvlIdentsLHSV123[n,p,r,a,b,g,0]-ModFn[BinomCvlIdentsRHSV1[n,p,r,a,b,g,0],p*Power[a,r]],p*Power[a,r]]]},{n,supper,nupper},{p,2,pupper},{r,0,p},{a,Range[ablower,abupper]},{b,Range[ablower,abupper]},{g,Range[glower,gupper]}];
Select[Flatten[%],Last[#1]=!={0}&]==={}

nupper=12;pupper=8;
{ablower,abupper,glower,gupper}={1,6,-3,3};
Table[sum[p,n,r,a,b,g]->{FS[ModFn[BinomCvlIdentsLHSV123[n,p,r,a,b,g,0]-ModFn[BinomCvlIdentsRHSV2[n,p,r,a,b,g,0],p*Power[a,r]],p*Power[a,r]]]},{n,supper,nupper},{p,2,pupper},{r,0,p},{a,Range[ablower,abupper]},{b,Range[ablower,abupper]},{g,Range[glower,gupper]}];
Select[Flatten[%],Last[#1]=!={0}&]==={}

nupper=12;pupper=8;
{ablower,abupper,glower,gupper}={1,6,-3,3};
Table[sum[p,n,r,a,b,g]->{FS[ModFn[BinomCvlIdentsLHSV123[n,p,r,a,b,g,0]-ModFn[BinomCvlIdentsRHSV3[n,p,r,a,b,g,0],p*Power[a,r]],p*Power[a,r]]]},{n,supper,nupper},{p,2,pupper},{r,0,p},{a,Range[ablower,abupper]},{b,Range[ablower,abupper]},{g,Range[glower,gupper]}];
Select[Flatten[%],Last[#1]=!={0}&]==={}

nupper=12;pupper=8;
{ablower,abupper,glower,gupper}={1,6,-3,3};
Table[sum[p,n,r,a,b,g]->{FS[ModFn[BinomCvlIdentsLHSV4[n,p,r,a,b,g,0]-ModFn[BinomCvlIdentsRHSV4[n,p,r,a,b,g,0],p*Power[a,r]],p*Power[a,r]]]},{n,supper,nupper},{p,2,pupper},{r,0,p},{a,Range[ablower,abupper]},{b,Range[ablower,abupper]},{g,Range[glower,gupper]}];
Select[Flatten[%],Last[#1]=!={0}&]==={}j

▶▶ Example: Combinatorial sums for the double factorial and α-factorial functions:

First, check the expansion of a binomial coefficient identitiy at non-integer arguments:

FS[Gamma[1/alpha-(k+1)]/Gamma[1/alpha]*Gamma[1/alpha-(n-1-k)]/Gamma[1/alpha-n]/.(alpha->a)]
FE[Binomial[1/a-n+k,k+1]/Binomial[1/a-1,k+1]]
FS[(%%)/(%)]

Compute several forms of the first single sum identity:

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[Sum[Binomial[n-1,k+1]*Power[-1,k]*AlphaFactorial[alpha,alpha *(k+1)-1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Pochhammer[1/alpha,-(k+1)]*Pochhammer[1/alpha-n,k+1],{k,0,n-1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[-Sum[Binomial[n-1,k+1]*Power[alpha,k+1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Pochhammer[1/alpha-n,k+1],{k,0,n-1}]]},{n,2,nupper},{alpha,1,alphaupper}] // TF

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[Sum[Binomial[n-1,k+1]*Power[-1,k]*AlphaFactorial[alpha,alpha *(k+1)-1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Gamma[1/alpha-(k+1)]/Gamma[1/alpha]*Gamma[1/alpha-(n-1-k)]/Gamma[1/alpha-n],{k,0,n-1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[Sum[Binomial[n-1,k+1]*Power[-1,k]*AlphaFactorial[alpha,alpha *(k+1)-1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Binomial[1/alpha+k-n,k+1]/Binomial[1/alpha-1,k+1],{k,0,n-1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

Compute tables of the first double sum identity (and check differences in the computed values):

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[Sum[Binomial[n-1,k+1]*Binomial[k+1,i]*Power[-1,k]*Power[alpha,k+1-i]*AlphaFactorial[alpha,alpha *i-1]*Pochhammer[n-1-k,k+1-i]*AlphaFactorial[alpha,alpha *(n-1-k)-1],{k,0,n-1},{i,0,k+1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1]-FS[Sum[Binomial[n-1,k+1]*Binomial[k+1,i]*Power[-1,k]*Power[alpha,k+1-i]*AlphaFactorial[alpha,alpha *i-1]*Pochhammer[n-1-k,k+1-i]*AlphaFactorial[alpha,alpha *(n-1-k)-1],{k,0,n-1},{i,0,k+1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

Compute tables of the second double sum identity (and check differences in the computed values):

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1],FS[Sum[Binomial[n-1,k+1]*Binomial[k+1,i]*Binomial[n-1-i,k+1-i]*Power[-1,k]*Power[alpha,k+1-i]*AlphaFactorial[alpha,alpha *i-1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Factorial[k+1-i],{k,0,n-1},{i,0,k+1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

alphaupper=10;nupper=12;
Table[factfn[alpha,n]->{AlphaFactorial[alpha,alpha *n-1]-FS[Sum[Binomial[n-1,k+1]*Binomial[k+1,i]*Binomial[n-1-i,k+1-i]*Power[-1,k]*Power[alpha,k+1-i]*AlphaFactorial[alpha,alpha *i-1]*AlphaFactorial[alpha,alpha *(n-1-k)-1]*Factorial[k+1-i],{k,0,n-1},{i,0,k+1}]]},{n,2,nupper},{alpha,2,alphaupper}] // TF

▶▶ Polynomial expansions by multiple sum identities:

▶▶▶ The multiple 5-sum and 6-sum expansions of the generalized product sequence cases:

First,verify the subexpansions of the generalized product functions noted in the proof:

kupper=12;
Table[{Index->k,FS[pn[k,a,b n+g+r]-FE[Power[a,k]*Pochhammer[(b n+g+r)/a,k]]],FS[pn[k,a,b n+g+r]-Expand[Sum[S1[k,m]*Power[a,k-m]*Power[(b n+g+r),m],{m,0,k}]]],FS[pn[k,a,b n+g+r]-Sum[S1[k,m]*Binomial[m,p]*Power[a,k-m]*Power[b,p]*Power[g+r+b*n0,m-p]*Power[n-n0,p],{p,0,k},{m,p,k}]],FS[pn[k,a,b n+g+r]]},{k,0,kupper}] // TF

Verify cases of the multiple 5-sum expansions:
(Subscript[p, n])(α,β n+γ) ↦ (∑_(p=0)^(n-s))(∑_(r=0)^p)((∑_(k=0)^(n-s-1))(∑_(m=0)^k)((∑_(t=0)^(n-s-k))(Binomial[m, r]) (Binomial[n-s, k]) (Binomial[t, p-r]) [({{k}, {m}})][({{n-s-k}, {t}})]×(((-1))^(-1+p-r))(α^(-m+n-s-t)) (β^r) (((α+β))^(p-r)) ((((1+s) α-γ))^(-p+r+t)) (γ^(m-r)) × (n^p)))+(Subscript[[n≤s], δ])

Compute these expansions without adding the extra term from Kronecker delta / Iverson's convention:

nupper=12;supper=4;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-FS[-Sum[Binomial[n-s,k]*Power[n,p]*S1[k,m]*S1[n-s-k,t]*Binomial[m,r]*Binomial[t,p-r]*Power[b,r]*Power[g,m-r]*Power[-a-b,p-r]*Power[a*(1+s)-g,t-p+r]*Power[a,k-m+n-s-k-t],{k,0,n-s-1},{p,0,n-s},{r,0,p},{m,0,k},{t,0,n-s-k}]]},{n,1,nupper},{s,0,supper}] // TF // FS

nupper=12;supper=4;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-FS[-Sum[Sum[Sum[Binomial[m,r]*Binomial[n-s,k]*Binomial[t,p-r]*S1[k,m]*S1[n-s-k,t]*Power[a,n-s-m-t]*Power[b,r]*Power[g,m-r]*Power[a*(1+s)-g,t]*Power[(a+b)/(g-a*(s+1)),p-r]*Power[n,p],{t,0,n-s-k}],{k,0,n-s-1},{m,0,k}],{p,0,n-s},{r,0,p}]],pn[n-s,a,b n+g]-FS[Sum[Sum[Sum[Binomial[m,r]*Binomial[n-s,k]*Binomial[t,p-r]*S1[k,m]*S1[n-s-k,t]*Power[a,n-s-m-t]*Power[b,r]*Power[g,m-r]*Power[a*(1+s)-g,t-(p-r)]*Power[-1,p-r-1]*Power[(a+b),p-r]*Power[n,p],{t,0,n-s-k}],{k,0,n-s-1},{m,0,k}],{p,0,n-s},{r,0,p}]]},{s,0,supper},{n,s+1,nupper}] // TF // FS

Include the extra term from Kronecker delta / Iverson's convention:

nupper=12;supper=4;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-FS[-Sum[Sum[Sum[Binomial[m,r]*Binomial[n-s,k]*Binomial[t,p-r]*S1[k,m]*S1[n-s-k,t]*Power[a,n-s-m-t]*Power[b,r]*Power[g,m-r]*Power[a*(1+s)-g,t]*Power[(a+b)/(g-a*(s+1)),p-r]*Power[n,p],{t,0,n-s-k}],{k,0,n-s-1},{m,0,k}],{p,0,n-s},{r,0,p}]+KroneckerDelta[n≤s,True]],pn[n-s,a,b n+g]-FS[Sum[Sum[Sum[Binomial[m,r]*Binomial[n-s,k]*Binomial[t,p-r]*S1[k,m]*S1[n-s-k,t]*Power[a,n-s-m-t]*Power[b,r]*Power[g,m-r]*Power[a*(1+s)-g,t-(p-r)]*Power[-1,p-r-1]*Power[(a+b),p-r]*Power[n,p],{t,0,n-s-k}],{k,0,n-s-1},{m,0,k}],{p,0,n-s},{r,0,p}]+KroneckerDelta[n≤s,True]]},{n,0,nupper},{s,0,supper}] // TF // FS

Verify cases of the multiple 6-sum expansions:
(Subscript[p, n])(α,β n+γ) ↦ (∑_(k=0)^(n-s-1))(∑_(i=0)^k)(∑_(m=0)^k)((∑_(u=0)^(3 n))(∑_(p=0)^u)(∑_(r=0)^p)((∑_(t=0)^(n-s-k))(Binomial[m, r]) (Binomial[i, u-p]) (Binomial[t, p-r]) [({{k}, {m}})] [({{k}, {i}})][({{n-s-k}, {t}})]×(((((-1))^(1+k-r+u))  (α^(-m+n-s-t)) (β^r) (((α+β))^(p-r)) ((((1+s) α-γ))^(-p+r+t)) (γ^(m-r)) )/(k!))×(s^(i+p-u)) (n^u)))+(Subscript[[n≤s], δ])

Clear[s]
FS[Power[n,u]*S1[k,m]*S1[n-s-k,t]*Binomial[m,r]*Binomial[t,p-r]*Power[b,r]*Power[g,m-r]*Power[-a-b,p-r]*Power[a*(1+s)-g,t-p+r]*Power[a,k-m+n-s-k-t]*S1[k,i]*Binomial[i,u-p]*Power[-s,i-u+p]*Power[-1,k-i]/Factorial[k]]
Assuming[{Element[p,Integers],Element[r,Integers],Element[m,Integers]},FS[%]] // PE
Assuming[{Element[p,Integers],Element[r,Integers],Element[m,Integers],Element[n,Integers],Element[s,Integers],Element[t,Integers],Element[k,Integers]},FS[PE[%]]] // PE
FS[%]

Compute these expansions without adding the extra term from the Kronecker delta / Iverson's convention:

nupper=8;supper=3;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-
Factor[-Sum[Power[n,u]*S1[k,m]*S1[n-s-k,t]*Binomial[m,r]*Binomial[t,p-r]*Power[b,r]*Power[g,m-r]*Power[-a-b,p-r]*Power[a(1+s)-g,t-p+r]*Power[a,k-m+n-s-k-t]*S1[k,i]*Binomial[i,u-p]*Power[-s,i-u+p]*Power[-1,k-i]/Factorial[k],{k,0,n-s-1},{u,0,3 n},{p,0,u},{r,0,p},{i,0,k},{m,0,k},{t,0,n-s-k}]]},{n,1,nupper},{s,1,supper}] // TF

nupper=8;supper=3;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-
Factor[-Sum[(1/(k!))(((-1))^(i+m+n-r+s+t-u)) (a^(-m+n-s-t)) (b^r) (((a+b))^(p-r)) (g^(m-r)) (n^u) (s^(i+p-u)) (((a-g+a s))^(-p+r+t)) Binomial[i,-p+u] Binomial[m,r] Binomial[t,p-r] StirlingS1[k,i] StirlingS1[k,m] StirlingS1[-k+n-s,t],{k,0,n-s-1},{u,0,3 n},{p,0,u},{r,0,p},{i,0,k},{m,0,k},{t,0,n-s-k}]]},{s,0,supper},{n,s+1,nupper}] // TF

Include the extra term from Kronecker delta / Iverson's convention:

nupper=8;supper=4;
Table[prodseqs[s,n]->{pn[n-s,a,b n+g]-FS[Sum[Sum[Sum[Binomial[m,r]*Binomial[i,u-p]*Binomial[t,p-r]*S1[k,m]*S1[k,i]*S1[n-s-k,t]*Power[-1,u-r+k+1]/Factorial[k]*Power[a,n-s-m-t]*Power[b,r]*Power[g,m-r]*Power[s,i-u+p]*Power[a+b,p-r]*Power[a(1+s)-g,t-(p-r)]*Power[n,u],{t,0,n-s-k}],{u,0,3 n},{p,0,u},{r,0,p}],{k,0,n-s-1},{i,0,k},{m,0,k}]+KroneckerDelta[n≤s,True]]},{n,1,nupper},{s,1,supper}] // TF // FS

▶▶▶ Triple sum expansions of the single factorial function involving the Stirling numbers:

Simplify parameters for the triple sums for the single factorial function:

Clear[s]
Binomial[n,k]*Power[n-s,p]*S1[k,m]*S1[n-s-k,t]*Binomial[m,r]*Binomial[t,p-r]*Power[b,r]*Power[g,m-r]*Power[-a-b,p-r]*Power[a-g,t-p+r]*Power[a,k-m+n-s-k-t]/.(r->m)/.(m->p)
Assuming[{Element[p,Integers],Element[r,Integers],Element[m,Integers]},FS[%]]
Assuming[{Element[p,Integers],Element[r,Integers],Element[m,Integers],Element[n,Integers],Element[s,Integers],Element[t,Integers]},FS[(%)/.(g->0)/.(a->-1)/.(b->1)]]

Clear[s];nupper=10;s=1;
Table[{Index->n,pn[n-s,a,b (n-s)+g],pn[n-s,a,b (n-s)+g]-FS[Sum[Binomial[n,k]*Power[n-s,p]*S1[k,m]*S1[n-s-k,t]*Binomial[m,r]*Binomial[t,p-r]*Power[b,r]*Power[g,m-r]*Power[-a-b,p-r]*Power[a-g,t-p+r]*Power[a,k-m+n-s-k-t],{k,0,n-1},{p,0,n},{r,0,p},{m,0,k},{t,0,n-s-k}]],Index->n,Sum[(((-1))^(p+t)) (((-n+s))^p) Binomial[n,k] StirlingS1[k,p] StirlingS1[-k+n-s,t],{p,0,n},{k,0,n-1},{t,0,n-s-k}],Sum[(((-1))^(n-s)) (((-n+s))^p) Binomial[n,k] S1[k,p] S1[-k+n-s,t],{p,0,n-1},{k,0,n-1},{t,0,n-s-k}],Sum[(((-1))^(n-1-s)) (((-n+s))^p) Binomial[n-1,k] S1[k,p] S1[-k+n-s,t],{p,0,n-1},{k,0,n-2},{t,0,n-1-k}],Index->n,Sum[(((-1))^(n+p+1)) (((n-s))^p) Binomial[n,n-1-k] S1[n-1-k,p] S1[k,k-t],{p,0,n},{k,0,n-1},{t,0,k}],Sum[(((-1))^(p+1)) (((n-s))^(n-p)) Binomial[n,n-1-k] S1[n-1-k,n-p] S1[k,k-t],{p,0,n},{k,0,n-1},{t,0,k}]},{n,2,nupper}] // TF // FS
Clear[s];

Compute tables of the stated triple sum expansions:

nupper=12;
Table[{Index->n,Factorial[n-1],Index->n,Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[n-1,p],{p,0,n},{k,0,n-1},{t,0,k}],Sum[Binomial[n,k]*S1[k,p]*S1[n-1-k,n-1-k-t]*Power[-1,n-1-p]*Power[n-1,p],{p,0,n},{k,0,n-1},{t,0,n-1-k}],Sum[Binomial[n,n-1-k]*S1[n-1-k,n-p]*S1[k,k-t]*Power[-1,p+1]*Power[n-1,n-p],{p,0,n},{k,0,n-1},{t,0,k}]},{n,2,nupper}] // TF

▶▶▶ Examples of triple sum expansions for the double factorial function:

Comparisons to known double and triple sum expansions of the double factorial function:
Compute cases of all five sums:

nupper=12;
Table[{Index->n,Factorial2[2 n-1],Sum[Binomial[2n-k-1,k-1]S1[k,j]*Factorial2[2n-2k-1],{k,0,n},{j,1,k}],
Index->n,Sum[Binomial[2n-k-1,k-1]S1[k,j]*Power[2,n-k]*Pochhammer[1/2,n-k],{k,0,n},{j,1,k}],Sum[Binomial[2n-k-1,k-1]S1[k,j]*S1[n-k,m]*Power[2,n-k-m]*Power[1/2,m*0],{k,0,n},{j,1,k},{m,0,n-k}],
Index->n,Sum[Binomial[2n-k-1,k-1]S1[k,j]*Power[-2,n-k]*Pochhammer[1/2-(n-k),n-k],{k,0,n},{j,1,k}],Sum[Binomial[2n-k-1,k-1]S1[k,j]*pn[n-k,-2,2*(n-k)-1],{k,0,n},{j,1,k}],Sum[Binomial[2n-k-1,k-1]S1[k,j]*Fcf[2,n-k+1,m+1]*If[n-k≠0,Power[2 n-2k,m],1]*Power[-1,n-k-m],{k,0,n},{j,1,k},{m,0,n-k}]},{n,0,nupper}] // TF

Compute cases of the first two sums:

nupper=12;
Table[{Index->n,Factorial2[2 n-1],Sum[S1[k-1,j-1]*Power[2,n-j]*Power[-1,n-k]*Pochhammer[1-n,n-k],{k,0,n},{j,1,k}],Index->n,Sum[S1[k-1,j-1]*S1[n-k+1,m]*Power[2,n-j]*Power[-1,n-k+1-m]*Power[n,m-1],{k,0,n},{j,1,k},{m,0,n-k+1}],Sum[S1[k-1,j-1]*S1[n-k+1,m+1]*Power[2,n-j]*Power[-1,n-k-m]*Power[n,m],{k,0,n},{j,1,k},{m,0,n-k}]},{n,0,nupper}] // TF

Compute cases of the last three sums:
Generate some table and polynomial expansion data related to these sums:

kupper=4;
Table[{Index->k,Expand[FE[Power[-1,k]*Pochhammer[1-n,k]]],Sum[S1[k+1,m]*Power[-1,k+1-m]*Power[n,m-1],{m,0,k+1}]},{k,0,kupper}] // TF

alpha=2;nkupper=10;
Table[fcf[n,k]->Simplify[Fcf[alpha,n,k]],{n,0,nkupper},{k,0,nkupper}] // TF

kupper=4;
Table[{Index->k,Expand[FE[pn[k,-2,2n-1]]],Sum[Fcf[2,k+1,m+1]*Power[2 n,m]*Power[-1,k-m],{m,0,k}],Expand[Sum[Fcf[1,k+1,m+1]*Power[2 (n-1/2),m]*Power[-1,k-m],{m,0,k}]]},{k,0,kupper}] // TF

kupper=4;
Table[{Index->k,Expand[FE[pn[k,-2,2n-2k-1]]],Expand[Sum[Fcf[2,k+1,m+1]*Power[4 k-2 n,m]*Power[-1,m],{m,0,k}]],Expand[Sum[Fcf[1,k+1,m+1]*Power[4 k-2 n-2,m]*Power[-1,m],{m,0,k}]]},{k,0,kupper}] // TF

Compute tables of the last three sums:

nupper=12;
Table[{Index->n,Factorial2[2 n-1],
Index->n,Sum[Binomial[2n-k-1,k-1]S1[k,j]*Power[-2,n-k]*Pochhammer[1/2-(n-k),n-k],{k,0,n},{j,1,k}],Sum[Binomial[2n-k-1,k-1]S1[k,j]*pn[n-k,-2,2*(n-k)-1],{k,0,n},{j,1,k}],Sum[Binomial[2n-k-1,k-1]S1[k,j]*Fcf[2,n-k+1,m+1]*If[n-k≠0,Power[2 n-2k,m],1]*Power[-1,n-k-m],{k,0,n},{j,1,k},{m,0,n-k}]},{n,0,nupper}] // TF

▶▶▶ Finite sums for the single factorial function involving the (modified) Stirling polynomials and generalized Bernoulli polynomial sequences:

Definitions and computations with the modified Stirling polynomial sequences,(SuperStar[(Subscript[σ, n])])(x),defined in the article:
Mathematica is limited in its computations of the triple sum identities expanded in Section 6.2 when the indices correspond to inputs to the 
Stirling polynomial expansions of the Stirling numbers of the first kind when the variable x is zero-valued, 
for example, in the forms of 
[({{k}, {k-t}})] ↦ (((k-t) × k! (Subscript[σ, t])(k))/((k-t)!))
in the first of these sums. The modified Stirling polynomial sequences defined as StirlingPolyStar removes the need for cases in evaluating these sums.

Compute tables to verify the pair of sums stated in Section 6.5 for some fixed parameter values of (Subscript[ℓ, 0])≠0 (or \[FormalCapitalL]≠0):

nupper=12;
Table[{Index->n,Factorial[n-1],Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*If[k>0,k*StirlingPoly[t,k]*Factorial[k-1]/Factorial[k-t-1],1]*Power[-1,n-1-p]*Power[n-1,p],{p,0,n},{k,0,n-1},{t,0,k}],Index->n,Factorial[n-1],Sum[Binomial[n,n-1-k]*StirlingPolyStar[p-1-k,n-1-k]*StirlingPolyStar[t,k]*Power[-1,p+1]*Power[n-1,n-p],{p,0,n},{k,0,p-1},{t,0,k}],FS[Sum[Binomial[n,n-1-k]*Binomial[n-p,r]*Power[n-\[FormalCapitalL],r]*Power[\[FormalCapitalL]-1,n-p-r]*(StirlingPolyStar[p-1-k,n-1-k])*StirlingPolyStar[t,k]*Power[-1,p+1],{p,0,n},{k,0,p-1},{t,0,k},{r,0,n-p}]]},{n,2,nupper}] // TF

nupper=12;
Table[{Index->n,Factorial[n-1],Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*If[k>0,k*StirlingPoly[t,k]*Factorial[k-1]/Factorial[k-t-1],1]*Power[-1,n-1-p]*Power[n-1,p],{p,0,n},{k,0,n-1},{t,0,k}],Index->n,Factorial[n-1],Sum[Binomial[n,n-1-k]*StirlingPolyStar[p-1-k,n-1-k]*StirlingPolyStar[t,k]*Power[-1,p+1]*Power[n-1,n-p],{p,0,n},{k,0,p-1},{t,0,k}],FS[Sum[Binomial[n,n-1-k]*Binomial[n-p,r]*Power[n-\[FormalCapitalL],r]*Power[\[FormalCapitalL]-1,n-p-r]*(StirlingPolyStar[p-1-k,n-1-k])*StirlingPolyStar[t,k]*Power[-1,p+1],{p,0,n},{k,0,p-1},{t,0,k},{r,0,n-p}]]},{n,2,nupper}] // TF

▶▶ Parameterized congruence expansions in Wilson’s theorem:

First, load the following Mathematica function definitions:

Clear[FwnCongruence,FwnCongruenceMod,FwnCongruencePolyMod,Nw,Mw]
FwnCongruence[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=(Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[xp,p]*Power[xt,t]*Power[xk,k]*NwpnFn[p,n],{p,0,n},{k,0,n-1},{t,0,k}])
FwnCongruenceMod[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_,modOffset_:0]:=Mod[FwnCongruence[n,xp,xt,xk,NwpnFn,MwnFn],MwnFn[n],modOffset]
FwnCongruencePolyMod[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=PolynomialMod[FwnCongruence[n,xp,xt,xk,NwpnFn,MwnFn],MwnFn[n]]
Nw=Power[-1,#1]&;
Mw=#1&;

Compute tables of the parameterized Wilson's theorem congruence when  {(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])} := {1,1,1}:

nupper=32;modOffset=-1;
{xp,xt,xk}={1,1,1};
Table[Map[PrimeCondFn[n],{Index->n,FwnCongruence[n,xp,xt,xk,Nw,Mw],Power[-1,n+1]*S1[n+1,2],Power[-1,n+1]*Factorial[n]*HarmonicNumber[n,1]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={1,1,1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n],modOffset],Mod[Power[-1,n+1]*S1[n+1,2],Mw[n],modOffset],Mod[Power[-1,n+1]*Factorial[n]*HarmonicNumber[n,1],Mw[n],modOffset]}],{n,2,nupper}] // TF

nupper=32;modOffset=0;
{xp,xt,xk}={1,1,1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n],modOffset],Mod[Power[-1,n+1]*S1[n+1,2],Mw[n],modOffset],Mod[Power[-1,n+1]*Factorial[n]*HarmonicNumber[n,1],Mw[n],modOffset]}],{n,2,nupper}] // TF

Footnote:Wilson's theorem noted congruence property I:

nupper=32;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),1,1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Expand[Power[-1,n-1]FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),1,1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Expand[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),1,1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Factor[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

Footnote:Wilson's theorem noted congruence property II:

nupper=32;modOffset=-1;
{xp,xt,xk}={1,1,(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Factor[FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={1,1,(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Expand[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={1,1,(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Factor[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

Footnote:Wilson's theorem noted congruence property III:

nupper=32;modOffset=-1;
{xp,xt,xk}={1,(Subscript[x, T]),1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Factor[FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={1,(Subscript[x, T]),1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],FactorTerms[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=32;modOffset=-1;
{xp,xt,xk}={1,(Subscript[x, T]),1};
Table[Map[PrimeCondFn[n],{Index->n,Mod[Factorial[n-1],n,-1],Factor[FwnCongruencePolyMod[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

Footnote:Wilson's theorem noted congruence property IV:

nupper=32;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),1,1};
Table[Map[PrimeCondFn[n],{Index->n,Expand[Sum[S1[n,p+1]*Power[xp,p]*(p+1),{p,0,n-1}]-Power[-1,n-1]FwnCongruence[n,xp,xt,xk,Nw,Mw]],Expand[Power[-1,n-1]FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

Further examples from the remarks on using PolynomialMod
Compute tables of the more general parameterized forms of the Wilson's theorem congruence:

nupper=16;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,FS[FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,FS[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]]]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},FS]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xt,xt^_},FS]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},FS]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},Collect[#1,{xp,xp^_},FS]&]}],{n,2,nupper}] // TF

nupper=21;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},Collect[#1,{xt,xt^_},FS]&]}],{n,2,nupper}] // TF

▶▶ Proposition: Congruences for powers modulo double and triple integer products:

First double product congruence for the powers of(((n-1))^p)obtained from the binomial theorem:

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-r]*Power[n+k,r-1],{s,1,p},{r,1,s-1}]
FS[%]
FS[Expand[(%)-Power[-1,p]Power[1-n,p]]]

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]
FS[%]
Collect[%,{n,n^_},FS]

pupper=10;
Table[{Index->p,FS[PolynomialMod[Power[n-1,p],n(n+k)]],FS[PolynomialMod[(((((-1))^p) (k+n-(((1+k))^p) n))/k),n(n+k)]]},{p,1,pupper}] // TF

pupper=10;nupper=10;
Table[cong[n,p]->{FS[PolynomialMod[Power[n-1,p],n(n+k)]],FS[PolynomialMod[(((((-1))^p) (k+n-(((1+k))^p) n))/k),n(n+k)]]},{n,1,nupper},{p,1,pupper}] // TF

Second double product congruence for the powers of(((n-1))^p)obtained from the binomial theorem:

Power[k1-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[k1-1,p-s]*(n-k1)*Power[-(k1+k2),s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Power[k1-1,p-s]*(n-k1)*(n+k2)*Power[-(k1+k2),s-1-r]*Power[n+k2,r-1],{s,1,p},{r,1,s-1}]
FS[%]
PE[%]

Power[k1-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[k1-1,p-s]*(n-k1)*Power[-(k1+k2),s-1-0],{s,1,p}]
FS[%]
PE[%]
Collect[%,n,FS]

pupper=10;
Table[{Index->p,FS[PolynomialMod[Power[n-1,p],(n-k1)(n+k2)]],FS[PolynomialMod[(((((-1+k1))^p) (k2+(((1-k1))^(-p)) k1 (((1+k2))^p)))/(k1+k2))+(((((-1+k1))^p) (1-(((1-k1))^(-p)) (((1+k2))^p)) n)/(k1+k2)),(n-k1)(n+k2)]]},{p,1,pupper}] // TF

pupper=10;nupper=10;
Table[cong[n,p]->{FS[PolynomialMod[Power[n-1,p],(n-k1)(n+k2)]],FS[PolynomialMod[(((((-1+k1))^p) (k2+(((1-k1))^(-p)) k1 (((1+k2))^p)))/(k1+k2))+(((((-1+k1))^p) (1-(((1-k1))^(-p)) (((1+k2))^p)) n)/(k1+k2)),(n-k1)(n+k2)]]},{n,1,nupper},{p,1,pupper}] // TF

Last form of the triple product congruence for the powers of(((n-1))^p)obtained from the binomial theorem:

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,1]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-1]*Power[n+k,1-1],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-r]*Power[n+k,r-1],{s,1,p},{r,2,s-1}]
Table[Factor[%],{p,0,5}] // FS

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,1]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-1]*Power[n+k,1-1],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Binomial[r-1,t]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-r]*Power[k-j,r-1-t]*Power[n+j,t],{s,1,p},{r,2,s-1},{t,0,r-1}]
Table[Factor[%],{p,0,5}] // FS

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,1]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-1]*Power[n+k,1-1],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Binomial[r-1,0]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-r]*Power[k-j,r-1-0]*Power[n+j,0],{s,1,p},{r,2,s-1}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Binomial[r-1,t]*Power[-1,p-s]*n*(n+k)*(n+j)*Power[-k,s-1-r]*Power[k-j,r-1-t]*Power[n+j,t-1],{s,1,p},{r,2,s-1},{t,1,r-1}]
Table[Factor[%],{p,0,5}] // FS

Power[-1,p]+Sum[Binomial[p,s]*Binomial[s-1,0]*Power[-1,p-s]*n*Power[-k,s-1-0],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,1]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-1]*Power[n+k,1-1],{s,1,p}]+Sum[Binomial[p,s]*Binomial[s-1,r]*Binomial[r-1,0]*Power[-1,p-s]*n*(n+k)*Power[-k,s-1-r]*Power[k-j,r-1-0]*Power[n+j,0],{s,1,p},{r,2,s-1}] // FS
Apart[%]
Collect[%,n^_,FS]
FS[%/.(j+1->w)/.(k+1->v)/.(-k-1->-v)]
Collect[PE[%],{w^_,v^_},FS]

▶▶ Parameterized congruence expansions in Clement’s theorem:

First, load the following Mathematica function definitions:

Clear[FwnCongruence,FwnCongruenceMod,FwnCongruencePolyMod,Nw,Mw]
FwnCongruence[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=FwnCongruence[n,xp,xt,xk,NwpnFn,MwnFn]=(4*Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[xp,p]*Power[xt,t]*Power[xk,k]*NwpnFn[p,n],{p,0,n},{k,0,n-1},{t,0,k}]+4+n)
FwnCongruenceMod[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_,modOffset_:0]:=FwnCongruenceMod[n,xp,xt,xk,NwpnFn,MwnFn,modOffset]=Mod[FwnCongruence[n,xp,xt,xk,NwpnFn,MwnFn],MwnFn[n],modOffset]
FwnCongruencePolyMod[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=FwnCongruencePolyMod[n,xp,xt,xk,NwpnFn,MwnFn]=PolynomialMod[FwnCongruence[n,xp,xt,xk,NwpnFn,MwnFn],MwnFn[n]]
Nw=((1/2) (-(((-3))^(#1)) #2+(((-1))^(#1)) (2+#2)))&;
Mw=(#1)*(#1+2)&;

LocalTwinPrimeCondFn[n_]:=PrimePairCondFn[n,PrimeQ[#1+2]&]
CollectFn[input_,v1_,v2_,SimpFn_:FS]:=Collect[Expand[input],v1^_,Collect[#1,v2^_,SimpFn]&]

Compute tables of the parameterized Clement's theorem congruence when  {(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])} := {1,1,1}:

nupper=35;modOffset=-1;
{xp,xt,xk}={1,1,1};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,FwnCongruence[n,xp,xt,xk,Nw,Mw]}],{n,2,nupper}] // TF

nupper=35;modOffset=-1;
{xp,xt,xk}={1,1,1};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,FwnCongruence[n,xp,xt,xk,Nw,Mw],Index->n,Mod[Factorial[n-1],Mw[n],modOffset],Mod[4*Factorial[n-1]+4+n,Mw[n],modOffset],FwnCongruenceMod[n,xp,xt,xk,Nw,Mw,modOffset]}],{n,2,nupper}] // TF

nupper=35;modOffset=0;
{xp,xt,xk}={1,1,1};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,FwnCongruence[n,xp,xt,xk,Nw,Mw],Index->n,Mod[Factorial[n-1],Mw[n],modOffset],Mod[4*Factorial[n-1]+4+n,Mw[n],modOffset],FwnCongruenceMod[n,xp,xt,xk,Nw,Mw,modOffset]}],{n,2,nupper}] // TF

Footnote:Clement's theorem noted congruence property I:

nupper=35;modOffset=0;
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],PolyDegree[(Subscript[x, K])]->Exponent[FwnCongruencePolyMod[n,1,1,(Subscript[x, K]),Nw,Mw],(Subscript[x, K])],FS[FwnCongruencePolyMod[n,1,1,(Subscript[x, K]),Nw,Mw]],Index->n,FS[FwnCongruence[n,1,1,(Subscript[x, K]),Nw,Mw]]}],{n,2,2*nupper}] // TF

nupper=35;modOffset=0;
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],PolyDegree[(Subscript[x, P])]->Exponent[FwnCongruencePolyMod[n,(Subscript[x, P]),1,1,Nw,Mw],(Subscript[x, P])],FS[FwnCongruencePolyMod[n,(Subscript[x, P]),1,1,Nw,Mw]],Index->n,FS[FwnCongruence[n,(Subscript[x, P]),1,1,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=35;modOffset=0;
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],PolyDegree[(Subscript[x, T])]->Exponent[FwnCongruencePolyMod[n,1,(Subscript[x, T]),1,Nw,Mw],(Subscript[x, T])],FS[FwnCongruencePolyMod[n,1,(Subscript[x, T]),1,Nw,Mw]],Index->n,FS[FwnCongruence[n,1,(Subscript[x, T]),1,Nw,Mw]]}],{n,2,nupper}] // TF

Further examples from the remarks on using PolynomialMod :

numprimes=8;PrimesList=Table[Prime[n],{n,1,numprimes}]
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],FS[FwnCongruence[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw]],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],FS[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw]],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, P])^_,FS],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, T])^_,FS],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, K])^_,FS],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=9;PrimesList=Table[Prime[n],{n,1,numprimes}]
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],FS[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),1,Nw,Mw]],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],FS[FwnCongruencePolyMod[n,(Subscript[x, P]),1,(Subscript[x, K]),Nw,Mw]],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],FS[FwnCongruencePolyMod[n,1,(Subscript[x, T]),(Subscript[x, K]),Nw,Mw]],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=18;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),1},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),1,Nw,Mw],(Subscript[x, P])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),1},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),1,Nw,Mw],(Subscript[x, T])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=18;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),1,(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),1,(Subscript[x, K]),Nw,Mw],(Subscript[x, P])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),1,(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,(Subscript[x, P]),1,(Subscript[x, K]),Nw,Mw],(Subscript[x, K])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=18;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{1,(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,1,(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, T])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{1,(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],Collect[FwnCongruencePolyMod[n,1,(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, K])^_,Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=12;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, P]),(Subscript[x, T]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, P]),(Subscript[x, K]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=12;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, T]),(Subscript[x, P]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, T]),(Subscript[x, K]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numprimes=12;PrimesList=Table[Prime[n],{n,1,numprimes}];
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, K]),(Subscript[x, P]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,XPKTVars->{(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])},Mod[4*Factorial[n-1]+4+n,n*(n+2),-1],CollectFn[FwnCongruencePolyMod[n,(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K]),Nw,Mw],(Subscript[x, K]),(Subscript[x, T]),Factor],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

Compute tables of the more general parameterized forms of the Clement' s theorem congruence:

nupper=12;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,FS[FwnCongruence[n,xp,xt,xk,Nw,Mw]]}],{n,2,nupper}] // TF

nupper=15;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]]}],{n,2,nupper}] // TF

nupper=12;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,FS[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]]]}],{n,2,nupper}] // TF

nupper=19;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},FS]}],{n,2,nupper}] // TF

nupper=19;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xt,xt^_},FS]}],{n,2,nupper}] // TF

nupper=19;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[PrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},FS]}],{n,2,nupper}] // TF

nupper=19;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},Collect[#1,{xp,xp^_},FS]&]}],{n,2,nupper}] // TF

nupper=19;modOffset=-1;
{xp,xt,xk}={(Subscript[x, P]),(Subscript[x, T]),(Subscript[x, K])};
Table[Map[LocalTwinPrimeCondFn[n],{Index->n,Collect[PolynomialMod[FwnCongruence[n,xp,xt,xk,Nw,Mw],Mw[n]],{xk,xk^_},Collect[#1,{xt,xt^_},FS]&]}],{n,2,nupper}] // TF

▶▶ Parameterized congruence expansions of special case prime triplets:

▶▶▶ The sexy prime triplets:

Congruences for prime triples of the form, (p, p+6, p+12):

{f1,f2}={6,12};
Clear[FwnCongruence,Mw,Nw]
FwnCongruence[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=(Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[xp,p]*Power[xt,t]*Power[xk,k]*NwpnFn[p,n],{p,0,n},{k,0,n-1},{t,0,k}])
Mw[n_]:=n(n+f1)(n+f2)
Nw[p_,n_,k_:f1,j_:f2]:=Power[-1,p]*((n+f1)(n+f2)/j/k+n*(n+f2)/k/(k-j)*Power[f1+1,p]+n*(n+f1)/j/(j-k)*Power[f2+1,p])
p[1,n_]:=1+PH[n,f1]+PH[n,f2]
p[2,n_]:=PH[n,f1]+PH[n,f2]+PH[n,f1]*PH[n,f2]
p[3,n_]:=PH[n,f1]*PH[n,f2]
PrimeTripleCondFnLocal[n_]:=PrimeTripleCondFn[n,0,f1,f2]
checkBox[p_,m_]:=Labeled[Framed[PrimeTripleCondFnLocal[p][Style[If[PrimeQ[m],✓,𝒳],Bold,FontSize->14] ]],m];

nupper=32;
Table[Map[PrimeTripleCondFnLocal[n],{Index->n,checkBox[n,n],checkBox[n,n+f1],checkBox[n,n+f2],Mod[Sum[p[i,n]*Power[FwnCongruence[n,1,1,1,Nw[#1,#2]&,Mw[#1]&],i],{i,1,3}],Mw[n],-1]}],{n,1,nupper}] // TF

▶▶▶ Other notable cases of prime triples:

Congruences for prime triples of the form, (p, p+2, p+4):

{f1,f2}={2,6};
Clear[FwnCongruence,Mw,Nw]
FwnCongruence[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=(Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[xp,p]*Power[xt,t]*Power[xk,k]*NwpnFn[p,n],{p,0,n},{k,0,n-1},{t,0,k}])
Mw[n_]:=n(n+f1)(n+f2)
Nw[p_,n_,k_:f1,j_:f2]:=Power[-1,p]*((n+f1)(n+f2)/j/k+n*(n+f2)/k/(k-j)*Power[f1+1,p]+n*(n+f1)/j/(j-k)*Power[f2+1,p])
p[1,n_]:=1+PH[n,f1]+PH[n,f2]
p[2,n_]:=PH[n,f1]+PH[n,f2]+PH[n,f1]*PH[n,f2]
p[3,n_]:=PH[n,f1]*PH[n,f2]
PrimeTripleCondFnLocal[n_]:=PrimeTripleCondFn[n,0,f1,f2]
checkBox[p_,m_]:=Labeled[Framed[PrimeTripleCondFnLocal[p][Style[If[PrimeQ[m],✓,𝒳],Bold,FontSize->14] ]],m];

nupper=32;
Table[Map[PrimeTripleCondFnLocal[n],{Index->n,checkBox[n,n],checkBox[n,n+f1],checkBox[n,n+f2],Mod[Sum[p[i,n]*Power[FwnCongruence[n,1,1,1,Nw[#1,#2]&,Mw[#1]&],i],{i,1,3}],Mw[n],-1]}],{n,1,nupper}] // TF

Congruences for prime triples of the form, (p, p+4, p+6):

{f1,f2}={4,6};
Clear[FwnCongruence,Mw,Nw]
FwnCongruence[n_,xp_,xt_,xk_,NwpnFn_,MwnFn_]:=(Sum[Binomial[n,n-1-k]*S1[n-1-k,p]*S1[k,k-t]*Power[-1,n-1-p]*Power[xp,p]*Power[xt,t]*Power[xk,k]*NwpnFn[p,n],{p,0,n},{k,0,n-1},{t,0,k}])
Mw[n_]:=n(n+f1)(n+f2)
Nw[p_,n_,k_:f1,j_:f2]:=Power[-1,p]*((n+f1)(n+f2)/j/k+n*(n+f2)/k/(k-j)*Power[f1+1,p]+n*(n+f1)/j/(j-k)*Power[f2+1,p])
p[1,n_]:=1+PH[n,f1]+PH[n,f2]
p[2,n_]:=PH[n,f1]+PH[n,f2]+PH[n,f1]*PH[n,f2]
p[3,n_]:=PH[n,f1]*PH[n,f2]
PrimeTripleCondFnLocal[n_]:=PrimeTripleCondFn[n,0,f1,f2]
checkBox[p_,m_]:=Labeled[Framed[PrimeTripleCondFnLocal[p][Style[If[PrimeQ[m],✓,𝒳],Bold,FontSize->14] ]],m];

nupper=32;
Table[Map[PrimeTripleCondFnLocal[n],{Index->n,checkBox[n,n],checkBox[n,n+f1],checkBox[n,n+f2],Mod[Sum[p[i,n]*Power[FwnCongruence[n,1,1,1,Nw[#1,#2]&,Mw[#1]&],i],{i,1,3}],Mw[n],-1]}],{n,1,nupper}] // TF

▶▶ Expansions of the single factorial congruence sums: (TODO)

Tables to verify all of the sums at once:

hupper=21;nupper=32;supperrange=Range[-4,4];
tbl=Table[sfact[h,n,s]->{Mod[(n-s)!,h,-1],Mod[Chn[h,n-s,1,1],h,-1],Mod[Sum[Binomial[h,i]*Pochhammer[-h,i]*Factorial[n-s-i],{i,0,n-s}],h,-1],Mod[Sum[(Binomial[h,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-s-i],{i,0,n-s}],h,-1],Mod[Sum[Binomial[h,i]*Binomial[i-h-1,i]*Factorial[i]*Factorial[n-s-i],{i,0,n-s}],h,-1],
Mod[Chn[h,n-s,-1,n-s],h,-1],Mod[Sum[Binomial[h,i]*Power[-1,n-s-i]*Pochhammer[n+1-s-h,i]*Pochhammer[-(n-s),n-s-i],{i,0,n-s}],h,-1],Mod[Sum[Binomial[h,i]*Binomial[n,i]*Binomial[h-n+s-1,i]*Power[-1,i]*Factorial[i]*Factorial[n-s-i],{i,0,n-s}],h,-1]}===ConstantArray[Mod[(n-s)!,h,-1],8],{s,supperrange},{n,Max[0,s],nupper},{h,2,hupper}];
tbl // TF;
Select[Flatten[tbl],Last[#1]==False&]==={}

Compute tables of the individual right-hand-side congruence sums:

SgFactFnCongRHSExpV11[n_,h_,modOffset_:-1]:=Mod[Chn[h,n,1,1],h,modOffset]
SgFactFnCongRHSExpV12[n_,h_,modOffset_:-1]:=Mod[Sum[Binomial[h,i]*Pochhammer[-h,i]*Factorial[n-i],{i,0,n}],h,modOffset]
SgFactFnCongRHSExpV13[n_,h_,modOffset_:-1]:=Mod[Sum[(Binomial[h,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],h,modOffset]
SgFactFnCongRHSExpV14[n_,h_,modOffset_:-1]:=Mod[Sum[Binomial[h,i]*Binomial[i-h-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],h,modOffset]
SgFactFnCongRHSExpV21[n_,h_,modOffset_:-1]:=Mod[Chn[h,n,-1,n],h,modOffset]
SgFactFnCongRHSExpV22[n_,h_,modOffset_:-1]:=Mod[Sum[Binomial[h,i]*Power[-1,n-i]*Pochhammer[n+1-h,i]*Pochhammer[-n,n-i],{i,0,n}],h,modOffset]
SgFactFnCongRHSExpV23[n_,h_,modOffset_:-1]:=Mod[Sum[Binomial[h,i]*Binomial[n,i]*Binomial[h-n-1,i]*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],h,modOffset]

hupper=21;nupper=32;supperrange=Range[1,1];modOffset=-1;
tbl=Table[sfact[h,n,s]->{Mod[(n-s)!,h,modOffset],{Mod[(n-s)!,h,modOffset],SgFactFnCongRHSExpV11[n-s,h,modOffset],SgFactFnCongRHSExpV12[n-s,h,modOffset],SgFactFnCongRHSExpV13[n-s,h,modOffset],SgFactFnCongRHSExpV14[n-s,h,modOffset]}===ConstantArray[Mod[(n-s)!,h,modOffset],5]},{s,supperrange},{h,2,hupper},{n,Max[0,s],nupper}];
tbl // TF
Select[Flatten[tbl],Last[Last[#1]]==False&]==={}

hupper=21;nupper=32;supperrange=Range[1,1];modOffset=-1;
tbl=Table[sfact[h,n,s]->{Mod[(n-s)!,h,modOffset],{Mod[(n-s)!,h,modOffset],SgFactFnCongRHSExpV21[n-s,h,modOffset],SgFactFnCongRHSExpV22[n-s,h,modOffset],SgFactFnCongRHSExpV23[n-s,h,modOffset]}===ConstantArray[Mod[(n-s)!,h,modOffset],4]},{s,supperrange},{h,2,hupper},{n,Max[0,s],nupper}];
tbl // TF
Select[Flatten[tbl],Last[Last[#1]]==False&]==={}

▶▶ Identities expanding variants of Wilson’s theorem:

Clear[TestFormulaV4,TestFormulaV6,CongV4LHSEqualsRHSQ,CongV6LHSEqualsRHSQ]
Clear[TestFormulaV4V2,TestFormulaV6V2,CongV4V2LHSEqualsRHSQ,CongV6V2LHSEqualsRHSQ]

TestFormulaV4[n_,p_]:=TestFormulaV4[n,p]=Power[2,1-n]*Sum[(Binomial[p,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}]*Sum[(Binomial[p,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n+1-i],{i,0,n+1}]
CongV4LHSEqualsRHSQ[n_,modOffset_:-1]:=PrimeQ[2n+1]&&(Mod[TestFormulaV4[n,2n+1],2n+1,modOffset]==Power[-1,Binomial[n+2,2]])||!PrimeQ[2n+1]&&(Mod[TestFormulaV4[n,2n+1],2n+1,modOffset]==0)

TestFormulaV4V2[n_,p_]:=TestFormulaV4V2[n,p]=Power[2,-(n-1)]*Product[Sum[(Binomial[2n+1,i]^2)*Power[-1,i]*(i!)*((n+s-i)!),{i,0,n+s}],{s,{0,1}}]
CongV4V2LHSEqualsRHSQ[n_,modOffset_:-1]:=PrimeQ[2n+1]&&(Mod[TestFormulaV4V2[n,2n+1],2n+1,modOffset]==Power[-1,(n+1)(n+2)/2])||!PrimeQ[2n+1]&&(Mod[TestFormulaV4V2[n,2n+1],2n+1,modOffset]==0)

TestFormulaV6[n_,p_]:=TestFormulaV6[n,p]=(Sum[(Binomial[p,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}]^2)
CongV6LHSEqualsRHSQ[n_,modOffset_:-1]:=PrimeQ[2n+1]&&(Mod[TestFormulaV6[n,2n+1],2n+1,modOffset]==Power[-1,n+1])||!PrimeQ[2n+1]&&(Mod[TestFormulaV6[n,2n+1],2n+1,modOffset]==0)

TestFormulaV6V2[n_,p_]:=TestFormulaV6V2[n,p]=Sum[(Binomial[2n+1,i]^2)*Power[-1,i]*(i!)*((n-i)!),{i,0,n}]^2
CongV6V2LHSEqualsRHSQ[n_,modOffset_:-1]:=PrimeQ[2n+1]&&(Mod[TestFormulaV6V2[n,2n+1],2n+1,modOffset]==Power[-1,n+1])||!PrimeQ[2n+1]&&(Mod[TestFormulaV6V2[n,2n+1],2n+1,modOffset]==0)

nupper=101;modOffset=-1;
Table[Map[PrimeCondFn[2n+1],{
Index->n,CheckMarkEquals[CongV4LHSEqualsRHSQ[n]],CheckMarkEquals[CongV4V2LHSEqualsRHSQ[n]],(2n+1),PrimeQ[2n+1],Power[-1,Binomial[n+2,2]],Mod[Power[2,1-n]*Factorial[n]*Factorial[n+1],2n+1,modOffset],Mod[TestFormulaV4[n,2n+1],(2n+1),modOffset],Mod[TestFormulaV4V2[n,2n+1],(2n+1),modOffset],
Index->n,CheckMarkEquals[CongV6LHSEqualsRHSQ[n]],CheckMarkEquals[CongV6V2LHSEqualsRHSQ[n]],(2n+1),PrimeQ[2n+1],Power[-1,n+1],Mod[(Factorial[n]^2),2n+1,modOffset],Mod[TestFormulaV6[n,2n+1],(2n+1),modOffset],Mod[TestFormulaV6V2[n,2n+1],(2n+1),modOffset]}],{n,1,nupper,1}] // TF

▶▶ Congruences for primes of the form (n^2)+1:

Verify the two squared single sum identities:

nupper=101;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,nupper^2+1}],PrimeQ[#1]&&IntegerQ[Sqrt[(#1-1)]]&]
Table[Map[PrimeCondFn[n^2+1],{
CheckMarkEquals[PrimeQ[n^2+1]&&(Mod[Factorial[n^2],n^2+1,modOffset]==-1)||!PrimeQ[n^2+1]],Index->n,n^2+1,MemberQ[expectedPrimesList,n^2+1],Mod[Power[-1,(n^2+2)/2],n^2+1,modOffset],
Index->n,n^2+1,Mod[(Sum[Binomial[n^2+1,i]*Pochhammer[-(n^2+1),i]*(((n^2)/2-i)!),{i,0,(n^2)/2}])^2,n^2+1,modOffset],Mod[Sum[(Binomial[n^2+1,i]^2)*Power[-1,i]*(i!)*(((n^2)/2-i)!),{i,0,(n^2)/2}]^2,n^2+1,modOffset],Mod[Sum[Binomial[n^2+1,i]*Binomial[i-n^2-2,i]*(i!)*(((n^2)/2-i)!),{i,0,(n^2)/2}]^2,n^2+1,modOffset]}],{n,2,nupper,2}] // TF

Verify each of the multiple sum identities from Section 5.2:

Clear[ChkIdentV1,ChkIdentV2,ChkIdentV3,ChkIdentV4]
ChkIdentV1[h_,n_,a_,R_]:=ChkIdentV1[h,n,a,R]=Sum[Sum[Binomial[h,k] Binomial[m,s] S1[k,m]*Power[-1,m]*Power[a,n]*Pochhammer[R/a,n-k]*If[R/a-1==0,0,Power[R/a-1,m-s]]*Power[h,s],{k,0,n},{m,0,k}],{s,0,n}]
ChkIdentV2[h_,n_,a_,R_]:=ChkIdentV2[h,n,a,R]=Sum[Sum[Binomial[h,k] Binomial[m,t] S1[k,m]*S1[n-k,s-t]*Power[-1,m]*Power[a,n-s]*Power[h-1,m-t]*Power[R,s],{k,0,n},{m,0,k}],{s,0,n},{t,0,s}]
ChkIdentV3[h_,n_,a_,R_]:=ChkIdentV3[h,n,a,R]=Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]S1[k,m]*StirlingS2[s,i]*Power[-1,m]*Power[a,n]*If[R/a-1==0,0,Power[R/a-1,m-s]]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]
ChkIdentV4[h_,n_,a_,R_]:=ChkIdentV4[h,n,a,R]=Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[a,n+s-m]*If[R-a==0,0,Power[R-a,m-s]]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]

nupper=6;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,4*(nupper^2+1)}],PrimeQ[#1]&&IntegerQ[Sqrt[(#1-1)]]&]
Table[Map[PrimeCondFn[n^2+1],{Index->n,n^2+1,PrimeQ[n^2+1],MemberQ[n^2+1,expectedPrimesList],Mod[ChkIdentV1[n^2+1,n^2,-1,n^2],n^2+1,modOffset],Mod[ChkIdentV2[n^2+1,n^2,-1,n^2],n^2+1,modOffset],Mod[ChkIdentV3[n^2+1,n^2,-1,n^2],n^2+1,modOffset],Mod[ChkIdentV4[n^2+1,n^2,-1,n^2],n^2+1,modOffset],
Index->n,ChkIdentV1[n^2+1,n^2,-1,n^2],PrintTemporary[n," of ",nupper]}],{n,1,nupper}] // TF

nupper=6;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,4*(nupper^2+1)}],PrimeQ[#1]&&IntegerQ[Sqrt[(#1-1)]]&]
Table[Map[PrimeCondFn[n^2+1],{Index->n,n^2+1,PrimeQ[n^2+1],MemberQ[n^2+1,expectedPrimesList],Mod[ChkIdentV1[n^2+1,n^2,1,1],n^2+1,modOffset],Mod[ChkIdentV2[n^2+1,n^2,1,1],n^2+1,modOffset],Mod[ChkIdentV3[n^2+1,n^2,1,1],n^2+1,modOffset],Mod[ChkIdentV4[n^2+1,n^2,-1,n^2],n^2+1,modOffset],
Index->n,ChkIdentV1[n^2+1,n^2,1,1],PrintTemporary[n," of ",nupper]}],{n,1,nupper}] // TF

Compute tables of the two specific multiple sum expansions cited in the article:

Clear[ChkIdentV4VNSquared,ChkIdentV5VNSquared]
ChkIdentV4VNSquared[n_]:=ChkIdentV4VNSquared[n]=
Sum[Sum[Binomial[n^2+1,k]*Binomial[m,s]*Binomial[i,v]*Binomial[n^2+1+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[n^2+1,m-s]*Pochhammer[-n^2,n^2-k]*Factorial[i],{k,0,n^2},{m,0,k}],{s,0,n^2},{i,0,s},{v,0,i}]
ChkIdentV5VNSquared[n_]:=ChkIdentV5VNSquared[n]=
Sum[Sum[Sum[Binomial[n^2+1,k] Binomial[m,t] S1[k,m]*S1[n^2-k,s-t]*S2[s,i]*Power[-1,m+s-i]*Power[n^2,m-t],{k,0,n^2},{m,0,k}],{s,0,n^2},{t,0,s}]*Factorial[i],{i,0,n^2}]

nupper=6;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,4*(nupper^2+1)}],PrimeQ[#1]&&IntegerQ[Sqrt[(#1-1)]]&]
Table[Map[PrimeCondFn[n^2+1],{Index->n,n^2+1,PrimeQ[n^2+1],MemberQ[n^2+1,expectedPrimesList],Mod[ChkIdentV4VNSquared[n],n^2+1,modOffset],Mod[ChkIdentV5VNSquared[n],n^2+1,modOffset],
Index->n,ChkIdentV4VNSquared[n],ChkIdentV5VNSquared[n],PrintTemporary[n," of ",nupper]}],{n,1,nupper}] // TF

▶▶ Wilson primes:

Compute the expected sequence elements:

nump=5000;
Table[{n,Mod[Factorial[n-1]+1,n^2,0]==0},{n,Table[Prime[m],{m,1,nump}]}];
Select[%,Last[#1]==True&];
Map[First,%]

First, load the following local Mathematica function definitions:

WPPrimeCondFn[n_]:=PrimePairCondFn[n,IntegerQ[(Factorial[#1-1]+1)/((#1)^2)]&]

Clear[ChkIdentV3,ChkIdentV4]
ChkIdentV3[h_,n_,a_,R_]:=ChkIdentV3[h,n,a,R]=Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]S1[k,m]*StirlingS2[s,i]*Power[-1,m]*Power[a,n]*If[R/a-1==0,0,Power[R/a-1,m-s]]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]
ChkIdentV4[h_,n_,a_,R_]:=ChkIdentV4[h,n,a,R]=Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[a,n+s-m]*If[R-a==0,0,Power[R-a,m-s]]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]

Clear[ChkIdentV3V2,ChkIdentV4V2]
ChkIdentV3V2[n_]:=ChkIdentV3V2[n]=Sum[Sum[Binomial[n^2,k]*Binomial[n^2,i]*Binomial[m,s]*S1[k,m]*StirlingS2[s,i]*Power[-1,n-1-k]*Pochhammer[1-n,n-1-k]*Power[-n,m-s]*Factorial[i],{k,0,n-1},{m,0,k}],{s,0,n-1},{i,0,s}]
ChkIdentV4V2[n_]:=ChkIdentV4V2[n]=Sum[Sum[Binomial[n^2,k]*Binomial[m,s]*Binomial[i,v]*Binomial[n^2+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,i-v]*Power[-n,m-s]*FallingFactorial[n-1,n-1-k]*Factorial[i],{k,0,n-1},{m,0,k}],{s,0,n-1},{i,0,s},{v,0,i}]

Tabulate the sums for the first three congruences for several hundred primes:

numPrimes=250;modOffset=-1;
WPrimes={5,13,563};PrimesList=Union[Table[Prime[m],{m,2,numPrimes}],WPrimes];

Table[Map[PrimePairCondFn[n,IntegerQ[(Factorial[#1-1]+1)/((#1)^2)]&],{
Index->n,PrimeQ[n],MemberQ[WPrimes,n],Index->n,
Mod[Sum[Power[-1,i]/Factorial[i]*Power[Pochhammer[-n^2,i],2]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Mod[Sum[Power[Binomial[n^2,i],2]*Power[-1,i]*Factorial[i]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Mod[Sum[Binomial[n^2,i]*Binomial[i-n^2-1,i]*(i!)*((n-1-i)!),{i,0,n-1}]+1,n^2,modOffset],Mod[Sum[Binomial[n^2,i]*FallingFactorial[n^2-n,i]*Power[-1,n-1-i]*FallingFactorial[n-1,n-1-i],{i,0,n-1}]+1,n^2,modOffset],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numInts=35;modOffset=-1;
WPrimes={5,13,563};IntsList=Union[Table[m,{m,2,numInts}],WPrimes];

Table[Map[PrimePairCondFn[n,IntegerQ[(Factorial[#1-1]+1)/((#1)^2)]&],{
Index->n,PrimeQ[n],MemberQ[WPrimes,n],Index->n,
Mod[Sum[Power[-1,i]/Factorial[i]*Power[Pochhammer[-n^2,i],2]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Mod[Sum[Power[Binomial[n^2,i],2]*Power[-1,i]*Factorial[i]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Mod[Sum[Binomial[n^2,i]*Binomial[i-n^2-1,i]*(i!)*((n-1-i)!),{i,0,n-1}]+1,n^2,modOffset],Mod[Sum[Binomial[n^2,i]*FallingFactorial[n^2-n,i]*Power[-1,n-1-i]*FallingFactorial[n-1,n-1-i],{i,0,n-1}]+1,n^2,modOffset],PrintTemporary[n," of ",Max[IntsList]]}],{n,IntsList}] // TF

Tabulate the multiple sum congruences:

numPrimes=12;modOffset=-1;
WPrimes={5,13};PrimesList=Union[Table[Prime[m],{m,2,numPrimes}],WPrimes]
Table[Map[WPPrimeCondFn[n],{Index->n,PrimeQ[n],MemberQ[WPrimes,n],Mod[Sum[Power[-1,i]/Factorial[i]*Power[Pochhammer[-n^2,i],2]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Index->n,Mod[ChkIdentV3[n^2,n-1,-1,n-1]+1,n^2,modOffset],Mod[ChkIdentV4[n^2,n-1,-1,n-1]+1,n^2,modOffset],Mod[ChnV2[n^2,n-1,-1,n-1]+1,n^2,modOffset],
Index->n,Mod[ChkIdentV3[n^2,n-1,1,1]+1,n^2,modOffset],Mod[ChkIdentV4[n^2,n-1,1,1]+1,n^2,modOffset],Mod[ChnV2[n^2,n-1,1,1]+1,n^2,modOffset],
Index->n,ChkIdentV3[n^2,n-1,-1,n-1]+1,ChkIdentV4[n^2,n-1,-1,n-1],PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

numPrimes=12;modOffset=-1;
WPrimes={5,13};PrimesList=Union[Table[Prime[m],{m,2,numPrimes}],WPrimes]
Table[Map[WPPrimeCondFn[n],{Index->n,PrimeQ[n],MemberQ[WPrimes,n],Mod[Sum[Power[-1,i]/Factorial[i]*Power[Pochhammer[-n^2,i],2]*Factorial[n-1-i],{i,0,n-1}]+1,n^2,modOffset],
Index->n,Mod[ChkIdentV3V2[n]+1,n^2,modOffset],Mod[ChkIdentV4V2[n]+1,n^2,modOffset],
Index->n,Mod[ChnV2[n^2,n-1,-1,n-1]+1,n^2,modOffset],Mod[ChnV2[n^2,n-1,1,1]+1,n^2,modOffset],
Index->n,ChkIdentV3V2[n],ChkIdentV4V2[n]+1,PrintTemporary[n," of ",Max[PrimesList]]}],{n,PrimesList}] // TF

The multiple sum congruence formulas
(∑_(s=0)^(n-1))(∑_(i=0)^s)((∑_(k=0)^(n-1))(∑_(m=0)^k)i! (((-1))^(m+n-1)) (Binomial[(n^2), i]) (Binomial[(n^2), k]) (Binomial[m, s]) (Pochhammer[1-n, -k+n-1]) (((-n))^(m-s)) {({{s}, {i}})} [({{k}, {m}})])
(∑_(s=0)^(n-1))(∑_(i=0)^s)(∑_(v=0)^i)((∑_(k=0)^(n-1))(∑_(m=0)^k)i! (Binomial[i, v]) (Binomial[(n^2), k]) (Binomial[m, s]) (Binomial[(n^2)+v, v]) (Pochhammer[1-n, -k+n-1]) (n^(m-s)) {({{s}, {i}})} [({{k}, {m}})](((-1))^(i+n+s-v-1)))

ChkIdentV3V2[n]  // TraditionalForm
ChkIdentV4V2[n]// TraditionalForm

FS[ReleaseHold[HoldForm[Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]s1[k,m]*s2[s,i]*Power[-1,m]*Power[a,n]*Power[R/a-1,m-s]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]]/.(n->n-1)/.(h->n^2)/.(a->-1)/.(R->n-1)]]
%// TraditionalForm

FS[ReleaseHold[HoldForm[Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*s1[k,m]*s2[s,i]*Power[-1,m+i-v]*Power[a,n+s-m]*Power[R-a,m-s]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]]/.(n->n-1)/.(h->n^2)/.(a->-1)/.(R->n-1)]]
%// TraditionalForm

▶▶ Expansions of the sums in several prime pair congruences:

▶▶▶ Congruences for the twin primes:

Verify the congruence expansions stated in the introduction:

Clear[primeTupleDiff,firstCongFn,secondCongFn]
TwinPrimeCongV1[n_]:=2*Power[Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]+Power[-1,n]*(10n+7)
TwinPrimeCongV2[n_]:=4*Sum[(Binomial[(2n+1)(2n+3),i]^2)*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2 n}]+2*n+5

pupper=125;modOffset=-1;
{primeTupleDiff,firstCongFn,secondCongFn}={2,TwinPrimeCongV1,TwinPrimeCongV2};
expectedPrimesList=Select[Table[If[PrimeQ[p+primeTupleDiff],p,Null],{p,Table[Prime[n],{n,2,pupper}]}],NumericQ];
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,
CF[{Primes,2n+1,2n+1+primeTupleDiff}],
CF[{IsPrime->PrimeQ[2n+1],IsPrimePair->PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],ExpectedTuple->MemberQ[expectedPrimesList,2n+1]}],
CF[{FirstCong[n]->Mod[firstCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset],SecondCong[n]->Mod[secondCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset]}]}],{n,1,pupper}] // TF

Additional forms of the multiple sum expansions:

Clear[ChkIdentV3,ChkIdentV4]
ChkIdentV3[h_,n_,a_,R_]:=ChkIdentV3[h,n,a,R]=Sum[Sum[Binomial[m,s]*Binomial[h,i]*Binomial[h,k]S1[k,m]*StirlingS2[s,i]*Power[-1,m]*Power[a,n]*Power[R/a-1,m-s]*Factorial[i]*Pochhammer[R/a,n-k],{k,0,n},{m,0,k}],{s,0,n},{i,0,s}]
ChkIdentV4[h_,n_,a_,R_]:=ChkIdentV4[h,n,a,R]=Sum[Sum[Binomial[h,k]*Binomial[m,s]*Binomial[i,v]*Binomial[h+v,v]*S1[k,m]*StirlingS2[s,i]*Power[-1,m+i-v]*Power[a,n+s-m]*Power[R-a,m-s]*Pochhammer[R/a,n-k]*Factorial[i],{k,0,n},{m,0,k}],{s,0,n},{i,0,s},{v,0,i}]

nupper=21;primeTupleDiff=2;modOffset=-1;
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],Mod[2*(ChkIdentV3[(2n+1)*(2n+1+primeTupleDiff),n,-1,n]^2)+Power[-1,n]*(10n+7),(2n+1)*(2n+1+primeTupleDiff),modOffset],PrintTemporary[n," of ", nupper]}],{n,1,nupper}] // TF

nupper=15;primeTupleDiff=2;modOffset=-1;
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],Mod[4*ChkIdentV4[(2n+1)*(2n+1+primeTupleDiff),2n,-1,2n]+2n+5,(2n+1)*(2n+1+primeTupleDiff),modOffset],PrintTemporary[n," of ", nupper]}],{n,1,nupper}] // TF

Clear[TwinPrimeChkIdentV3,TwinPrimeChkIdentV4]
TwinPrimeChkIdentV3[n_]:=TwinPrimeChkIdentV3[n]=2 ((((∑_(s=0)^n)(∑_(i=0)^s)((∑_(k=0)^n)(∑_(m=0)^k)i! (((-1))^(s+k)) (Binomial[(2 n+1) (2 n+3), i]) (Binomial[(2 n+1) (2 n+3), k]) (Binomial[m, s]) FallingFactorial[n,n-k] (((n+1))^(m-s)) S2[s,i] S1[k,m])))^2)+(((-1))^n) (10 n+7)
TwinPrimeChkIdentV4[n_]:=TwinPrimeChkIdentV4[n]=4 (∑_(s=0)^(2 n))(∑_(i=0)^s)(∑_(v=0)^i)((∑_(k=0)^(2 n))(∑_(m=0)^k)i! (Binomial[i, v]) (Binomial[(2 n+1) (2 n+3), k]) (Binomial[m, s]) (Binomial[(2 n+1) (2 n+3)+v, v]) FallingFactorial[2n,2n-k] (((2 n+1))^(m-s)) S2[s,i] S1[k,m] (((-1))^(i+k+s+v)))+2 n+5

nupper=32;primeTupleDiff=2;modOffset=-1;
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],Mod[TwinPrimeChkIdentV3[n],(2n+1)*(2n+1+primeTupleDiff),modOffset],PrintTemporary[n," of ", nupper]}],{n,1,nupper}] // TF

nupper=16;primeTupleDiff=2;modOffset=-1;
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],Mod[TwinPrimeChkIdentV4[n],(2n+1)*(2n+1+primeTupleDiff),modOffset],PrintTemporary[n," of ", nupper]}],{n,1,nupper}] // TF

▶▶▶ Congruences for the cousin prime pairs:

Clear[primeTupleDiff,firstCongFn,secondCongFn]
CousinPrimeCongV1[n_]:=36*Power[Sum[(Binomial[(2n+1)(2n+5),i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]+Power[-1,n]*(29-14n)
CousinPrimeCongV2[n_]:=96*Sum[(Binomial[(2n+1)(2n+5),i]^2)*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2 n}]+46*n+119

pupper=125;modOffset=-1;
{primeTupleDiff,firstCongFn,secondCongFn}={4,CousinPrimeCongV1,CousinPrimeCongV2};
expectedPrimesList=Select[Table[If[PrimeQ[p+primeTupleDiff],p,Null],{p,Table[Prime[n],{n,2,pupper}]}],NumericQ];
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,
CF[{Primes,2n+1,2n+1+primeTupleDiff}],
CF[{IsPrime->PrimeQ[2n+1],IsPrimePair->PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],ExpectedTuple->MemberQ[expectedPrimesList,2n+1]}],
CF[{FirstCong[n]->Mod[firstCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset],SecondCong[n]->Mod[secondCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset]}]}],{n,1,pupper}] // TF

▶▶▶ Congruences for the sexy prime pairs:

{6*((5!!)^2),(6*((5!!)^2)+(((5!!)^2)+4^3)*p),((6*((5!!)^2)+(((5!!)^2)+4^3)*p))/.(p->2n+1) } // Expand
{(6*(6!)+(6!-1)*p),((6*(6!)+(6!-1)*p))/.(p->2n+1)} // Expand

Clear[primeTupleDiff,firstCongFn,secondCongFn]
SexyPrimeCongV1[n_]:=1350*Power[Sum[(Binomial[(2n+1)(2n+7),i]^2)*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]+Power[-1,n]*(1639+578 n)
SexyPrimeCongV2[n_]:=4320*Sum[(Binomial[(2n+1)(2n+7),i]^2)*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2 n}]+5039+1438 n

pupper=125;modOffset=-1;
{primeTupleDiff,firstCongFn,secondCongFn}={6,SexyPrimeCongV1,SexyPrimeCongV2};
expectedPrimesList=Select[Table[If[PrimeQ[p+primeTupleDiff],p,Null],{p,Table[Prime[n],{n,2,pupper}]}],NumericQ];
Table[Map[PrimeTupleCondFn[2n+1,primeTupleDiff],{Index->n,
CF[{Primes,2n+1,2n+1+primeTupleDiff}],
CF[{IsPrime->PrimeQ[2n+1],IsPrimePair->PrimeQ[2n+1]&&PrimeQ[2n+1+primeTupleDiff],ExpectedTuple->MemberQ[expectedPrimesList,2n+1]}],
CF[{FirstCong[n]->Mod[firstCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset],SecondCong[n]->Mod[secondCongFn[n],(2n+1)(2n+1+primeTupleDiff),modOffset]}]}],{n,1,pupper}] // TF

▶▶ Results and divisibility properties related to the double factorial function:

▶▶▶ Initial expansions of the double factorial function:

Table[{Index->n,Factorial2[2n-1],pn[n,2,1],pn[n,-2,2n-1],Index->n,FootnoteBinomialIdents[n]->{Pochhammer[1/2,n],Binomial[-1/2,n]*Power[-1,n]*(n!),Binomial[2n,n]*(n!)/(4^n)}},{n,0,nupper}] // TF

▶▶▶ Congruences for the double factorial function, (2n-1)!!, modulo (2^s) h for 0 ≤ s ≤ h:

nupper=100;hupper=6;modOffset=-1;
Table[mods[h,s,n]->{h*Power[2,s],{Mod[Factorial2[2n-1],h*Power[2,s],modOffset],
Mod[Sum[Binomial[h,i]*Pochhammer[1/2-h,i]*Power[2,n+i*(s+1)]*Pochhammer[1/2,n-i],{i,0,n}],h*Power[2,s],modOffset],Mod[Sum[Binomial[h,i]*Pochhammer[1/2-h,i]*Power[2,i*(s+2)]*Factorial2[2n-2i-1],{i,0,n}],h*Power[2,s],modOffset],Mod[Sum[Binomial[h,i]*Binomial[2n-2i,n-i]*Pochhammer[1/2-h,i]*Factorial[n-i]*Power[2,n+i*(s+1)]/Power[4,n-i],{i,0,n}],h*Power[2,s],modOffset],
Mod[Sum[Binomial[h,i]*Pochhammer[1/2+n-h,i]*Power[-2,n+i*(s+1)]*Pochhammer[1/2-n,n-i],{i,0,n}],h*Power[2,s],modOffset]}===ConstantArray[Mod[Factorial2[2n-1],h*Power[2,s],modOffset],5],Mod[Factorial2[2n-1],h*Power[2,s],modOffset]},{n,3,nupper,2},{h,1,hupper},{s,0,h}] // TF

▶▶▶ Polynomial congruences for the central binomial coefficients, (Binomial[2n, n]), 
           modulo individual polynomial powers of (n^p) for some integers p ≥ 1:

CentralBinomPolyModFn[n_,p_]:=PolynomialMod[FE[#1],n^p,CoefficientDomain->Integers]&

Clear[CentralBinomSumV1,CentralBinomSumV2,CentralBinomSumV3,CentralBinomSumV4,CentralBinomSumV5]
CentralBinomSumV1[x_,n_,p_]:=CentralBinomSumV1[x,n,p]=
     CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Pochhammer[1/2-x^p,i]*Pochhammer[1/2,n-i]*Power[2,2n+i],{i,0,n}]/Factorial[n]
CentralBinomSumV2[x_,n_,p_]:=CentralBinomSumV2[x,n,p]=
     CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Pochhammer[1/2-x^p,i]*Factorial2[2n-2i-1]*Power[2,n+2i],{i,0,n}]/Factorial[n]
CentralBinomSumV3[x_,n_,p_]:=CentralBinomSumV3[x,n,p]=
      CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Binomial[2x-2i,x-i]*Factorial[n-i]*Pochhammer[1/2-x^p,i]*Power[2,2n+i]/Power[4,n-i],{i,0,n}]/Factorial[n]
CentralBinomSumV4[x_,n_,p_]:=CentralBinomSumV4[x,n,p]=
     CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Binomial[2x-2i,x-i]*Factorial[n-i]*Pochhammer[1/2-x^p,i]*Power[8,i],{i,0,n}]/Factorial[n]
CentralBinomSumV5[x_,n_,p_]:=CentralBinomSumV5[x,n,p]=
     CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Pochhammer[1/2+n-x^p,i]*Pochhammer[1/2-n,n-i]*Power[2,2n]*Power[-2,i],{i,0,n}]/Factorial[n]

CentralBinomSumV5[x_,n_,p_]:=CentralBinomSumV5[x,n,p]=
     CentralBinomPolyModFn[x,p]@@Sum[Binomial[x^p,i]*Pochhammer[1/2+x-x^p,i]*Pochhammer[1/2-x^p,n-i]*Power[2,2n]*Power[-2,i],{i,0,n}]/Factorial[n]

nupper=50;nidxstep=2;pupper=5;modOffset=-1;
Table[Index[n,p]->{n^p,{Mod[Binomial[2n,n],n^p,modOffset],Mod[Power[2,n]Factorial2[2n-1]/Factorial[n],n^p,modOffset],Mod[CentralBinomSumV1[x,n,p]/.(x->n),n^p,modOffset],Mod[CentralBinomSumV2[x,n,p]/.(x->n),n^p,modOffset],Mod[CentralBinomSumV3[x,n,p]/.(x->n),n^p,modOffset],Mod[CentralBinomSumV4[x,n,p]/.(x->n),n^p,modOffset],Mod[CentralBinomSumV5[x,n,p]/.(x->n),n^p,modOffset]}===ConstantArray[Mod[Binomial[2n,n],n^p,modOffset],7],Mod[Binomial[2n,n],n^p,modOffset]},{n,3,nupper,nidxstep},{p,1,pupper}] // TF

nupper=100;modOffset=-1;
Table[mods[p,n]->{n^p,{Mod[Binomial[2n,n]*Factorial[n],n^p,modOffset],Mod[Sum[Binomial[n^p,i]*Pochhammer[1/2-n^p,i]*Power[2,2n+i]*Pochhammer[1/2,n-i],{i,0,n}],n^p,modOffset],Mod[Sum[Binomial[n^p,i]*Pochhammer[1/2-n^p,i]*Power[2,n+2i]*Factorial2[2n-2i-1],{i,0,n}],n^p,modOffset],Mod[Sum[Binomial[n^p,i]*Pochhammer[1/2+n-n^p,i]*Pochhammer[1/2-n,n-i]*Power[-2,2n+i]*Power[-1,n-i],{i,0,n}],n^p,modOffset]}===ConstantArray[Mod[Binomial[2n,n]*Factorial[n],n^p],4],Mod[Binomial[2n,n]*Factorial[n],n^p,modOffset]},{n,3,nupper,2},{p,1,5}] // TF

▶▶▶ The combined single and double factorial function sum identity:

nupper=12;
Table[{Index->n,Factorial[n],Factorial2[2n-1]-Sum[Sum[FactorialPower[j,k]*FactorialPower[2n-k-j,j-k]*Factorial2[2n-2j-1],{j,k,n}]-Factorial2[k]*Factorial2[2n-k-1],{k,1,n-1}],Factorial2[2n-1]-Sum[Sum[FactorialPower[j,k]*FactorialPower[2n-k-j,j-k]*Factorial2[2n-2j-1],{j,k,n}]-Sum[FactorialPower[j,k+1]*FactorialPower[2n-k-1-j,j-k-1]*Factorial2[2n-2j-1],{j,k+1,n}],{k,1,n-1}]},{n,1,nupper}] // TF

nupper=12;
Table[{Index->n,Factorial[n-1],Factorial2[2n-3]-Sum[Sum[FactorialPower[j,k]*FactorialPower[2n-2-k-j,j-k]*Factorial2[2n-2-2j-1],{j,k,n-1}]-Factorial2[k]*Factorial2[2n-2-k-1],{k,1,n-2}],Factorial2[2n-3]-Sum[Sum[FactorialPower[j,k]*FactorialPower[2n-2-k-j,j-k]*Factorial2[2n-2-2j-1],{j,k,n-1}]-Sum[FactorialPower[j,k+1]*FactorialPower[2n-2-k-1-j,j-k-1]*Factorial2[2n-2-2j-1],{j,k+1,n-1}],{k,1,n-2}],Factorial2[2n-3]-Sum[Sum[FallingFactorial[j,k]*FallingFactorial[2n-2-k-j,j-k]*Factorial2[2n-2-2j-1],{j,k,n-1}]-Sum[FallingFactorial[j,k+1]*FallingFactorial[2n-2-k-1-j,j-k-1]*Factorial2[2n-2-2j-1],{j,k+1,n-1}],{k,1,n-2}],Factorial2[2n-3]-Sum[Sum[Pochhammer[-j,k]*Power[-1,k+j-k]*Pochhammer[-(2n-2-k-j),j-k]*Factorial2[2n-2-2j-1],{j,k,n-1}]-Sum[Pochhammer[-j,k+1]*Pochhammer[-(2n-2-k-1-j),j-k-1]*Power[-1,k+1+j-k-1]*Factorial2[2n-2-2j-1],{j,k+1,n-1}],{k,1,n-2}],Index->n,Factorial[n-1],Factorial2[2n-3]+Sum[Sum[Power[-1,j+1]*Pochhammer[-j,k]*Pochhammer[-(2n-k-j-2),j-k]*Factorial2[2n-2j-3],{j,k,n-1}]+Sum[Power[-1,j]*Pochhammer[-j,k+1]*Pochhammer[-(2n-k-j-3),j-k-1]*Factorial2[2n-2j-3],{j,k+1,n-1}],{k,1,n-2}]},{n,1,nupper}] // TF

▶▶ Results obtained from symbolic computations with Mathematica’s Sigma Package:

▶▶▶ Alternate simplified forms of the right-hand-side sums in the congruences: 
          n! ≡  (∑_(i=0)^(n-1))((Binomial[n+d, i])^2) (((-1))^i) (n-1-i)! (mod n+d)

Compute and solve a recurrence for the right-hand-side (RHS) sum using the Sigma package routines:

sum=SigmaSum[SigmaPower[SigmaBinomial[n+d,i],1]*SigmaPochhammer[-(n+d),i]*SigmaFactorial[n-i],{i,0,n}];
GenerateRecurrence[sum,n] // FS
rec=%[[1]];
recsol=SolveRecurrence[rec,SUM[n]] // FS
recsol2=FindLinearCombination[recsol,sum,2]

Use Mathematica to simplify the product terms in terms of the Pochhammer symbol:
(∏_(i=1)^n)(1-2 d-i) = (((-1))^n) (Pochhammer[2 d, n])

Product[1-2d-i,{i,1,n}]
Product[1-2d-i,{i,1,n}] // HoldForm // TraditionalForm
Product[1-2d-i,{i,1,n}] // TraditionalForm

Compute tables of the new summation identities, where the last sum form is obtained by applying the fractions of Pochhammer symbols footnote expansion:

nupper=4;
Table[{Index->n,FS[Sum[Binomial[n+d,i]Pochhammer[-(n+d),i]*Factorial[n-i],{i,0,n}]],FS[Power[-1,n]*Pochhammer[2d,n]*(1+(d^2)*Sum[Binomial[i+d,i]*Pochhammer[-(i+d),i]*Power[-1,i]/((i+d)^2)/Pochhammer[2d,i],{i,1,n}])],FS[Power[-1,n]*Pochhammer[2d,n]*(1+(d^2)*Sum[(Binomial[i+d,i]^2)*Factorial[i]/((i+d)^2)/Pochhammer[2d,i],{i,1,n}])],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,i]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,Factor[FE[Sum[Binomial[n+d,i]Pochhammer[-(n+d),i]*Factorial[n-i],{i,0,n}]]],PolynomialMod[FE[Sum[Binomial[n+d,i]Pochhammer[-(n+d),i]*Factorial[n-i],{i,0,n}]],n+d],Factor[PolynomialMod[FE[Sum[Binomial[n+d*c,i]Pochhammer[-(n+d*c),i]*Factorial[n-i],{i,0,n}]],n+d]],FS[PolynomialMod[FE[Sum[Binomial[n+d*a,i]Pochhammer[-(n+d*b),i]*Factorial[n-i],{i,0,n}]],n+d]]},{n,0,nupper}] // TF

▶▶▶ Expansions of particular special cases of the sums, (Subscript[S, 1,d])(n), in terms of the first-order harmonic numbers:

(Subscript[S, 1,d])(n) := (((-1))^n) (d^2) (∑_(i=0)^n)((((Binomial[i+d, d])^2) i! (Pochhammer[2 d+i, n-i]))/(((i+d))^2))

Some initial observations on the forms of the expansions given below and in the special cases cited as example cases in the article section :
 ▶   The factored coefficients  in the terms obtained from the Sigma sums correspond to multiples of the Stirling number triangles.
 ▶   Since the parameter d in these sums can vary with n, the harmonic number expansions noted in the few example cases suggest one form of the
       generalized harmonic number expansions implied by the congruences for the prime pair sums, among several other variations of these sums 
      noted in the applications. If d := (2n+1)(2n+3) , or  d := (2n+1)(2n+7) , in the expansions of these particular sum cases, the 
       congruences for the twin and sexy prime pairs expanded in this section yield congruences involving a leading first-order harmonic number term 
      whose dividibility depends quadratically on the sequence index index, for example, in the forms of 
      (HarmonicNumber[4 (n^2)+9 n+3]) × ((n+1)(n+3)+n)!, or (HarmonicNumber[7+17 n+4 (n^2)]) × ((n+1)(n+7)+n)!

▶ Another couple of observed special case formulas for the sums (Subscript[S, 1,d])(n) when d:=1,2 given in terms of the first and second-order Eulerian number triangles:

Table[{Index->n,Factor[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->d)],Index->n,S1[n+2,2]*Power[-1,n],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->1)],
Index->n,EulerianE2[n+2,n]*Power[-1,n],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->2)],
Index->n,FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->3)],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->4)],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->5)],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->6)],FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]/.(d->7)]},{n,1,5}] // TF

Table[{Index->n,Mod[n!,n+1,-1],Mod[S1[n+2,2]*Power[-1,n],n+1,-1],Index->n,Mod[n!,n+2,-1],Mod[EulerianE2[n+2,n]*Power[-1,n],n+2,-1]},{n,2,24}] // TF

▶ Generate the expansions of the identities cited as special cases using Sigma and the built-in Mathematica 
    routine FindSequenceFunction which is able to recognize thesse harmonic number sequence cases:

getHarmonicNumberSumExps[d_,nupper_:18]:=Module[{},

sigmaSum=SigmaSum[SigmaPower[SigmaBinomial[i+d,d],2]*SigmaFactorial[i]*SigmaPochhammer[2 d+i,n-i]*SigmaPower[i+d,-2]*SigmaPower[-1,n],{i,0,n}];
sigmaRec=GenerateRecurrence[sigmaSum,n][[1]];
sigmaRecSol=FS[SolveRecurrence[sigmaRec,SUM[n]]];
sigmaRecSolLC=FS[FindLinearCombination[sigmaRecSol,sigmaSum,2]];
polyTerms=Cancel[sigmaRecSolLC/SigmaPochhammer[2 d,n]/SigmaPower[-1,n]]/.(((Underoverscript[(∑^(.)), ((Subscript[ι, 1])=1), n])(1/(Subscript[ι, 1])))->0);
fsfData=Table[FS[Power[-1,n]*(d^2)*Sum[(Binomial[i+d,d]^2)*Factorial[i]/((i+d)^2)*Pochhammer[2d+i,n-i],{i,0,n}]],{n,1,nupper}];
fsfFormula=FS[FindSequenceFunction[fsfData,n]];
fsfFormulaFactored=FS[Factor[(fsfFormula)/Gamma[n+d+1]]];

printOutput[headerStr_,formula_]:={Print["▶ ", Style[headerStr,Bold,Italic,Larger],formula]};
printOutput["Recurrence d Paremeter: ",d];
printOutput["Sigma Recurrence: ",sigmaRec];
printOutput["Sigma Computed Solutions: ",sigmaRecSol];
printOutput["Sigma Combined Solutions: ",sigmaRecSolLC];
printOutput["Expansion of Partial Terms I:  ",Factor[polyTerms]];
printOutput["Expansion of Partial Terms II: ",Apart[polyTerms]];
printOutput["FindSequenceFunction Sequence Formula: ",fsfFormula];
printOutput[ToString[StringForm["FindSequenceFunction Sequence Formula × (n+`1`)!: ",d]],fsfFormulaFactored];

Return[{sigmaRecSolLC,fsfFormula,fsfFormulaFactored}];

]

getHarmonicNumberSumExps[1]

getHarmonicNumberSumExps[2]

getHarmonicNumberSumExps[3]

getHarmonicNumberSumExps[4]

▶▶▶ Alternate simplified forms of the right-hand-side sums in the congruences:
          n! ≡  (∑_(i=0)^n)((Binomial[2n+1, i])^2) (((-1))^i) (n-i)! (mod 2n+1)

Compute and solve a recurrence for the right-hand-side (RHS) sum using the Sigma package routines:

sum=SigmaSum[SigmaPower[SigmaBinomial[2n+1,i],2]*SigmaPower[-1,i]*SigmaFactorial[i]*SigmaFactorial[n-i],{i,0,n}];
GenerateRecurrence[sum,n] // FS
rec=%[[1]];
recsol=SolveRecurrence[rec,SUM[n]] // FS;
recsol2=FindLinearCombination[recsol,sum,2]

formula1[n_]:=((1/8) ((Underoverscript[(∏^(.)), ((Subscript[ι, 1])=1), n])(27-(6/(Subscript[ι, 1]))-27 (Subscript[ι, 1]))) (8 (1+3 n)-10 (1+3 n) ((Underoverscript[(∑^(.)), ((Subscript[ι, 1])=1), n])((((((((({{1+2 (Subscript[ι, 1])}, {(Subscript[ι, 1])}})))^(.))))^2) (Subscript[ι, 1])(Subscript[!, .]) (((-1))^(Underscript[(Subscript[ι, 1]), .])) (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), (Subscript[ι, 1])])(-((Subscript[ι, 2])/(3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))))))/(Subscript[ι, 1])))+(1+3 n) ((Underoverscript[(∑^(.)), ((Subscript[ι, 1])=1), n])((((((((({{1+2 (Subscript[ι, 1])}, {(Subscript[ι, 1])}})))^(.))))^2) (Subscript[ι, 1])(Subscript[!, .]) (((-1))^(Underscript[(Subscript[ι, 1]), .])) (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), (Subscript[ι, 1])])(-((Subscript[ι, 2])/(3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))))))/(((1+2 (Subscript[ι, 1])))^2)))-5 (1+3 n) ((Underoverscript[(∑^(.)), ((Subscript[ι, 1])=1), n])((((((((({{1+2 (Subscript[ι, 1])}, {(Subscript[ι, 1])}})))^(.))))^2) (Subscript[ι, 1])(Subscript[!, .]) (((-1))^(Underscript[(Subscript[ι, 1]), .])) (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), (Subscript[ι, 1])])(-((Subscript[ι, 2])/(3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))))))/(1+2 (Subscript[ι, 1]))))+32 (1+3 n) ((Underoverscript[(∑^(.)), ((Subscript[ι, 1])=1), n])((((((((({{1+2 (Subscript[ι, 1])}, {(Subscript[ι, 1])}})))^(.))))^2) (Subscript[ι, 1])(Subscript[!, .]) (((-1))^(Underscript[(Subscript[ι, 1]), .])) (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), (Subscript[ι, 1])])(-((Subscript[ι, 2])/(3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))))))/(1+3 (Subscript[ι, 1]))))))
SSum[n_]:=Power[Sum[Power[Binomial[2n+1,i],2]*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],2]
nupper=10;
Table[{Index->n,Sqrt[SSum[n]],Power[-1,n]formula1[n],Power[27,n]*(3n+1)*Pochhammer[1/3,n]*Pochhammer[2/3,n]/8/Factorial[n]*(8+Sum[(Binomial[2i+1,i]^2)*(Factorial[i]^2)/Power[27,i]/Pochhammer[1/3,i]/Pochhammer[2/3,i]*(-10/i+1/Power[2i+1,2]-5/(2i+1)+32/(3i+1)),{i,1,n}]),(3n+1)*Factorial[3n]/8/(Factorial[n]^2)*(8+Sum[(Binomial[2i+1,i]^2)*(Factorial[i]^3)/Factorial[3i]*(-10/i+1/Power[2i+1,2]-5/(2i+1)+32/(3i+1)),{i,1,n}]),
Index->n,(1/8) ((Underoverscript[(∏^(.)), ((Subscript[ι, 1])=1), n])(27-(6/(Subscript[ι, 1]))-27 (Subscript[ι, 1]))),Power[-27,n]*Pochhammer[1/3,n]*Pochhammer[2/3,n]/8/Factorial[n]},{n,0,nupper}] // TF

Simplfy the product terms to ratios of factorials:
(((-1))^(Underscript[i, .]))  (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), i])(-((Subscript[ι, 2])/(3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))))) =  (Underoverscript[(∏^(.)), ((Subscript[ι, 2])=1), i])(((Subscript[ι, 2])/(3 (3(Subscript[ι, 2])-1)(3(Subscript[ι, 2])-2)))) =((((i!))^2)/((3 i)!))  and  (Underoverscript[(∏^(.)), ((Subscript[ι, 1])=1), n])(27-(6/(Subscript[ι, 1]))-27 (Subscript[ι, 1])) = (((((-1))^n) (3 n)!)/(((n!))^2))

Factor[3 (2+9 (-1+(Subscript[ι, 2])) (Subscript[ι, 2]))]/.((Subscript[ι, 2])->i)
Factor[27-(6/(Subscript[ι, 1]))-27 (Subscript[ι, 1])]
Product[(-2+3 i) (-1+3 i)*(3 i),{i,1,n}] // FS // Expand

Collect the inner sum terms:

FS[-10/i+1/Power[2i+1,2]-5/(2i+1)+32/(3i+1)]
Apart[%]
Apart[(%%)*(3i+1)]
Apart[-((2 (((1+i))^2) (5+11 i))/(i (((1+2 i))^2)))]

The stated expansions cited in the article:

nupper=10;
Table[{Index->n,Sum[Power[Binomial[2n+1,i],2]*Power[-1,i]*Factorial[i]*Factorial[n-i],{i,0,n}],Power[-1,n]*Factorial[3n+1]/8/(Factorial[n]^2)*(8+Sum[(Binomial[2i+1,i]^2)*(Factorial[i]^3)/Factorial[3i]*(-(10/i)+(1/(((1+2 i))^2))-(5/(1+2 i))+(32/(1+3 i))),{i,1,n}]),Power[-1,n]*Factorial[3n+1]/(Factorial[n]^2)+Power[-1,n]/8*(3n+1)*Sum[(Binomial[2i+1,i]^2)*(Factorial[i])Pochhammer[1+3i,3n-3i]/(Pochhammer[1+i,n-i]^2)*(-(10/i)+(1/(((1+2 i))^2))-(5/(1+2 i))+(32/(1+3 i))),{i,1,n}],Power[-1,n]*Factorial[3n+1]/8/(Factorial[n]^2)*(8-1/2*Sum[(Binomial[2i+1,i]^2)*(Factorial[i]^3)/Factorial[3i+1]*(11+20/i-8/(2i+1)+1/((2i+1)^2)),{i,1,n}]),Power[-1,n]*Factorial[3n+1]/(Factorial[n]^2)-Power[-1,n]/16*Sum[(Binomial[2i+1,i]^2)*(Factorial[i])Pochhammer[2+3i,3n-3i]/(Pochhammer[1+i,n-i]^2)*(11+20/i-8/(2i+1)+1/((2i+1)^2)),{i,1,n}]},{n,0,nupper}] // TF

▶▶▶ Forms of the expansions of the Apery-like sums in the twin, cousin, andsexy  prime congruence results obtained using Sigma:

Obtain the recurrence solution for the sums generated by Sigma:

sum=SigmaSum[SigmaPower[SigmaBinomial[h,i],1]*SigmaPochhammer[-h,i]*SigmaFactorial[2n-i],{i,0,2n}];
GenerateRecurrence[sum,n] // FS
rec=%[[1]];
recsol=SolveRecurrence[rec,SUM[n]] // FS
recsol2=FindLinearCombination[recsol,sum,2]

Simplify the products and collect the sum terms as follows:

((((((h-2 (Subscript[ι, 1])))^2) (((1+h-2 (Subscript[ι, 1])))^2))/(2 (1+2 h-2 (Subscript[ι, 1])) (h-(Subscript[ι, 1])))))/.((Subscript[ι, 1])->i)
{Product[(%),{i,1,n}],Power[Pochhammer[-(h)+1,2n],2]/(Pochhammer[-(2h)+1,2n])}
Table[FS[(%)[[1]]-(%)[[2]]],{n,1,10}]

(((2 (1+2 h-2 (Subscript[ι, 2])) (h-(Subscript[ι, 2])))/((((h-2 (Subscript[ι, 2])))^2) (((1+h-2 (Subscript[ι, 2])))^2))))/.((Subscript[ι, 2])->j)
{Product[(%),{j,1,i}],1/(Power[Pochhammer[-(h)+1,2i],2]/(Pochhammer[-(2h)+1,2i]))}

FS[(2*(h+1)/(h+1-2i)+2*(h-1)*((h+1)^2)*(2h+1)/(2h+1-2i)-(h^2)*(h+1)*(2h-1)/(h-i))/(h*(h-1))]
Apart[%]
Plus@@Map[Factor,Table[%[[j]],{j,1,Length[%]}]]

Define the next shorthand functions given in the examples from the article:

Clear[SnhSum,T,H,TestSnhSumV1,TestSnhSumV2,GenPairCongruenceMod]

SnhSum[n_,h_]:=SnhSum[n,h]=Sum[Binomial[h,i]*Pochhammer[-h,i]*Factorial[2n-i],{i,0,2n}]
T[h_,n_]:=T[h,n]=((((Pochhammer[1-h,2 n])^2)/(Pochhammer[1-2 h,2 n])))
H[h_,i_]:=H[h,i]=(((2 (1+h))/((-1+h) h (1+h-2 i)))+((2 (((1+h))^2) (1+2 h))/(h (1+2 h-2 i)))-((h (1+h) (-1+2 h))/((-1+h) (h-i))))
T[h_,n_,i_]:=T[h,n,i]=(Power[Pochhammer[1-h+2i,2(n-i)],2]/(Pochhammer[1-2h+2i,2(n-i)]))
TestSnhSumV1[n_,h_]:=TestSnhSumV1[n,h]=Sum[(Binomial[h,2i]^2)*Factorial[2i]*T[h,n]/T[h,i]*H[h,i],{i,0,n}]
TestSnhSumV2[n_,h_]:=TestSnhSumV2[n,h]=Sum[(Binomial[h,2i]^2)*Factorial[2i]*H[h,i]*T[h,n,i],{i,0,n}]

GenPairCongruenceMod[n_,d_,a_,b_,c_,modOffset_:-1]:=Mod[a*TestSnhSumV2[n,(2n+1)(2n+1+2*d)]+b*n+c,(2n+1)(2n+1+2*d),modOffset]

Verify the computed expansions match the original input sum:

Table[{Index->n,FS[FE[SnhSum[n,h]]]-FS[FE[TestSnhSumV1[n,h]]],FS[FE[SnhSum[n,h]]]-FS[FE[TestSnhSumV2[n,h]]],
Index->n,Mod[4*TestSnhSumV2[n,(2n+1)(2n+3)]+2n+5,(2n+1)(2n+3),0],Mod[96*TestSnhSumV2[n,(2n+1)(2n+5)]+46n+119,(2n+1)(2n+5),0],Mod[4320*TestSnhSumV2[n,(2n+1)(2n+7)]+1438n+5039,(2n+1)(2n+7),0]},{n,0,12}] // TF

Resulting congruence for the twin primes:

nupper=105;{d,a,b,c}={1,4,2,5};
expectedPrimesList=Select[Table[n,{n,2,4*nupper}],PrimeQ[#1]&&PrimeQ[#1+2*d]&]
Table[Map[PrimeTupleCondFn[2n+1,2*d],{Index->2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+2*d],MemberQ[expectedPrimesList,2n+1],GenPairCongruenceMod[n,d,a,b,c]}],{n,1,nupper}] // TF

Resulting congruence for the cousin primes:

nupper=105;{d,a,b,c}={2,96,46,119};
expectedPrimesList=Select[Table[n,{n,2,4*nupper}],PrimeQ[#1]&&PrimeQ[#1+2*d]&]
Table[Map[PrimeTupleCondFn[2n+1,2*d],{Index->2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+2*d],MemberQ[expectedPrimesList,2n+1],GenPairCongruenceMod[n,d,a,b,c]}],{n,1,nupper}] // TF

Resulting congruence for the sexy prime pairs:

nupper=105;{d,a,b,c}={3,4320,1438,5039};
expectedPrimesList=Select[Table[n,{n,2,4*nupper}],PrimeQ[#1]&&PrimeQ[#1+2*d]&]
Table[Map[PrimeTupleCondFn[2n+1,2*d],{Index->2n+1,PrimeQ[2n+1],PrimeQ[2n+1]&&PrimeQ[2n+1+2*d],MemberQ[expectedPrimesList,2n+1],GenPairCongruenceMod[n,d,a,b,c]}],{n,1,nupper}] // TF

▶▶▶ Harmonic-number-related sums in the previous example:

FormulaGrid[list_,type_]:=Grid[Transpose@{list},Alignment->{Left,Automatic},Background->{None,{{Lighter[Blend[Switch[type,M,{Blue,Green},CM,{Red,Orange},FM,{Magenta,Cyan},C,{Purple,Red}]],.8],White}}},Dividers->{None,{Darker[Gray,.6],{False},Darker[Gray,.6]}}]
FormulaGrid[tblData_]:=FormulaGrid[tblData,M]

H[h_,i_]:=((((1+h) (1+2 h-4 i) (h-2 i))/((1+h-2 i) (1+2 h-2 i) (h-i))))
T[h_,n_,i_]:=(Power[Pochhammer[1-h+2i,2(n-i)],2]/(Pochhammer[1-2h+2i,2(n-i)]))

nupper=4;
Table[{Index->n,Factor[FE[Sum[Power[Binomial[h,i],2]*Power[-1,i]*Factorial[i]*Factorial[2n-i],{i,0,2n}]]],Factor[FE[Sum[Power[Binomial[h,2i],2]*Factorial[2i]*H[h,i]*T[h,n,i],{i,0,n}]]],Apart[Factor[FE[Sum[Power[Binomial[h,2i],2]*Factorial[2i]*(((2 (1+h))/((-1+h) h (1+h-2 i)))+((2 (((1+h))^2) (1+2 h))/(h (1+2 h-2 i)))-((h (1+h) (-1+2 h))/((-1+h) (h-i))))*T[h,n,i],{i,0,n}]]]],Sum[Power[Binomial[h,2i],2]*Factorial[2i]*(((2 (1+h))/((-1+h) h (1+h-2 i)))+((2 (((1+h))^2) (1+2 h))/(h (1+2 h-2 i)))-((h (1+h) (-1+2 h))/((-1+h) (h-i))))*T[h,n,i],{i,0,n}]},{n,0,nupper}] // FormulaGrid

▶▶ Other examples and notable applications of Wilson’s theorem:

▶▶▶ Factorial Primes:

Compute expected factorial prime sequence members:

nupper=100;
Map[First,Select[Table[{n,PrimeQ[n!+1]},{n,1,nupper}],Last[#1]==True&]]
Map[First,Select[Table[{n,PrimeQ[n!-1]},{n,1,nupper}],Last[#1]==True&]]

Compute congruences for prime elements of the form p:=n!+1:

nupper=100;expectedPrimesList=Map[First,Select[Table[{n,PrimeQ[n!+1]},{n,1,nupper}],Last[#1]==True&]];
nupper=5;fprimes=Map[First,Select[Table[{n,PrimeQ[n!+1]},{n,1,nupper}],Last[#1]==True&]]

Table[Map[PrimeCondFn[n!+1],{Index->n,Factorial[n],PrimeQ[n!+1],MemberQ[expectedPrimesList,n],Mod[Sum[(Binomial[n!+1,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n!-i],{i,0,n!}],n!+1,-1],PrintTemporary[n," of ", nupper]}],{n,1,nupper}] // TF

Compute congruences for prime elements of the form p:=n!-1:

nupper=100;expectedPrimesList=Map[First,Select[Table[{n,PrimeQ[n!-1]},{n,1,nupper}],Last[#1]==True&]];
nupper=7;fprimes=Map[First,Select[Table[{n,PrimeQ[n!-1]},{n,1,nupper}],Last[#1]==True&]]

Table[Map[PrimeCondFn[n!-1],{Index->n,Factorial[n],PrimeQ[n!-1],MemberQ[expectedPrimesList,n],Mod[Sum[(Binomial[n!-1,i]^2)*Power[-1,i]*Factorial[i]*Factorial[n!-2-i],{i,0,n!-2}],n!-1,-1],PrintTemporary[n," of ", nupper]}],{n,3,nupper}] // TF

▶▶▶ Fermat Primes:

Compute expected sequence elements:

nupper=12;
Table[{Index->n,PrimeQ[Power[2,Power[2,n]]+1],Power[2,Power[2,n]]+1},{n,0,nupper}] // TF

Verify the iterated factorial function expansions of the single factorial function, ((2^(2^n)))!:

Table[{Index->n,N[Factorial[2^(2^n)]/(Power[2,2^(2^n-1)]*Factorial[2^(2^n-1)]*Factorial2[2^(2^n)-1])]},{n,0,6}] // TF

Table[{Index->n,N[Factorial[2^(2^n)]/(Power[2,2^(2^n-1)]*Factorial[2^(2^n-1)]*Factorial2[2^(2^n)-1])]},{n,0,5}] // TF

Table[{Index->n,N[Factorial[2^(2^n)]/(Power[2,3/4*(2^(2^n))]*Factorial[2^(2^n-2)]*Factorial2[2^((2^n)-1)-1]*Factorial2[2^(2^n)-1])]},{n,0,4}] // TF

Table[{Index->n,N[Factorial[2^(2^n)]/(Power[2,7/8*(2^(2^n))]*Factorial[2^(2^n-3)]*Factorial2[2^((2^n)-2)-1]*Factorial2[2^((2^n)-1)-1]*Factorial2[2^(2^n)-1])]},{n,0,4}] // TF

Table[{Index->n,N[Factorial[h-1]/(Power[2,((h-1)/2)]*Factorial[(h-1)/2]*Factorial2[h-2])/.(h->m+1)/.(m->Power[2,2^n])]},{n,0,6}] // TF

Table[{Index->n,N[Factorial[h-1]/(Power[2,(h-1)*3/4]*Factorial[(h-1)/4]*Factorial2[(h-3)/2]*Factorial2[h-2])/.(h->m+1)/.(m->Power[2,2^n])]},{n,0,4}] // TF

Table[{Index->n,N[Factorial[h-1]/(Power[2,(h-1)*7/8]*Factorial[(h-1)/8]*Factorial2[(h-5)/4]*Factorial2[(h-3)/2]*Factorial2[h-2])/.(h->m+1)/.(m->Power[2,2^n])]},{n,0,4}] // TF

▶▶▶ Mersenne primes:

Compute tables of the congruences for the Mersenne primes:

pupper=13;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,2*pupper}],PrimeQ[#1]&&PrimeQ[Power[2,#1]-1]&]
Table[Map[PrimePairCondFn[p,PrimeQ[2^p-1]&],{
Index->p,2^p-1,PrimeQ[p],PrimeQ[p]&&PrimeQ[2^p-1],MemberQ[expectedPrimesList,p],
SgFactCong1[p],Mod[Factorial[p-1]*Factorial[2^p-2]+Factorial[p-1]+Factorial[2^p-2]+1,p*(2^p-1),modOffset],
SgFactCong2[p],Mod[ChnV2[p*(2^p-1),p-1,-1,p-1]*ChnV2[p*(2^p-1),2^p-2,-1,2^p-2]+ChnV2[p*(2^p-1),p-1,-1,p-1]+ChnV2[p*(2^p-1),2^p-2,-1,2^p-2]+1,p*(2^p-1),modOffset],
SgFactCong3[p],Mod[ChnV2[p*(2^p-1),p-1,1,1]*ChnV2[p*(2^p-1),2^p-2,1,1]+ChnV2[p*(2^p-1),p-1,1,1]+ChnV2[p*(2^p-1),2^p-2,1,1]+1,p*(2^p-1),modOffset],
DblFactCong4[p],Mod[Factorial[p-1]*Factorial[2^p-2]+Factorial[p-1]+Power[2,2^(p-1)-1]*Factorial[2^(p-1)-1]*Factorial2[2^(p)-3]+1,p*(2^p-1),modOffset],PrintTemporary[p," of ", pupper]}],{p,1,pupper}] // TF

pupper=13;modOffset=-1;
expectedPrimesList=Select[Table[n,{n,2,2*pupper}],PrimeQ[#1]&&PrimeQ[Power[2,#1]-1]&]
Table[Map[PrimePairCondFn[p,PrimeQ[2^p-1]&],{
Index->p,2^p-1,PrimeQ[p],PrimeQ[p]&&PrimeQ[2^p-1],MemberQ[expectedPrimesList,p],
Cong4SumExp1[p],Mod[Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[p-1-i],{i,0,p-1}]*(1+Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[Power[2,p]-2-i],{i,0,Power[2,p]-2}])+Power[2,2^(p-1)-1]*Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[Power[2,p-1]-1-i],{i,0,Power[2,p-1]-1}]*Factorial2[2^(p)-3]+1,p*(2^p-1),modOffset],
Cong4SumExp2[p],Mod[Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[p-1-i],{i,0,p-1}]*(1+Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[Power[2,p]-2-i],{i,0,Power[2,p]-2}])+Power[2,2^(p-1)-1]*Sum[(Binomial[p*(2^p-1),i]^2)*Power[-1,i]*Factorial[i]*Factorial[Power[2,p-1]-1-i],{i,0,Power[2,p-1]-1}]*Sum[Binomial[p*(2^p-1),i]*Pochhammer[-(1/2-Power[2,p-1]-1),i]*Pochhammer[1/2,(Power[2,p-1]-1)-i]*Power[2,Power[2,p-1]-1+i],{i,0,Power[2,p-1]-1}]+1,p*(2^p-1),modOffset],PrintTemporary[p," of ", pupper]}],{p,1,pupper}] // TF

▶▶▶ Sophie Germain primes:

Compute tables of the congruences for the Sophie Germain primes:

primePairQ=PrimeQ[2#1+1]&;
PrimeCondFn=PrimePairCondFn[#1,primePairQ]&;
modulusFn=(#1*(2#1+1))&;
modOffset=-1;

pupper=50;
expectedPrimesList=Select[Table[n,{n,2,2*pupper}],PrimeQ[#1]&&primePairQ[#1]&]
Table[Map[PrimeCondFn[p],{Index->p,2p+1,PrimeQ[p],PrimeQ[p]&&primePairQ[p],MemberQ[expectedPrimesList,p],Mod[(Factorial[p-1]*Factorial[2 p]+Factorial[p-1]+Factorial[2 p])+1,modulusFn[p],modOffset],Mod[((2^p)*Factorial[p-1]*Factorial[p]*Factorial2[2 p-1]+Factorial[p-1]+Factorial[2 p])+1,modulusFn[p],modOffset]}],{p,1,pupper}] // TF

▶▶ Remarks on expansions of congruences involving sequences of binomials:

Tables of the congruences for powers of 2 modulo n^2:

nupper=64;
Table[{Index->n,Mod[Power[2,n-1],n^2,0],Mod[Sum[S2[n-1,k](Binomial[n^2,i]^2)*Power[-1,n-1-k-i]*(i!)*((k+1-i)!),{k,0,n-1},{i,0,k+1}],n^2,0],Index->n,Mod[Power[2,n-1]-1,n^2,0],Mod[Sum[S2[i,j](Binomial[n^2,m]^2)*Power[-1,i-j+m]*(m!)*((j+1-m)!),{i,0,n-2},{j,0,i},{m,0,j+1}],n^2,0],Index->n,Mod[Power[2,n-1]-1,n^2,0],Mod[Sum[S2[i,j](Binomial[n^2,m])*Power[-1,i-j+m]*FallingFactorial[n^2+1,m]*Pochhammer[2,j-m],{i,0,n-2},{j,0,i},{m,0,j}],n^2,0]},{n,1,nupper}] // TF

Tables of the congruences for powers of 3:

tupper=75;
Table[Map[PrimeCondFn[2t+1],{Index->t,IsPrimeQ->PrimeQ[2t+1],Pow2Q->IntegerQ[Log[2,t]],Mod[Power[3,t]+1,2t+1,0],Mod[Sum[Binomial[2t+1,j]*FallingFactorial[2t+3,j]*Power[-1,t-i-j]Pochhammer[3,i-j]*S2[t,i],{i,0,t},{j,0,i}]+1,2t+1,0],Mod[Sum[Sum[Binomial[2t+1,j]*FallingFactorial[-(1-(2t+1)-3),j]*Power[-1,m-i-j]Pochhammer[3,i-j]*S2[m,i]*4,{i,0,m},{j,0,i}]*Power[-1,t-1-m],{m,0,t-1}],2t+1,0]}],{t,1,tupper}] // TF

▶▶ More general expansions by multiple factorial functions and generalized harmonic number sequences:

▶▶▶ Expansions of the factorial-related congruence results by more general cases of the α-factorial functions and corresponding Pochhammer symbol representations of these functions:

Compute examples of the congruence results for the generalized Sophie Germain prime sequences:

primePairQ=PrimeQ[4#1+1]&;
PrimeCondFn=PrimePairCondFn[#1,primePairQ]&;
modulusFn=(#1*(4#1+1))&;
modOffset=-1;

pupper=128;
expectedPrimesList=Select[Table[n,{n,2,2*pupper}],PrimeQ[#1]&&primePairQ[#1]&]
Table[Map[PrimeCondFn[p],{Index->p,PrimeQ[p],PrimeQ[p]&&primePairQ[p],MemberQ[expectedPrimesList,p],Mod[(Factorial[p-1]*Factorial[4 p]+Factorial[p-1]+Factorial[4 p])+1,modulusFn[p],modOffset],Mod[(Factorial[p-1]*(AlphaFactorial[4,4p]*AlphaFactorial[4,4p-1]*AlphaFactorial[4,4p-2]*AlphaFactorial[4,4p-3]+1)+Factorial[4 p])+1,modulusFn[p],modOffset],Mod[(Factorial[p-1]*(Power[4,4p]*Pochhammer[1,p]*Pochhammer[1/4,p]*Pochhammer[1/2,p]*Pochhammer[3/4,p]+1)+Factorial[4 p])+1,modulusFn[p],modOffset]}],{p,1,pupper}] // TF

primePairQ=PrimeQ[6#1+1]&;
PrimeCondFn=PrimePairCondFn[#1,primePairQ]&;
modulusFn=(#1*(6#1+1))&;
modOffset=-1;

pupper=111;
expectedPrimesList=Select[Table[n,{n,2,2*pupper}],PrimeQ[#1]&&primePairQ[#1]&]
Table[Map[PrimeCondFn[p],{Index->p,PrimeQ[p],PrimeQ[p]&&primePairQ[p],MemberQ[expectedPrimesList,p],Mod[(Factorial[p-1]*Factorial[6 p]+Factorial[p-1]+Factorial[6 p])+1,modulusFn[p],modOffset],Mod[(Factorial[p-1]*(AlphaFactorial[6,6p]*AlphaFactorial[6,6p-1]*AlphaFactorial[6,6p-2]*AlphaFactorial[6,6p-3]*AlphaFactorial[6,6p-4]*AlphaFactorial[6,6p-5]+1)+Factorial[6 p])+1,modulusFn[p],modOffset],Mod[(ChnV2[p*(6p+1),p-1,-1,p-1]*(1+Product[ChnV2[p*(6p+1),p,-6,6p-i],{i,0,5}])+ChnV2[p*(6p+1),6p,-1,6p])+1,modulusFn[p],modOffset],Mod[(Factorial[p-1]*(Power[6,6p]*Pochhammer[1,p]*Pochhammer[1/6,p]*Pochhammer[1/3,p]*Pochhammer[1/2,p]*Pochhammer[2/3,p]*Pochhammer[5/6,p]+1)+Factorial[6 p])+1,modulusFn[p],modOffset],Mod[(ChnV2[p*(6p+1),p-1,-1,p-1]*(1+Power[6,6p]*Product[ChnV2[p*(6p+1),p,6,i],{i,1,6}])+ChnV2[p*(6p+1),6p,-1,6p])+1,modulusFn[p],modOffset]}],{p,1,pupper}] // TF

▶▶▶ Expansions of the generalized Stirling number triangles, (Subscript[[({{n}, {k}})], α]), by the particular cases of the generalized harmonic number sequences, (HarmonicNumber2[n,α, r]), defined by the article:

The special case expansions of the coefficients,(Subscript[[({{n}, {k}})], α])(Subscript[and[({{n}, {k}})], 2]):
Compute particular cases of the expansion identitiy involving the r-order harmonic number sequences:

SeriesCoefficient[Power[1-α z,1-1/α],{z,0,n}]

nupper=12;rupper=6;
Table[hn[r,n]->{Sum[Power[2k-1,-r],{k,1,n}]-(HarmonicNumber[2n,r]-Power[2,-r]*HarmonicNumber[n,r])},{n,0,nupper},{r,1,rupper}] // TF

Expansions corresponding to the first few coefficient cases:

(HarmonicNumber[2n,r]-Power[2,-r]*HarmonicNumber[n,r])/.(r->1)

(-((HarmonicNumber[n])/2)+HarmonicNumber[2 n])^2-((HarmonicNumber[2n,r]-Power[2,-r]*HarmonicNumber[n,r])/.(r->2)) // Expand

Compute tables of the coefficient expansions when k := 2:

nupper=8;
Table[{Index->n,FS[Fcf[a,n+1,2]/Factorial[n]],FS[Power[a,n-1]*Sum[Binomial[1-1/a,k]*Power[-1,k]*((HarmonicNumber[n-k])),{k,0,n}]],FS[Factor[Power[a,n]*Pochhammer[1/a,n]/Factorial[n]*Sum[1/(a k+1-a),{k,1,n}]]],FS[Factor[Power[a,n]*Binomial[n-1+1/a,n]*Sum[1/(a k+1-a),{k,1,n}]]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,FS[Fcf[2,n+1,2]],FS[Factor[Power[2,n]*Pochhammer[1/2,n]*Hn[2,n,1]]],FS[Factor[Factorial2[2n-1]*Hn[2,n,1]]],FS[Factor[Power[2,n]*Pochhammer[1/2,n]*(-((HarmonicNumber[n])/2)+HarmonicNumber[2 n])]],FS[Factor[Binomial[2 n,n]/Power[2,n]*Factorial[n]*(-((HarmonicNumber[n])/2)+HarmonicNumber[2 n])]]},{n,0,nupper}] // TF

Compute tables of the coefficient expansions when k := 3:

nupper=8;
Table[{Index->n,FS[Fcf[a,n+1,3]/Factorial[n]],FS[Power[a,n-2]*Sum[Binomial[1-1/a,k]*Power[-1,k]*((HarmonicNumber[n-k]^2-HarmonicNumber[n-k,2])/2),{k,0,n}]],FS[Factor[Power[a,n]*Pochhammer[1/a,n]/Factorial[n]*(Sum[1/(a k+1-a),{k,1,n}]^2-Sum[1/((a k+1-a)^2),{k,1,n}])/2]],FS[Factor[FE[Power[a,n]*Binomial[n-1+1/a,n]*(Sum[1/(a k+1-a),{k,1,n}]^2-Sum[1/((a k+1-a)^2),{k,1,n}])/2]]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,FS[Fcf[2,n+1,3]],FS[Factor[Power[2,n]*Pochhammer[1/2,n]*(Hn[2,n,1]^2-Hn[2,n,2])/2]],FS[Factor[Factorial2[2n-1]*(Hn[2,n,1]^2-Hn[2,n,2])/2]],FS[Factor[Power[2,n]*Pochhammer[1/2,n]*((((-((HarmonicNumber[n])/2)+HarmonicNumber[2 n]))^2)+(1/4) HarmonicNumber[n,2]-HarmonicNumber[2 n,2])/2]],FS[Factor[Binomial[2 n,n]/Power[2,n+1]*Factorial[n]*((((-((HarmonicNumber[n])/2)+HarmonicNumber[2 n]))^2)+(1/4) HarmonicNumber[n,2]-HarmonicNumber[2 n,2])]]},{n,0,nupper}] // TF

Compute tables of the coefficient expansions when k := 4:

nupper=8;
Table[{Index->n,FS[Fcf[a,n+1,4]/Factorial[n]],FS[Power[a,n-3]*Sum[Binomial[1-1/a,k]*Power[-1,k]*((HarmonicNumber[n-k]^3-3*HarmonicNumber[n-k]*HarmonicNumber[n-k,2]+2*HarmonicNumber[n-k,3])/6),{k,0,n}]],FS[Factor[Power[a,n]*Pochhammer[1/a,n]/Factorial[n]*(Sum[1/(a k+1-a),{k,1,n}]^3-3*Sum[1/(a k+1-a),{k,1,n}]*Sum[1/((a k+1-a)^2),{k,1,n}]+2*Sum[1/((a k+1-a)^3),{k,1,n}])/6]],FS[Factor[FE[Power[a,n]*Binomial[n-1+1/a,n]*(Sum[1/(a k+1-a),{k,1,n}]^3-3*Sum[1/(a k+1-a),{k,1,n}]*Sum[1/((a k+1-a)^2),{k,1,n}]+2*Sum[1/((a k+1-a)^3),{k,1,n}])/6]]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,FS[Fcf[2,n+1,4]],FS[Factor[Power[2,n]*Pochhammer[1/2,n]*(Hn[2,n,1]^3-3*Hn[2,n,1]*Hn[2,n,2]+2*Hn[2,n,3])/6]],FS[Factor[Factorial2[2n-1]*(Hn[2,n,1]^3-3*Hn[2,n,1]*Hn[2,n,2]+2*Hn[2,n,3])/6]],FS[Factor[Factorial2[2n-1]/48*((((2*HarmonicNumber[2 n,1]-HarmonicNumber[n,1]))^3)-3*(2*HarmonicNumber[2 n,1]-HarmonicNumber[n,1])*(4*HarmonicNumber[2 n,2]-HarmonicNumber[n,2])+2*(8*HarmonicNumber[2 n,3]-HarmonicNumber[n,3]))]],FS[Factor[Binomial[2 n,n]/Power[2,n]*Factorial[n]/48*((((2*HarmonicNumber[2 n,1]-HarmonicNumber[n,1]))^3)-3*(2*HarmonicNumber[2 n,1]-HarmonicNumber[n,1])*(4*HarmonicNumber[2 n,2]-HarmonicNumber[n,2])+2*(8*HarmonicNumber[2 n,3]-HarmonicNumber[n,3]))]]},{n,0,nupper}] // TF

▶ §8: Computational data for the topics suggested for future research:

▶▶ S-fraction generating functions Involving the central binomial coefficients and the Catalan numbers:

S-fraction series approximations to the Catalan number OGF and S-fraction series approximations to the central binomial coefficient OGF:

CatalanNumberSFracAFnParam[k_,z_]:=If[k==1,1,-1*Power[z,1]]
CatalanNumberSFracBFnParam[k_,z_]:=If[k<0,0,1]
CatalanNumberSFractionGF[h_,z_]:=ContinuedFractionK[CatalanNumberSFracAFnParam[n,z],CatalanNumberSFracBFnParam[n,z],{n,1,h}]
CentralBinomDerivGF[Cz_,z_]:=(z)*D[Cz,{z,1}]+Cz
CentralBinomSFractionGF[h_,z_]:=CentralBinomDerivGF[ContinuedFractionK[CatalanNumberSFracAFnParam[n,z],CatalanNumberSFracBFnParam[n,z],{n,1,h}],z]

{hupper,hlower,hdiff}={8,3,2};
getSFracSeriesDataMapFn[h_,sFracInput_,expectedCoeffFn_]:=Map[#1[sFracInput]&,{Factor,Apart[FS[#1]]&,getMarkedSeriesData[Series[#1,{z,0,h+2}],expectedCoeffFn]&}]
Table[{Index->h,CF[Flatten[{CatalanNumberSFracOGFData[h],
getSFracSeriesDataMapFn[h,CatalanNumberSFractionGF[h,z],CatalanNumber]}]],CF[Flatten[{CentralBinomialSFracOGFData[h],
getSFracSeriesDataMapFn[h,CentralBinomSFractionGF[h,z],CentralBinomial]}]]},{h,hlower,hupper,hdiff}] // TF

▶▶ Some examples of the suggested binomial coefficient expansions in the prime pair congruence sums when h is a quadratic function of n:

Set h ↦(2n+1)(2n+3), or in the shorthand h ↦(x+1)(x+3):

Define the next function to assist with computing the tables for a few example cases of the linear upper index functions, 
upperIndexFn[x,i], in the following expansions: 
(∑_(i=0)^(2 k))(Subscript[c, k,i]) ×(Binomial[upperIndexFn(x,i), k])

getBinomialExpCoeffs[d_,kv_,upperIndexFn_]:={UpperIndexFn->upperIndexFn[x,i],BinomExpCoeffs->Solve[Map[#1==0&,FS[CoefficientList[Collect[Expand[FE[Binomial[(x+1)(x+1+2*d),kv]]-FE[Sum[c[kv,i]*Binomial[upperIndexFn[x,i],i],{i,0,2 kv}]]],{x,x^_},FS],x]]]][[1]]}

paramd=1;kupper=6;
Table[{Index->kv,getBinomialExpCoeffs[paramd,kv,(#1+0)&]},{kv,1,kupper}] // TF

paramd=1;kupper=6;
Table[{Index->kv,getBinomialExpCoeffs[paramd,kv,(#1+#2)&]},{kv,1,kupper}] // TF

paramd=1;kupper=6;
Table[{Index->kv,getBinomialExpCoeffs[paramd,kv,(#1+3+#2)&]},{kv,1,kupper}] // TF

paramd=1;kupper=6;
Table[{Index->kv,getBinomialExpCoeffs[paramd,kv,(3#1+#2+1)&]},{kv,1,kupper}] // TF

paramd=1;kupper=6;
Table[{Index->kv,getBinomialExpCoeffs[paramd,kv,(4#1+#2+2)&]},{kv,1,kupper}] // TF

▶ § Appendix A: Generating tables:

▶▶ Table A.1: 
       Special Cases of the α-Factorial Coefficient Triangles:

▶▶▶ Definition of the triangle and generalized table cases:

(Subscript[[({{n}, {k}})], α]) := (Subscript[(α n+1-2α) [({{n-1}, {k}})], α]) + (Subscript[[({{n-1}, {k-1}})], α]) +  (KroneckerDeltaSeq[0,n]) (KroneckerDeltaSeq[0,k])

alpha=α;nkupper=8;
Table[fcf[n,k]->FS[Fcf[alpha,n,k]],{n,0,nkupper},{k,0,nkupper}] // TF

alpha=α;nkupper=8;
Table[fcf[n,k]->Factor[Fcf[alpha,n,k]],{n,0,nkupper},{k,0,nkupper}] // TF

▶▶▶ Table of the Stirling numbers of the first kind (α := 1):

alpha=1;nkupper=8;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

▶▶▶ Table of the special case double factorial function triangle where α := 2:

alpha=2;nkupper=8;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

▶▶▶ Table of the special case triple factorial function triangle where α := 3:

alpha=3;nkupper=8;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

▶▶▶ Table of the special case quadruple factorial function triangle where α := 4:

alpha=4;nkupper=8;
Table[fcf[n,k]->Fcf[alpha,n,k],{n,0,nkupper},{k,0,nkupper}] // TF

▶▶ Table A.2: 
       Generating the Stirling Polynomial Tables:

▶▶▶ Table Listings of the Polynomial Sequences :

nupper=8;
Table[{Index->n,TraditionalForm[ToExpression[ToString[StringForm["x \\sigma_{`1`}(x)",n]],TeXForm]],Factor[Factorial[2 n]*StirlingPoly[n,x]],FactorTerms[Factorial[2 n]*StirlingPoly[n,x]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),Collect[Factorial[2 n]*StirlingAlphaPoly[α,n,x],x,Factor]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),Collect[StirlingAlphaPoly[α,n,x],α,Factor]},{n,0,nupper}] // TF

▶▶▶ Generate the LaTeX Output for the Table Listings of these Polynomial Sequences :

nupper=8;
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),Collect[Factorial[2 n]*x*StirlingAlphaPoly[α,n,x],x,Factor]},{n,0,nupper}] // TF
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),TeXForm[TraditionalForm[Collect[Factorial[2 n]*x*StirlingAlphaPoly[α,n,x],x,Factor]]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),Collect[x*StirlingAlphaPoly[α,n,x],α,Factor]},{n,0,nupper}] // TF
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),TeXForm[TraditionalForm[Collect[x*StirlingAlphaPoly[α,n,x],α,Factor]]]},{n,0,nupper}] // TF
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),TeXForm[Collect[x*StirlingAlphaPoly[α,n,x],α,Factor]]},{n,0,nupper}] // TF

nupper=8;
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),Collect[x*StirlingPoly[n,x],α,FactorTerms]},{n,0,nupper}] // TF
Table[{Index->n,(Subscript[σ, n]^((α)))(x),TeXForm[TraditionalForm[Collect[StirlingPoly[n,x],α,Factor]]]},{n,0,nupper}] // TF
Table[{Index->n,x (Subscript[σ, n]^((α)))(x),TeXForm[TraditionalForm[Collect[x*StirlingPoly[n,x],α,FactorTerms]]]},{n,0,nupper}] // TF

▶▶ Table A.3: 
       Generating the Congruences Modulo p (and pα) Tables for p:= 2,3,4,5 and α ∈ {1,2,3,4} 
       (and the extended congruence cases referenced within the article):

▶▶▶ Some First Listings of These Congruences:

RpConvFn[p_,alpha_,n_]:=SeriesCoefficient[Conv[p,-alpha,n,z],{z,0,Floor[(n+alpha-1)/alpha]}]
getModString[modulo_]:=ToString[StringForm["(`1`)",modulo]]

GetModGridTableV2[alpha_,nupper_:12]:=Text@Grid[Prepend[
Table[{n,AlphaFactorial[alpha,n],
RpConvFn[2,alpha,n],Mod[AlphaFactorial[alpha,n],2,0],Mod[RpConvFn[2,alpha,n],2,0], Mod[AlphaFactorial[alpha,n],2*alpha,0],Mod[RpConvFn[2,alpha,n],2*alpha,0],
RpConvFn[3,alpha,n],Mod[AlphaFactorial[alpha,n],3,0],Mod[RpConvFn[3,alpha,n],3,0], Mod[AlphaFactorial[alpha,n],3*alpha,0],Mod[RpConvFn[3,alpha,n],3*alpha,0],
RpConvFn[4,alpha,n],Mod[AlphaFactorial[alpha,n],4,0],Mod[RpConvFn[4,alpha,n],4,0], Mod[AlphaFactorial[alpha,n],4*alpha,0],Mod[RpConvFn[4,alpha,n],4*alpha,0],
RpConvFn[5,alpha,n],Mod[AlphaFactorial[alpha,n],5,0],Mod[RpConvFn[5,alpha,n],5,0], Mod[AlphaFactorial[alpha,n],5*alpha,0],Mod[RpConvFn[5,alpha,n],5*alpha,0]
}, {n, 0, nupper}],
Map[Style[#1,Bold]&,{"n",(Subscript[n!, (α)]),
(Subscript[(OverTilde[R]), 2]^((alpha)))(n),getModString[2],getModString[2],getModString[2*alpha],getModString[2*alpha],
(Subscript[(OverTilde[R]), 3]^((alpha)))(n),getModString[3],getModString[3],getModString[3*alpha],getModString[3*alpha],
(Subscript[(OverTilde[R]), 4]^((alpha)))(n),getModString[4],getModString[4],getModString[4*alpha],getModString[4*alpha],
(Subscript[(OverTilde[R]), 5]^((alpha)))(n),getModString[5],getModString[5],getModString[5*alpha],getModString[5*alpha]
}]
],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Left,Left,Center,Center,Center,Center,Left,Center,Center,Center,Center,Left,Center,Center,Center,Center,Left,Center,Center,Center,Center}},Dividers->{{True,True,True,False,False,False,False,True,False,False,False,False,True,False,False,False,False,True,False,False,False,False}}]

nupper=24;
GetModGridTableV2[1,12]
GetModGridTableV2[2,21]
GetModGridTableV2[3,32]
GetModGridTableV2[4,42]

▶▶▶ Table Listings of These Congruences (modulo p and pα):

RpConvFn[p_,alpha_,n_]:=SeriesCoefficient[Conv[p,-alpha,n,z],{z,0,Floor[(n+alpha-1)/alpha]}]
getModString[modulo_]:=ToString[StringForm["(`1`)",modulo]]

GetModGridTableV3[alpha_,nupper_:12]:=Text@Grid[Prepend[
Table[{n,AlphaFactorial[alpha,n],
RpConvFn[2,alpha,n],Mod[RpConvFn[2,alpha,n],2,0],Mod[RpConvFn[2,alpha,n],2*alpha,0],
RpConvFn[3,alpha,n],Mod[RpConvFn[3,alpha,n],3,0],Mod[RpConvFn[3,alpha,n],3*alpha,0],
RpConvFn[4,alpha,n],Mod[RpConvFn[4,alpha,n],4,0],Mod[RpConvFn[4,alpha,n],4*alpha,0],
RpConvFn[5,alpha,n],Mod[RpConvFn[5,alpha,n],5,0],Mod[RpConvFn[5,alpha,n],5*alpha,0]
}, {n, 0, nupper}],
Map[Style[#1,Bold]&,{"n",(Subscript[n!, (α)]),
(Subscript[(OverTilde[R]), 2]^((alpha)))(n),getModString[2],getModString[2*alpha],
(Subscript[(OverTilde[R]), 3]^((alpha)))(n),getModString[3],getModString[3*alpha],
(Subscript[(OverTilde[R]), 4]^((alpha)))(n),getModString[4],getModString[4*alpha],
(Subscript[(OverTilde[R]), 5]^((alpha)))(n),getModString[5],getModString[5*alpha]
}]
],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Left,Left,Center,Center,Left,Center,Center,Left,Center,Center,Left,Center,Center}},Dividers->{{True,True,True,False,False,True,False,False,True,False,False,True,False,False}}]

nupper=24;
GetModGridTableV3[1,12]
GetModGridTableV3[2,21]
GetModGridTableV3[3,32]
GetModGridTableV3[4,42]

▶▶▶ Generate the LATEX Code for these Tables:

alpha=1;nupper=12;
GetModGridTableV3[alpha,nupper]
GetModGridTableV3[alpha,nupper] // TeXForm

alpha=2;nupper=21;
GetModGridTableV3[alpha,nupper]
GetModGridTableV3[alpha,nupper] // TeXForm

alpha=3;nupper=32;
GetModGridTableV3[alpha,nupper]
GetModGridTableV3[alpha,nupper] // TeXForm

alpha=4;nupper=42;
GetModGridTableV3[alpha,nupper]
GetModGridTableV3[alpha,nupper] // TeXForm

▶▶▶ Extended Congruence Table Data for (Subscript[n!, (α)]) (mod p (α^i))  (0 ≤ i ≤ p):

RpConvFn[p_,alpha_,n_]:=SeriesCoefficient[Conv[p,-alpha,n,z],{z,0,Floor[(n+alpha-1)/alpha]}]
getModString[modulo_]:=ToString[StringForm["(`1`)",modulo]]
getCongruenceRow[p_,alpha_,n_]:=Flatten[Prepend[Table[{Mod[AlphaFactorial[alpha,n],p*Power[alpha,i],0],Mod[RpConvFn[p,alpha,n],p*Power[alpha,i],0]},{i,0,p}],{p,alpha,n,AlphaFactorial[alpha,n],RpConvFn[p,alpha,n]}]]
getCongruenceRowHeader[p_,alpha_]:=Map[Style[#1,Bold]&,Flatten[Prepend[Table[{"(Subscript[n!, (α)]) " <> getModString[p*Power[alpha,i]],"(Subscript[(OverTilde[R]), p]^((α)))(n) " <> getModString[p*Power[alpha,i]]},{i,0,p}],{ToString[StringForm["p ↦ `1`",p]],ToString[StringForm["α ↦ `1`",alpha]],n,"(Subscript[n!, (α)])","(Subscript[(OverTilde[R]), p]^((α)))(n)"}]]]
TableGrid[table_]:=Text@Grid[table,Background->{None,{Map[Lighter[#1,0.35]&,{LightCyan,Green,Lighter[Blue,0.8],LightGreen,LightPurple}]}},Frame->True,Alignment->{{Center,Center,Center,Left,Left,Center,Center,Center,Center}},Dividers->{{True,True,True,True,True,{True,False}}}]
GetModGridTableFull[pval_,alpha_,nupper_]:=TableGrid[Prepend[Table[getCongruenceRow[pval,alpha,n],{n,1,nupper+2*pval-1}],getCongruenceRowHeader[pval,alpha]]]

pval=2;nupper=32;
GetModGridTableFull[pval,2,nupper]
GetModGridTableFull[pval,3,nupper]
GetModGridTableFull[pval,4,nupper]

pval=3;nupper=32;
GetModGridTableFull[pval,2,nupper]
GetModGridTableFull[pval,3,nupper]
GetModGridTableFull[pval,4,nupper]

pval=4;nupper=42;
GetModGridTableFull[pval,2,nupper]
GetModGridTableFull[pval,3,nupper]
GetModGridTableFull[pval,4,nupper]

pval=5;nupper=48;
GetModGridTableFull[pval,2,nupper]
GetModGridTableFull[pval,3,nupper]
GetModGridTableFull[pval,4,nupper]

pval=6;nupper=55;
GetModGridTableFull[pval,2,nupper]
GetModGridTableFull[pval,3,nupper]
GetModGridTableFull[pval,4,nupper]

▶▶ Table A.4: 
       The Convergent Numerator and Denominator Function Tables:

▶▶▶ The convergent numerator functions, (Subscript[FP, h])(α,R;z) :

Tables of these polynomials gathered by powers of z:

hupper=6;
Table[{Index->h, Collect[FP[ h,a,R, z], z^_ ,Factor]}, {h,0,hupper}] // TF

Tables of these polynomials gathered by powers of R,α,and then simlified by Mathematica's built-in FullSimplify (FS) function:

hupper=6;
Table[{Index->h, CF[{NumFn[h],Collect[FP[h,a,R, z], {R,R^_} ,FS],Collect[FP[h,a,R, z], {a,a^_} ,FS],FS[FP[h,a,R, z]]}]}, {h,0,hupper}] // TF

▶▶▶ The convergent numerator functions, (Subscript[FQ, h])(α,R;z):

Tables of these polynomials gathered by powers of z:

hupper=6;
Table[{Index->h, Collect[FQ[h,a,R, z], z^_ ,Factor]}, {h,0,hupper}] // TF

Tables of these polynomials gathered by powers of R,α,and then simlified by Mathematica's built-in FullSimplify (FS) function:

hupper=6;
Table[{Index->h, CF[{DenomFn[h],Collect[FQ[h,a,R, z], {R,R^_} ,FS], Collect[FQ[h,a,R, z], {a,a^_} ,FS],FS[FQ[h,a,R, z]]}]}, {h,0,hupper}] // TF

▶▶▶ The convergent numerator and denominator function special cases, (Subscript[FP, h])(1,1;z) and (Subscript[FQ, h])(1,1;z):

Generate tables of the component convergent functions that enumerate the single factorial function, n!, h ≥(Floor[(n/2)]):

hupper=6;
Table[{Index->h, Collect[FP[h,1,1, z], z^_ ,Factor],Index->h, Collect[FQ[h,1,1, z], z^_ ,Factor]}, {h,0,hupper}] // TF
Table[{h, StandardForm[Collect[FP[h,1,1, z], z^_ ,Factor]], StandardForm[Collect[FQ[h,1,1, z], z^_ ,Factor]]}, {h,0,hupper}] // TF
TeXForm[%]

▶▶▶ The convergent numerator and denominator function special cases, (Subscript[FP, h])(2,1;z) and (Subscript[FQ, h])(2,1;z):

Generate tables of the component convergent functions that enumerate the double factorial function, (2n-1)!!, h ≥(Floor[(n/2)]):

hupper=6;
Table[{h, StandardForm[Collect[FP[h,2,1, z], z^_ ,Factor]], StandardForm[Collect[FQ[h,2,1, z], z^_ ,Factor]]}, {h,0,hupper}] // TF
TeXForm[%]

▶▶ Table A.5: 
       The Reflected Numerator Polynomial Sequences:

hupper=8;
exData=Table[{h,FS[Power[z,h-1]*FP[h,a, R, 1/z]]/.(a->ToExpression["$\\alpha$",TeXForm]),TeXForm[FS[Power[z,h-1]*FP[h,a, R, 1/z]]/.(a->ToExpression["$\\alpha$",TeXForm])]},{h,2,hupper}];

Text@Grid[Prepend[exData,{"h","Simplified (OverTilde[FP])(α, R, z) := \!\(TraditionalForm\`\*SuperscriptBox[\(z\), \(h - 1\)]\\ \(FP(α, R, \*FractionBox[\(1\), \(z\)])\)\)","TeX Output"}],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Left,Left}},Dividers->{{True,True,True}}]

hupper=8;
exData=Table[{h,Collect[Expand[FS[Power[z,h-1]*FP[h,a, R, 1/z]/.(R->z-w)]/.(a->ToExpression["$\\alpha$",TeXForm])],w^_],TeXForm[Collect[Expand[FS[Power[z,h-1]*FP[h,a, R, 1/z]/.(R->z-w)]/.(a->ToExpression["$\\alpha$",TeXForm])],w^_]],Collect[Expand[FS[Power[z,h-1]*FP[h,-a, R, 1/z]/.(R->z-w)]/.(a->ToExpression["$\\alpha$",TeXForm])],α^_],TeXForm[Collect[Expand[FS[Power[z,h-1]*FP[h,-a, R, 1/z]/.(R->z-w)]/.(a->ToExpression["$\\alpha$",TeXForm])],α^_]]},{h,2,hupper}];

Text@Grid[Prepend[exData,{"h","(OverTilde[FP])(α, R, z) (w:=z-R <-> R->z-w)","TeX Output"," \!\(TraditionalForm\`FS : \\ \*OverscriptBox[\(FP\), \(~\)](α, R, z)\) (w:=z-R <-> R->z-w)","TeX Output"}],Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Left,Left}},Dividers->{{True,True,False,True,False,True}}]

▶▶ Table A.6: 
       The (p^th) Power Sequences (Special Case Sequences of Binomials):

▶▶▶ Generating the Sequences, (2^p)-1: (First Tables)

Examples leading to the expansions of the first table data:

pupper=10;rupper=6;
Table[sums[p,r]->{Power[2,p]-1,GeneratingFunction[(FS[FE[Sum[Binomial[p,p+1-i],{i,0,r}]]])/.(p->p+r+1),p,z],Factor[GeneratingFunction[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k],{k,0,p-r-1}],p,x]]},{r,1,rupper}] // TF

Gen2PowTable[mval_,leadingTermGF_,expGF_,pupper_:10]:=Module[{leadingTermGFz,expGFx},
leadingTermGFz=Function[z,leadingTermGF];
expGFx=Function[x,expGF];
resultTbl=Table[sums[p,m]->{Power[2,p]-1,SeriesCoefficient[leadingTermGFz[z],{z,0,p-mval-1}]+SeriesCoefficient[expGFx[x]*Conv[p,-1,p-mval-1,z/x],{x,0,mval+1},{z,0,p-mval-1}],SeriesCoefficient[leadingTermGFz[z],{z,0,p-mval-1}]+SeriesCoefficient[expGFx[x]*Conv[p,1,1,z/x],{z,0,p-mval-1},{x,0,mval+1}]},{p,mval+1,pupper+mval}];
Return[resultTbl];
];

pupper=12;
Gen2PowTable[1,(1/(1-z)),2 (E^x) (-1+2 (E^x)) (x^2),pupper] // TF
Gen2PowTable[2,((4-3 z)/(((-1+z))^2)),(E^x) (-5+8 (E^x)-x) (x^3),pupper] // TF
Gen2PowTable[3,((-11+17 z-7 (z^2))/(((-1+z))^3)),(1/2) (E^x) (x^4) (-24+32 (E^x)-10 x-(x^2)),pupper] // TF
Gen2PowTable[4,((26-62 z+52 (z^2)-15 (z^3))/(((-1+z))^4)),(1/6) (E^x) (x^5) (-162+192 (E^x)-96 x-18 (x^2)-(x^3)),pupper] // TF
Gen2PowTable[5,((-57+186 z-238 (z^2)+139 (z^3)-31 (z^4))/(((-1+z))^5)),(1/24) (E^x) (x^6) (-1392+1536 (E^x)-1008 x-264 (x^2)-28 (x^3)-(x^4)),pupper] // TF

Other forms of the examples leading to the expansions of the first table data:

pupper=10;mupper=6;
Table[sums[p,m]->{Power[2,p]-1,GeneratingFunction[(FS[FE[Sum[Binomial[p,p+1-i],{i,0,m}]]])/.(p->p+m+1),p,z],GeneratingFunction[(FS[-FE[Sum[Binomial[p,p+1-i],{i,0,m}]]])/.(p->p+m+1),p,z],Collect[GeneratingFunction[Sum[Factorial[p]/Factorial[p-m-1]/Factorial[k+1]/Factorial[p-1-k],{k,0,p-m-1}],p,x],Exp[_],Factor]},{m,1,mupper}] // TF

Gen2PowTableV2[mval_,leadingTermGF_,cm2_,cm1_,pmxFn_,pupper_:10]:=Module[{leadingTermGFz,pmxFnx},
leadingTermGFz=Function[z,leadingTermGF];
pmxFnx=Function[x,pmxFn];
resultTbl=Table[sums[p,m]->{Power[2,p]-1,SeriesCoefficient[leadingTermGFz[z]/Power[1-z,mval],{z,0,p-mval-1}]+SeriesCoefficient[(cm2*Exp[2 x]-cm1*Exp[x]*pmxFnx[x])*Conv[p,-1,p-mval-1,z/x],{x,0,0},{z,0,p-mval-1}],SeriesCoefficient[leadingTermGFz[z]/Power[1-z,mval],{z,0,p-mval-1}]+SeriesCoefficient[(cm2*Exp[2 x]-cm1*Exp[x]*pmxFnx[x])*Conv[p,1,1,z/x],{z,0,p-mval-1},{x,0,0}]},{p,mval+1,pupper+mval}];
Return[resultTbl];
];

pupper=12;
Gen2PowTableV2[1,1,4,1,1,pupper] // TF
Gen2PowTableV2[2,4-3 z,8,1,x+5,pupper] // TF
Gen2PowTableV2[3,11-17 z+7 (z^2),16,1/2,(4+x) (6+x),pupper] // TF
Gen2PowTableV2[4,26-62 z+52 (z^2)-15 (z^3),32,1/6,162+96 x+18 (x^2)+(x^3),pupper] // TF
Gen2PowTableV2[5,57-186 z+238 (z^2)-139 (z^3)+31 (z^4),64,1/24,1392+1008 x+264 (x^2)+28 (x^3)+(x^4),pupper] // TF
Gen2PowTableV2[6,120-501 z+868 (z^2)-769 (z^3)+346 (z^4)-63 (z^5),128,1/120,14520+11880 x+3840 (x^2)+580 (x^3)+40 (x^4)+(x^5),pupper] // TF

Gen2PowTableV3[mval_,leadingTermGF_,pmxFn_,pupper_:10]:=Module[{leadingTermGFz,pmxFnx,p,m},
leadingTermGFz=Function[z,leadingTermGF];
pmxFnx=Function[x,pmxFn];
resultTbl=

Table[sums[p,mval]->{Power[2,p]-1,SeriesCoefficient[leadingTermGFz[z]/Power[1-z,mval],{z,0,p-mval-1}]+SeriesCoefficient[(Power[2,mval+1]*Exp[2 x]-Exp[x]/Factorial[mval-1]*pmxFnx[x])*Conv[p,-1,p-mval-1,z/x],{x,0,0},{z,0,p-mval-1}],SeriesCoefficient[leadingTermGFz[z]/Power[1-z,mval],{z,0,p-mval-1}]+SeriesCoefficient[(Power[2,mval+1]*Exp[2 x]-Exp[x]/Factorial[mval-1]*pmxFnx[x])*Conv[p,1,1,z/x],{z,0,p-mval-1},{x,0,0}]},{p,mval+1,pupper+mval}];
Return[resultTbl];
];

pupper=12;
Gen2PowTableV3[1,1,2,pupper] // TF
Gen2PowTableV3[2,4-3 z,x+5,pupper] // TF
Gen2PowTableV3[3,11-17 z+7 (z^2),(4+x) (6+x),pupper] // TF
Gen2PowTableV3[4,26-62 z+52 (z^2)-15 (z^3),162+96 x+18 (x^2)+(x^3),pupper] // TF
Gen2PowTableV3[5,57-186 z+238 (z^2)-139 (z^3)+31 (z^4),1392+1008 x+264 (x^2)+28 (x^3)+(x^4),pupper] // TF
Gen2PowTableV3[6,120-501 z+868 (z^2)-769 (z^3)+346 (z^4)-63 (z^5),14520+11880 x+3840 (x^2)+580 (x^3)+40 (x^4)+(x^5),pupper] // TF

▶▶▶ Generating the Sequences, (((s+1))^p)-1: (Last Table)

Examples leading to the expansions of the generalized symbolic expansions with respect to s for the last table data:

rupper=6;
mtable=Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]],Collect[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)],{z,z^_},FactorTerms]},{r,1,rupper}];
mtable // TF

rupper=6;
mtable=Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]],Collect[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)],{s,s^_},Factor]},{r,1,rupper}];
mtable // TF

rupper=6;
mtable=Table[sums[p,r]->{Collect[1/Power[s,2]*-Coefficient[GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x],Exp[s x]]/Power[x,r+1],{s,s^_},Factor]},{r,1,rupper}];
mtable // TF

rupper=6;
mtable=Table[sums[p,r]->{Collect[Factorial[r-1]/Power[s,2]*-Coefficient[GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x],Exp[s x]]/Power[x,r+1],{s,s^_},Factor]},{r,1,rupper}];
mtable // TF

Gen2PowTableV4[mval_,s_,leadingTermGF_,cmsxFn_,pupper_:10]:=Module[{leadingTermGFz,expGFFnx},
leadingTermGFz=Function[z,leadingTermGF*Power[s,2]/Power[1-s z,mval]];
expGFFnx=Function[x,-Exp[x]+Power[s+1,mval+1]*Exp[(s+1)*x]-Power[s,2]/Factorial[mval-1]*Exp[s x]*cmsxFn];
resultTbl=Table[sums[p,m]->{FS[Expand[Power[s+1,p]-1]-FS[SeriesCoefficient[leadingTermGFz[z],{z,0,p-mval-1}]+SeriesCoefficient[(expGFFnx[x])*Conv[p,-1,p-mval-1,z/x],{x,0,0},{z,0,p-mval-1}]]],FS[Expand[Power[s+1,p]-1]-FS[SeriesCoefficient[leadingTermGFz[z],{z,0,p-mval-1}]+SeriesCoefficient[(expGFFnx[x])*Conv[p,1,1,z/x],{z,0,p-mval-1},{x,0,0}]]]},{p,mval+1,pupper+mval}];
Return[resultTbl];
];

pupper=10;
Gen2PowTableV4[1,s,1,1,pupper] // TF
Gen2PowTableV4[2,s,3+s (1-2 z)-(s^2) z,3+s (1+x),pupper] // TF
Gen2PowTableV4[3,s,6+(s^4) (z^2)-4 s (-1+2 z)+(s^3) z (-2+3 z)+(s^2) (1-7 z+3 (z^2)),12+8 s (1+x)+(s^2) (2+2 x+(x^2)),pupper] // TF
Gen2PowTableV4[4,s,10-(s^6) (z^3)-10 s (-1+2 z)-(s^5) (z^2) (-3+4 z)+5 (s^2) (1-5 z+3 (z^2))-(s^4) z (3-13 z+6 (z^2))+(s^3) (1-14 z+21 (z^2)-4 (z^3)),60+60 s (1+x)+15 (s^2) (2+2 x+(x^2))+(s^3) (6+6 x+3 (x^2)+(x^3)),pupper] // TF
Gen2PowTableV4[5,s,15+(s^8) (z^4)-20 s (-1+2 z)+(s^7) (z^3) (-4+5 z)+5 (s^2) (3-13 z+9 (z^2))+(s^6) (z^2) (6-21 z+10 (z^2))-3 (s^3) (-2+18 z-27 (z^2)+8 (z^3))+(s^5) z (-4+33 z-44 (z^2)+10 (z^3))+(s^4) (1-23 z+73 (z^2)-46 (z^3)+5 (z^4)),360+480 s (1+x)+180 (s^2) (2+2 x+(x^2))+24 (s^3) (6+6 x+3 (x^2)+(x^3))+(s^4) (24+24 x+12 (x^2)+4 (x^3)+(x^4)),pupper] // TF

▶▶▶ Generating the Sequences, (2^p)-1: (Second Tables)

sval=1;rupper=6;
Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]/.(s->sval)],Expand[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)]/.(s->sval)]},{r,1,rupper}] // TF

sval=1;rupper=6;
Table[sums[p,r]->{Factor[FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,x]/.(s->sval)]],Expand[((GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1])-(-Exp[x]+Power[sval+1,r+1]*Exp[(sval+1)*x]))/(-Power[sval,2]*Exp[sval*x]/Factorial[r-1])]/.(x->x/sval),Collect[(GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1]),Exp[_],Collect[#1,x^_,Factor]&]},{r,1,rupper}] // TF

▶▶▶ Generating the Sequences, (3^p)-1: (Second Tables)

sval=2;rupper=6;
Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]/.(s->sval)],Expand[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)]/.(s->sval)]},{r,1,rupper}] // TF

sval=2;rupper=6;
Table[sums[p,r]->{Factor[FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,x]/.(s->sval)]],Expand[((GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1])-(-Exp[x]+Power[sval+1,r+1]*Exp[(sval+1)*x]))/(-Power[sval,2]*Exp[sval*x]/Factorial[r-1])]/.(x->x/sval),Collect[(GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1]),Exp[_],Collect[#1,x^_,Factor]&]},{r,1,rupper}] // TF

▶▶▶ Generating the Sequences, (4^p)-1: (Second Tables)

sval=3;rupper=6;
Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]/.(s->sval)],Expand[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)]/.(s->sval)]},{r,1,rupper}] // TF

sval=3;rupper=6;
Table[sums[p,r]->{Factor[FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,x]/.(s->sval)]],Expand[((GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1])-(-Exp[x]+Power[sval+1,r+1]*Exp[(sval+1)*x]))/(-Power[sval,2]*Exp[sval*x]/Factorial[r-1])]/.(x->x/sval),Collect[(GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1]),Exp[_],Collect[#1,x^_,Factor]&]},{r,1,rupper}] // TF

▶▶▶ Generating the Sequences, (5^p)-1: (Second Tables)

sval=4;rupper=6;
Table[sums[p,r]->{FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]/.(s->sval)],Expand[FS[Numerator[FS[Power[-1,r]*GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,z]]]/(s^2)]/.(s->sval)]},{r,1,rupper}] // TF

sval=4;rupper=6;
Table[sums[p,r]->{Factor[FS[GeneratingFunction[FE[Sum[Binomial[p,p+1-i]*Power[s,p+1-i],{i,0,r}]]/.(p->p+r+1),p,x]/.(s->sval)]],Expand[((GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1])-(-Exp[x]+Power[sval+1,r+1]*Exp[(sval+1)*x]))/(-Power[sval,2]*Exp[sval*x]/Factorial[r-1])]/.(x->x/sval),Collect[(GeneratingFunction[FE[Sum[Factorial[p]/Factorial[p-r-1]/Factorial[k+1]/Factorial[p-1-k]*Power[s,k+1],{k,0,p-r-1}]],p,x]/.(s->sval))/(Power[x,r+1]),Exp[_],Collect[#1,x^_,Factor]&]},{r,1,rupper}] // TF

▶▶ Table A.7: 
       The Auxilliary Convergent Numerator Function Subsequences, (Subscript[C, h,n])(α,R): (See Section 5 above)

▶▶▶ Expansions of the polynomials in h only:

GetPolyHOnlyTableDataV1[nupper_]:=Table[Factor[FE[If[n≥i,Sum[Sum[Binomial[h,k] Binomial[m,t] S1[k,m]*S1[n-k,s-t]*S2[s,i]*Power[-1,m+s-i]*Power[h-1,m-t],{k,0,n},{m,0,k}],{s,0,n},{t,0,s}]/(Power[-1,n]/Factorial[n]*Binomial[n,i]*Product[h-n+i,{i,0,Floor[(n-1)/2]}]),0]]],{n,0,nupper},{i,0,nupper}]
GetPolyHOnlyTableDataV2[nupper_]:=MapIndexed[Prepend[Prepend[#1,Product[h-(First[#2]-1)+i,{i,0,Floor[(First[#2]-1-1)/2]}]],First[#2]-1]&,GetPolyHOnlyTableDataV1[nupper]]
GetPolyHOnlyTableDataFull[nupper_]:=Prepend[GetPolyHOnlyTableDataV2[nupper],Flatten[{n,(Subscript[m, n,h]),Table[(Subscript[p, n,ii])[h], {ii, 0, nupper}]}]]
PolyHOnlyTable[nupper_]:=Text@Grid[GetPolyHOnlyTableDataFull[nupper],
Background->{None,{Lighter[Green,.6],{White,Lighter[Blue,0.8]}}},Frame->True,Alignment->{{Center,Left,Left,Center,Center,Left,Center,Center,Left,Center,Center,Left,Center,Center}},Dividers->{{True,True,True,True,True,True,True,True,True,True}}]

nupper=7;
PolyHOnlyTable[nupper]

▶▶▶ The special case where n := 0:

nval=0;hupper=16+nval;knownFactors=1;
Table[FS[Chn[h,nval,a,R]],{h,1,hupper}]

▶▶▶ The other special cases where n ≥ 1:

printChnTableFormula[nval_,knownFactors_,hupper_]:=Module[{chnTbl,chnFormula,chnFormulav2,outTriple,outTripleFn,chnComputedFormulaDiffsTbl},
chnTbl=Table[FS[Chn[h,nval,a,R]],{h,nval,hupper}];
chnFormula=FS[FindSequenceFunction[chnTbl,h]/.(h->h-nval+1)];
chnFormulav2=FS[Cancel[chnFormula/knownFactors]];
outTriple={
{NVal,nval},
{KnownFactors,knownFactors},
{KnownFactorsDiff,FS[knownFactors-(Power[-1,nval]/Factorial[nval]*Product[h-nval+j,{j,0,Floor[(nval-2)/2]}])]},
{ChnFormulaV11,chnFormula},
{ChnFormulaV21,Collect[Expand[chnFormulav2]/.(a->α),{R,R^_},Factor]},
{ChnFormulaV22,Collect[Expand[chnFormulav2]/.(a->α),{h,h^_},Factor]},
{ChnFormulaV12,Collect[Expand[chnFormula*Factorial[nval]]/.(a->α),{h,h^_},Factor]}
};
outTripleFn[hidx_,alpha_]:=(outTriple/.(h->hidx)/.(α->alpha));
chnComputedFormulaDiffsTbl=Table[{Index->h,FS[(Chn[h,nval,a,R]/knownFactors)-Last[outTripleFn[h,a][[5]]]],FS[(Chn[h,nval,a,R]/knownFactors)-Last[outTripleFn[h,a][[6]]] ],Collect[Expand[(Chn[h,nval,a,R]*Factorial[nval])-Last[outTripleFn[h,a][[7]]]],R^_,FS]},{h,nval+1,hupper}];

Print[TF[Append[Map[{#1[[1]],CF[{#1[[2]],TeXForm[StandardForm[#1[[2]]]]}]}&,outTriple],{ComputedFormulaDiffsTable,TF[chnComputedFormulaDiffsTbl]}]]];
]

The special case where n:=1:

nval=1;hupper=16+nval;knownFactors=-1;
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=2:

nval=2;hupper=16+nval;knownFactors=1/2*(h-2);
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=2:

nval=2;hupper=16+nval;knownFactors=1/2*(h-2);
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=3:

nval=3;hupper=16+nval;knownFactors=-1/6*(h-3);
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=4:

nval=4;hupper=16+nval;knownFactors=1/24*(h-3)*(h-4);
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=5:

nval=5;hupper=16+nval;knownFactors=-1/120*(h-3)*(h-4)*(h-5);
printChnTableFormula[nval,knownFactors,hupper]

The special case where n:=6:

nval=6;hupper=16+nval;knownFactors=1/720*(h-4)*(h-5)*(h-6);
printChnTableFormula[nval,knownFactors,hupper]

▶▶ Table A.8: 
       The Auxilliary Convergent Numerator Function Subsequences, (Subscript[R, h,k])(α,z): (See Section 5 above)
       Special Cases of the auxiliary numerator subsequences, (Subscript[R, h,k])(α,z), in the following forms:
       (((-1))^(h-k)) (z^(k-h)) × (Subscript[R, h,h-k])(α,z) and k! × (((-1))^(h-k)) (z^(k-h)) × (Subscript[R, h,h-k])(α,z):

▶▶▶ The special case where k := 1:

kval=1;hupper=16+kval;
rhkFormula=FindSequenceFunction[Table[FS[Power[-1,h-kval]*Power[z,-(h-kval)]*Rhk[h,h-kval,a,R]],{h,kval,hupper}],h]/.(h->h-kval+1) // FS

▶▶▶ The other special cases where k ≥ 2:

printRhkTableFormula[kval_,hupper_]:=Module[{rhkTbl,rhkFormula,zexpv1,hexpv1,alphaexpv1,zexpv2,hexpv2,alphaexpv2,outTriple,outTriplev2,rhkComputedFormulaDiffsTbl,outTriplePrintLabels,rhkPrintData},
rhkTbl=Table[FS[Power[-1,h-kval]*Power[z,-(h-kval)]*Rhk[h,h-kval,a,R]],{h,kval,hupper}];
rhkFormula=FS[FindSequenceFunction[rhkTbl,h]/.(h->h-kval+1)];
zexpv1=Collect[Expand[rhkFormula],{z,z^_},Factor];
hexpv1=Collect[Expand[rhkFormula],{h,h^_},Factor];
alphaexpv1=Collect[Expand[rhkFormula],{a,a^_},Factor];
zexpv2=Collect[Expand[rhkFormula*Factorial[kval]],{z,z^_},Factor];
hexpv2=Collect[Expand[rhkFormula*Factorial[kval]],{h,h^_},Factor];
alphaexpv2=Collect[Expand[rhkFormula*Factorial[kval]],{a,a^_},Factor];
outTriple={zexpv1,hexpv1,alphaexpv1,zexpv2,hexpv2,alphaexpv2};
rhkComputedFormulaDiffsTbl=Table[{Index->h,Expand[Rhk[h,h-kval,a,R]-outTriple[[1]]/(Power[-1,h-kval]*Power[z,-(h-kval)]) ],Expand[Rhk[h,h-kval,a,R]-outTriple[[2]]/(Power[-1,h-kval]*Power[z,-(h-kval)]) ],Expand[Rhk[h,h-kval,a,R]*Factorial[kval]-outTriple[[6]]/(Power[-1,h-kval]*Power[z,-(h-kval)]) ]},{h,kval,hupper}];
outTriplev2=Prepend[Prepend[outTriple,rhkFormula],kval];
outTriplePrintLabels={KVal,RkhFormulaV1,RkhFormulaCollectBy[z],RkhFormulaCollectBy[h],RkhFormulaCollectBy[a],RkhFormulaV2CollectBy[z],RkhFormulaV2CollectBy[h],RkhFormulaV2CollectBy[a]};
rhkPrintData=Append[MapIndexed[{outTriplePrintLabels[[First[#2]]],CF[{#1,TeXForm[StandardForm[#1]]}]}&,outTriplev2/.(a->α)],{ComputedFormulaDiffsTable,TF[rhkComputedFormulaDiffsTbl]}];
Print[TF[rhkPrintData]];
]

The special case where k:=2:

kval=2;hupper=16+kval;
printRhkTableFormula[kval,hupper]

The special case where k:=3:

kval=3;hupper=16+kval;
printRhkTableFormula[kval,hupper]

The special case where k:=4:

kval=4;hupper=16+kval;
printRhkTableFormula[kval,hupper]

The special case where k:=5:

kval=5;hupper=16+kval;
printRhkTableFormula[kval,hupper]

▶ Input Cell Data Used to Create this Notebook:

▶▶ Subsection:

▶▶▶ Subsubsection:

Paragraph

Input code:

(** : ************************** : **)