Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Plotting a series of Roots

• To: mathgroup at smc.vnet.net
• Subject: [mg128711] Re: Plotting a series of Roots
• From: Bob Hanlon <hanlonr357 at gmail.com>
• Date: Mon, 19 Nov 2012 04:09:37 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• Delivered-to: l-mathgroup@wolfram.com
• Delivered-to: mathgroup-newout@smc.vnet.net
• Delivered-to: mathgroup-newsend@smc.vnet.net
• References: <20121117084935.868E56AF3@smc.vnet.net>

Not clear what you are trying to accomplish. The following example
provides some approaches

s1[lambda_, t_] =
 x[t] /. DSolve[{x'[t] == lambda, x[0] == 0}, x[t], t][[1]]

lambda t


t1[lambda_, value_] = t /. Solve[s1[lambda, t] == value, t][[1]]

value/lambda


s1[lambda, t1[lambda, value]]

value


Manipulate[
 Module[
  {ti = 0,
   tf = 100,
   pt = {t1[lambda, value], value}},
  Plot[s1[lambda, t], {t, ti, tf},
   PlotRange -> {0, 0.7},
   Epilog -> {
     Text[
      {NumberForm[pt[[1]], {4, 1}],
       NumberForm[pt[[2]], {4, 2}]},
      pt, {1.5, -1.5}],
     LightGray,
     Line[{{ti, value}, pt}],
     Line[{
       {t1[lambda, value], 0}, pt}],
     Red,
     AbsolutePointSize[5],
     Point[pt]}]],
 {{value, 0.1}, 0, 0.7, 0.01,
  Appearance -> "Labeled"},
 {{lambda, 0.001}, 0.001, 0.007, 0.00025,
  Appearance -> "Labeled"}]


Bob Hanlon


On Sat, Nov 17, 2012 at 3:49 AM, William Duhe <wjduhe at loyno.edu> wrote:
> Bellow is a program that solves a diff eq, then finds a particular valued root for that eq. What I want to do is be able to plot how the root changes as a function of Lambda.
>
>
>
>
>
> m = Manipulate[Module[
>    {ti, tf, s1},
>    imgSize = 375;
>
>    ti = 0;(*initial time*)
>    tf = 100;(*final plot time*)
>
>
>    s1 = NDSolve[{x'[t] == lambda, x[0] == 0}, x, {t, ti, tf}][[1]];
>
>    t1 = FindRoot[x[t] == .1 /. s1, {t, tf}];
>
>    delta[lambda] :=
>     Module[{times, v, s = s1[lambda]},
>      times = Quiet[
>        Chop[FindRoot[x[t] == .1 /. s, {t, #}] & /@ {tf - 1, ti + 1}]];
>      v = Flatten[x[t] /. s /. times];
>      Subtract @@ v];
>    Plot[delta[lambda], {lambda, 0, .007}, Frame -> True,
>      Axes -> False,
>      FrameLabel -> {"lambda", "Change in value of root"},
>      ImageSize -> imgSize,
>      Epilog -> {Text[ToString[pt, TraditionalForm], pt, {-1.25, 1}],
>        Red, AbsolutePointSize[4], Point[pt]}]
>
>     Column[{Plot[Evaluate[{Tooltip[x[t] /. s1, "x[t]"]}], {t, ti, tf},
>         PlotRange -> Automatic, AxesLabel -> {"Time", "functions"},
>        ImageSize -> 350, Exclusions -> Automatic],
>       Row[{"x[t] = 1 when ",
>         t1 =
>          Quiet[Chop[
>            FindRoot[x[t] == .1 /. s1, {t, #}] & /@ {tf, ti}]]}],
>
>       "\n\n"}]], {{lambda, .001}, 0.001, 0.007,
>    Appearance -> "Labeled"}]
>

• References:
  • Plotting a series of Roots
    • From: William Duhe <wjduhe@loyno.edu>