CA II - Uebungsblatt 06

Aufgabe 1

benoetigte Funktionen

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

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)

DE=HolonomicDE[Sin[x]Cos[x],F[x]]

RE=DEtoRE[DE,F[x],A[k]]

Nach Taylor ergibt sich für die Anfangswerte:

A[0]=Sin[x]Cos[x]/.x->0

A[1]=D[Sin[x]Cos[x],x]/.x->0

Folglich verschwinden alle Koeffizienten fuer gerade k.
Fuer ungerade k ergibt sich:

RAT=A[k+2]/A[k]/.(Solve[RE,A[k+2]][[1]])

Factor[RAT/.k-> 2m+1]

Also ergibt sich fuer B[m]=A[2m+1]

FullSimplify[(-1)^m /Pochhammer[1,m]/Pochhammer[3/2,m]*A[1]]

und somit

SUM[(-4)^k/(2k+1)!x^(2k+1),{k,0,Infinity}]

(b)

DE=HolonomicDE[ArcTan[x],F[x]]

RE=DEtoRE[DE,F[x],A[k]]

Nach Taylor ergibt sich für die Anfangswerte

A[0]=ArcTan[0]

A[1]=D[ArcTan[x],x]/.x->0

Folglich verschwinden alle Koeffizienten fuer gerade k.
Fuer ungerade k ergibt sich:

RAT=A[k+2]/A[k]/.(Solve[RE,A[k+2]][[1]])

Factor[RAT/.k-> 2m+1]

Also ergibt sich fuer B[m]=A[2m+1]

FullSimplify[(-1)^m Pochhammer[1/2,m]/Pochhammer[3/2,m]*A[1]]

und somit

SUM[(-1)^k /(2k+1)x^(2k+1),{k,0,Infinity}]

Aufgabe 2

benoetigte Funktionen

HolonomicRE[a_,A_[k_]]:=Module[{rat},
rat=Together[FunctionExpand[(a/.k->k+1)/a]];
Denominator[rat]A[k+1]-Numerator[rat] A[k]==0
]

Clear[Theta];
Theta[f_,x_,n_]:=Expand[Theta[x D[f,x],x,n-1]]/;IntegerQ[n] && Positive[n];
Theta[f_,x_,0]=f;

Theta[f[x],x,1]

Clear[RetoDe];
RetoDe[RE_,A_[k_],F_[x_]]:=Module[{rules},
rules={k^l_ A[k+m_]->Sum[Binomial[l,r](-m)^(l-r)Theta[F[x],x,r]/x^m,{r,0,l}],k A[k+m_]->-m F[x]/x^m+Theta[F[x],x,1]/x^m,k^l_ A[k]->Theta[F[x],x,l],k A[k]->Theta[F[x],x,1],A[k+m_]-> F[x]/x^m,A[k]->F[x]};
Collect[Numerator[Together[Expand[Expand[RE[[1]]-RE[[2]]]//.rules]]],D[F[x],{x,_}],Factor]==0
]

(i)

RE=HolonomicRE[1/k!,k]

DE=RetoDe[RE,A[k],F[x]]

Mit dem Satz von Taylor folgt F[0]=a[0]=1, also:

DSolve[{DE,F[0]==1},F[x],x]

(ii)

RE=HolonomicRE[(-1)^k/k!^2,k]

DE=RetoDe[RE,A[k],F[x]]

Mit dem Satz von Taylor folgt F[0]=a[0]=1, also:

sol=DSolve[{DE,F[0]==1},F[x],x]

Die Loesung ist die Besselfunktion ausgewertet an der Stelle 2Sqrt[x].

(iii)

RE=HolonomicRE[k^2,k]

DE=RetoDe[RE,A[k],F[x]]

Mit dem Satz von Taylor folgt F[0]=a[0]=0 und F'[0]=a[1]=1, also:

DSolve[{DE,F[0]==0,F'[0]==1},F[x],x]