<<RISC`HolonomicFunctions`

HolonomicFunctions Package version 1.7.3 (21-Mar-2017)
written by Christoph Koutschan
Copyright Research Institute for Symbolic Computation (RISC),
Johannes Kepler University, Linz, Austria

Show that DxH satisfies the equation for DxR

(* This is the identity we wish to show, where (Subscript[D, p])(x) is defined by the second-order recurrence below. *)
TraditionalForm[(Subscript[D, p])[x]==R1[p]+Sum[R2[i,p],{i,1,p-1}]+Sum[R3[i,p]*(Subscript[D, i])[x],{i,1,p-1}]]

(* This is the recursive definition of D_p(x) *)
R1[p_]:=(-12*p^2*(x-p)/(x^3-x+p-p^3))*(-28/9*x^2+29/45+274/45*p^2-1/6*(x^3-x)/p+1/5*(x^3-x)*(x+p)/(x^2+x*p+p^2-1)-13/9*x*p);
R2[i_,p_]:=(12*i^2*(i-x)/x/(x+1)/(x-1))*((-12)*p*(p-i)*(x-p)/(x-i)/(x^3-x+p-p^3))*(5/18*(x^3-x)*1/p+38/15*p^2+(x^3-x)/5*(x+p)/(x^2+p^2+x*p-1)-13/9*i*p-13/9*(p-i)*x+49/45);
R3[i_,p_]:=(-12)*p*(p-i)*(x-p)/(x-i)/(x^3-x+p-p^3);
Clear[DxR];
DxR[p_,x_]:=DxR[p,x]=
If[p==1,
Together[(-12*(x-1)/(x^3-x)*(-28/9*x^2+29/45+274/45-1/6*(x^3-x)+1/5*(x^2-1)-13/9*x))],
Together[R1[p]+Sum[R2[i,p],{i,1,p-1}]+Sum[R3[i,p]*DxR[i,x],{i,1,p-1}]]
];
Table[DxR[n,x],{n,6}]

