www.mathematik-verstehen.de
© Prof. Dr. Dörte Haftendorn

Link zum Buch
Site-Info
URL  http://haftendorn.uni-lueneburg.de/mathe-lehramt/kurven/tranzendente/traktrix/traktrix.htm
[Kurven]  [Tranzendente Kurven]  [Computer]
Download dieses Mathematica-Notebooks
Euler-Verfahren und Heun-Verfahren für numerische DGL-Lösung

Leitseite Differentialgleichungen und entsprechendes Vorgehen mit ausführlicheren Erläuterungen in MuPAD

Richtungsfelder bei DGL'n 1.Ordnung Traktrix

•richtungesinus.nb Ha 7/97   Isoklinen

Needs["Graphics`Master`"]

Zusätzliche Definition für Richtungsfelder von DGLn

PlotDGLField[f_, {x_, x0_, x1_, dx_: Automatic}, {y_, y0_, y1_, dy_: Automatic}, <br />   ...   opts___] := PlotVectorField[{1, f}/(1 + f^2)^(1/2), {x, x0, x1, dx}, {y, y0, y1, dy}, opts]

Anpassung an die  spezielle DGL

xmin = 0 ; xmax = 3.8 ; ymin = 0 ; ymax = 3 ; dx = 0.2 ; dy = 0.2 ;

Fur Anfangswertprobleme ist unten fa[x0,y0] zuständig.

g Term       Angabe der DGL in der Form  y'[x]=g[x,y]  als Term von x und y;

g            Angabe der DGL in der Form  y'[x]=g[x,y]  als Term von x und y[x];

Clear[g, k, c]

gTerm = 1/(k - x) (k^2 - (k - x)^2)^(1/2) ; gN[x_, yd_] := 1/(k - x) (k^2 - (k - x)^2)^(1/2) ; g = 1/(k - x) (k^2 - (k - x)^2)^(1/2) ;

gTerm

(k^2 - (k - x)^2)^(1/2)/(k - x)

k = 4 ; vec = PlotDGLField[gTerm, {x, xmin, xmax, dx}, {yd, ymin, ymax, dy}, PlotStyle -> {RGBColor[1, 0, 1]}, DisplayFunction -> Identity    ] ; Clear[k]

deso = DSolve[yd^'[x] == g, yd[x], x]

{{yd[x] -> -(k^2 - (k - x)^2)^(1/2) + C[1] - (k (k^2 - (k - x)^2)^(1/2) Log[(2 k^(1/2) + x^ ... - x^(1/2))) + (2 (2 k - x)^(1/2))/(k^(3/2) (2 k^(1/2) - 2 x^(1/2)))])/((2 k - x)^(1/2) x^(1/2))}}

<br /> ({hi} = yd[x] /. deso) ; <br /> f[x_, c_] := Evaluate[hi /. C[1] -> c] ; <br /> f[x, c]

c - (k^2 - (k - x)^2)^(1/2) - 1/((2 k - x)^(1/2) x^(1/2)) (k (k^2 - (k - x)^2)^(1/2) Log[(2 k^ ... - x^(1/2))/(k^(3/2) (k^(1/2) - x^(1/2))) + (2 (2 k - x)^(1/2))/(k^(3/2) (2 k^(1/2) - 2 x^(1/2)))])

% /. k -> 4

