Thanks to Ben Bourgeois
MAT 360 pg 77 #1; pg 80 #1; pg 88, #2, 4, 7, 8

Pg 77 #1

Plot[{Tan[x],Tanh[x]}, {x, -3Pi, 3Pi}, Ticks->{{-5Pi/2,-2Pi,-3 Pi/2,-Pi,-Pi/2,0,Pi/2,Pi,3 Pi/2,2 Pi,5 Pi/2},{-1,1}},PlotLegends->"Expressions"]
f[x_]:= Tan[x]-Tanh[x]
Plot[f[x], {x,-3Pi, 3Pi},Ticks->{{-5Pi/2,-2Pi,-3 Pi/2,-Pi,-Pi/2,0,Pi/2,Pi,3 Pi/2,2 Pi,5 Pi/2},{-1,1}}]

For the nth root, use the interval [n*pi, n*pi+pi/4]

Options[Bisection]={maxits->100,epsilon->0} ;
Bisection[f_,a0_,b0_,OptionsPattern[]] :=
Module[{i=1,its=OptionValue[maxits],eps=OptionValue[epsilon]},
If[Abs[f[a0]]≤eps, Print["Root at endpoint a."];Return[Transpose[{{a0,a0,b0,0}}]]];
If[Abs[f[b0]]≤eps, Print["Root at endpoint b."];Return[Transpose[{{a0,b0,b0,0}}]]];
a=N[a0]; (* Slight change -- use a local variable (so as not to alter passed arguments *)
b=N[b0];
fa = f[a];  
fb = f[b];  
If[fa*fb>=0,Print["Error: function value doesn't change sign."];Return[Transpose[{{a0,a0,b0,0}}]]];
width=b-a;
slope=(fb-fa)/width;
c = a+0.5*width; 
fc=f[c]; (* Slight change -- moved first evaluation of fc above the while, immediately after c is defined.*)
output={{a,c,b,fc,slope}}; (* Let's collect the output, since we've gone to the trouble of computing it. *)
If[Abs[fc]≤eps, Print["Root at c."];Printout[output,a,b,c,fc,slope];Return[Transpose[{{a,c,b,fc}}]]];While[a < c && c<b  && i<its,
If[ Sign[fa] ==  Sign[fc], 
a = c;fa=fc, 
b = c;fb=fc
];
width=b-a;
slope =(fb-fa)/width;
i=i+1;
c = a+0.5*width;
fc=f[c];
If[Abs[fc]≤eps, Print["Root at c."];Printout[output,a,b,c,fc,slope];Return[Transpose[{{a,c,b,fc}}]]];
output=Append[output,{a,c,b,fc,slope}]; (* once again, collect output. *)
]; 
(* Now let's augment the naive function to include printing some nice formatted output: *)
Printout[output,a,b,c,fc,slope];
Return[Transpose[output]]; (* Now I'll actually return the output, so that it can be plotted, etc. *)
]

results=Bisection[f,4.0*Pi,4.0*Pi+Pi/4.0]
results=Bisection[f,3.0*Pi,3.0*Pi+Pi/4.0]
results=Bisection[f,30.0*Pi,30.0*Pi+Pi/4.0];
f[30.0*Pi]
f[30.0*Pi+Pi/4.0]

Page 88

#2

Clear[x,g, newtons, xK]
g[x_]:=x^2-x-1
Solve[g[x]==0,x] (*only care about the positive root*)
gR = 1/2 *(1+(Sqrt[5]))
N[gR]
eps = 10^-3
newtons[x_]:= x - ((g[x])/(g'[x]))
xK = 1 (* store the next x value *)
Print["Notice the succession of Fibonacci numbers in these ratios:"];
While[Abs[xK - gR] ≥ eps,
xK = newtons[xK];
Print[xK,": approximately ", N[xK]];
xK
]
N[xK]

#4

Clear[x,g, newtons, xK]
a=5
g[x_]:=1/x^2-1/a
Plot[g[x],{x,-a,a}]
newtons[x_]:= x - ((g[x])/(g'[x]))
Plot[{x,newtons[x]},{x,-a,a}]
xK=Sqrt[2.999*a]
gR=Sqrt[a]
i=0;
While[Abs[xK - gR] ≥ eps && i<100,
xK = newtons[xK];
i=i+1;
Print[xK];
xK
]
N[xK]

#7

Clear[x,g, newtons, xK]
g[x_]:= Tan[x]-Tanh[x]
newtons[x_]:= x - ((g[x])/(g'[x]))
Plot[g[x], {x,-3Pi, 3Pi},Ticks->{{-5Pi/2,-2Pi,-3 Pi/2,-Pi,-Pi/2,0,Pi/2,Pi,3 Pi/2,2 Pi,5 Pi/2},{-1,1}}]
(* A good x0 to start with would π/4+mπ 
where m is the (m^th)positive root that we are looking for. *)
n=5
xK=N[n*Pi+Pi/4]*1.01
i=0;
While[ i<10,
xK = newtons[xK];
i=i+1;
Print[xK];
xK
]
N[xK]

#8

Clear[x,g, newtons, xK]

g[x_]:= x-3+1/x

newtons[x_]:=x-((g[x])/(g'[x]))

oldxK = 0

(*Testing for one which fails*)

xK=1
xK0 = N[newtons[xK]]
xK1 = N[newtons[xK0]]
xK2 = N[newtons[xK1]]

(*Testing 0<xK<1*)

Clear[xK, xK0, xK1, xK2]
xK=0.4
xK0 = N[newtons[xK]]
xK1 = N[newtons[xK0]]
xK2 = N[newtons[xK1]]

(*Testing 1<xK<*)

Clear[xK, xK0, xK1, xK2]
xK=0.4
xK0 = N[newtons[xK]]
xK1 = N[newtons[xK0]]
xK2 = N[newtons[xK1]]

Clear[xK, xK0, xK1, xK2]
xK=10^100
xK0 = N[newtons[xK]]
xK1 = N[newtons[xK0]]
xK2 = N[newtons[xK1]]

While[Abs[xK - oldxK] ≥ eps,
oldxK = xK;
xK = newtons[xK];
]
N[xK]

Plot[g[x],{x,0,5}]