<<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

Univariate examples from the slides

((erf((Sqrt[x+1])))^2)+(exp^2)((Sqrt[x+1]))

First, by executing the corresponding closure properties “by hand”:

annErf=ToOrePolynomial[{Der[z]^2+2z**Der[z]}]

ApplyOreOperator[annErf,Erf[z]]

annErf1=DFiniteSubstitute[annErf,{z->Sqrt[x+1]},Algebra->OreAlgebra[Der[x]]]

annErf2=DFiniteTimes[annErf1,annErf1]

ApplyOreOperator[annErf2,Erf[Sqrt[x+1]]^2]

Together[%]

annExp=ToOrePolynomial[{Der[z]-1}]

annExp2=DFiniteSubstitute[annExp,{z->2*Sqrt[x+1]},Algebra->OreAlgebra[Der[x]]]

DFinitePlus[annErf2,annExp2]

Second, by using the convenient Annihilator command:

Annihilator[Erf[Sqrt[x+1]]^2+Exp[Sqrt[x+1]]^2,Der[x]]

((sinh^2)(x)+(1/((sin^2)(x)))) ((cosh^2)(x)+(1/((cos^2)(x))))

Annihilator[(Sinh[x]^2+Sin[x]^(-2))*(Cosh[x]^2+Cos[x]^(-2)),Der[x]]

((log((Sqrt[1-(x^2)])))/(exp((Sqrt[1-(x^2)]))))

Annihilator[Log[Sqrt[1-x^2]]/Exp[Sqrt[1-x^2]],Der[x]]

(tan^(-1))(exp(x))

Annihilator[ArcTan[Exp[x]],Der[x]]

Finite Element Methods

annphi=Annihilator[(1-x)^i*JacobiP[j,2i+1,0,2x-1]*LegendreP[i,2y/(1-x)-1],{S[i],S[j],Der[x],Der[y]}]

ByteCount[annphi]

Support[annphi]

FindRelation[annphi,Eliminate->{x,y},Pattern->{_,_,0|1,0}]

ApplyOreOperator[Factor[First[%]],(Subscript[ϕ, i,j])[x]]

Example from Gradshteyn & Ryzhik

CreativeTelescoping[(1-x^2)^(nu-1/2)*Exp[I*a*x]*GegenbauerC[n,nu,x],Der[x],{S[n],Der[a]}]//Timing

Printlevel=5;
CreativeTelescoping[(1-x^2)^(nu-1/2)*Exp[I*a*x]*GegenbauerC[n,nu,x],Der[x],{S[n],Der[a]}]

Printlevel=0;

Annihilator[Pi*2^(1-nu)*I^n*Gamma[2nu+n]/n!/Gamma[nu]*a^(-nu)*BesselJ[nu+n,a],{S[n],Der[a]}]

Holonomic Special Function Identities

(1)    (∑_(k=0)^n)((Binomial[n, k])^2) ((Binomial[n+k, k])^2)=(∑_(k=0)^n)(Binomial[n, k]) (Binomial[k+n, k]) (∑_(j=0)^k)((Binomial[k, j])^3)

CreativeTelescoping[Binomial[k,j]^3,S[j]-1,{S[k],S[n]}][[1]]

DFiniteTimes[Annihilator[Binomial[n,k]*Binomial[k+n,k],{S[k],S[n]}],%]

CreativeTelescoping[%,S[k]-1][[1]]

CreativeTelescoping[Binomial[n,k]^2*Binomial[n+k,k]^2,S[k]-1,S[n]]

(4)    (∫_(-∞)^∞)((∑_(m=0)^∞)((∑_(n=0)^∞)(((HermiteH[m, x]) (HermiteH[n, x]) (r^m) (s^n) exp(-(x^2)))/(m! n!))))dx==(Sqrt[π]) exp(2 r s)

CreativeTelescoping[HermiteH[m,x]*HermiteH[n,x]*r^m*s^n*Exp[-x^2]/m!/n!,S[n]-1,{S[m],Der[x],Der[r],Der[s]}][[1]]

CreativeTelescoping[%,S[m]-1][[1]]

CreativeTelescoping[%,Der[x]][[1]]

Proof of Di Francesco’s Conjecture