Clear[DxH];
DxH[n_,x_]:=DxH[n,x]=
Which[n==1,2/15*(15*x^3+262*x^2+115*x-588)/x/(x+1),
n==2,4/15/x*(15*x^6+524*x^5+490*x^4-4910*x^3-3649*x^2+1266*x+16056)/(x+1)/(x-1)/(x^2+2*x+3),
True,
Together[ (* This is the conjectured recurrence that D_p(x) appears to satisfy. *)(2*(100*n^12-26*n^11*x-351*n^9*x^3+78*n^8*x^4+453*n^6*x^6-78*n^5*x^7-199*n^3*x^9+26*n^2*x^10-3*x^12-1200*n^11+286*n^10*x+3159*n^8*x^3-624*n^7*x^4-2718*n^5*x^6+390*n^4*x^7+597*n^2*x^9-52*n*x^10+5900*n^10-897*n^9*x-78*n^8*x^2-11730*n^7*x^3+1122*n^6*x^4+156*n^5*x^5+6642*n^4*x^6-183*n^3*x^7-78*n^2*x^8-380*n*x^9+12*x^10-15000*n^9-507*n^8*x+624*n^7*x^2+23142*n^6*x^3+2004*n^5*x^4-780*n^4*x^5-8448*n^3*x^6-1011*n^2*x^7+156*n*x^8-18*x^9+19500*n^8+9312*n^7*x-1575*n^6*x^2-26037*n^5*x^3-10086*n^4*x^4+963*n^3*x^5+5655*n^2*x^6+828*n*x^7-18*x^8-7200*n^7-23688*n^6*x+714*n^5*x^2+16701*n^4*x^3+15336*n^3*x^4+231*n^2*x^5-1662*n*x^6+54*x^7-13900*n^6+29027*n^5*x+3444*n^4*x^2-5741*n^3*x^3-10868*n^2*x^4-516*n*x^5+12*x^6+21000*n^5-18703*n^4*x-6888*n^3*x^2+771*n^2*x^3+3064*n*x^4-54*x^5-11600*n^4+5784*n^3*x+5265*n^2*x^2+68*n*x^3-3*x^4+2400*n^3-588*n^2*x-1506*n*x^2+18*x^3)*n/(n-1)/(n-1-x)/(n^2+n*x+x^2-1)/(100*n^9-26*n^8*x-251*n^6*x^3+52*n^5*x^4+202*n^3*x^6-26*n^2*x^7+3*x^9-1350*n^8+312*n^7*x+2259*n^5*x^3-390*n^4*x^4-909*n^2*x^6+78*n*x^7+7800*n^7-1309*n^6*x-52*n^5*x^2-8231*n^4*x^3+740*n^3*x^4+52*n^2*x^5+1313*n*x^6-61*x^7-25200*n^6+1953*n^5*x+390*n^4*x^2+15501*n^3*x^3+180*n^2*x^4-156*n*x^5-606*x^6+49800*n^5+1601*n^4*x-942*n^3*x^2-15916*n^2*x^3-1482*n*x^4+113*x^5-61650*n^4-9417*n^3*x+729*n^2*x^2+8490*n*x^3+900*x^4+46700*n^3+12874*n^2*x+169*n*x^2-1855*x^3-19800*n^2-7788*n*x-294*x^2+3600*n+1800*x)*DxH[n-1,x]-(n^2+n*x+x^2-4*n-2*x+3)*(100*n^9-26*n^8*x-251*n^6*x^3+52*n^5*x^4+202*n^3*x^6-26*n^2*x^7+3*x^9-450*n^8+104*n^7*x+753*n^5*x^3-130*n^4*x^4-303*n^2*x^6+26*n*x^7+600*n^7+147*n^6*x-52*n^5*x^2-701*n^4*x^3-300*n^3*x^4+52*n^2*x^5+101*n*x^6-9*x^7-805*n^5*x+130*n^4*x^2+147*n^3*x^3+580*n^2*x^4-52*n*x^5-600*n^5+831*n^4*x+98*n^3*x^2+26*n^2*x^3-202*n*x^4+9*x^5+450*n^4-199*n^3*x-277*n^2*x^2+26*n*x^3-100*n^3-52*n^2*x+101*n*x^2-3*x^3)*n/(n-2)/(100*n^9-26*n^8*x-251*n^6*x^3+52*n^5*x^4+202*n^3*x^6-26*n^2*x^7+3*x^9-1350*n^8+312*n^7*x+2259*n^5*x^3-390*n^4*x^4-909*n^2*x^6+78*n*x^7+7800*n^7-1309*n^6*x-52*n^5*x^2-8231*n^4*x^3+740*n^3*x^4+52*n^2*x^5+1313*n*x^6-61*x^7-25200*n^6+1953*n^5*x+390*n^4*x^2+15501*n^3*x^3+180*n^2*x^4-156*n*x^5-606*x^6+49800*n^5+1601*n^4*x-942*n^3*x^2-15916*n^2*x^3-1482*n*x^4+113*x^5-61650*n^4-9417*n^3*x+729*n^2*x^2+8490*n*x^3+900*x^4+46700*n^3+12874*n^2*x+169*n*x^2-1855*x^3-19800*n^2-7788*n*x-294*x^2+3600*n+1800*x)/(n^2+n*x+x^2-1)*DxH[n-2,x])]];
(* Check that the two sequences, the original one and the one defined by the recurrence, are the same: *)
Table[Together[DxH[n,x]-DxR[n,x]],{n,6}]

annR1=Annihilator[R1[p],S[p]]

annSum1=Annihilator[Sum[R2[i,p],{i,1,p-1}],S[p]]

(* Convert the second-order recurrence into an operator *)
annDp={NormalizeCoefficients[ToOrePolynomial[f[p,x]==(DxH[n,x]/.DxH->f/.n->p)[[6,1]],f[p,x]]]};
Support[annDp]

(* Prepare the bivariate summand for the second sum *)
annSmnd=DFiniteTimes[
ToOrePolynomial[Append[annDp/.p->i,S[p]-1],OreAlgebra[S[i],S[p]]],
Annihilator[R3[i,p],{S[i],S[p]}]];
ByteCount[annSmnd]

ct=CreativeTelescoping[annSmnd,S[i]-1]

(* Telescoper is 1! Hence the following is an antidifference (i.e., an annihilator for it): *)
cert=DFiniteOreAction[annSmnd,ct[[2,1]]];
ByteCount[cert]

(* Sanity check, that the above gives indeed an antidifference for the summand. *)
test=smnd[i,p]+ApplyOreOperator[(S[i]-1)**ct[[2,1]],smnd[i,p]];
Together[Table[test,{p,10,15},{i,5}]/.smnd[i_,p_]:>R3[i,p]*DxR[i,x]]

(* Evaluate the antidifference at the upper summation bound: *)
annUpper=DFiniteSubstitute[cert,{i->p}]

