Related
I am very new to Mathematica, and I am trying to solve the following problem.
I have a cubic equation of the form Z = aZ^3 + bZ^2 + a + b. The first thing I want to do is to get a function that solves this analytically for Z and chooses the minimal positive root for that, as a function of a and b.
I thought that in order to get the root I could use:
Z = Solve[z == az^3 + bz^2 + a + b, z];
It seems like I am not quite getting the roots, as I would expect using the general cubic equation solution formula.
I want to integrate the minimal positive root of Z over a and b (again, preferably analytically) from 0 to 1 for a and for a to 1 for b.
I tried
Y = Integrate[Z, {a, 0, 1}, {b, a, 1}];
and that does not seem to give any formula or numerical value, but just returns an integral. (Notice I am not even sure how to pick the minimal positive root, but I am playing around with Mathematica to try to figure it out.)
Any ideas on how to do this?
Spaces between a or b and z are important. You can get the roots by:
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z]
However, are you sure this expression has a solution as you expect? For a=0.5 and b=0.5, the only real root is negative.
sol /. {a->0.5, b->0.5}
{-2.26953,0.634765-0.691601 I,0.634765+0.691601 I}
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z];
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ sol /. {a -> a0, b -> b0} ,
Element[#, Reals] && # > 0 & ]]
This returns -infinty when there are no solutions. As sirintinga noted your example integration limits are not valid..
RegionPlot[NumericQ[zz[a, b] ] , {a, -1, .5}, {b, -.5, 1}]
but you can numerically integrate if you have a valid region..
NIntegrate[zz[a, b], {a, -.5, -.2}, {b, .8, .9}] ->> 0.0370076
Edit ---
there is a bug above Select in Reals is throwin away real solutions with an infinitesimal complex part.. fix as:..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ Chop[ sol /. {a -> a0, b -> b0} ],
Element[#, Reals] && # > 0 & ]]
Edit2, a cleaner approach if you dont find Chop satisfyting..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Module[{z, a, b},
Min[z /. Solve[
Reduce[(z > 0 && z == a z^3 + b z^2 + a + b /.
{ a -> a0, b -> b0}), {z}, Reals]]]]
RegionPlot[NumericQ[zz[a, b] ] , {a, -2, 2}, {b, -2, 2}]
NIntegrate[zz[a, b], {a, 0, .5}, {b, 0, .5 - a}] -> 0.0491321
I am fiddling around with Kramers-Kronig relations, and for that I need to use the Principal Value. I have the following notebook, where I take the dispersion disp and from that find the absorption using the Kramers-Kronig relation.
When I compare the resulting absorption to the analytical expression for the absorption, I see that the widths of are not the same after normalizing - which they should be. Is there a setting/parameter I am missing?
\[CapitalGamma] = 50 10^3;
disp[\[CapitalDelta]_] :=
1/\[Pi] \[CapitalDelta]/(\[CapitalDelta]^2 + (\[CapitalGamma]/(4 \
\[Pi]))^2/4);
abs[\[CapitalDelta]_] :=
1/\[Pi] (\[CapitalGamma]/(4 \[Pi]))/(\[CapitalDelta]^2 + (\
\[CapitalGamma]/(4 \[Pi]))^2);
absKK[\[CapitalDelta]_] := -NIntegrate[disp[x]/(
x - \[CapitalDelta]), {x, -Infinity, \[CapitalDelta], Infinity},
Method -> PrincipalValue, Exclusions -> Automatic,
MaxRecursion -> 100] // Quiet;
max = \[CapitalGamma];
step = 100;
absVals = {}; dispVals = {};
For[i = -step, i < step + 1, i++,
\[Delta] = max*i/step;
absVals = Append[absVals, {\[Delta], absKK[\[Delta]]}]];
Show[
ListLinePlot[absVals, PlotRange -> Full, PlotStyle -> {Red, Dashed}],
Plot[-6.5 abs[\[CapitalDelta]], {\[CapitalDelta], -\[CapitalGamma], \
\[CapitalGamma]}, PlotRange -> Full]]
I am not sure where you got your analytic expression for the absorption from but could it maybe be erroneous? If you replace \Delta with 2 \Delta the issue seems resolved
1/\[Pi] (\[CapitalGamma]/(4 \[Pi]))/((2 \[CapitalDelta])^2 + (\[CapitalGamma]/(4 \[Pi]))^2);
Does anyone know the Mathematica code that will trace the graph below?
Here is the equation for the graph, a second order linear differential equation with constant coefficients:
Here is the graph traced by this equation:
Quote from the book "Times Series Analysis and Forecasting By Example":
... where δ(t ) is an impulse (delta) function that, like a pea shot, at
time t = 0 forces the pendulum away from its equilibrium and a is the
size of the impact by the pea. It is easy to imagine that the curve
traced by this second order differential equation is a damped
sinusoidal function of time although, if the friction or viscosity is
sufficiently large, the (overdamped) pendulum may gradually come to
rest following an exponential curve without ever crossing the
centerline.
eq = m z''[t] + c z'[t] + k z[t] == a DiracDelta[t];
parms = {m -> 1, c -> .1, k -> 1, a -> 1};
sol = First#DSolve[{eq /. parms, z[0] == 1, z'[0] == 0}, z[t], t];
Plot[z[t] /. sol, {t, 0, 70}, PlotRange -> All, Frame -> True,
FrameLabel -> {{z[t], None}, {Row[{t, " (sec)"}], eq}},
GridLines -> Automatic]
Notice that, for zero initial conditions, another option is to use the Control system functions in Mathematica as follows
parms = {m -> 10, c -> 1.2, k -> 4.3, a -> 1};
tf = TransferFunctionModel[a/(m s^2 + c s + k) /. parms, s]
sol = OutputResponse[tf, DiracDelta[t], t];
Plot[sol, {t, 0, 60}, PlotRange -> All, Frame -> True,
FrameLabel -> {{z[t], None}, {Row[{t, " (sec)"}], eq}},
GridLines -> Automatic]
Update
Strictly speaking, the result of DSolve above is not what can be found by hand derivation of this problem. The correct solution should come out as follows
(see this also for reference)
The correct analytical solution is given by
which I derived for this problem and similar cases in here (first chapter).
Using the above solution, the correct response will look like this:
parms = {m -> 1, c -> .1, k -> 1, a -> 1};
w = Sqrt[k/m];
z = c/(2 m w);
wd = w Sqrt[1 - z^2];
analytical =
Exp[-z w t] (u0 Cos[wd t] + (v0 + (u0 z w))/wd Sin[wd t] +
a/(m wd) Sin[wd t]);
analytical /. parms /. {u0 -> 1, v0 -> 0}
(* E^(-0.05 t) (Cos[0.998749 t] + 1.05131 Sin[0.998749 t]) *)
Plotting it:
Plot[analytical /. parms /. {u0 -> 1, v0 -> 0}, {t, 0, 70},
PlotRange -> All, Frame -> True,
FrameLabel -> {{y[t], None}, {Row[{t, " (sec)"}],
"analytical solution"}}, GridLines -> Automatic, ImageSize -> 300]
If you compare the above plot with the first one shown above using DSolve you can see the difference near t=0.
I have a function, let's say for example,
D[x^2*Exp[x^2], {x, 6}] /. x -> 0
And I want to replace 6 by a general integer n,
Or cases like the following:
Limit[Limit[D[D[x /((-1 + x) (1 - y) (-1 + x + x y)), {x, 3}], {y, 5}], {x -> 0}], {y -> 0}]
And I want to replace 3 and 5 by a general integer m and n respectively.
How to solve these two kinds of problems in general in mma?
Many thanks.
Can use SeriesCoefficient, sometimes.
InputForm[n! * SeriesCoefficient[x^2*Exp[x^2], {x,0,n}]]
Out[21]//InputForm=
n!*Piecewise[{{Gamma[n/2]^(-1), Mod[n, 2] == 0 && n >= 2}}, 0]
InputForm[mncoeff = m!*n! *
SeriesCoefficient[x/((-1+x)*(1-y)*(-1+x+x*y)), {x,0,m}, {y,0,n}]]
Out[22]//InputForm=
m!*n!*Piecewise[{{-1 + Binomial[m, 1 + n]*Hypergeometric2F1[1, -1 - n, m - n,
-1], m >= 1 && n > -1}}, 0]
Good luck extracting limits for m, n integer, in this second case.
Daniel Lichtblau
Wolfram Research
No sure if this is what you want, but you may try:
D[x^2*Exp[x^2], {x, n}] /. n -> 4 /. x -> 0
Another way:
f[x0_, n_] := n! SeriesCoefficient[x^2*Exp[x^2], {x, x0, n}]
f[0,4]
24
And of course, in the same line, for your other question:
f[m_, n_] :=
Limit[Limit[
D[D[x/((-1 + x) (1 - y) (-1 + x + x y)), {x, m}], {y, n}], {x ->
0}], {y -> 0}]
These answers don't give you an explicit form for the derivatives, though.
Still early days with Mathematica so please forgive what is probably a very obvious question. I am trying to generate some parametric plots. I have:
ParametricPlot[{
(a + b) Cos[t] - h Cos[(a + b)/b t],
(a + b) Sin[t] - h Sin[(a + b)/b t]},
{t, 0, 2 \[Pi]}, PlotRange -> All] /. {a -> 2, b -> 1, h -> 1}
No joy: the replacement rules are not applied and a, b and h remain undefined.
If I instead do:
Hold#ParametricPlot[{
(a + b) Cos[t] - h Cos[(a + b)/b t],
(a + b) Sin[t] - h Sin[(a + b)/b t]},
{t, 0, 2 \[Pi]}, PlotRange -> All] /. {a -> 2, b -> 1, h -> 1}
it looks like the rules ARE working, as confirmed by the output:
Hold[ParametricPlot[{(2 + 1) Cos[t] -
1 Cos[(2 + 1) t], (2 + 1) Sin[t] - 1 Sin[(2 + 1) t]}, {t, 0,
2 \[Pi]}, PlotRange -> All]]
Which is what I'd expect. Take the Hold off, though, and the ParametricPlot doesn't work. There's nothing wrong with the equations or the ParametricPlot itself, though, because I tried setting values for a, b and h in a separate expression (a=2; b=1; h=1) and I get my pretty double cardoid out as expected.
So, what am I doing wrong with ReplaceAll and why are the transformation rules not working? This is another fundamentally important aspect of MMA that my OOP-ruined brain isn't understanding.
I tried reading up on ReplaceAll and ParametricPlot and the closest clue I found was that "ParametricPlot has attribute HoldAll and evaluates f only after assigning specific numerical values to variables" which didn't help much or I wouldn't be here.
Thanks.
Mathematica evaluates each head without holding attributes by first evaluating head of each subexpression. Since ReplaceAll doesn't have holding attributes, ParametricPlot becomes Graphics before replacement
To see the expression tree, do
ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] -
h Sin[(a + b)/b t]}, {t, 0, 2 \[Pi]},
PlotRange -> All] /. {a -> 2, b -> 1, h -> 1} // Hold // TreeForm
From that tree you can see that your command is the same as doing
temp1=ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] -
h Sin[(a + b)/b t]}, {t, 0, 2 \[Pi]},
PlotRange -> All]
temp2={a -> 2, b -> 1, h -> 1}
temp1/.temp2
Look at FullForm[temp1] to confirm that there's no a or b in that expression.
If you set ReplaceAll to HoldFirst, that prevents ParametricPlot from being evaluated before ReplaceAll, and result is what you expected. In this case, ReplaceAll evaluates to expression with head ParametricPlot, and only at that point ParametricPlot is evaluated. Make sure to reset the attributes back because changing behavior of built-in commands can have unexpected side-effects.
SetAttributes[ReplaceAll, HoldFirst];
ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] -
h Sin[(a + b)/b t]}, {t, 0, 2 \[Pi]},
PlotRange -> All] /. {a -> 2, b -> 1, h -> 1}
ClearAttributes[ReplaceAll, HoldFirst]
A useful trick when needing to evaluate arguments passed to function with HoldAll is to do operations on an expression with List head, and substitute ParametricPlot in the end, for instance
ParametricPlot ## ({{(a + b) Cos[t] -
h Cos[(a + b)/b t], (a + b) Sin[t] - h Sin[(a + b)/b t]}, {t, 0,
2 \[Pi]}, PlotRange -> All} /. {a -> 2, b -> 1, h -> 1})
The best way for using local variables in Mathematica is Module[]:
Module[{a = 2, b = 1, h = 1},
ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] - h Sin[(a + b)/b t]},
{t, 0, 2 \[Pi]},
PlotRange -> All]]
This way a, b, and h do not get assigned values in the Global context but only inside the Module. If you still want to use replacement rules you just have to ReleaseHold after you have done the replacement:
ReleaseHold[
Hold#ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] - h Sin[(a + b)/b t]},
{t, 0, 2 \[Pi]},
PlotRange -> All] /. {a -> 2, b -> 1, h -> 1}]
EDIT: As to why this happens. The way I understand it, HoldAll prevents the arguments of the function from being modified by any rules (internal or explicit). What your Hold does, is place the entire function on hold (not just the arguments), and the replacement rule gets applied after the function has gone through evaluation (which it didn't so there is still something there to replace) and HoldAll is no longer valid.
In[1] := Hold[a /. a -> 5]
Out[1] := Hold[a /. a -> 5]
In[2] := Hold[a] /. a -> 5
Out[2] := Hold[5]
Of course, Hold also has HoldAll as an attribute, so this doen't explain why ParametricPlot's HoldAll is different. :-(
EDIT2: I used Trace to look at what happens, and it seems like ReplaceAll gets applied only at the very end, when ParametricPlot has already turned into a graphical object (and does not contain a, b, or h anymore). In the case of Hold[a] /. a -> 5 the hold evaluates to Hold[a] and the replacement rule can then be successfully applied.
That is the way ReplaceAll always work.
See for example:
In[10]:= (a/a) /. a -> 0
Out[10]= 1
Clearly the replacement is done AFTER the evaluation, because if you do:
In[11]:= a = 0; a/a
During evaluation of In[11]:= Power::infy: Infinite expression 1/0 encountered. >>
During evaluation of In[11]:= Infinity::indet: Indeterminate expression 0 ComplexInfinity encountered. >>
Out[12]= Indeterminate
Now, is a matter of inserting the replacement at the level you want it to operate. As the result of a Plot is basically an Image with the numeric coordinates already "solved", you want to put those coordinates in before the plot is calculated. In your case:
ParametricPlot[
{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] - h Sin[(a + b)/b t]}
/. {a -> 2, b -> 1, h -> 1},
{t, 0, 2 \[Pi]},
PlotRange -> All
]
This is not an answer as such, just a comment on using Module with Plot.
If I proceed as follows
f[t_] := {(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] -
h Sin[(a + b)/b t]}
The following will NOT work
Method 1:
Module[{a = 2, b = 1, h = 1},
ParametricPlot[f[t], {t, 0, 2 \[Pi]}, PlotRange -> All]]
Method 2:
Module[{a = 2, b = 1, h = 1},
ParametricPlot[Evaluate[f[t]], {t, 0, 2 \[Pi]}, PlotRange -> All]]
The following does work (Method 3)
ParametricPlot[
Module[{a = 2, b = 1, h = 1}, Evaluate[f[t]]], {t, 0, 2 \[Pi]},
PlotRange -> All]
as does the method described above (method 4)
Module[{a = 2, b = 1, h = 1},
ParametricPlot[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] - h Sin[(a + b)/b t]},
{t, 0, 2 \[Pi]},
PlotRange -> All]]
Can anyone explain why method 4 works but method 2 doesn't? (The same applies to With, which I find more intuitive to Module).
For what its worth, I would generate the original parametric plot using replacement rules as follows:
ParametricPlot[
Evaluate[{(a + b) Cos[t] - h Cos[(a + b)/b t], (a + b) Sin[t] -
h Sin[(a + b)/b t]}] /. {a -> 2, b -> 1, h -> 1}, {t, 0,
2 \[Pi]}, PlotRange -> All]
EDIT
f[x_] := (a x)/(b + x);
With[{a = 10, b = 100}, Plot[Evaluate[f[x]], {x, 0, 100}]]
With[{a = 10, b = 100}, Plot[(a x)/(b + x), {x, 0, 100}]]
Plot[With[{a = 10, b = 100}, Evaluate[f[x]]], {x, 0, 100}]
Plot[Evaluate[f[x]] /. {a -> 10, b -> 100}, {x, 0, 100}]
Method 1 (of Edit) does not work (because 'Plot' treats the variable x as local, effectively using Block'?)
It seems to me that it is absolutely clear to anyone, even those with a rudimentary knowledge of Mathematica, what is going on with Method 2, showing the power and ease-of-use of Mathematica. When the equations become more complex, is it advantageous to define them separately. It is now not so clear that Method 3 must be used instead of Method 1. (Method 4, of course, is probably the best of all.)