MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: find roots

  • To: mathgroup at smc.vnet.net
  • Subject: [mg71024] Re: find roots
  • From: ab_def at prontomail.com
  • Date: Mon, 6 Nov 2006 02:52:18 -0500 (EST)
  • References: <eicmq3$fn6$1@smc.vnet.net>

dimitris wrote:
> Consider the following code
>
> curveFindRoot[{f_, g_}, {x_, x0_, x1_}, {y_, y0_, y1_}, curve_,
> opts___] :=
>   Block[{contourdata, pos, seeds, gg},
>    contourdata = Cases[Graphics[ContourPlot[f, {x, x0, x1}, {y, y0,
> y1},
>         Contours -> {0}, ContourShading -> False, PlotPoints -> 50,
>         DisplayFunction -> Identity]], Line[a_] :> a, Infinity];
>     gg = Function[{x, y}, Evaluate[g]];
>     pos = Position[Partition[Apply[gg, contourdata[[curve]], {1}], 2,
> 1],
>       _?(Times @@ #1 < 0 & ), {1}]; seeds =
> contourdata[[1,Flatten[pos]]];
>     (FindRoot[{f == 0, g == 0}, {x, #1[[1]]}, {y, #1[[2]]}, opts] & )
> /@
>      seeds]
>
> Let's see if it works properly
>
> f[x_, y_] := x - y^2*Cos[y]
> g[x_, y_] := -y + x*Sin[x]
>
> sols = curveFindRoot[{f[x, y], g[x, y]}, {x, -10, 10}, {y, -10, 10}, 1]
> {{x -> -9.0853967973071, y -> 3.0245614583297393}, {x ->
> -6.700183681818852, y -> 2.7136941190359805},{x ->
> -6.36474234835293*^-23, y -> 0.}, {x -> -3.803951720532517, y ->
> -2.339349621541291}, {x -> -5.819369961493473, y ->
> -2.6033743973130083}, {x -> -9.750793769187966, y ->
> -3.1228989336700392}}
>
> Show[Block[{$DisplayFunction = Identity},
>     (ContourPlot[#1, {x, -10, 10}, {y, -10, 10}, Contours -> {0},
>        ContourShading -> False, PlotPoints -> 100] & ) /@
>      {f[x, y], g[x, y]}], Graphics[{Red, Circle[{x, y}, 0.32] /.
> sols}]];
>
> So, for the central curve the functions works properly.
>
> However
>
> comsols = Flatten[(curveFindRoot[{f[x, y], g[x, y]}, {x, -10, 10}, {y,
> -10, 10}, #1] & ) /@
>     Range[Length[Cases[Graphics[ContourPlot[f[x, y], {x, -10, 10}, {y,
> -10, 10}, Contours -> {0}, ContourShading -> False, PlotPoints -> 50,
> DisplayFunction -> Identity]], Line[a_] :> a, Infinity]]], 1]
>
> Show[Block[{$DisplayFunction = Identity}, (ContourPlot[#1, {x, -10,
> 10}, {y, -10, 10}, Contours -> {0}, ContourShading -> False, PlotPoints
> -> 100] & ) /@ {f[x, y], g[x, y]}],
> Graphics[{Red, Circle[{x, y}, 0.32] /. comsols}]];
>
> As it can be seen from the last plot the function don't give the
> desired results for the other curves.
> Do you have any ideas what went wrong and what can I do in order to fix
> the definition of the function?

You're using contourdata[[curve]] to find the sign changes, but then
you always extract the corresponding points from contourdata[[1]].
Change the code to seeds = contourdata[[curve, Flatten[pos]]].

Also you can pass two points to FindRoot to use the secant method:

seeds = contourdata[[curve, Flatten[pos]]];
seeds2 = contourdata[[curve, Flatten[pos] + 1]];
MapThread[FindRoot[{f, g}, Transpose@ {{x, y}, ##}]&, {seeds, seeds2}]

Maxim Rytin
m.r at inbox.ru


  • Prev by Date: Re: Two small problems compute OK, but not their sum.
  • Next by Date: Re: really simple question
  • Previous by thread: find roots
  • Next by thread: Conceptual Issues with NonlinearRegress[]