(* Evaluate the antidifference at the lower summation bound: *)
annLower=DFiniteSubstitute[cert,{i->1}]

annSum2=DFinitePlus[annUpper,annLower];
Support[annSum2]

(* Sanity check: *)
test=ApplyOreOperator[annSum2[[1]],f[p]];
Together[Table[test,{p,10}]/.f[p_]:>Sum[R3[i,p]*DxR[i,x],{i,1,p-1}]]

(* Putting all parts together, into a single recurrence *)
annTotal=DFinitePlus[annR1,annSum1,annSum2,annDp];
Support[annTotal]

(* Look at the integer roots of the leading coefficient: no positive ones. *)
(* Thus, initial values for p = 1,...,6 need to be checked (has already been done above). *)
Cases[p/.Solve[LeadingCoefficient[annTotal[[1]]]==0,p],_Integer]

Show that CxH satisfies the definition of CxR

CxR[p_,x_]:=Together[Sum[DxR[i,x],{i,1,p-1}]];
Table[CxR[n,x],{n,2,6}]

Clear[myK,CxH];
myK[n_,x_]:=myK[n,k]=
Which[
n==1,2/15*(15*x^3+262*x^2+115*x-588)/(x+1)/x,
n==2,2/15*(45*x^6+1325*x^5+1372*x^4-10076*x^3-8557*x^2+1599*x+33876)/(x^2+2*x+3)/x/(x+1)/(x-1),
True,Together[(500*n^13-456*n^12*x-196*n^11*x^2-1706*n^10*x^3+1726*n^9*x^4+946*n^8*x^5+1402*n^7*x^6-2084*n^6*x^7-1304*n^5*x^8-226*n^4*x^9+814*n^3*x^10+554*n^2*x^11+30*n*x^12-3250*n^12+2736*n^11*x+1078*n^10*x^2+8530*n^9*x^3-7767*n^8*x^4-3784*n^7*x^5-4907*n^6*x^6+6252*n^5*x^7+3260*n^4*x^8+452*n^3*x^9-1221*n^2*x^10-554*n*x^11-15*x^12+6000*n^11-3996*n^10*x-4480*n^9*x^2-12635*n^8*x^3+9184*n^7*x^4+10758*n^6*x^5+7519*n^5*x^6-6275*n^4*x^7-6810*n^3*x^8-4124*n^2*x^9+547*n*x^10+262*x^11+2750*n^10-5100*n^9*x+12075*n^8*x^2-640*n^7*x^3+4102*n^6*x^4-19030*n^5*x^5-6530*n^4*x^6+2130*n^3*x^7+6955*n^2*x^8+3898*n*x^9-70*x^10-19000*n^9+15517*n^8*x-13586*n^7*x^2+10746*n^6*x^3-14138*n^5*x^4+16200*n^4*x^5+12799*n^3*x^6+7957*n^2*x^7-2701*n*x^8-1374*x^9+11250*n^8-1372*n^7*x-1253*n^6*x^2+5828*n^5*x^3+6967*n^4*x^4-5098*n^3*x^5-15122*n^2*x^6-7980*n*x^7+300*x^8+16000*n^7-17938*n^6*x+13177*n^5*x^2-16440*n^4*x^3-9334*n^3*x^4-6474*n^2*x^5+5499*n*x^6+2550*x^7-17750*n^6+7100*n^5*x-7025*n^4*x^2+5360*n^3*x^3+14263*n^2*x^4+6482*n*x^5-330*x^6-1500*n^5+7589*n^4*x+3227*n^3*x^2+2803*n^2*x^3-5233*n*x^4-2026*x^5+7000*n^4-3364*n^3*x-4875*n^2*x^2-1846*n*x^3+115*x^4-2000*n^3-716*n^2*x+1858*n*x^2+588*x^3)/(n-1)/(n-1-x)/(n^2+n*x+x^2-1)/(250*n^9-228*n^8*x-98*n^7*x^2-603*n^6*x^3+635*n^5*x^4+375*n^4*x^5+98*n^3*x^6-407*n^2*x^7-277*n*x^8-15*x^9-2250*n^8+1824*n^7*x+686*n^6*x^2+3618*n^5*x^3-3175*n^4*x^4-1500*n^3*x^5-294*n^2*x^6+814*n*x^7+277*x^8+8250*n^7-5521*n^6*x-2693*n^5*x^2-8410*n^4*x^3+5715*n^3*x^4+2885*n^2*x^5+946*n*x^6-362*x^7-15750*n^6+7590*n^5*x+6605*n^4*x^2+9520*n^3*x^3-4445*n^2*x^4-2770*n*x^5-750*x^6+16500*n^5-4057*n^4*x-9145*n^3*x^2-5870*n^2*x^3+797*n*x^4+965*x^5-9000*n^4-324*n^3*x+6503*n^2*x^2+2348*n*x^3+473*x^4+2000*n^3+716*n^2*x-1858*n*x^2-588*x^3)*myK[n-1,x]-n*(n-x)*(250*n^9-228*n^8*x-98*n^7*x^2-603*n^6*x^3+635*n^5*x^4+375*n^4*x^5+98*n^3*x^6-407*n^2*x^7-277*n*x^8-15*x^9-750*n^7+863*n^6*x-635*n^5*x^2+635*n^4*x^3-635*n^3*x^4+635*n^2*x^5+652*n*x^6+45*x^7+750*n^5-1042*n^4*x+635*n^3*x^2-635*n^2*x^3-473*n*x^4-45*x^5-250*n^3+407*n^2*x+98*n*x^2+15*x^3)*(n^2+n*x+x^2-2*n-x)/(n-1)/(n-1-x)/(n^2+n*x+x^2-1)/(250*n^9-228*n^8*x-98*n^7*x^2-603*n^6*x^3+635*n^5*x^4+375*n^4*x^5+98*n^3*x^6-407*n^2*x^7-277*n*x^8-15*x^9-2250*n^8+1824*n^7*x+686*n^6*x^2+3618*n^5*x^3-3175*n^4*x^4-1500*n^3*x^5-294*n^2*x^6+814*n*x^7+277*x^8+8250*n^7-5521*n^6*x-2693*n^5*x^2-8410*n^4*x^3+5715*n^3*x^4+2885*n^2*x^5+946*n*x^6-362*x^7-15750*n^6+7590*n^5*x+6605*n^4*x^2+9520*n^3*x^3-4445*n^2*x^4-2770*n*x^5-750*x^6+16500*n^5-4057*n^4*x-9145*n^3*x^2-5870*n^2*x^3+797*n*x^4+965*x^5-9000*n^4-324*n^3*x+6503*n^2*x^2+2348*n*x^3+473*x^4+2000*n^3+716*n^2*x-1858*n*x^2-588*x^3)*myK[n-2,x]]];
CxH[n_,x_]:=myK[n-1,x];
Table[CxH[n,x]-CxR[n,x],{n,2,6}]

