Exam 2 Key, Numerical Analysis

Problem 1:

Clear[x,a,f,g,h]
g[x_]=Normal[Series[f[x],{x,a,4}]]
g[a+h]
f[x_]:=Cos[x]
a=Pi/4
g[x]

h=Pi/4 
(* Error largest at endpoints, implies bound Cosine by 1: *)
Abs[(1/24) (h^4)]

Problem 2:

f[x_]:=Cos[x]
n=2;
xs={0,Pi/4,Pi/2};
b=Pi/2;
x0=xs[[1]];
x1=xs[[2]];
x2=xs[[3]];
p1=Plot[f[x],{x,0,Pi/2}];
p2=ListPlot[Table[{xs[[i]],f[xs[[i]]]},{i,1,n+1}],PlotMarkers->{Automatic,Medium}];
Show[p1,p2]

dividedDifference[list_]:=
Module[
{n=Length[list],b},
If[n==1,
b=list[[1]][[2]],
If[n==2 && list[[1]][[1]]==list[[2]][[1]],
b=list[[1]][[3]],
b=(dividedDifference[list[[2;;n]]]-dividedDifference[list[[1;;n-1]]])/
(list[[n]][[1]]-list[[1]][[1]])];
];
b
]
(* HermiteCoefs finds the four Hermite cubic coefficients to fit two points and the derivative of f at those points: *)
HermiteCoefs[f_,x1_,x2_]:=
Module[
{d21=x2-x1,y1=f[x1],y2=f[x2],y1p=f'[x1],y2p=f'[x2]},
dd=dividedDifference[{{x1,y1},{x2,y2}}];
{
y1,
y1p,
(dd-y1p)/d21,
(y1p+y2p-2*dd)/d21^2
}
]
HermiteCoefs[f,x0,x1]
HermiteCoefs[f,x1,x2]

(* HermiteCoefsList creates a list of the Hermite cubic coefficients for a set of abscissa: *)
HermiteCoefsList[f_,xs_]:=
Module[{n=Length[xs],i=1,result={}},
While[i<n,
result=Append[result,HermiteCoefs[f,xs[[i]],xs[[i+1]]]];
i=i+1;
];
result
]
coefs=HermiteCoefsList[f,xs]

(* HermitePoly is the Hermite cubic polynomial fitting two points,which evaluates at any value of x: *)
HermitePoly[x_,x1_,x2_,coefs_]:=
Module[{d21=x2-x1},
dx1=x-x1;
dx2=x-x2;
coefs[[1]]+dx1*(coefs[[2]]+dx1*(coefs[[3]]+dx2*coefs[[4]]))
]
Plot[{f[x],HermitePoly[x,x0,x1,HermiteCoefs[f,x0,x1]]},{x,x0,x1}]
Plot[f[x]-HermitePoly[x,x0,x1,HermiteCoefs[f,x0,x1]],{x,x0,x1}]

(* HermiteSpline is the Hermite cubic spline,which evaluates at any value of x: *)
HermiteSpline[x_,xs_,coefs_]:=
Module[{i=2,n=Length[xs]-1},
While[x>xs[[i]] && i≤n,
i=i+1
];
HermitePoly[x,xs[[i-1]],xs[[i]],coefs[[i-1]]]
]
Plot[{f[x],HermiteSpline[x,xs,coefs]},{x,x0,b}]
Plot[f[x]-HermiteSpline[x,xs,coefs],{x,x0,b}]

(* Error bound: middle, and the error will be largest on the first first spline: bound (Pi/8)^4*1/24 *)
(Pi/8)^4*1/24

Problem 3:

xs={0,2,4}
x1=xs[[1]];
x2=xs[[2]];
x3=xs[[3]];
ys={1,2,1};
y1=ys[[1]];
y2=ys[[2]];
y3=ys[[3]];
dividedDifference[{{0,1},{2,2}}]
dividedDifference[{{2,2},{4,1}}]
dividedDifference[{{0,1},{2,2},{4,1}}]

pN[x_]:=1+(x-0)(dividedDifference[{{0,1},{2,2}}]+(x-2)*dividedDifference[{{0,1},{2,2},{4,1}}])
pN[xs]
qL[x_]:=y1*(x-x2)(x-x3)/((x1-x2)(x1-x3))+
y2*(x-x1)(x-x3)/((x2-x1)(x2-x3))+
y3*(x-x1)(x-x2)/((x3-x1)(x3-x2))
qL[xs]
qSimple[x_]:=2-(x-2)^2/4
qSimple[xs]
qHorner[x_]:=1-(x-2-2+2)^2/4
g[x_]=Normal[Series[qSimple[x],{x,4,2}]]
g[xs]
Solve[qSimple[x]==0,x]

x0=1;
y0=1;
x1=2;
y1=2;
x2=4;
y2=1;
Plot[
{(* Newton: *)
1+(x-4)*(-1/2 + (x-2)*(-1/4)),
(* Lagrange: *)
1*(x-2)(x-4)/((0-2)(0-4))+2*(x-0)(x-4)/((2-0)(2-4))+1*(x-0)(x-2)/((4-0)(4-2)),
(* Simplest: *)
2-(x-2)^2/4,
(* Horner about 4: *)
1+(x-4)(-1-(x-4)/4)
},{x,-1,5}]
root=x/.Solve[2-(x-2)^2/4==0,x][[2]]
N[root]

Problem 4:

f[a]+h f'[a]+(1/2) (h^2) f''[a]+(1/6) (h^3) Derivative[3][f][a]+(1/24) (h^4) Derivative[4][f][a]

Problem 5:

Clear[x,f,g,h]
f[x_]:=3*(x^3-x^(1/3))
f'[x]
h[x_]:=3*(-(1/(3*x^(2/3))) + 3*x^2)
g[x_]:=h[Abs[x]]
g[2]
Plot[{f'[x],f[x]},{x,-2,2}]
f[x_]:=N[3*(x^3-Sign[x]Abs[x]^(1/3))]
Plot[f[x],{x,-2,2}]
f[-2]
Plot[f[x],{x,-.2,.2}]
f[-2]

NewtonMethod[x_]:=x-f[x]/g[x]
NewtonMethod[.001]
Limit[f''[x]/(2f'[x]),x->0]
Limit[NewtonMethod'[x],x->0]

Just play and you’ll find out what happens!

Clear[p,k]
p0=.001;
p[0]=N[p0];
Do[p[k]=N[NewtonMethod[p[k-1]]],{k,1,100}]
TableForm[Table[{k,p[k]},{k,0,11}]]