Eigensystem analysis in mathematica - wolfram-mathematica

The example for DEigensystem on the mathematica site is:
DEigensystem[{-Laplacian[u[x], {x}],DirichletCondition[u[x] == 0, True]}, u[x], {x, 0, \[Pi]}, 4]
This works perfectly. I want to modify this to find eigenvectors/values for a fourth order system: y''''=lambda*y with BC on y,y', so I use:
DEigensystem[{y''''[x], y[0] == 0, y'[0] == 0, y[1] == 0, y'[1] == 0},y[x], {x, 0, 1}, 4]
With the unhelpful return:
DEigensystem[{y^4[x], y[0] == 0, Derivative[1][y][0] == 0, y[1] == 0, Derivative[1][y][1] == 0}, y[x], {x, 0, 1}, 4]
This eigenproblem has a neat exact solution, so I wanted to see if Mathematica would find it. Any thoughts?

It looks like you're not passing in the equations in the correct format. If you read the "Details and Options" section in the documentation, you see:
"DEigensystem[eqns,u,t,{x,y,…}∈Ω,n]
gives the eigenvalues and eigenfunctions for solutions u of the time-dependent differential equations eqns."
and
"The equations eqns are specified as in DSolve."
Then, once you reference the DSolve documentation, you see that you need to specify the equations like this:
"DSolve[eqn,u,x] solves a differential equation for the function u, with independent variable x."
I'm assuming you want to solve the equation
y''''(x) = y(x)
with the initial conditions
y[0] = 0, y'[0] = 0, y[1] = 0, y'[1] = 0
so you might want to try
DEigensystem = [{y''''[x] == y[x], y[0] == 0, y'[0] == 0, y[1] == 0, y'[1] == 0}, y[x], {x, 0, 1}, 4]
Disclaimer: I don't have access to Mathematica, so all I can do is theorize on what the error is. Feel free to edit if you have a working solution.

Related

Mathematica equations returning true instead of solving ODE?

I want to solve a system of two ODEs using mathematica's DSolve function. Here is what I have written down:
DSolve[{x'[t] == 0.02*x - .00004*x*y, y'[t] == .0004*x*y - .04*y,
x[0] == 500, y[0] == 200}, {x[t], y[t]}, t]
But for some reason it just keeps telling me that the equations return true and I shouldn't have that in my syntax, and it won't solve it. Not sure why this is happening or how to fix it.
Prolbmes:
DSolve::dvnoarg: The function x appears with no arguments. >>
You should place x[t] instead of x in equations.
NIntegrate::nlim: K[1] = x[t] is not a valid limit of integration. >>
You should use numerical solution because there is problem with analytical.
Solution:
s = NDSolve[
{
x'[t] == 0.02*x[t] - .00004*x[t]*y[t],
y'[t] == .0004*x[t]*y[t] - .04*y[t],
x[0] == 500,
y[0] == 200
}, {x, y}, {t, 0, 100}]
Plot[{Evaluate[x[t] /. s], Evaluate[y[t] /. s]}, {t, 0, 100}]
Result:

How does this deviation come out after I use Evaluate and Plot in Mathematica?

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.

Solution of non-linear differential equation

I don't use Mathematica in general and I need it to compare with an other program. I want to solve a system of three differential and non linear equations. For this I use Dsolve. Everything goes wrong when I put the nonlinear term (exponential).
Here is my code:
equa = {x'[t] == z[t] - Exp[y[t]],
y'[t] == z[t] - y[t],
z'[t] == x[t] + y[t] - z[t],
x[0] == 0,
y[0] == 0,
z[0] == 0};
slt = DSolve[equa, {x, y, z}, t]
Plot[{x[t] /. slt}, {t, 0, 10}]
And the errors are like this :
DSolve::dsvar: 0.1 cannot be used as a variable.
ReplaceAll::reps:{Dsolve[<<1>>]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing
Does someone know why the exponential term makes troubles ?
Thanks
You may try
s = NDSolve[equa, {x, y, z}, {t, 0, 10}];
Plot[Evaluate[({x[t], y[t], z[t]} /. s)], {t, 0, 1}]

How to force variables of differential equations to be Real numbers. a question arising from the warning: "NDSolve::evfrf: "

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}

in mathematica, how to make initial condition as a variable in ndsolve?

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]

Resources