(* Prepare the bivariate summand for the sum *)
annSmnd=ToOrePolynomial[Append[annDp/.p->i,S[p]-1],OreAlgebra[S[i],S[p]]];

ct=CreativeTelescoping[annSmnd,S[i]-1,S[p]]

(* Telescoper is 1! Hence the following is an antidifference (i.e., an annihilator for it): *)
cert=DFiniteOreAction[annSmnd,ct[[2,1]]];
ByteCount[cert]

Support[cert]

(* Sanity check, that the above gives indeed an antidifference for the summand. *)
test=smnd[i,p]+ApplyOreOperator[(S[i]-1)**ct[[2,1]],smnd[i,p]];
Together[Table[test,{p,8},{i,p}]/.smnd[i_,p_]:>DxR[i,x]]

(* Evaluate the antidifference at the upper summation bound: *)
annUpper=DFiniteSubstitute[cert,{i->p}]

(* Evaluate the antidifference at the lower summation bound: *)
annLower=DFiniteSubstitute[cert,{i->1}]

annSumC=DFinitePlus[annUpper,annLower];
Support[annSumC]

(* Sanity check: *)
test=ApplyOreOperator[annSumC[[1]],f[p]];
Together[Table[test,{p,10}]/.f[p_]:>Sum[DxR[i,x],{i,1,p-1}]]

(* Convert the second-order recurrence for K into an operator for C. *)
annC={NormalizeCoefficients[ToOrePolynomial[(f[p,x]==(myK[n,x]/.myK->f/.n->p)[[6,1]])/.f[p_,x_]->f[p+1,x],f[p,x]]]}

(* The third-order recurrence for the sum is a left-multiple of the guessed operator for C. *)
OreReduce[annSumC,annC]

(* Look at the integer roots of the leading coefficient: no positive ones. *)
(* Thus, initial values for p = 2,...,4 need to be checked (has already been done above). *)
Cases[p/.Solve[LeadingCoefficient[annSumC[[1]]]==0,p],_Integer]