HW#6 Muller’s Method
Joey Hastings

f[x_]:=Exp[x]-(1/(x^2));
Plot[f[x],{x,-3,3},PlotRange->Automatic]

x0 = 2;
x1 = 1.5;
x2 = 1;
N[{x2,f[x2]}]
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

{x2,f[x2]}
h0 = x0 - x2;
h1 = x1 - x2;
k0 = f[x0]-f[x2];
k1 = f[x1]-f[x2];
a=((h0*k1-h1*k0)/(h0*(h1^2)-(h0^2)*h1));
b = (((h1^2)*k0-(h0^2)*k1)/(h0*(h1^2)-(h0^2)*h1));
c = f[x2];
g[x_]:=a(((x-x2))^2)+b(x-x2)+c;
Plot[{f[x],g[x]},{x,-3,3},PlotRange->Automatic]
x3 = x2 - ((2*c)/(b+Sign[b]*(Sqrt[(b^2)-4*a*c])));
x0 = x1;
x1 = x2;
x2 = x3;

N[Solve[f[x]==0,x]]

Pretty good, I’d say! :)