Exercise 2.2 Solutions

3

(a)  (e^x) - 2 - x

Plot[(E^x) - 2 - x, {x, 0, 2}];

Bisection[(E^x) - 2 - x, 0, 2, 0.01, 
      10, {0, 2}, {-1, 3}]

FalsePosition[(E^x) - 2 - x, 0, 2, 0.01, 0.02, 
      10, {0, 2}, {-1, 4}]

(b)  Cos[x]+1-x

Plot[Cos[x] + 1 - x, {x, -1, 3}];

Bisection[Cos[x] + 1 - x, 1, 2, 0.01, 
      10, {0, 3}, {-3, 3}]

FalsePosition[Cos[x] + 1 - x, 1, 2, 0.01, 0.01, 
      10, {0, 3}, {-3, 3}]

(c)  Log[x]-5+x

Plot[Log[x] - 5 + x, {x, 0, 5}];

Bisection[Log[x] - 5 + x, 2, 4, 0.01, 
      10, {0, 4}, {-5, 2}]

FalsePosition[Log[x] - 5 + x, 2, 4, 0.01, 0.01, 
      10, {0, 4}, {-5, 2}]

(d)  (x^2) - 10  x + 23

Plot[(x^2) - 10  x + 23, {x, 0, 5}];

Bisection[(x^2) - 10  x + 23, 3, 5, 0.01, 
      10, {3, 5}, {-2, 2}]

FalsePosition[(x^2) - 10  x + 23, 3, 5, 0.01, 0.01, 
      10, {3, 5}, {-2, 2}]

5

FalsePosition[Cos[x] + 1 - x, 0.8, 1.6, 0.1, 0.1, 
      10, {0, 2}, {-2, 2}]

7

FalsePosition[(x^2) - 10  x + 23, 6, 6.8, 0.1, 0.1, 
      10, {5, 7}, {-2, 2}]

9

Bisection[1/(x - 2), 3. , 7. , 0.01, 2, {0, 10}, {-5, 5}, 
      0]

Bisection[1/(x - 2), 1. , 7. , 0.01, 5, {0, 10}, {-5, 5}, 
      0]

11

Floor[(Log[7 - 2] - Log[5 (10^(-9))])/Log[2]]

Table[{n, (7 - 2)/2^(n + 1) < 5 10^-9}, {n, 1, 
        30}]

Algorithms and Programs 3

\(\(Bisection[f0_, a0_, b0_, delta_, 
          digits_, {leftx_, rightx_}, {lowery_, uppery_}, graphicstoggle_] := 
        Module[{a, b, c, Ya, Yb, Yc, f, k, cond, MaxIter, MethodDoesNotApply, 
            PerfectZero, RootInTolerance, tablelist, newa, newb, deltax, gr1, 
            gr2, gr3}, 
		Set @@ {f[x_], f0}; 
		a = 
            N[a0, digits]; 
		b = N[b0, digits]; 
	
          newa = a; newb = b; 
	
          tablelist = {}; 
		k = 0; 
		Ya = f[a]; 
		Yb = 
            f[b]; 
		dx = b - a; 
		cond = 0; 
If[
            Ya*Yb > 0, cond = MethodDoesNotApply; 
            Print["Starting Points Don't Have Opposite Signs"]; 
            Break[];]; 
gr1\  = 
            Plot[f[x], {x, leftx, rightx}, 
              PlotRange -> {{leftx, rightx}, {lowery, uppery}}, 
              DisplayFunction -> Identity]; 
		MaxIter = 
            N[1 + Floor[\(Log[dx] - Log[delta]\)\/Log[2.0]]]; 
		While[
            cond == 0 && 
              k < MaxIter, 
		 (*If\ iteration\ count\ and\ dx\ are\ less\ than\ maximum\ continue*) 
		c = \(a + b\)\/2; 
			Yc = 
              f[c]; 

	 (*Add\ new\ point\ to\ list\ of\ points\ and\ display\ graphs*) 
	
            tablelist = 
              Append[tablelist, {k, newa, c, newb, Yc, 
                  deltax = Min[{Abs[newb - c], Abs[newa - c]}]}]; 
            gr2\  = Show[
                Graphics[
                  Map[{PointSize[0.03], RGBColor[1, 0, 0], Point[#]} &, {{c, 
                        0}}]], 
DisplayFunction -> 
                  Identity]; 
            gr3 = Show[
                Graphics[
                  Map[{PointSize[0.02], Point[#]} &, {{newa, 0}, {newb, 
                        0}}]], 
DisplayFunction -> 
                  Identity]; 
If[graphicstoggle == 1, 
              Show[{gr1, gr2, gr3}, 
                DisplayFunction -> $DisplayFunction]]; 
	
 (*\ 
              Check\ to\ see\ whether\ zero\ has\ been\ \(reached--\) 
                if\ so\ indicate\ a\ stop*) 
	
            If[Yc == 0, a = c; b = c; 
              cond = PerfectZero]; 

 (*\ 
              
              Check\ to\ see\ which\ point\ should\ be\ replaced\ by\ the\ new\ point\ and\ make\ the\ replacement*) 	
	
            If[Yb\ Yc > 0, b = c; newb = b; Yb = Yc, a = c; newa = c; 
              Ya = Yc]; 

 (*\ 
              Find\ the\ distance\ between\ endpoints\ a\ and\ b, \ 
              and\ increase\ iteration\ count\ by\ 1*) 
		\(dx = b - a; k = k + 1;\)]; 
	
          If[dx < delta && cond ≠ PerfectZero, 
            cond = RootInTolerance]; 
		Print["Sequence of Approximations for ", f[x]]; 
			Print[
            TableForm[tablelist, 
              TableHeadings -> {None, {"k", "left", "new midpoint", "right", "yval", "deltax"}}]];
];\)\)

