Numerisk ekvationslösning

Exempel 2: Intervallhalveringsmetoden

Remove["Global`*"]
f[x_]:=Exp[-x]-x
(* f(x) är strängt avtagande och har max ett nollställe *)
Plot[f[x],{x,0,1}]

Remove["Global`*"]
f[x_]:=Exp[-x]-x;
{a,b}={0.55,0.6};
epsilon=0.001;
While[b-a>epsilon,
c=0.5*(a+b);
Print[{a,c,b}];
If[f[a]*f[c]<0,b=c,a=c]
]
(* Kontroll med NSolve *)
NSolve[f[x]==0,x]

Exempel 3: Newton - Raphsons metod

Remove["Global`*"]
f[x_]:=Exp[-x]-x;
epsilon=0.000001;
diff=1;
xold=0.2;
While[diff>epsilon,
xnew=xold-f[xold]/f'[xold];
diff=Abs[xnew-xold];
Print[{xnew,diff}];
xold=xnew;
]
(* Kontroll med NSolve *)
NSolve[f[x]==0,x]

Exempel 4: Sekantmetoden

Remove["Global`*"]
f[x_]:=Exp[-x]-x;
epsilon=0.000001;
diff=1;
xold=0.2;
xolder=0.1;
While[diff>epsilon,
xnew=xold-f[xold]*(xold-xolder)/(f[xold]-f[xolder]);
diff=Abs[xnew-xold];
Print[{xnew,diff}];
xolder=xold;
xold=xnew;
]
(* Kontroll med NSolve *)
NSolve[f[x]==0,x]

Exempel 5: Fixpunktsiteration

Remove["Global`*"]
f[x_]:=x^3-4x^2+4x+1;
g[1][x_]:=(1/4)*(-x^3+4x^2-1);
g[2][x_]:=-1/(x^2-4x+4);
g[3][x_]:=-(1/2)*Sqrt[x^3+4x+1];
epsilon=0.000001;
diff=1;
For[i=1,i≤3,i++,
xold[i]=-0.2;
k=1;
While[diff>epsilon&&k<30,
xnew[i]=g[i][xold[i]];
diff=Abs[xnew[i]-xold[i]];
xold[i]=xnew[i];
++k
];
diff=1;
]
Print["g[1] = ",g[1][xnew[1]],", g[2] = ",g[2][xnew[2]],", g[3] = ",g[3][xnew[3]]]
(* Kontroll med NSolve *)
NSolve[f[x]==0,x]

Remove["Global`*"]
list={{"k","g1","g2","g3"}};
f[x_]=x^3-4x^2+4x+1;g[x_]={(1/4)*(-x^3+4x^2-1),-1/(x^2-4x+4),-(1/2)*Sqrt[x^3+4x+1]};
kmax=10;
xold=Table[-0.2,{i,1,3}];
For[k=1,k<=kmax,++k,
For[i=1,i≤3,i++,
xnew[i]=g[xold[[i]]][[i]];
xold[[i]]=xnew[i];
];
AppendTo[list,Flatten[{k,Table[DecimalForm[g[xnew[j]][[j]],
DefaultPrintPrecision->10],{j,1,3}]}]]
]
Grid[list,Frame->All]
Print["NSolve: ",NSolve[f[x]==0,x][[1]]]

Remove["Global`*"]
{xmin,xmax}={-0.21,-0.2};g[x_]={(1/4)*(-x^3+4x^2-1),-1/(x^2-4x+4),-(1/2)*Sqrt[x^3+4x+1]};
Do[Print["g",i,"'(x) = ",g'[x][[i]]],{i,1,3}];
Plot[Evaluate[Table[Abs[g'[x][[i]]],{i,1,3}]],{x,xmin,xmax},PlotLegends->{"g1","g2","g3"}]
Grid[Table[{
FindMinimum[{Abs[g'[x][[i]]],xmin≤x≤xmax},{x,xmin}],FindMaximum[{Abs[g'[x][[i]]],xmin≤x≤xmax},{x,xmin}]
},{i,1,3}],Frame->All]