Extend FindRoot
- To: mathgroup at smc.vnet.net
- Subject: [mg71299] Extend FindRoot
- From: "dimitris" <dimmechan at yahoo.com>
- Date: Tue, 14 Nov 2006 05:06:13 -0500 (EST)
Consider the following approaches to define a function that will extend FindRoot. Here is one based on the package IntervalRoots.m Needs["NumericalMath`IntervalRoots`"] IntervalBisection[Tan[x] - Cot[x], x, Interval[{-11, 11}], 0.1, MaxRecursion -> 10] List @@ % (FindRoot[Tan[x] - Cot[x], {x, #1[[1]], #1[[2]]}] & ) /@ % Chop[Tan[x] - Cot[x] /. %] Plot[Tan[x] - Cot[x], {x, -10, 10}, Epilog -> ({Red, PointSize[0.02], Point[{#1, 0}]} & ) /@ (x /. %%)] It works as someone can see. Here is another approach based on the points used by the Plot command. plot = Plot[Tan[x] - Cot[x], {x, -10, 10}, DisplayFunction -> Identity]; plotdata = Cases[plot, {(x_)?NumberQ, (y_)?NumberQ}, Infinity]; Mean /@ Extract[Partition[plotdata[[All,1]], 2, 1], Position[Apply[Times, Partition[plotdata[[All,2]], 2, 1], 1], x_ /; x <= 0]] (FindRoot[Tan[x] - Cot[x], {x, #1}] & ) /@ % Chop[Tan[x] - Cot[x] /. %] Plot[Tan[x] - Cot[x], {x, -10, 10}, Epilog -> ({Red, PointSize[0.02], Point[{#1, 0}]} & ) /@ (x /. %%)] And this works. Now consider the following approach which also is based on the points used by the Plot command. plot = Plot[Tan[x] - Cot[x], {x, -10, 10}, DisplayFunction -> Identity]; plotdata = Cases[plot, {(x_)?NumberQ, (y_)?NumberQ}, Infinity]; (FindRoot[Tan[x] - Cot[x], {x, #1[[1]], #1[[2]]}] & ) /@ Extract[Partition[plotdata[[All,1]], 2, 1], Position[Apply[Times, Partition[plotdata[[All,2]], 2, 1], 1], x_ /; x <= 0]] Chop[Tan[x] - Cot[x] /. %] Plot[Tan[x] - Cot[x], {x, -10, 10}, Epilog -> ({Red, PointSize[0.02], Point[{#1, 0}]} & ) /@ (x /. %%)] This approach fails (for the discontinuus Tan[x]-Cot[x]; for others that I have tried it succeeds) and consider as roots the points where the "buggy" vertical lines of the Plot command cross the horizontal line. I don't understand why this happens. My query becomes even bigger considered that even the following aproach don't give more successful results PlotDiscPer[f_, {x_, a_, b_, c_}, opts___] := Show[(Plot[f, {x, #1[[1]], #1[[2]]}, DisplayFunction -> Identity, opts] & ) /@ Partition[Range[a, b, c], 2, 1], DisplayFunction -> $DisplayFunction] plot = PlotDiscPer[Tan[x] - Cot[x], {x, -3*Pi, 3*Pi, Pi/2}, Axes -> False, Frame -> {True, True, False, False}] plotdata = Cases[plot, {(x_)?NumberQ, (y_)?NumberQ}, Infinity]; (FindRoot[Tan[x] - Cot[x], {x, #1[[1]], #1[[2]]}] & ) /@ Extract[Partition[plotdata[[All,1]], 2, 1], Position[Apply[Times, Partition[plotdata[[All,2]], 2, 1], 1], x_ /; x <= 0]] Chop[Tan[x] - Cot[x] /. %] Plot[Tan[x] - Cot[x], {x, -10, 10}, Epilog -> ({Red, PointSize[0.02], Point[{#1, 0}]} & ) /@ (x /. %%)] I will appreciate any kind of assistance. Regards Dimitris