Doron Zeilberger wrote (23.06.2021):
Philippe Di Francesco just gave a great talk at the Lattice path conference mentioning, inter alia, a certain conjectured determinant.
It is Conj. 8.1 (combined with Th. 8.2) in https://arxiv.org/pdf/2102.02920.pdf
I am curious if you can prove it by the Koutschan-Zeilberger-Aek holonomic ansatz method.
If you can do it before Friday, June 25, 2021, 17:00 Paris time, I will mention it in my talk in that conference.

(* The matrix entries *)
mya[i_,j_]:=FunctionExpand[2^i*Binomial[i+2j+1,2j+1]-Binomial[i-1,2j+1]];
TableForm[Table[mya[i,j],{i,0,5},{j,0,5}]]

(* Annihilator of the matrix entries a_{i,j} *)
anna=Annihilator[mya[i,j],{S[i],S[j]}];
Factor[anna]

(* Test conjectured identity. *)
Table[Det[Table[mya[i,j],{i,0,n-1},{j,0,n-1}]]/(2*Product[2^(i-1)*(4i-2)!/(n+2i-1)!,{i,n}]),{n,10}]

data=Table[
ns=NullSpace[Table[mya[i,j],{i,0,n-2},{j,0,n-1}]][[1]];
Together[ns/Last[ns]]
,{n,2,30}];

Take[data,10]

<<RISC`Guess`

Package GeneratingFunctions version 0.8 written by Christian Mallinger
Copyright Research Institute for Symbolic Computation (RISC),
Johannes Kepler University, Linz, Austria

Guess Package version 0.52
written by Manuel Kauers
Copyright Research Institute for Symbolic Computation (RISC),
Johannes Kepler University, Linz, Austria

guess=GuessMultRE[PadRight[data],{c[n,j],c[n+1,j],c[n,j+1],c[n+2,j],c[n+1,j+1],c[n,j+2]},{n,j},8,StartPoint->{2,0},Infolevel->5];

annc=OreGroebnerBasis[NormalizeCoefficients/@ToOrePolynomial[guess,c[n,j]]];
#[annc]&/@{ByteCount,Support}

annc//Factor

Identity (1)

anncnn=DFiniteSubstitute[annc,{j->n-1}]

ApplyOreOperator[anncnn,1]

OreReduce[anncnn,Annihilator[1,S[n]]]

Identity (2)

annci=OreGroebnerBasis[Append[annc,S[i]-1],OreAlgebra[S[n],S[j],S[i]]];
annSmnd1=DFiniteTimes[Annihilator[2^i*Binomial[i+2j+1,2j+1],{S[n],S[j],S[i]}],annci];
annSmnd2=DFiniteTimes[Annihilator[Binomial[i-1,2j+1],{S[n],S[j],S[i]}],annci];

#[annSmnd1]&/@{ByteCount,UnderTheStaircase}
#[annSmnd2]&/@{ByteCount,UnderTheStaircase}

Timing[id2fct1=FindCreativeTelescoping[annSmnd1,S[j]-1];]

#[id2fct1[[1]]]&/@{ByteCount,UnderTheStaircase}

Timing[id2fct2=FindCreativeTelescoping[annSmnd2,S[j]-1];]

#[id2fct2[[1]]]&/@{ByteCount,UnderTheStaircase}

GBEqual[id2fct1[[1]],id2fct2[[1]]]

AnnihilatorSingularities[id2fct1[[1]],{0,0}]

Identity (3)

annSmnd1=DFiniteTimes[Annihilator[2^(n-1)*Binomial[n+2j,2j+1],{S[n],S[j]}],annc];
annSmnd2=DFiniteTimes[Annihilator[Binomial[n-2,2j+1],{S[n],S[j]}],annc];

#[annSmnd1]&/@{ByteCount,UnderTheStaircase}
#[annSmnd2]&/@{ByteCount,UnderTheStaircase}

Timing[id3fct1=FindCreativeTelescoping[annSmnd1,S[j]-1];]

Timing[id3fct2=FindCreativeTelescoping[annSmnd2,S[j]-1];]

rec=DFinitePlus[id3fct1[[1]],id3fct2[[1]]];
Support[rec]

With[{b=2*prod[2^(i-1)*(4i-2)!/(n+2i-1)!,{i,1,n}]},b/(b/.n->n-1)]

%/.prod[a_,{i,1,n}]:>(a/.i->n)*prod[a,{i,1,n-1}]/.
prod[a1_,b_]/prod[a2_,b_]:>prod[FunctionExpand[a1/a2],b]

FunctionExpand[%/.prod->Product]

OreReduce[rec[[1]],Annihilator[%,S[n]]]