Topic : Bisection Method - Roots of Equations
Simulation : Pitfall - Slow Convergence
Language : Mathmatica 4.1
Authors : Nathan Collier, Autar Kaw
Date : 11 July 2002
Abstract : This simulation illustrates the slow convergence of the bisection method of finding the root of an equation f[x] = 0.

INPUTS: Enter the Following

Function in f[x] = 0

f[x_] := x^2 - 1

Range of 'x' you want to see the function

(Subscript[x, b]) = -2;
(Subscript[x, e]) = 2;

curve = 
        Plot[f[x], {x, (Subscript[x, b]), (Subscript[x, e])}, 
          PlotLabel -> "Entered function on given interval", 
          TextStyle -> {FontSize -> 11}];

Lower initial guess

(Subscript[x, l]) = -1.25;

Upper initial guess

(Subscript[x, u]) = -0.5;

Maximum number of iterations

(Subscript[n, maximum]) = 30;

Counting from the left, enter the number of the root desired

numroot = 1;

SOLUTION

maxi = f[(Subscript[x, b])];
mini  =  f[(Subscript[x, b])];
step  =  ((Subscript[x, e]) - (Subscript[x, b]))/10;
Do[ If[f[i] >  maxi, maxi = f[i]]; 
        If[f[i] <  mini, mini = f[i]],  {i, (Subscript[x, b]), (Subscript[x, e]), 
          step}];
tot = maxi - mini;
mini = mini - 0.1*tot;
maxi  =  maxi  +  0.1*tot;

Check first if the lower and upper guesses bracket the root of the equation

f[(Subscript[x, l])]

f[(Subscript[x, u])]

%*%%

Show[Graphics[Line[{{(Subscript[x, u]), maxi}, {(Subscript[x, u]), mini}}]], curve, 
        Graphics[Line[{{(Subscript[x, l]), maxi}, {(Subscript[x, l]), mini}}]], Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses", TextStyle -> {FontSize -> 11}];

True Solution

This is the solution found by Mathematica

xactual = Root[f[x], numroot]

Value of root as a function of iterations

Here the bisection method algorithm is applied to generate the values of the roots, thrue error, absolute relative true error, approximate error, absolute relative approximate error, and the number of significant digits at least correct in the estimated root as a function of number of iterations.

Array[xr, (Subscript[n, maximum])];

For[i = 1; xu = (Subscript[x, u]); xl = (Subscript[x, l]), i <= (Subscript[n, maximum]), i++, 
      xr[i] = (xu + xl)/2; 
      If[f[xr[i]]*f[xu] ≤ 0, xl = xr[i], xu = xr[i]]]

Absolute true error

Array[Et, (Subscript[n, maximum])];

For[i = 1, i <= (Subscript[n, maximum]), i++, 
      Et[i] = Abs[xactual - xr[i]]]

Absolute relative true error

Array[ϵt, (Subscript[n, maximum])];

For[i = 1, 
      i <= (Subscript[n, maximum]), i++, ϵt[i] = 
        Abs[Et[i]/xactual*100]]

Absolute approximate error

Array[Ea, (Subscript[n, maximum])];

For[i = 1, i <= (Subscript[n, maximum]), i++, 
      If[i <= 1,  Ea[i] =  0, Ea[i] = Abs[xr[i] - xr[i - 1]]]]

Absolute relative approximate error

Array[ϵa, (Subscript[n, maximum])];

For[i = 1, i <= (Subscript[n, maximum]), i++, 
      If[i <= 1, ϵa[i] = 0, ϵa[i] = 
          Abs[Ea[i]/xr[i]*100]]]

Significant digits at least correct

Array[sigdig, (Subscript[n, maximum])];

For[i = 1, i <= (Subscript[n, maximum]), i++, 
      If[(ϵa[i] ≥ 5)  ||  (i <= 1), 
        sigdig[i] = 0, 
        sigdig[i] = 
          Floor[(2 - Log[10, Abs[ϵa[i]/0.5]])]]]

Graphs

xrplot = Table[xr[i], {i, 1, (Subscript[n, maximum])}];

ListPlot[xrplot,PlotJoined -> True, PlotRange -> All, AxesOrigin -> {1, Min[xrplot]}, PlotLabel -> "Estimated root as a function of number \
of iterations"];

Etplot = Table[Et[i], {i, 1, (Subscript[n, maximum])}];

ListPlot[Etplot,PlotJoined -> True, PlotRange -> All, AxesOrigin -> {1, Min[Etplot]}, PlotLabel -> "Absolute true error as a function of \
number of iterations"];

ϵtplot = 
        Table[ϵt[i], {i, 1, (Subscript[n, maximum])}];

ListPlot[ϵtplot,PlotJoined -> True, PlotRange -> All, AxesOrigin -> {1, Min[ϵtplot]}, PlotLabel -> "Absolute relative true error as a \
function of number of iterations"];

Eaplot = Table[Ea[i], {i, 1, (Subscript[n, maximum])}];

ListPlot[Eaplot,PlotJoined -> True, PlotRange -> All,AxesOrigin -> {1, Min[Eaplot]}, PlotLabel -> "Absolute approximate error as a function \
of number of iterations"];

ϵaplot = 
        Table[ϵa[i], {i, 1, (Subscript[n, maximum])}];

ListPlot[ϵaplot,PlotJoined -> True, PlotRange -> All, AxesOrigin -> {1, Min[ϵaplot]}, PlotLabel -> "Absolute relative approximate error as a \
function of number of iterations"];

sigdigplot = Table[sigdig[i], {i, 1, (Subscript[n, maximum])}];

<< Graphics`Graphics`

BarChart[sigdigplot];