Root plotting function from Paul Wellin's book?

Questions
,
1

In An introduction to programming with Mathematica by Paul R. Wellin, Richard J. Gaylord, Samuel N. Kamin, there is a section in page 279 that about root finding with this code:

RootPlot[fun_, {x_, xmin_, xmax_}] := 
 Module[{z, fplot, pts, spts, roots, points, 
   f = Function[{x, Evaluate[fun]}]}, 
  fplot = Plot [f [x], {x, xmin, xmax}, DisplayFunction -> Identity]; 
  pts = Cases[fplot, Line[{ z__ }] -> z, Infinity]; 
  spts = Map[First, 
    Select[Split[pts, Sign[Last[# 2]] == -Sign[Last[# 1]] &], 
     Length[# 1] == 2 &], {2}]; 
  roots = Map[FindRoot[f[x] == 0, {x, # [[ 1]], # [[2]]}] &, spts]; 
  points = Map[Point[{#, 0}] &, x /. roots]; 
  Show[fplot, DisplayFunction -> $DisplayFunction, 
   Epilog -> {RGBColor[ 0, 0, 1], PointSize[.02], points}]; roots]

Actually when i made an effort to test this code for Sin[2x] something happened wrong! Please check it out and tell what is mistake!?

2

There must not be a space between # and the numbers 1 or 2. Then the plot code should be updated from the version 5 style:

RootPlot[fun_, {x_, xmin_, xmax_}] :=
 
 Module[{z, fplot, pts, roots, spts, points,
   f = Function @@ {x, fun}},
  fplot = Plot[fun, {x, xmin, xmax}];
  pts = Cases[fplot, Line[{z__}] -> z, All];
  spts = Map[First, 
    Select[Split[pts, Sign[Last[#2]] == -Sign[Last[#1]] &], 
     Length[#1] == 2 &], {2}];
  roots = Map[FindRoot[f[x] == 0, {x, #[[1]], #[[2]]}] &, spts];
  points = Map[Point[{#, 0}] &, x /. roots];
  Print@Show[fplot, 
    Epilog -> {Blue, PointSize[.02], points}];
  roots]

It works for me now:

RootPlot[Sin[2 x], {x, 0, 3 Pi}]

ScreenShot2016-11-09at12.04.37PM.png
ScreenShot2016-11-09at12.04.37PM.png600×280 32.1 KB

3

Great!..thanks. This method can be very useful to solve Transcendental equations.

4

After clearing this algorithm, now there is one question: How can we rewrite this algorithm for Contour plot with two variables?

5

Not sure if this is really relevant, but you should look this up. Sharing my solution:

FindCrossings2D[{f_, g_}, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}] := 
  {x, y} /. (FindRoot[{f[x, y] == 0, g[x, y] == 0}, {{x, #[[1]]}, 
  {y, #[[2]]}}] & /@ (ContourPlot[{f[x, y] == 0, g[x, y] == 0}, 
  {x, xmin, xmax}, {y, ymin, ymax}][[1, 1]]))

f[x_, y_] := -Cos[y] + 2 y Cos[y^2] Cos[2 x];
g[x_, y_] := -Sin[x] + 2 Sin[y^2] Sin[2 x];

pts = FindCrossings2D[{f, g}, {x, -7/2, 4}, {y, -9/5, 21/5}];

ContourPlot[{f[x, y] == 0, g[x, y] == 0}, {x, -7/2, 4}, {y, -9/5, 21/5},
 Epilog -> {AbsolutePointSize[6], Red, Point /@ pts}]

Untitled-7.png
Untitled-7.png360×361 32.5 KB

6

Vitaliy, you are right but here FindCrossing2D will take two equations,f and g, and return all the simultaneous solutions (only
the crossings!). My question was about when we have only one function such as f(x,y)!! can we put zero instead of g(x,y)?