Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

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

Search the Archive

find roots

  • To: mathgroup at smc.vnet.net
  • Subject: [mg70940] find roots
  • From: "dimitris" <dimmechan at yahoo.com>
  • Date: Thu, 2 Nov 2006 06:47:39 -0500 (EST)

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?


  • Prev by Date: RE: Adding a key binding for a Style
  • Next by Date: Conceptual Issues with NonlinearRegress[]
  • Previous by thread: Re: Clarification re. Curiosity concerning transformation rules for List
  • Next by thread: Re: find roots