Exercise 2.3 Solutions

1.  (x^2) - (e^x)

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

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

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

3.  Sin[x]-2Cos[x]

Plot[Sin[x] - 2  Cos[x], {x, -2, 2}];

Bisection[Sin[x] - 2  Cos[x], 0, 2, 0.01, 
      10, {0, 2}, {-2, 2}]

FalsePosition[Sin[x] - 2  Cos[x], 0, 2, 0.01, 0.01, 
      10, {0, 2}, {-2, 2}]

5.  (((x - 2))^2)- Log[x]

Plot[(((x - 2))^2)-Log[x],{x, 0.5, 4.5}];

FalsePosition[(((x - 2))^2)-Log[x],1,2,0.01,0.01,10,{1, 2},{-1, 1}]

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

Mathematica Functions Used in this Notebook

\(\(Bisection[f0_, a0_, b0_, delta_, 
          digits_, {leftx_, rightx_}, {lowery_, uppery_}] := 
        Module[{a, b, c, Ya, Yb, Yc, f, k, cond, MaxIter, MethodDoesNotApply, 
            PerfectZero, RootInTolerance, tablelist, 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; 
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]]]; 
          If[Ya\ Yb > 0, cond = MethodDoesNotApply; 
            Print["Starting Points Don't Have Opposite Signs"]; 
            Break[];]; 
		While[cond == 0 && k < MaxIter, 
            c = \(a + b\)\/2; 
			Yc = f[c]; 
            tablelist = 
              Append[tablelist, {k, newa, c, newb, Yc}]; 
			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]; 
            Show[{gr1, gr2, gr3}, DisplayFunction -> $DisplayFunction]; 
            If[Yc == 0, a = c; b = c; cond = PerfectZero]; 
            If[Yb\ Yc > 0, b = c; newb = b; Yb = Yc, a = c; newa = c; 
              Ya = Yc]; 
			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", "mid", "right", "yval"}}]];
];\)\)

\(FalsePosition[f0_, a0_, b0_, delta_, epsilon_, 
        digits_, {leftx_, rightx_}, {lowery_, uppery_}] := 
      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}]; 
			 (*\(Print["c"\_k, " = ", 
                N[c, digits], ",   |dc| ≤ ", 
                N[dx, digits]];\)*) 
			If[Yc == 0, a = c; b = c; 
            cond = PerfectZero]; 
gr3 = 
            Show[Graphics[
                Map[{PointSize[0.02], Point[#]} &, {{newa, Ya}, {newb, 
                      Yb}}]], 
              DisplayFunction -> Identity]; 
gr4 = 
            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]; 
	
          gr2 = Show[
              Graphics[
                Map[{PointSize[0.03], RGBColor[1, 0, 0], Point[#]} &, {{c, 
                      0}}]], DisplayFunction -> Identity]; 
          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", "mid", "right", "yval"}}]]
]\)