Given the following code:
s := NDSolve[{x''[t] == -x[t], x[0] == 1, x'[0] == 1}, x, {t, 0, 5 }]
Plot[Evaluate[{x[t]} /. s], {t, 0, 3}]
This plots the solution to the differential equation. How would I numerically solve for a zero of x[t] where t ranges between 0 and 3?
The original question was answered by #rcollyer. I am answering the question you posted in your first comment to rcollyer's answer:
But what if instead our s is "s := NDSolve[{x'[t]^2 == -x[t]^3 - x[t] + 1, x[0] == 0.5}, x, {t, 0, 5}]" Then the FindRoot function just gives back an error while the plot shows that there is a zero around 0.6 or so.
So:
s = NDSolve[{x'[t]^2 == -x[t]^3 - x[t] + 1, x[0] == 0.5},
x, {t, 0, 1}, Method -> "StiffnessSwitching"];
Plot[Evaluate[{x[t]} /. s], {t, 0, 1}]
FindRoot[x[t] /. s[[1]], {t, 0, 1}]
{t -> 0.60527}
Edit
Answering rcollyer's comment, the "second line" comes from the squared derivative, as in:
s = NDSolve[{x'[t]^2 == Sin[t], x[0] == 0.5}, x[t], {t, 0, Pi}];
Plot[Evaluate[{x[t]} /. s], {t, 0, Pi}]
Coming from:
DSolve[{x'[t]^2 == Sin[t]}, x[t], t]
(*
{{x[t] -> C[1] - 2 EllipticE[1/2 (Pi/2 - t), 2]},
{x[t] -> C[1] + 2 EllipticE[1/2 (Pi/2 - t), 2]}}
*)
FindRoot works
In[1]:= FindRoot[x[t] /. s, {t, 0, 3}]
Out[1]:= {t -> 2.35619}
Related
We're asking NDSolve to solve x'' + x == 0 to 20 digits, but when we compare to the true solution, we only see 9 correct digits. Are we not using NDSolve correctly?
Clear["Global`*"]
sol = NDSolve[{x'[t] == v[t], v'[t] == -x[t], x[0] == 1, v[0] == 0}, {x, v},
{t, 0, 100},
PrecisionGoal -> 20, AccuracyGoal -> 20, WorkingPrecision -> 40, MaxSteps -> 10^6];
Plot[(x[t] - Cos[t]) /. sol[[1]], {t, 0, 100}]
This is a very simple one-dimensional solid-phase heat conduction differential equation, here is my code:
a = NDSolve[{D[721.7013888888889` 0.009129691127380562` tes[t, x],
t] == 2.04988920646734`*^-6 D[tes[t, x], x, x],
tes[t, 0] == 298 + 200 t, tes[t, 0.01] == 298,
tes[0, x] == 298}, {tes[t, x]}, {t, 0, 0.005}, {x, 0, 0.01}]
Plot3D[tes[t, x] /. a, {t, 0, 0.005}, {x, 0, 0.01}, PlotRange -> All]
(Plot[(tes[t, x] /. a) /. t -> 0.0005, {x, 0, 0.01},
PlotRange -> All])
After you run it, you will see: the temperature (in the equation it's named as tes) is lower than 298! It's ridiculous, it's against the second law of thermodynamics…how does this error come out? How can I correct it?
I'll deal only with the numerical aspects of this. First, scale time and space so that your equation becomes $\partial_t f=\partial_{x,x}f$ in the dimensionless units. then, for instance,
a = NDSolve[{D[ tes[t, x], t] == D[tes[t, x], x, x],
tes[t, 0] \[Equal] 1,
tes[t, 1] \[Equal] 1,
tes[0, x] \[Equal] Cos[2 \[Pi]*x/2]^2},
tes[t, x],
{t, 0, 1},
{x, 0, 1}
]
Plot3D[tes[t, x] /. a, {t, 0, .2}, {x, 0, 1}, PlotRange -> All,
AxesLabel \[Rule] {"t", "x"}]
so heat just diffuses inwards (note I changed the boundary and initial conditions).
This problem has been solved here,
I should admit that I haven't catch the nature yet at the time I posted this question…
I ran into this problem when I try to solve a partial differential equation. Here is my code:
dd = NDSolve[{D[tes[t, x], t] ==D[tes[t, x], x, x] + Exp[-1/(tes[t, x])],
tes[t, 0] == 1, tes[t, -1] == 1, tes[0, x] == 1}, {tes[t, x]}, {t, 0, 5}, {x, -1, 0}]
f[t_, x_] = tes[t, x] /. dd
kkk = FunctionInterpolation[Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}], {t, 0, 0.05}]
kkg[t_] = Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}]
Plot[Evaluate[kkk[t]] - Evaluate[kkg[t]], {t, 0, 0.05}]
N[kkg[0.01] - kkk[0.01], 1]
It's strange that the deviation showed in the graph reaches up to more than 5*10^-7 around t=0.01, while it's only -3.88578*10^-16 when calculated by N[kkg[0.01] - kkk[0.01], 1], I wonder how this error comes out.
By the way, I feel it strange that the output of N[kkg[0.01] - kkk[0.01], 1] has so many decimal places, I've set the precision as 1, right?
Using Mathematica 7 the plot I get does not show a peak at 0.01:
Plot[kkk[t] - kkg[t], {t, 0, 0.05}, GridLines -> Automatic]
There is a peak at about 0.00754:
kkk[0.00754] - kkg[0.00754] // N
{6.50604*10^-7}
Regarding N, it does not change the precision of machine precision numbers as it does for exact or arbitrary precision ones:
N[{1.23456789, Pi, 1.23456789`50}, 2]
Precision /# %
{1.23457, 3.1, 1.2}
{MachinePrecision, 2., 2.}
Look at SetPrecision if you want to force (fake) a precision, and NumberForm if you want to print a number in a specific format.
When I numerically solving a ode with the following code, warnings named "evfrf" prompted.
I am wondering how to force variables of differential equations to be Real numbers
NDSolve[{y''[t] + .1 y'[t] + Sin[y[t]] == 0, y'[0] == 1,
y[0] == 0}, y, {t, 0, 20},
Method -> {"EventLocator", "Event" -> y[t],
"EventCondition" -> y'[t] > 0,
"EventAction" :> Print[t, ", ", y[t], ", ", y'[t]]}]
warning message:
NDSolve::evfrf:
The event function did not evaluate to a real number somewhere
between t = 1.5798366385128957` and t = 1.6426647495929725`,
preventing FindRoot from finding the root accurately. >>
Thanks :)
The error message seems to be caused by the "EventCondition" -> y'[t] >= 0 part only. I don't know what the problem is there, but given that you want to restrict events (y[t]==0) to passages going up (y'[t]>0), you can replace that part with "Direction" -> 1 which does the same.
Alternatively, you could simply switch off the message using Off[NDSolve::evfrf] as it doesn't seem to make a difference in the final result. The "Direction" -> 1 method yields the same events as the original one which generated the messages.
I don't think this is an issue of the answer genuinely being a complex number at those points.
The following does not give an error.
sol = NDSolve[{y''[t] + .1 y'[t] + Sin[y[t]] == 0, y'[0] == 1,
y[0] == 0}, y, {t, 0, 20}]
Plot[y[t] /. sol, {t, 0, 20}]
The issue is the attempt to find the zero in y'[t] and limitations in the implied root-finding process. I tried increasing the WorkingPrecision and the MaxSteps but it didn't remove the error.
sol = NDSolve[{y''[t] + .10`64 y'[t] + Sin[y[t]] == 0, y'[0] == 1,
y[0] == 0}, y, {t, 0, 20},
Method -> {"EventLocator", "Event" -> y[t],
"EventCondition" -> y'[t] >= 0,
"EventAction" :> Print[t, ", ", y[t], ", ", y'[t]]},
MaxSteps -> 10^9, MaxStepSize -> 0.0001, WorkingPrecision -> 32]
Unless you really care about the eighth or subsequent decimal place, I would suggest not worrying about this error.
Those more expert than me in numerical analysis might disagree, but I work in a field where we usually don't have any faith in the accuracy of any data past the first decimal place of a percentage change (third decimal place of a level).
is it important to use the EventLocator? is it possible to solve for y' and then apply FindRoot on it? something like:
ndsolveOptions = {MaxSteps -> Infinity, Method -> {"StiffnessSwitching",
Method ->{"ExplicitRungeKutta", Automatic}}, AccuracyGoal -> 10,PrecisionGoal -> 10};
sol = First#NDSolve[{y''[t] + .1 y'[t] + Sin[y[t]] == 0, y'[0] == 1, y[0] == 0},
{y[t], y'[t]}, {t, 0, 20}, Sequence#ndsolveOptions];
der = y'[t] /. sol;
Plot[der, {t, 1.2, 1.7}]
FindRoot[der, {t, 1.6}]
{t -> 1.614}
i'd like to have something like this
w[w1_] :=
NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0}, y, {x, 0, 30}]
this seems like it works better but i think i'm missing smtn
w := NDSolve[{y''[x] + y[x] == 2, y[0] == w1, y'[0] == 0},
y, {x, 0, 30}]
w2 = Table[y[x] /. w, {w1, 0.0, 1.0, 0.5}]
because when i try to make a table, it doesn't work:
Table[Evaluate[y[x] /. w2], {x, 10, 30, 10}]
i get an error:
ReplaceAll::reps: {<<1>>[x]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>
ps: is there a better place to ask questions like that? mathematica doesn't have supported forums and only has mathGroup e-mail list. it would be nice if stackoverflow would have more specific mathematica tags like simplify, ndsolve, plot manipulation
There are a lot of ways to do that. One is:
w[w1_] := NDSolve[{y''[x] + y[x] == 2,
y'[0] == 0}, y[0] == w1,
y[x], {x, 0, 30}];
Table[Table[{w1,x,y[x] /. w[w1]}, {w1, 0., 1.0, 0.5}]/. x -> u, {u, 10, 30, 10}]
Output:
{{{0., 10, {3.67814}}, {0.5, 10, {3.25861}}, {1.,10, {2.83907}}},
{{0., 20, {1.18384}}, {0.5, 20, {1.38788}}, {1.,20, {1.59192}}},
{{0., 30, {1.6915}}, {0.5, 30, {1.76862}}, {1.,30, {1.84575}}}}
I see you already chose an answer, but I want to toss this solution for families of linear equations up. Specifically, this is to model a slight variation on Lotka-Volterra.
(*Put everything in a module to scope x and y correctly.*)
Module[{x, y},
(*Build a function to wrap NDSolve, and pass it
the initial conditions and range.*)
soln[iCond_, tRange_, scenario_] :=
NDSolve[{
x'[t] == -scenario[[1]] x[t] + scenario[[2]] x[t]*y[t],
y'[t] == (scenario[[3]] - scenario[[4]]*y[t]) -
scenario[[5]] x[t]*y[t],
x[0] == iCond[[1]],
y[0] == iCond[[2]]
},
{x[t], y[t]},
{t, tRange[[1]], tRange[[2]]}
];
(*Build a plot generator*)
GeneratePlot[{iCond_, tRange_, scen_,
window_}] :=
(*Find a way to catch errors and perturb iCond*)
ParametricPlot[
Evaluate[{x[t], y[t]} /. soln[iCond, tRange, scen]],
{t, tRange[[1]], tRange[[2]]},
PlotRange -> window,
PlotStyle -> Thin, LabelStyle -> Medium
];
(*Call the plot generator with different starting conditions*)
graph[scenario_, tRange_, window_, points_] :=
{plots = {};
istep = (window[[1, 2]] - window[[1, 1]])/(points[[1]]+1);
jstep = (window[[2, 2]] - window[[2, 1]])/(points[[2]]+1);
Do[Do[
AppendTo[plots, {{i, j}, tRange, scenario, window}]
, {j, window[[2, 1]] + jstep, window[[2, 2]] - jstep, jstep}
], {i, window[[1, 1]] + istep, window[[1, 2]] - istep, istep}];
Map[GeneratePlot, plots]
}
]
]
We can then use Animate (or table, but animate is awesome)
tRange = {0, 4};
window = {{0, 8}, {0, 6}};
points = {5, 5}
Animate[Show[graph[{3, 1, 8, 2, 0.5},
{0, t}, window, points]], {t, 0.01, 5},
AnimationRunning -> False]