Exercise 2.1 Solutions

1

(a)

g[x_] := 1 - (x^2/4)

Plot[{x, g[x]}, {x, 0, 1}];

Abs[D[g[x], x]]

Plot[Abs[D[g[y], y]] /. y -> x, {x, 0, 1}, 
        AxesOrigin -> {0, 0}];

FixedPointIteration[1 - (x^2)/4, 0.3, 0.01, 30, 
      4, {0, 1}, {0, 1}]

Solve[1 - x^2/4 == x, x]

N[%]

(b)

g[x_] := (2^(-x))

Plot[{x, g[x]}, {x, 0, 1}];

Abs[D[g[x], x]]

Plot[Abs[D[g[y], y]] /. y -> x, {x, 0, 1}, 
        AxesOrigin -> {0, 0}];

FixedPointIteration[(2^(-x)), 0.3, 0.01, 30, 
      4, {0, 1}, {0, 1}]

Solve[(2^(-x)) == x, x]

N[ProductLog[Log[2]]/Log[2]]

(c)

g[x_] := 1/x

Plot[{x, g[x]}, {x, 0.5, 5.2}];

Abs[D[g[x], x]]

Plot[Abs[D[g[y], y]] /. y -> x, {x, 0.5, 5.2}, 
        AxesOrigin -> {0, 0}];

FixedPointIteration[1/x, 1.2, 0.01, 30, 4, {0, 6}, {0, 6}]

Solve[1/x == x, x]

2

(a)

g[x_] := -4 + 4  x - (1/2) x^2

Solve[g[x] == x, x]

(b)

FixedPointIteration[-4 + 4  x - (1/2) x^2, 1.9, 0.01, 3, 
      4, {0, 6}, {0, 6}]

(c)

FixedPointIteration[-4 + 4  x - (1/2) x^2, 3.8, 0.01, 3, 
      4, {0, 6}, {0, 6}]

3a

Clear[g]

g[x_] := (((6 + x))^(1/2))

Plot[{g[x], x}, {x, -6, 10}];

FixedPointIteration[(((6 + x))^(1/2)), 3.5, 0.01, 3, 
      4, {0, 6}, {0, 6}]

Solve[(((6 + x))^(1/2)) == x, x]

3c

Clear[g]

g[x_] := ((x^2)/3)

Plot[{g[x], x}, {x, 0, 6}];

FixedPointIteration[((x^2)/3), 3.5, 0.01, 8, 
      4, {0, 6}, {0, 6}]

Solve[((x^2)/3) == x, x]

4

Clear[g]

g[x_] := (x^2) + x - 4

Plot[{g[x], x}, {x, -5, 5}];

FixedPointIteration[g[x], 2.2, 0.01, 8, 
      4, {-6, 6}, {-6, 20}]

FixedPointIteration[g[x], -1.2, 0.01, 8, 
      4, {-6, 6}, {-6, 20}]

9

FixedPointIteration[0.5  x + 1.5, 4, 0.01, 8, 
      4, {0, 6}, {0, 6}]

Algorithms and Programs 1(b)

Plot[{Cos[Sin[x]], x}, {x, 0, 1}];

FixedPointIteration[Cos[Sin[x]], 0.4, 0.01, 8, 
      4, {0, 1}, {0, 1}]

Mathematica Functions Used in Solutions

Off[General::"spell1"];
Clear[FixedPointIteration, g0, X0, tolerance, max, x];
\(\(FixedPointIteration[g0_, X0_, tolerance_, max_, 
          digits_, {leftx_, rightx_}, {lowery_, uppery_}] := 
	
        Module[{g, k, x0, x1, relerr, plist, doubleplist, gr1, gr2, gr3, 
            gr4}, 
 (*Initial\ Values\ for\ Variables*) 
	
          Set @@ {g[x_], g0}; 
		x0 = 
            N[X0, digits]; 
	\ \ plist = {x0}; 
		k = 
            0; 
		err = 1. ; 
		relerr = 1; 
		small = 
            N[1\/10\^20, 
              digits]; 
Print[\*""Iterates (Subscript[p, k]),  "", "    Relative Error |Δp|"]; 
		Print["p"\_0, " = ", N[x0, digits]]; 
 (*Iteration*) 
		While[
            k < max && 
              tolerance ≤ 
                relerr, 
			Module[{}, 
				x1 = 
                g[x0]; 
				k = k + 1; 
				err = 
                Abs[x1 - x0]; 
				Print["p"\_k, " = ", 
                N[x1, digits], ",   |Δp| ≤ ", 
                N[err, digits]]; 
				relerr = \(2\ Abs[x1 - x0]\)\/\(Abs[x1] + small\); 
				x0 = x1; 
              plist = Append[plist, x1]]]; 
		p = 
            x0; 
		Print[" "]; 
 (*Collect\ approximations\ into\ a\ list\ to\ form\ points\ for\ graphing*) 
	
          doubleplist = 
            Flatten[Transpose[{plist, plist}]]; 
	
          pts = Transpose[{Drop[doubleplist, {Length[doubleplist]}], 
                Prepend[Drop[doubleplist, 2], 
                  0]}]; 
 (*Print\ Results*) 
		Print["The function is g[x] = ", g[x]]; 
          Print["Approximation to a fixed point of g[x] is:"]; 
          Print["  p  = ", N[p, digits]]; 
          Print["g[p] at the approximated fixed point= ", 
            N[g[p], digits]]; 
          Print["|Δp| ≤ ", 
            N[err, digits]]; 
 (*Graph\ Results*) 
	
          gr1\  = Plot[g[x], {x, leftx, rightx}, 
              PlotRange -> {{leftx, rightx}, {lowery, uppery}}, 
              PlotStyle -> RGBColor[1, 0, 0], 
              DisplayFunction -> Identity]; 
		gr2\  = 
            Plot[x, {x, leftx, rightx}, 
              PlotRange -> {{leftx, rightx}, {lowery, uppery}}, 
              PlotStyle -> RGBColor[0, 1, 0], 
              DisplayFunction -> Identity]; 
	
          gr3\  = ListPlot[pts, 
              PlotRange -> {{leftx, rightx}, {lowery, uppery}}, 
              PlotStyle -> {PointSize[0.01]}, 
              DisplayFunction -> Identity]; 
	
          gr4 = Show[Graphics[Line[pts]], 
              DisplayFunction -> Identity]; 
		Show[{gr1, gr2, gr3, 
              gr4}, DisplayFunction -> $DisplayFunction];];\)\)
On[General::"spell1"];