c - (16 - (4 - x)^2)^(1/2) - (4 (16 - (4 - x)^2)^(1/2) Log[(4 + x^(1/2))/(8 (2 + x^(1/2))) - ( ... Log[(4 - x^(1/2))/(8 (2 - x^(1/2))) + (8 - x)^(1/2)/(4 (4 - 2 x^(1/2)))])/((8 - x)^(1/2) x^(1/2))

f[x,c] ist die allgemeine Lösung  

Syntax für Anfangswertprobleme

x0 = 0 ; y0 = 0 ; k = 4 ;

DSolve[{yd^'[x] == g, yd[x0] == y0}, yd[x], x] ; {hi} = yd[x] /. % ; fa[x_, x0_, y0_] := Evaluate[hi] fa[x, x0, y0]

-(16 - (4 - x)^2)^(1/2) + 4 Log[4 + (16 - (4 - x)^2)^(1/2)] - 4 Log[4 - x]

fa[x, 0, 0] /. k -> 4

-(16 - (4 - x)^2)^(1/2) + 4 Log[4 + (16 - (4 - x)^2)^(1/2)] - 4 Log[4 - x]

Expand[%]

-(16 - (4 - x)^2)^(1/2) + 4 Log[4 + (16 - (4 - x)^2)^(1/2)] - 4 Log[4 - x]

% // N

-1.` (16.` - 1.` (4.` - 1.` x)^2)^(1/2) + 4.` Log[4.` + (16.` - 1.` (4.` - 1.` x)^2)^(1/2)] - 4.` Log[4.` - 1.` x]

fa[1.8, 0, 0]

1.4792262149750823`

fa[x, 0, 0]

-(16 - (4 - x)^2)^(1/2) + 4 Log[4 + (16 - (4 - x)^2)^(1/2)] - 4 Log[4 - x]

fa[x,x0,y0]  ist die Lösung des Anfangswertproblems.

k = 4 ; Clear[x0, y0] ;

alle = Join[Table[fa[x, x0, ymin], {x0, xmin, xmax}], Table[fa[x, xmin, y0], <br />  &nbs ... br />          Table[fa[x, xmax, y0], {y0, ymin, ymax}]] ;

alleGraph = Plot[Evaluate[alle], {x, xmin, xmax}, PlotStyle -> Farbig, <br />   & ... bsp;      PlotRange -> {ymin, ymax}, DisplayFunction -> Identity] ;

dummy = Plot[{0}, {x, xmin, xmax}, PlotRange -> {ymin, ymax}, <br />          DisplayFunction -> Identity] ;

Show[dummy, vec, DisplayFunction -> $DisplayFunction, AspectRatio -> Automatic]

[Graphics:traktrix-b/richtung-traktrix_33.gif]

-Graphics -

Show[alleGraph, vec, DisplayFunction -> $DisplayFunction, AspectRatio -> Automatic] ;

[Graphics:traktrix-b/richtung-traktrix_36.gif]

Verfahren von Heun

h = 0.2 ;

heun[{xk_, yk_}] := {xk + h, N[yk + 1/2 h (gN[xk, yk] + gN[xk + h, yk + h gN[xk, yk]])]} ;

heunListe[{x_, y_}] := Module[{x1, m0, z, mz, y1}, x1 = x + h ; <br />      ... sp;    Print[     {x1, m0, z, mz, (m0 + mz)/2, y1}] ; {x1, y1}]

k = 4 ; punkte = NestList[heunListe, {0, 0}, 15]

{0.2`, 0, 0, 0.3286841051788631`, 0.16434205258943155`, 0.03286841051788631`}

{0.4`, 0.3286841051788631`, 0.09860523155365894`, 0.48432210483785254`, 0.40650310500835785`, 0.11416903151955787`}

{0.6000000000000001`, 0.48432210483785254`, 0.2110334524871284`, 0.6197443384031024`, 0.5520332216204775`, 0.2245756758436534`}

{0.8`, 0.6197443384031024`, 0.34852454352427387`, 0.7499999999999998`, 0.6848721692015511`, 0.3615501096839636`}

{1.`, 0.7499999999999998`, 0.5115501096839636`, 0.8819171036881969`, 0.8159585518440984`, 0.5247418200527834`}

{1.2`, 0.8819171036881969`, 0.7011252407904227`, 1.020204061220407`, 0.9510605824543019`, 0.7149539365436437`}

{1.4`, 1.020204061220407`, 0.9189947487877251`, 1.1691295502746664`, 1.0946668057475368`, 0.933887297693151`}

{1.5999999999999999`, 1.1691295502746664`, 1.1677132077480843`, 1.333333333333333`, 1.2512314418039998`, 1.184133586053951`}

{1.7999999999999998`, 1.333333333333333`, 1.4508002527206176`, 1.518481189862733`, 1.425907261598033`, 1.4693150383735576`}

{1.9999999999999998`, 1.518481189862733`, 1.7730112763461041`, 1.7320508075688772`, 1.6252659987158051`, 1.7943682381167188`}

{2.1999999999999997`, 1.7320508075688772`, 2.140778399630494`, 1.9845078999435275`, 1.8582793537562023`, 2.1660241088679593`}

{2.4`, 1.9845078999435275`, 2.562925688856665`, 2.29128784747792`, 2.137897873710724`, 2.593603683610104`}

{2.6`, 2.29128784747792`, 3.051861253105688`, 2.6764277135993138`, 2.483857780538617`, 3.0903752397178272`}

{2.8000000000000003`, 2.6764277135993138`, 3.62566078243769`, 3.179797338056486`, 2.9281125258279`, 3.675997744883407`}

{3.0000000000000004`, 3.179797338056486`, 4.311957212494704`, 3.872983346207419`, 3.5263903421319522`, 4.381275813309798`}

{{0, 0}, {0.2`, 0.03286841051788631`}, {0.4`, 0.11416903151955787`}, {0.6000000000000001`, 0.2 ... 397178272`}, {2.8000000000000003`, 3.675997744883407`}, {3.0000000000000004`, 4.381275813309798`}}

heunpkt = ListPlot[punkte, Prolog -> {RGBColor[0, 1, 0], AbsolutePointSize[8]}] ;

[Graphics:traktrix-b/richtung-traktrix_58.gif]

graph = Plot[fa[x, 0, 0], {x, 0, 3}, Prolog -> RGBColor[0, 0, 1], Epilog -> RGBColor[1, 0, 1] ] ;

[Graphics:traktrix-b/richtung-traktrix_60.gif]

Show[heunpkt , graph] ;

[Graphics:traktrix-b/richtung-traktrix_62.gif]

Show[heunpkt, graph, vec, AspectRatio -> Automatic] ;

[Graphics:traktrix-b/richtung-traktrix_64.gif]

Converted by Mathematica  (May 16, 2004)


© Prof. Dr. Dörte Haftendorn
www.mathematik-verstehen.de
 [Kurven]  [Transzendente Kurven] 
Inhalt und Webbetreuung ©Prof. Dr. Dörte Haftendorn  Apr 2004, update 15. August 2011 		Site-Info
Link zum Buch
www.leuphana.de/matheomnibus       www.doerte-haftendorn.de
http://haftendorn.uni-lueneburg.de     http://www.mathematik-sehen-und-verstehen.de