MathGroup Archive 2006

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

Search the Archive

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


  • Prev by Date: Re: Re: Question about Reduce
  • Next by Date: Re: Function to solve polynomial
  • Previous by thread: GUIKit error on closing window
  • Next by thread: RE: FindUnknowns[ ] (Mathematica wish list)