Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

Topic: Subscript on plus expression
Replies: 16   Last Post: Dec 3, 2012 3:18 AM

 Messages: [ Previous | Next ]
 Bob Hanlon Posts: 906 Registered: 10/29/11
Re: Plotting a series of Roots
Posted: Nov 19, 2012 5:05 PM

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@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"}]
>

Date Subject Author
11/18/12 Nasser Abbasi