Re: Aufgabe::Gewöhnliches Differentialgleichungstennis

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Liebe Freundinnen und Freunde von Mma,

mit

Clear[ODETennis]
ODETennis[eqn_, var_, cond_List, intv_List, cnt_: 10,
  opts : OptionsPattern[]] :=
 Module[{rbVStore, deg = Length[cond], cnd = cond, z, oo = 0, sol,
    xLR, rbV, o},
   If[FreeQ[eqn, var] || FreeQ[eqn, First[intv]] ||
     FreeQ[cond, var] || FreeQ[cond, intv[[2]]],
    Print["Equation, variables and conditions do not fit together."];
    Return[$Failed]
    ];
   If[Length[cond] > 1 && FreeQ[cond, Derivative],
    Print["ODETennis works only for Cauchy boundary conditions."];
    Return[$Failed]
    ];
   rbVStore =
    List[Flatten[
      Table[Cases[
        First[Solve[cnd,
          Table[Derivative[o - 1][var][intv[[2]]], {o, deg}]]],
        Rule[Derivative[o - 1][var][intv[[2]]], z_] -> z], {o, deg}]]];
   While[oo < cnt,
    sol =
     NDSolve[Join[{eqn}, cnd], var, intv,
      FilterRules[{opts}, Options[NDSolve]]];
    If[Head[sol] == NDSolve, Abort[]];
    xLR = intv[[3 (* R *) - Mod[oo, 2] (* L *)]];
    rbV =
     Table[Derivative[o - 1][var][xLR], {o, deg}] /.
      var ->  First[var /. sol];
    cnd =
     Table[Equal[Derivative[o - 1][var][xLR],
       Rationalize[rbV[[o]], 0]], {o, deg}];
    AppendTo[rbVStore, rbV];
    oo++
    ];
   Print[TableForm[rbVStore,
     TableHeadings -> {Table[o - 1, {o, Length[rbVStore]}],
       Table[Derivative[o - 1][var], {o, deg}]}]];
   Show[Graphics[
     Line /@ Transpose[
       Flatten[{Thread[{intv[[2]], #[[1]]}],
           Thread[{intv[[3]], #[[2]]}]} & /@ Partition[rbVStore, 2],
        1]]
     ], Frame -> True, PlotLabel -> "ODETennis: " <> ToString[eqn]
    ]
   ] /; Head[eqn] == Equal && Head[var] == Symbol && cnt > 0

> Im Anhang ist ein Bildchen für das Tennis der Aufgabe
>
> NDSolve[{y'''[x] - y''[x] y'[x] + y[x] + 3 == 0,
>    y''[0] == -1, y'[0] == -1/4, y[0] == 1/2}, y, {x, 0, 5}]

kann man sagen

In[5]:= Clear[x, y] (* Invarianztest bzgl. der Schreibweise der  
Randbedingungen *)
ODETennis[
 y'''[x] - y''[x] y'[x] + y[x] + 3 == 0, y,  {y''[0] + y'[0] == -5/4,
  y''[0] == -3/4 + y'[0], y[0] == 1/2},
 {x, 0, 5 (* 3 *)}, 100, WorkingPrecision -> 32 (* 16 hat Tennis *)]

und sehen, dass das Tennis mit WorkingPrecision -> 32 bei dieser Gleichung  
erst ab der 8. Nachkommastelle stattfindet. NDSolve[] wird somit der  
Theorie praktisch gerecht.

Gruss
Udo.