Aufgabe 1

MAXDEORDER=5

Clear[HolonomicDE];
HolonomicDE[f_,F_[x_],print_:False]:=Module[{DF,eqcl,rat,A,approach,sol,eq,i,j,l,m},
DF=Table[D[f,{x,i}],{i,0,MAXDEORDER-1}];
DF=Map[If[Head[#]===Plus,Apply[List,#],{#}]&,DF];(* DF consists of lists of derivatives (sums are lists of summands) *)
eqcl={A[1]DF[[1]]};
For[i=2,i≤MAXDEORDER,i++,
For[l=1,l≤Length[DF[[i]]],l++, (* for every summand of the (i-1)-th derivative do the following *)
m=Length[eqcl];
For[j=1,j≤m,j++,
rat=Together[DF[[i,l]]/eqcl[[j,1]]]; (* building quotient of l-th summand and first element of j-th eq. class*)
If [PolynomialQ[Denominator[rat],x] && PolynomialQ[Numerator[rat],x], (* test, if rat is rational or not  *)
AppendTo[eqcl[[j]],A[i]DF[[i,l]]]; (* add to equivalence class *)
Break[],
If[j==Length[eqcl],AppendTo[eqcl,{A[i]DF[[i,l]]}];  (* build new equivalence class *)
];
];
];
];
var=Table[A[k],{k,i}];
approach=Map[Apply[Plus,#]&,eqcl]; (* sum over all elements in equivalence classes *)
approach=Map[#==0&,approach];
If[print,Print[{eqcl,approach}]];
Off[Solve::"svars"];
sol=Solve[approach,var];
If[sol=!={{}} && Union[var/.sol[[1]]]=!={0},
eq=Sum[A[k+1]D[F[x],{x,k}],{k,0,i-1}]/.sol[[1]];
eq=Numerator[Together[eq]]/.A[_]->1;
Return[Collect[eq,D[F[x],{x,_}],Factor]==0]];
];
]

Aufgabe 1

(a)

HolonomicDE[Cos[x],F[x]]

R1=D[F[x],{x,n_}]/;n>1->D[-F[x],{x,n-2}]

HolonomicDE[Sin[x],G[x]]

R2=D[G[x],{x,n_}]/;n>1->D[-G[x],{x,n-2}]

R={R1,R2}

S={D[F[x],{x,n_}]D[G[x],{x,m_}]->a[n,m],F[x]D[G[x],{x,m_}]->a[0,m],D[F[x],{x,n_}]G[x]->a[n,0],F[x]G[x]->a[0,0]}

H[x_]:=F[x]G[x]

eq1=h[x]==H[x]//.R

eq2=D[h[x],x]==D[H[x],x]//.R

eq3=D[h[x],{x,2}]==D[H[x],{x,2}]//.R

Eliminate[{eq1,eq2,eq3}/.S,Flatten[Table[a[i,j],{i,0,1},{j,0,1}]]]

eq4=D[h[x],{x,3}]==Expand[D[H[x],{x,3}]//.R]

DE=Eliminate[{eq1,eq2,eq3,eq4}/.S,Flatten[Table[a[i,j],{i,0,1},{j,0,1}]]]

Collect[DE[[2]]-DE[[1]],D[h[x],{x,_}],Factor]==0

Die Ordnung dieser Differentialgleichung ist, im Gegensatz zur Differentialgleichung aus Aufgabe 1 c), nicht minimal! Das liegt daran, das bei dem
Produktalgortihmus die lineare Abhaengigkeit der Ausdruecke f(x)g(x) und f'(x)g'(x) nicht beruecksichtigt wird ( bzw. werden kann ).

(b)

HolonomicDE[Sin[x],F[x]]

R1=D[F[x],{x,n_}]/;n>1->D[-F[x],{x,n-2}]

HolonomicDE[ArcTan[x],G[x]]

R2=D[G[x],{x,n_}]/;n>1->D[-2x/(x^2+1)D[G[x],x],{x,n-2}]

R={R1,R2}

H[x_]:=F[x]+G[x]

eq1=h[x]==H[x]//.R

eq2=D[h[x],x]==D[H[x],x]//.R

eq3=D[h[x],{x,2}]==D[H[x],{x,2}]//.R

Eliminate[{eq1,eq2,eq3},{F[x],G[x],D[F[x],x],D[G[x],x]}]

eq4=D[h[x],{x,3}]==Expand[D[H[x],{x,3}]//.R]

Eliminate[{eq1,eq2,eq3,eq4},{F[x],G[x],D[F[x],x],D[G[x],x]}]

eq5=D[h[x],{x,4}]==Expand[D[H[x],{x,4}]//.R]

DE=Eliminate[{eq1,eq2,eq3,eq4,eq5},{F[x],G[x],D[F[x],x],D[G[x],x]}]

Collect[DE[[1,1]]-DE[[1,2]],D[h[x],{x,_}],Factor]==0

Aufgabe 2

Clear[DEtoRE];
DEtoRE[DE_,F_[x_],A_[n_]]:=Module[{expr,rules},expr=Expand[DE[[1]]-DE[[2]]];
rules={x^j_ F[x]->A[n-j],x F[x]->A[n-1],F[x]->A[n],x^j_ D[F[x],{x,k_}]->Pochhammer[n+1-j,k] A[n+k-j],x D[F[x],{x,k_}]->Pochhammer[n,k] A[n+k-1],D[F[x],{x,k_}]->Pochhammer[n+1,k] A[n+k]};
Collect[expr/.rules,A[_],Factor]==0]

(a)

DEtoRE[D[f[x],{x,2}]-x f[x]==0,f[x],A[k]]

(b)

DEtoRE[(1-x^2)D[f[x],{x,2}]-2x D[f[x],x]+n^2f[x]==0,f[x],A[k]]

HolonomicDE

MAXDEORDER=5

Clear[HolonomicDE];
HolonomicDE[f_,F_[x_],print_:False]:=Module[{DF,eqcl,rat,A,approach,sol,eq,i,j,l,m},
DF=Table[D[f,{x,i}],{i,0,MAXDEORDER-1}];
DF=Map[If[Head[#]===Plus,Apply[List,#],{#}]&,DF];(* DF consists of lists of derivatives (sums are lists of summands) *)
eqcl={A[1]DF[[1]]};
For[i=2,i≤MAXDEORDER,i++,
For[l=1,l≤Length[DF[[i]]],l++, (* for every summand of the (i-1)-th derivative do the following *)
m=Length[eqcl];
For[j=1,j≤m,j++,
rat=Together[DF[[i,l]]/eqcl[[j,1]]]; (* building quotient of l-th summand and first element of j-th eq. class*)
If [PolynomialQ[Denominator[rat],x] && PolynomialQ[Numerator[rat],x], (* test, if rat is rational or not  *)
AppendTo[eqcl[[j]],A[i]DF[[i,l]]]; (* add to equivalence class *)
Break[],
If[j==Length[eqcl],AppendTo[eqcl,{A[i]DF[[i,l]]}];  (* build new equivalence class *)
];
];
];
];
var=Table[A[k],{k,i}];
approach=Map[Apply[Plus,#]&,eqcl]; (* sum over all elements in equivalence classes *)
approach=Map[#==0&,approach];
If[print,Print[approach]];
Off[Solve::"svars"];
sol=Solve[approach,var];
If[sol=!={{}} && Union[var/.sol[[1]]]=!={0},
eq=Sum[A[k+1]D[F[x],{x,k}],{k,0,i-1}]/.sol[[1]];
eq=Numerator[Together[eq]]/.A[_]->1;
Return[Collect[eq,D[F[x],{x,_}],Factor]==0]];
];
]

(c)

DE=HolonomicDE[Sin[x]+ArcTan[x],f[x]]

DEtoRE[DE,f[x],A[k]]