Stan Wagon's Mathematica in Action (second edition; I haven't read the third edition and I'm hoping to eventually see it), demonstrates a nifty function called FindAllCrossings2D[]. What the function basically does is to augment FindRoot[] by using ContourPlot[] to find crossings that FindRoot[] can subsequently polish. Here, Wagon uses the function to assist in solving one of the questions of the SIAM hundred-digit challenge.
ContourPlot[] changed quite a bit starting from version 6 (e.g., it now outputs GraphicsComplex[] objects), and FilterRules[] has superseded the old standby FilterOptions[] With these in mind, I set out to update FindAllCrossings2D[]:
Options[FindAllCrossings2D] = Sort[Join[Options[FindRoot], {MaxRecursion -> Automatic, PerformanceGoal :> $PerformanceGoal, PlotPoints -> Automatic}]]; FindAllCrossings2D[funcs_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, opts___] := Module[{contourData, seeds, tt, fy = Compile[{x, y}, Evaluate[funcs[[2]]]]}, contourData = Map[First, Cases[ Normal[ ContourPlot[funcs[[1]], {x, xmin, xmax}, {y, ymin, ymax}, Contours -> {0}, ContourShading -> False, PlotRange -> {Full, Full, Automatic}, Evaluate[ Sequence @@ FilterRules[Join[{opts}, Options[FindAllCrossings2D]], DeleteCases[Options[ContourPlot], Method -> _]]] ]], _Line, Infinity]]; seeds = Flatten[Map[#[[ 1 + Flatten[Position[Rest[tt = Sign[Apply[fy, #, 2]]] Most[tt], -1]] ]] &, contourData], 1]; If[seeds == {}, seeds, Select[ Union[Map[{x, y} /. FindRoot[{funcs[[1]] == 0, funcs[[2]] == 0}, {x, #[[1]]}, {y, #[[2]]}, Evaluate[ Sequence @@ FilterRules[Join[{opts}, Options[FindAllCrossings2D]], Options[FindRoot]]]] &, seeds]], (xmin < #[[1]] < xmax && ymin < #[[2]] < ymax) &]]] The function works splendidly, it seems. I tried out the same example Wagon used in his book:
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 = FindAllCrossings2D[{f[x, y], g[x, y]}, {x, -7/2, 4}, {y, -9/5, 21/5}, Method -> {"Newton", "StepControl" -> "LineSearch"}, PlotPoints -> 85, WorkingPrecision -> 20] // Chop; ContourPlot[{f[x, y], g[x, y]}, {x, -7/2, 4}, {y, -9/5, 21/5}, Contours -> {0}, ContourShading -> False, Epilog -> {AbsolutePointSize[6], Red, Point /@ pts}] ![FindAllCrossings2D[] example](https://i.sstatic.net/nQvwL.png)
Whew, that preamble was quite long. Here's my question, then:
Are there "neater" (for some definition of "neater") ways to update/reimplement
FindAllCrossings2D[]than my attempt?










ContourPlot[]approach is that one can exploit theRegionFunctionoption if one is only interested in roots within a given region. $\endgroup$ContourPlot[]- seems very short. $\endgroup$