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