Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: FindRoot s all

• To: mathgroup at smc.vnet.net
• Subject: [mg49446] Re: FindRoot s all
• From: drbob at bigfoot.com (Bobby R. Treat)
• Date: Tue, 20 Jul 2004 07:53:48 -0400 (EDT)
• References: <cddps2$pe9$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Here's a fairly general solution, based on something David Park did.
It uses Ted Ersek's RootSearch package at

http://library.wolfram.com/infocenter/MathSource/4482/

and David's DrawGraphics package at

http://home.earthlink.net/~djmp/

Needs["DrawGraphics`DrawingMaster`"]
Needs["Enhancements`RootSearch`"]
y[u_, c_] = c^u - u^c - 1;
plotSolutions[c_Integer, rawRange_List] :=
  Block[
    {rootColor = ColorMix[Cobalt, Black][0.3],
      functionColor = ColorMix[Red, Black][0.1],
      solutions, low, high, yLow, yHigh, increment, subDivisions
      },
    solutions = x /. RootSearch[y[x, c] == 0, {x, Sequence @@
rawRange}];
    {low, high} = Through[{Min, Max}@solutions];
    {low, high} = {11low - high, 11high - low}/10;
    If[low == high, {low, high} = rawRange];
    yLow = Floor@First@Minimize[{y[x, c], low ≤ x ≤ high},
{x}];
    yHigh = Ceiling@First@Maximize[{y[x, c], low ≤ x ≤
high}, {x}];
    increment = Max[4, Ceiling[(yHigh - yLow)/4]];
    subDivisions = If[# > 4, 1, #] &@FactorInteger[increment][[-1,
1]];
    Draw2D[
      {functionColor, Draw[y[x, c], {x, low, high}],
        rootColor, CirclePoint[{#, y[#, 
    c]}, 3, rootColor, Smoke] & /@ solutions
        },
      FrameTicks -> {
          CustomTicks[Identity, databased[solutions], CTNumberFunction
-> (
      StyleForm[NumberForm[#, {5, 3}, NumberPadding -> {
      "", "0"}], FontSize -> 11, FontColor -> rootColor,
                     FontFamily -> "Helvetica", FontWeight -> "Bold
                    "] &)], CustomTicks[Identity, {yLow, yHigh,
increment,
                    subDivisions}, CTNumberFunction -> (StyleForm[#,
FontSize \
-> 10] &)],
          None,
          None},
      GridLines -> {CustomGridLines[Identity, databased[solutions], {
            ColorMix[rootColor, White][0.7], AbsoluteDashing[{4}]}], \
CustomGridLines[Identity, databased[{0}], {ColorMix[rootColor,
White][0.7],
          AbsoluteDashing[{4}]}]},
      Frame -> True,
      PlotLabel -> StyleForm[SequenceForm[
        "Solutions of ", StyleForm[y[x, c] == 0], " on ", \
StyleForm[rawRange]]],
      Background -> Ghost,
      TextStyle -> {FontSize -> 11},
      PlotRange -> {11yLow - yHigh, 11yHigh - yLow}/10,
      ImageSize -> 450
      ]
    ]

plotSolutions[2, {-5, 5}];
plotSolutions[11, {-5, 5}];

Bobby

mathma18 at hotmail.com (Narasimham G.L.) wrote in message news:<cddps2$pe9$1 at smc.vnet.net>...
> y[u_,c_]=c^u-u^c-1 ;
> Plot[y[x,2],{x,-5,5}]; FindRoot[y[x,2]==0,{x,-5,5}];
> " Solution settles to a value outside the interval
> of roots of its derivative (humps and valleys),it may be 
> the problem of Newton-Raphson diverging tangets.How to
> capture all roots [in this case {x -> 0, 1}] ? It should be 
> valid for all c."
> TIA