\(FalsePosition[f0_, a0_, b0_, delta_, epsilon_, 
        digits_, {leftx_, rightx_}, {lowery_, uppery_}, graphicstoggle_:  1] := 
      Module[{a, b, c, Ya, Yb, Yc, f, k, cond, Iterating, RootInTolerance, 
          PerfectZero, MethodDoesNotApply, ptlist, nextpt, gr1, gr2, gr3, 
          gr4, gr5, gr6, gr7, newa, newb, 
          tablelist}, 
		Set @@ {f[x_], f0}; 
		a = 
          N[a0, digits]; 
		b = N[b0, digits]; 
		k = 0; newa = a; 
        newb = b; 
	
        tablelist = {}; 
		Ya = f[a]; 
		Yb = f[b]; 
		dx = 
          b - a; 
		cond = 0; 
		MaxIter = 
          100; 
		If[Ya\ Yb > 0, 
          cond = MethodDoesNotApply; 
          Print["Starting Points Don't Have Opposite Signs"]; 
          Break[];]; 
		gr1\  = 
          Plot[f[x], {x, leftx, rightx}, 
            PlotRange -> {{leftx, rightx}, {lowery, uppery}}, 
            DisplayFunction -> Identity]; 
		While[
          cond == 0 && 
            k < MaxIter, 
			dx = \(Yb\ \((b - a)\)\)\/\(Yb - Ya\); 
			c = b - dx; 
			Yc = f[c]; 
		tablelist = 
            Append[tablelist, {k, newa, c, newb, Yc, 
                Min[{Abs[newa - c], 
                    Abs[newb - 
                        c]}]}]; 
			 (*\(Print["c"\_k, " = ", 
                N[c, digits], ",   |dc| ≤ ", 
                N[dx, digits]];\)*) 
			If[Yc == 0, a = c; b = c; 
            cond = PerfectZero]; 
gr2 = 
            Show[Graphics[
                Map[{PointSize[0.02], Point[#]} &, {{newa, Ya}, {newb, 
                      Yb}}]], 
              DisplayFunction -> Identity]; 
gr3 = 
            Show[Graphics[Line[{{newa, Ya}, {newb, Yb}}]], 
              DisplayFunction -> Identity]; 
If[
            Yb\ Yc > 0, b = c; newb = b; Yb = Yc, a = c; newa = a; 
            Ya = Yc]; 
	
          gr4 = Show[
              Graphics[
                Map[{PointSize[0.03], RGBColor[1, 0, 0], Point[#]} &, {{c, 
                      0}}]], DisplayFunction -> Identity]; 
          If[graphicstoggle == 1, 
            Show[{gr1, gr2, gr3, gr4}, 
              DisplayFunction -> $DisplayFunction]]; 
If[Abs[dx] < delta && Abs[Yc] < epsilon, 
            cond = RootInTolerance]; k = k + 1;]; 
        If[cond == 0, 
          cond = Iterating]; 
		Print["Sequence of Approximations for ", f[x]]; 
Print[
          TableForm[tablelist, 
            TableHeadings -> {None, {"k", "left", "newpoint", "right", "yval", "deltax"}}]]
]\)