Topic : Newton Raphson Method - Roots of Equations
Simulation : Pitfall - Oscillation around a maxima or minima
Language : Mathmatica 4.1
Authors : Nathan Collier, Autar Kaw
Date : 11 July 2002
Abstract : This simulation illustrates a pitfall of the Newton-Raphson method where one is getting oscilation around a local maxima or minima of a function.

INPUTS: Enter the Following

Function in f[x] = 0

f[x_] := x^2 + 2

Range of 'x' you want to see the function

(Subscript[x, begin]) = -3;
(Subscript[x, end]) = 3;

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

Initial guess

x0 = -1;

Maximum number of iterations

(Subscript[n, maximum]) = 100;

Because this method uses a line tangent to the function at the initial guess, we must calculate the derivative of the function to find the slope of the line at this point.  Here we will define the derivative of the function f(x) as g(x).

g[x_] := f'[x]

Iteration 1

x1 = x0 - f[x0]/g[x0]

(Subscript[ϵ, a]) = Abs[(x1 - x0)/x1*100]

tanline[x_] := 
      f[x0] + ((0 - f[x0])/(x1 - x0))*(x - x0)

tline = Plot[tanline[x], {x, (Subscript[x, begin]), (Subscript[x, end])}];

Show[Graphics[Line[{{x0, 1}, {x0, -1}}]], curve, 
        Graphics[Line[{{x1, 1}, {x1, -1}}]], tline, Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses and estimated root", 
        TextStyle -> {FontSize -> 11}];

Iteration 2

x2 = x1 - f[x1]/g[x1]

(Subscript[ϵ, a]) = Abs[(x2 - x1)/x2*100]

tanline[x_] := 
      f[x1] + ((0 - f[x1])/(x2 - x1))*(x - x1)

tline = Plot[tanline[x], {x, (Subscript[x, begin]), (Subscript[x, end])}];

Show[Graphics[Line[{{x1, 1}, {x1, -1}}]], curve, 
        Graphics[Line[{{x2, 1}, {x2, -1}}]], tline, Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses and estimated root", 
        TextStyle -> {FontSize -> 11}];

Iteration 3

x3 = x2 - f[x2]/g[x2]

(Subscript[ϵ, a]) = Abs[(x3 - x2)/x3*100]

tanline[x_] := 
      f[x2] + ((0 - f[x2])/(x3 - x2))*(x - x2)

tline = Plot[tanline[x], {x, (Subscript[x, begin]), (Subscript[x, end])}];

Show[Graphics[Line[{{x3, 1}, {x3, -1}}]], curve, 
        Graphics[Line[{{x2, 1}, {x2, -1}}]], tline, Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses and estimated root", 
        TextStyle -> {FontSize -> 11}];

Iteration 4

x4 = x3 - f[x3]/g[x3]

(Subscript[ϵ, a]) = Abs[(x4 - x3)/x4*100]

tanline[x_] := 
      f[x3] + ((0 - f[x3])/(x4 - x3))*(x - x3)

tline = Plot[tanline[x], {x, (Subscript[x, begin]), (Subscript[x, end])}];

Show[Graphics[Line[{{x3, 1}, {x3, -1}}]], curve, 
        Graphics[Line[{{x4, 1}, {x4, -1}}]], tline, Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses and estimated root", 
        TextStyle -> {FontSize -> 11}];

Iteration 5

x5 = x4 - f[x4]/g[x4]

(Subscript[ϵ, a]) = Abs[(x5 - x4)/x5*100]

tanline[x_] := 
      f[x4] + ((0 - f[x4])/(x5 - x4))*(x - x4)

tline = Plot[tanline[x], {x, (Subscript[x, begin]), (Subscript[x, end])}];

Show[Graphics[Line[{{x5, 1}, {x5, -1}}]], curve, 
        Graphics[Line[{{x4, 1}, {x4, -1}}]], tline, Axes -> True, 
        PlotLabel -> "Entered function on given interval with upper \
and lower guesses and estimated root", 
        TextStyle -> {FontSize -> 11}];

Summary

Value of root as a function of iterations

Here the Newton-Raphson 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.

Clear[xr];

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

For[i = 1; xr[0] = x0, i <= (Subscript[n, maximum]), i++, 
      xr[i] = xr[i - 1] - f[xr[i - 1]]/g[xr[i - 1]] // N]

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

Absolute relative approximate error

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

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

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

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