Probleme mit Differentialgleichungen

Problemloser Fall

Remove["Global`*"]

DSolve[y'[x] == E^(3x+a)+1, y,x]

DSolve[y'[x] == 3y[x]-3x+1, y,x]

Plot[
        Evaluate[
          Table[(E^(3 x + a)) + x, {a, -20, 20, 
              1}]], {x, -3, 1.5}, 
        PlotRange -> {-1, 10}];

Kapazitätsproblem

(*  DSolve[(y'[x]-1)^3==27 (y[x]-x)^2,y,x]    *)

Numerisch problemlos

Remove["Global`*"]

solution=Evaluate[Table[NDSolve[{y'[x]-1==3 Re[ (y[x]-x)^2]^(1/3),y[1.]==a},y,{x,-3,3}],{a,-20,20}]];
solution[[1]];
tab=Table[
Re[y[x]]/.solution[[k]],{k,1,Length[solution]}
];
Plot[Evaluate[Union[{{x}},tab]],{x,-2,3},PlotRange->{-2,3},AspectRatio->Automatic];

Die Differentialgleichung y'[x] == 4/(x+y[x])^2

Remove["Global`*"]

Exakte Lösung

Integrate[z^2/(4 + z^2), z]

DSolve[y'[x] == 4/(x + y[x])^2, y, x]

Integrate[z^2/(4 + z^2), z]

Numerische Lösungskurven

Remove[x, y]

solution = 
      NDSolve[{y'[x] == 4/(x + y[x])^2, y[0] == 1}, 
        y, {x, 0, 10}]; 
    Plot[y[x] /. solution, {x, 0, 10}];

Remove[a, x, y]

solution = 
      Evaluate[Table[
          NDSolve[{y'[x] == 4/(x + y[x])^2, y[0] == a}, 
            y, {x, 0, 10}], {a, 0.2, 4, 0.2}]]

tab = 
      Table[y[x] /. solution[[k]], {k, 1, Length[solution]}]

Plot[Evaluate[Union[{{x}}, tab]], {x, 0, 10}, 
        PlotRange -> {-2, 10}, 
        AspectRatio -> Automatic];

Numerische Lösungskurven aus der exakten Lösung mit ImplicitPlot

Remove[x, y]

<< Graphics`ImplicitPlot`

ImplicitPlot[
        Evaluate[
          Table[y == c + 2  ArcTan[(x + y)/2], {c, -10, 10, 
              0.2}]], {x, -10, 10}, {y, -10, 10}];

Plot der Lösung einer Differentialgleichung in einem Schritt

Plot der exakten Lösung einer Differentialgleichung in einem Schritt

Remove["Global`*"];
solv = Flatten[DSolve[{3 v''[w] - 5 v'[w] + v[w]+ 2 w == 0, v[0]==-2,v[10]==5},v,w]];
v = v/.solv;
Print[Simplify[v[x]]];
Plot[v[y],{y,-1,10}];

Plot der numerischen Lösung einer Differentialgleichung in einem Schritt

Remove["Global`*"];
solution = 
      NDSolve[{3 v''[w] - 5 v'[w] + v[w] + 2 w == 0, 
          v[0] == -2, v[10] == 5}, v, {w, -1, 10}, 
        WorkingPrecision -> 24]; 
    Plot[v[w] /. solution, {w, -1, 10}];

Richtungsfeld

Richtungsfeld

Remove["Global`*"];
<< Graphics`PlotField`

g1=PlotVectorField[{1, x y^3},{x,-2,2,0.2},{y,-2,2,0.2},Epilog->{Hue[1],Line[{{-2,0},{2,0}}],Line[{{0,-2},{0,2}}]},AspectRatio->Automatic];

Exakte Lösung der Differentialgleichung

DSolve[y'[x] == x y[x]^3, y[x], x ]

Lösungskurven

g3=Plot[1/Sqrt[-x^2+4],{x,-2,2}];  (* Eine Lösungskurve *)

g3=ParametricPlot[Evaluate[Table[{x,1/Sqrt[-x^2-2 c]},{c,-3,-1}]],{x,-2,2},AspectRatio->Automatic,PlotRange->{-2,2}];

g4=ParametricPlot[Evaluate[Table[{x,-1/Sqrt[-x^2-2 c]},{c,-3,-1}]],{x,-2,2},AspectRatio->Automatic,PlotRange->{-2,2}];

DSolve[{y'[x] == x y[x]^3, y[1] == 1}, y[x], 
      x ]

DSolve[{y'[x]==x y[x]^3,y[1]==1},y,x ]

Isokline

u1[x_, c_] := 
        Re[PowerExpand[(c /x)^(1/3)]];
Print[u1[x, c]];
u[x_, c_] := 
        Abs[(c /x)]^(1/3) Sign[x c];
u[x, c]

g2 = 
        Plot[Evaluate[Table[u[x, c^3], {c, -5, 5, 0.3}]], {x, -2, 2}, 
          PlotRange -> {-2, 2}, 
          AspectRatio -> Automatic];

Show[g2, g1, g3, g4, 
        AspectRatio -> Automatic];

Plot der exakten Lösung der Differentialgleichung 3 v''[w] - 5 v'[w] + v[w]+ 2 w = 0 mit den Randbedingungen v[0] = -2 und v[10] = 5 in mehreren Schritten

Remove["Global`*"]

solv=DSolve[{3 v''[w] - 5 v'[w] + v[w]+ 2 w == 0, v[0]==-2,v[10]==5},v,w]//Flatten

v=v/.solv

v[x]//Simplify

pl3=Plot[v[m],{m,0,10}];

Weiteres Beispiel

Remove["Global`*"]

DSolve[{y''[x] - y'[x] +  y[x]  == E^(-x)}, 
        y[x], x ] // Simplify

DSolve[{y''[x] - y'[x] +  y[x]  == E^(-x), 
          y[0] == 0, y'[0] == 0}, y[x], x ] // 
      Simplify

solv=DSolve[{y''[x]-y'[x]+ y[x] ==E^(-x),y[0]==0,y'[0]==0},y,x ]//Simplify//Flatten

Wichtig: Am Schluss steht ....y,x ]//Simplify//Flatten und nicht ....y[x],x ]//Simplify//Flatten

y=y/.solv;
y[z]

y[1]

y[1]//N

pl=Plot[y[z],{z,0,10}];

Beispiele von Mathematica

Remove["Global`*"]

<< Graphics`ImplicitPlot`

DSolve[y''[x]==a y'[x]+y[x],y,x]

DSolve[{y''[x]==a y'[x]+y[x],y[0]==1,y'[0]==0},y,x]

DSolve[{y''[x]==a y'[x]+y[x],y[0]==1,y'[0]==0},y,x]

DSolve[(x^5) y'[x] + y[x]^2 - 4 (x^4) y[x] + (x^8) == 0, y, 
      x]

DSolve[
      x y'[x] == -y[x] + (3 - x) y[x]^2 + 3 x y[x]^3, y[x], 
      x]

DSolve[y'[
          x] == -(∂_x) f2[
                    x]/(3 f3[
                      x]) + ((f2[x] (f1[x] - ((2 f2[x]^2)/(9  f3[x]))))/(3 f3[x])) + f1[x] y[x] + 
          f2[x] y[x]^2 + f3[x] y[x]^3, y[x], x]

DSolve[{y'[
            x] == (((-1 + x))^(-1 + x)) (1 + 
                Log[-1 + x]), y[1] == 1}, y[x], x]

DSolve[y'[x] == y[(x/2)], y, x]

solution=NDSolve[{Derivative[3][y][x]+y''[x]+y'[x]==-y[x]^3,y[0] == 1,y'[0]==y''[0]==0},y,{x, 0, 20}];Plot[y[x] /. solution, {x, 0, 20}];

solution=NDSolve[{x'[t]==y[t],y'[t]==- .01 y[t] - Sin[x[t]],x[0] == 0,y[0] == 2.1},{x, y},{t, 0, 100}];ParametricPlot[
        Evaluate[{x[t], y[t]} /. solution], {t, 0, 100}];

solution=NDSolve[{x'[t]==-y[t] - z[t],x[0] == -0.04,y'[t]==x[t] +  .425 y[t],y[0] == -0.30,z'[t]==2 - z[t] (4 - x[t]),z[0] == 0.52},{x, y, z},{t, 0, 25},Method -> ExplicitRungeKutta];ParametricPlot3D[
        Evaluate[{x[t], y[t], z[t]} /. solution], {t, 0, 25}, 
        PlotPoints -> 1000, PlotRange -> All];

solution=NDSolve[{Derivative[3][y][x]-x y''[x]+6 y[x]==1 + 10 x - 13 (x^2) + (x^3),y[0] == 0,y[1] == -(5/6),y[4] == -(52/3)},y,{x, -1, 5},WorkingPrecision -> 24];Plot[y[x] /. solution, {x, -1, 5}];

solution=u/.First[NDSolve[{\(∂\_t u[x, 
                          t] == \(2\ ∂\_{x, 2}u[x, t]\)\/\(9\ \ π\^2\)\),u[x, 0] == 0,u[0, t] == Sin[t],Derivative[1, 0][u][1, t]==0},u,{x, 0, 1},{t, 0, 6 π}]];Plot3D[solution[x, t], {x, 0, 1}, {t, 0, 6 π}, 
        PlotRange -> All, PlotPoints -> 25];

Timing[sol=First[NDSolve[{(∂_(t, t))u[t, x, 
                        y] == (∂_(x, x))u[t, x, 
                          y] + (∂_(y, y))u[t, x, y] - 
                      Sin[u[t, x, y]],u[0, x, 
                      y] == (E^(-((x^2) + (y^2)))),Derivative[1, 0, 0][u][0, x, y]==0,u[t, -5, y] == u[t, 5, y],u[t, x, -5] == u[t, x, 5]},u,{t, 0, 4},{x, -5, 5},{y, -5, 5}]]]

Plot3D[Evaluate[u[4,x,y]/.sol],{x,-5,5},{y,-5,5}];

solution = 
      u /. First[
          NDSolve[{(∂_t) u[x, 
                    t] == -u[x, t] (∂_x) u[x, t], 
              u[x, 0] == Sin[2 π x], u[0, t] == u[1, t]}, {u}, {x, 0, 
              1}, {t, 0,  .5}]]; 
    Plot3D[solution[x, t], {x, 0, 1}, {t, 0,  .5}];

Differentialgleichung mit Differenzenmethode lösen

Remove["Global`*"]

Differenzenmethode

n=11

Transpose[{Table[y[k],{k,1,n-1}]}]//MatrixForm

Remove["Global`*"]

a=0; b=10;
n=11; h=(b-a)/n;
x[k_]:= a + k h;
y[0]=-2; y[n]=5;
y1[k_]:=(y[k]-y[k-1])/h;
y2[k_]:=(y1[k+1]-y1[k])/h;
gl[k_]:=(3 y2[k] - 5 y1[k] +y[k]+ 2 x[k]==0//Simplify);
gl[k]

ta1=Table[gl[k][[1]]-gl[k][[2]]==0,{k,1,n-1}]

ta1[[6]][[1]]

ta1[[1]][[1]]/.Table[y[k]->0,{k,1,n-1}]

ta1[[6]][[1]]/.Table[y[k]->0,{k,1,n-1}]

Coefficient[ta1[[1]][[1]],y[4]]

Coefficient[ta1[[1]][[1]],y[1]]

Evaluate[Coefficient[ta1[[1]][[1]],y[2]]]

lin[u_]:=Table[Coefficient[Evaluate[ta1[[u]][[1]]],y[k]],{k,1,n-1}]

lin[3]

mL=Table[lin[u],{u,1,n-1}]

z[u_]:=Evaluate[ta1[[u]][[1]]]/.Evaluate[Table[y[k]->0,{k,1,n-1}]]

mR=Table[z[u],{u,1,n-1}]

solv=Solve[ta1,Evaluate[Table[y[k],{k,1,n-1}]]]//Flatten

Table[y[k]=y[k]/.solv,{k,1,n-1}] //N

pt=Table[{x[k],y[k]},{k,0,n}]//N

pl1=ListPlot[pt,PlotStyle->PointSize[0.02]];

mL//MatrixForm

mR//MatrixForm

mL//MatrixForm

mR//MatrixForm

Differenzenmethode 2

Remove[a,b,n,h,x,k,y,gl,ta1,lin,mL,mR,z,solv,pt]

a=0; b=10;
n=40; h=(b-a)/n;
x[k_]:= a + k h;
y[0]=-2; y[n]=5;
y1[k_]:=(y[k]-y[k-1])/h;
y2[k_]:=(y1[k+1]-y1[k])/h;
gl[k_]:=(3 y2[k] - 5 y1[k] +y[k]+ 2 x[k]==0//Simplify);
gl[k]

q1[k_]:=(q[k]-q[k-1])/h; q2[k_]:=(q1[k+1]-q1[k])/h; q2[k]//Simplify

3 q2[k] - 5 q1[k] +q[k]+ 2 x[k] //Simplify

ta1=Table[gl[k][[1]]-gl[k][[2]]==0,{k,1,n-1}]

ta1[[6]][[1]]

ta1[[1]][[1]]/.Table[y[k]->0,{k,1,n-1}]

ta1[[6]][[1]]/.Table[y[k]->0,{k,1,n-1}]

Coefficient[ta1[[1]][[1]],y[4]]

Coefficient[ta1[[1]][[1]],y[1]]

Evaluate[Coefficient[ta1[[1]][[1]],y[2]]]

lin[u_]:=Table[Coefficient[Evaluate[ta1[[u]][[1]]],y[k]],{k,1,n-1}]

lin[3]

mL=Table[lin[u],{u,1,n-1}]

z[u_]:=Evaluate[ta1[[u]][[1]]]/.Evaluate[Table[y[k]->0,{k,1,n-1}]]

mR=Table[z[u],{u,1,n-1}]

solv=Solve[ta1,Evaluate[Table[y[k],{k,1,n-1}]]]//Flatten

Table[y[k]=y[k]/.solv,{k,1,n-1}] //N

pt=Table[{x[k],y[k]},{k,0,n}]//N

pl2=ListPlot[pt,PlotStyle->PointSize[0.015]];

Differenzenmethode mit Lösung

Remove[x]

s2=DSolve[{3 v''[w] - 5 v'[w] + v[w]+ 2 w == 0, v[0]==-2,v[10]==5},v,w]//Flatten

v=v/.s2

v[x]//Simplify

v[x]//N//Simplify

pl3=Plot[v[m],{m,0,10}];

Show[pl1,pl2,pl3];