Rules in mathematica - wolfram-mathematica

How to combine the following three rules in one.
Rule1 = Cos[m_ t]^3 Cos[n_ t] -> 0
Rule2 = Cos[1. t]^3 Cos[3. t] -> Pi/4
Rule3 = Cos[2. t]^3 Cos[6. t] -> Pi/4
In my present calculation, the value of m and n changes from 1 to 7 so Rule1 is not correct when (m=1,n=3) and (m=2,n=6). Is it possible to combine all these three rules in one?

Related

Syntax to figure out the y value for a particular x value in Mathematica

Here's the problem statement:
Two non-linear inter-dependent, initial value first order differential equations were solved using NDSolve to yield an analytical solution. The solution was used to calculate another parameter, as a function of the same x value.
Let's say we have the ODEs as:
X'[t]=a*S[t]*X[t]/(b+S[t]
S'[t]=-a*S[t]*X[t]/(c(b+S[t])) where a,b,c are also known constants
X[0]=constant
S[0]=constant
soln = NDSolve[{X'[t]=a*S[t]*X[t]/(b+S[t],S'[t]=-a*S[t]*X[t]/(c(b+S[t])),X[0]=constant,S[0]=constant},{X,S},{t,0,50}]
The solution is of the form
X-> InterpolatingFunction[{{0.0,50}},<>],S->InterpolationFunction[{{0.0,50}},<>}}
Now the new parameter is: Yvalue=(S[t]/.soln)+(X[t]/.soln)
I'm trying to figure out the correct syntax to calculate Yvalue for an entered t value.
Ex- One needs to calculate Yvalue at t=0.1,0.56, 2.3 etc
Thank you for your time.
Regards,
Ankur
NDSolve demands that all parameters be given specific numeric values. If you assign values to a,b,c,X[0],S[0] and carefully match up all your parens and carefully use == versus = correctly, then this can work
In[1]:= a = 2; b = 3; c = 5;
soln = NDSolve[{X'[t] == a*S[t]*X[t]/(b + S[t]),
S'[t] == -a*S[t]*X[t]/(c(b+S[t])), X[0]==7, S[0]==11}, {X,S}, {t,0,50}][[1]]
Out[2]= {X -> InterpolatingFunction[{{0.,50.}}, <>],
S -> InterpolatingFunction[{{0.,50.}}, <>]}
In[3]:= Yvalue = S[t] + X[t] /. soln /. t -> 0.1
Out[3]= 18.9506
In[4]:= Yvalue = S[t] + X[t] /. soln /. t -> 0.56
Out[4]= 25.6919
In[5]:= Yvalue = S[t] + X[t] /. soln /. t -> 2.3
Out[5]= 61.9823
and even
In[6]:= Plot[S[t] + X[t] /. soln, {t, 0, 50}, PlotRange -> {0, 70}]
Out[6]= ...PlotSnipped...

Mathematica code to draw a graph of this differential equation?

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.

Using the output of Solve

I had a math problem I solved like this:
In[1]:= Solve[2x(a-x)==0, x]
Out[1]= {{x->0}, {x->a}}
In[2]:= Integrate[2x(a-x), {x,0,a}]
Out[2]= (a^3)/3
In[3]:= Solve[(a^3)/3==a, a]
Out[3]= {{a->0}, {a->-Sqrt[3]}, {a->Sqrt[3]}}
My question is if I could rewrite this to compute it in one step, rather than having to manually input the result from the previous line. I could easily replace the integral used in step three with the Integrate command from step two. But what I can't figure out is how I would use the result from step 1 as the limits of integration in the integral.
You could combine step 1 and 2 by doing something like
Integrate[2 x (a - x), {x, ##}] & ## (x /. Solve[2 x (a - x) == 0, x]);
If you agree to delegate the choice of the (positive oriented) domain to Integrate, by means of using Clip or Boole:
In[77]:= Solve[
Integrate[
Clip[2 x (a - x), {0, Infinity}], {x, -Infinity, Infinity}] == a, a]
Out[77]= {{a -> 0}, {a -> Sqrt[3]}}
or
In[81]:= Solve[
Integrate[
2 x (a - x) Boole[2 x (a - x) > 0], {x, -Infinity, Infinity}] ==
a, a]
Out[81]= {{a -> 0}, {a -> Sqrt[3]}}
The reason only non-negative roots are found, is that Integrate will integrate from the smallest root to the largest root, i.e. from {x,0,a} for positive a and {x,a,0} for negative a.

Split expression into collection of terms

I have a long expression that I would like to split into a collection of terms. For example say I have:
a + b - c + d + 4*e - 3*f
I want to split the expression by addition/subtraction into:
{a, b, -c, d, 4*e, -3*f}
My motivation for this is that I want to deal with the original expression term by term. Is this possible?
Edit: The examples given are VERY simplistic compared to what I'm actually dealing with in Mathematica, it's just that I'm not sure how to write Math around here.
To split the expression, you need to use Level. Level gives you a list of subexpressions and you can specify the level at which you want the subexpressions returned. In this case, you need levelspec 1.
In[1]:= expr = a + b - c + d + 4 e - 3 f;
In[2]:= Level[expr, 1]
Out[2]= {a, b, -c, d, 4 e, -3 f}
An example with a slightly more complicated expression:
In[3]:= expr2 = a^2 + 5 bc/ef - Sqrt[g - h] - Cos[i]/Sin[j + k];
In[4]:= Level[expr2, 1]
Out[4]= {a^2, (5 bc)/ef, -Sqrt[g - h], -Cos[i] Csc[j + k]}
Since no one else has mentioned it, equivalent to Yoda's Level[expr, 1] construction is to use Apply to replace the head of an expression with List:
In[1]:= expr = a + b - c + d + 4 e - 3 f;
In[2]:= List ## expr
Level[expr, 1] == %
Out[2]= {a, b, -c, d, 4 e, -3 f}
Out[3]= True
In[4]:= expr2 = a^2 + 5 bc/ef - Sqrt[g - h] - Cos[i]/Sin[j + k];
In[5]:= List ## expr2
Level[expr2, 1] == %
Out[5]= {a^2, (5 bc)/ef, -Sqrt[g - h], -Cos[i] Csc[j + k]}
Out[6]= True
The two methods do basically the same thing and have identical timings (using my version of a average timing function)
In[1]:= SetOptions[TimeAv, Method -> {"MinNum", 80000}, "BlockSize" -> 20000];
In[7]:= List ## expr // TimeAv
Total wall time is 0.244517, total cpu time is 0.13
and total time spent evaluating the expression is 0.13
The expression was evaluated 80000 times, in blocks of 20000 runs. This yields
a mean timing of 1.625*10^-6 with a blocked standard deviation of 2.16506*10^-7.
Out[7]= {1.625*10^-6, {a, b, -c, d, 4 e, -3 f}}
In[8]:= Level[expr, 1] // TimeAv
Total wall time is 0.336927, total cpu time is 0.16
and total time spent evaluating the expression is 0.16
The expression was evaluated 80000 times, in blocks of 20000 runs. This yields
a mean timing of 2.*10^-6 with a blocked standard deviation of 3.53553*10^-7.
Out[8]= {2.*10^-6, {a, b, -c, d, 4 e, -3 f}}
You might also be able to use MonomialList, if you expression is a polynomial:
In[56]:= MonomialList[a + b - c + d + 4*e - 3*f]
Out[56]= {a, b, -c, d, 4 e, -3 f}
(Doesn't work on non-polynomials, such as Yoda's expr2.)
You could also use Replace:
In[65]:= Replace[a + b - c + d + 4*e - 3*f, HoldPattern[Plus[a___]] :> {a}]
Out[65]= {a, b, -c, d, 4 e, -3 f}
You need to use HoldPattern (or some equivalent trick) to prevent Plus[a__] from evaluating to a__, which has the result of just wrapping the first argument in a list instead of creating a list of the arguments to Plus.

Take positive square root in Mathematica

I'm currently doing some normalization along the lines of:
J = Integrate[Psi[x, 0]^2, {x, 0, a}]
sol = Solve[J == 1, A]
A /. sol
For this type of normalization, the negative square root is extraneous. The result of this calculation is:
In[49]:= J = Integrate[Psi[x, 0]^2, {x, 0, a}]
Out[49]= 2 A^2
In[68]:= sol = Solve[J == 1, A]
Out[68]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
Even if I try giving it an Assuming[...] or Simplify[...], it still gives me the same results:
In[69]:= sol = Assuming[A > 0, Solve[J == 1, A]]
Out[69]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
In[70]:= sol = FullSimplify[Solve[J == 1, A], A > 0]
Out[70]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
Can anyone tell me what I'm doing wrong here?
I'm running Mathematica 7 on Windows 7 64-bit.
ToRules does what the box says: converts equations (as in Reduce output) to rules. In your case:
In[1]:= ToRules[Reduce[{x^2==1,x>0},x]]
Out[1]= {x->1}
In[2]:= {ToRules[Reduce[{x^2==1},x]]}
Out[2]= {{x->-1},{x->1}}
For more complex cases, I have often found it useful to just check the value of the symbolic solutions after pluging in typical parameter values. This is not foolproof, of course, but if you know there is one and only one solution then it is a simple and efficient method:
Solve[x^2==someparameter,x]
Select[%,((x/.#)/.{someparameter-> 0.1})>0&]
Out[3]= {{x->-Sqrt[someparameter]},{x->Sqrt[someparameter]}}
Out[4]= {{x->Sqrt[someparameter]}}
Solve doesn't work like this. You might try Reduce, instead, e.g.
In[1]:= Reduce[{x^2 == 1, x > 0}, x]
Out[1]= x == 1
It's then a little tricky to transform this output to replacement rules, at least in the general case, because Reduce might use arbitrary many logical connectives. In this case, we could just hack:
In[2]:= Solve[Reduce[{x^2 == 1, x > 0}, x], x]
Out[2]= {{x->1}}

Resources