I need to solve a diferential equation of the form w'=g(t,w(t)) where g is defined as follows
g[t_, w_] := {f1[t, {w[[3]], w[[4]]}], f2[t, {w[[3]], w[[4]]}], w[[1]],w[[2]]};
and f1, f2 are
f1[t_, y_] := Sum[\[Mu][[i]] (s[[i]] - y)/Norm[s[[i]] - y]^2, {i, 1, 5}][[1]];
f2[t_, y_] := Sum[\[Mu][[i]] (s[[i]] - y)/Norm[s[[i]] - y]^2, {i, 1, 5}][[2]];
Everything else is defined properly and is not the cause of the error.
Yet when I use
sout = NDSolve[{y'[tvar] == g[tvar, y[tvar]],
y[0] == {Cos[Pi/6], Sin[Pi/6], 0, 0}}, y, {tvar, 0, 2}, Method -> "ExplicitRungeKutta"];
I get the error
Part::partw: Part 3 of y[tvar] does not exist.
Part::partw: Part 4 of y[tvar] does not exist.
I have looked in other questions and none of them solved this problem.
You want to find a function in $R^4$ satisfying a differential equation.
I don't think DSolve and NDSolve have a standard way of manipulating vectorial differential equations except by representing each component with an explicit name or an index for the dimensions.
Here is a working example, that can be executed without Method specification in dimension 4 with notations similar to your problem:
sout={w1[t],w2[t],w3[t],w4[t]} /. NDSolve[{
w1'[t]== t*w2[t],
w2'[t]== 2*t*w1[t],
w3'[t]==-2*w2[t]+w1[t],
w4'[t]== t*w3[t]-w1[t]+w2[t],
w1[0]==0,
w2[0]==1,
w3[0]==1,
w4[0]==0
},{w1[t],w2[t],w3[t],w4[t]},{t,0,2}]
ParametricPlot[{{sout[[1, 1]], sout[[1, 3]]}, {sout[[1, 2]], sout[[1, 4]]}}, {t, 0, 2}]
I think you will be able to adapt this working example to your needs.
I didn't use your original problem as I wanted to focus on the specification for Mathematica, not on the mathematics of your equation. There are constants involved such as Mu and s that you do not give.
Related
Hi I am trying to solve a linear system of equations with mathematica. I have 18 equations and 18 Unknowns and the coefficient matrix has full rank. All entries are symbolic since I am trying to solve the problem analytically. Unfortunately Mathematica never stops the evaluation. I have prepared a minimal working example:
n = 18
A = Table[AA[i, j], {i, 1, n}, {j, 1, n}];
A // MatrixForm
x = Table[xx[i], {i, 1, n}]
b = Table[bb[i], {i, 1, n}]
MatrixRank[A]
sol = Timing[Solve[{A.x == b}, x, Reals]]
A.x == b //. sol[[2]][[1]] // Simplify
For n=2,3,4,.. all works perfectly well. But with n=10... nothing works anymore.
Why has mathematica such problems solving this?
Is there a way to solve this problem?
Thanks for help,
Andreas
You simply need more memory:
The symbolic solution involves n+1 determinants, here is an estimate of the memory needed.
bc[n_] := (A = Det[Array[a, {n, n}]];ByteCount[A])
ListLogPlot[
t = Table[ {n, (n + 1) bc[n] /1024^3 // N} , {n,2,10}], Joined -> True]
extrapolating to n=18 we can see you'll need only about 10^8 Gigabytes..
(thats 1000x more than the largest supercomputers for anyone not getting the point )
I can't seem to understand the difference between the behaviour of Plot and PlotLog (and other log-scale plotting functions) in Mathematica. Let's say I have this simple function:
f [a_] := Length[Range[0, a]]
now running Plot[f[x], {x, 1, 10}] yields a correct graph, but when I try
PlotLog[f[x], {x, 1, 10}]
I get no output save the following error:
Range::range: "Range specification in Range[1,x] does not have appropriate bounds."
Looks like the evaluation of x is postponed which makes it impossible to create a list from Range, but why on Earth would it happen to log-scale plotting functions only and how do I handle this issue?
PlotLog doesn't exists. If you use LogPlot it will work correctly.
In any case, you may have problems with that definition. I would recommend to define f like f2[a_Real] := Length[Range[0, a]] or f3[a_?NumericQ] := Length[Range[0, a]]so only numbers will be passed to Range.
For example, with your definition, this will fail:
NIntegrate[f[x], {x, 1, 10}]
During evaluation of In[43]:= Range::range: Range specification in Range[0,x] does not have appropriate bounds. >>
18.
But defining a as NumericQ or Real, it will work.
NIntegrate[f2[x],{x,1,10}]
54.
Regards.
I am trying to get Mathematica to approximate an integral that is a function of various parameters. I don't need it to be extremely precise -- the answer will be a fraction, and 5 digits would be nice, but I'd settle for as few as 2.
The problem is that there is a symbolic integral buried in the main integral, and I can't use NIntegrate on it since its symbolic.
F[x_, c_] := (1 - (1 - x)^c)^c;
a[n_, c_, x_] := F[a[n - 1, c, x], c];
a[0, c_, x_] = x;
MyIntegral[n_,c_] :=
NIntegrate[Integrate[(D[a[n,c,y],y]*y)/(1-a[n,c,x]),{y,x,1}],{x,0,1}]
Mathematica starts hanging when n is greater than 2 and c is greater than 3 or so (generally as both n and c get a little higher).
Are there any tricks for rewriting this expression so that it can be evaluated more easily? I've played with different WorkingPrecision and AccuracyGoal and PrecisionGoal options on the outer NIntegrate, but none of that helps the inner integral, which is where the problem is. In fact, for the higher values of n and c, I can't even get Mathematica to expand the inner derivative, i.e.
Expand[D[a[4,6,y],y]]
hangs.
I am using Mathematica 8 for Students.
If anyone has any tips for how I can get M. to approximate this, I would appreciate it.
Since you only want a numerical output (or that's what you'll get anyway), you can convert the symbolic integration into a numerical one using just NIntegrate as follows:
Clear[a,myIntegral]
a[n_Integer?Positive, c_Integer?Positive, x_] :=
a[n, c, x] = (1 - (1 - a[n - 1, c, x])^c)^c;
a[0, c_Integer, x_] = x;
myIntegral[n_, c_] :=
NIntegrate[D[a[n, c, y], y]*y/(1 - a[n, c, x]), {x, 0, 1}, {y, x, 1},
WorkingPrecision -> 200, PrecisionGoal -> 5]
This is much faster than performing the integration symbolically. Here's a comparison:
yoda:
myIntegral[2,2]//Timing
Out[1]= {0.088441, 0.647376595...}
myIntegral[5,2]//Timing
Out[2]= {1.10486, 0.587502888...}
rcollyer:
MyIntegral[2,2]//Timing
Out[3]= {1.0029, 0.647376}
MyIntegral[5,2]//Timing
Out[4]= {27.1697, 0.587503006...}
(* Obtained with WorkingPrecision->500, PrecisionGoal->5, MaxRecursion->20 *)
Jand's function has timings similar to rcollyer's. Of course, as you increase n, you will have to increase your WorkingPrecision way higher than this, as you've experienced in your previous question. Since you said you only need about 5 digits of precision, I've explicitly set PrecisionGoal to 5. You can change this as per your needs.
To codify the comments, I'd try the following. First, to eliminate infinite recursion with regards to the variable, n, I'd rewrite your functions as
F[x_, c_] := (1 - (1-x)^c)^c;
(* see note below *)
a[n_Integer?Positive, c_, x_] := F[a[n - 1, c, x], c];
a[0, c_, x_] = x;
that way n==0 will actually be a stopping point. The ?Positive form is a PatternTest, and useful for applying additional conditions to the parameters. I suspect the issue is that NIntegrate is re-evaluating the inner Integrate for every value of x, so I'd pull that evaluation out, like
MyIntegral[n_,c_] :=
With[{ int = Integrate[(D[a[n,c,y],y]*y)/(1-a[n,c,x]),{y,x,1}] },
NIntegrate[int,{x,0,1}]
]
where With is one of several scoping constructs specifically for creating local constants.
Your comments indicate that the inner integral takes a long time, have you tried simplifying the integrand as it is a derivative of a times a function of a? It seems like the result of a chain rule expansion to me.
Note: as per Yoda's suggestion in the comments, you can add a cacheing, or memoization, mechanism to a. Change its definition to
d:a[n_Integer?Positive, c_, x_] := d = F[a[n - 1, c, x], c];
The trick here is that in d:a[ ... ], d is a named pattern that is used again in d = F[...] cacheing the value of a for those particular parameter values.
Suppose I write a black-box functions, which evaluates an expensive complex valued function numerically, and then returns real and imaginary part.
fun[x_?InexactNumberQ] := Module[{f = Sin[x]}, {Re[f], Im[f]}]
Then I can use it in Plot as usual, but Plot does not recognize that the function returns a pair, and colors both curves the same color. How does one tell Mathematica that the function specified always returns a vector of a fixed length ? Or how does one style this plot ?
EDIT: Given attempts attempted at answering the problem, I think that avoiding double reevalution is only possible if styling is performed as a post-processing of the graphics obtained. Most likely the following is not robust, but it seems to work for my example:
gr = Plot[fun[x + I], {x, -1, 1}, ImageSize -> 250];
k = 1;
{gr, gr /. {el_Line :> {ColorData[1][k++], el}}}
One possibility is:
Plot[{#[[1]], #[[2]]}, {x, -1, 1}, PlotStyle -> {{Red}, {Blue}}] &# fun[x + I]
Edit
If your functions are not really smooth (ie. almost linear!), there is not much you can do to prevent the double evaluation process, as it will happen (sort of) anyway due to the nature of the Plot[] mesh exploration algorithm.
For example:
fun[x_?InexactNumberQ] := Module[{f = Sin[3 x]}, {Re[f], Im[f]}];
Plot[{#[[1]], #[[2]]}, {x, -1, 1}, Mesh -> All,
PlotStyle -> {{Red}, {Blue}}] &#fun[x + I]
I don't think there's a good solution to this if your function is expensive to compute. Plot will only acknowledge that there are several curves to be styled if you either give it an explicit list of functions as argument, or you give it a function that it can evaluate to a list of values.
The reason you might not want to do what #belisarius suggested is that it would compute the function twice (twice as slow).
However, you could use memoization to avoid this (i.e. the f[x_] := f[x] = ... construct), and go with his solution. But this can fill up your memory quickly if you work with real valued functions. To prevent this you may want to try what I wrote about caching only a limited number of values, to avoid filling up the memory: http://szhorvat.net/pelican/memoization-in-mathematica.html
If possible for your actual application, one way is to allow fun to take symbolic input in addition to just numeric, and then Evaluate it inside of Plot:
fun2[x_] := Module[{f = Sin[x]}, {Re[f], Im[f]}]
Plot[Evaluate[fun2[x + I]], {x, -1, 1}]
This has the same effect as if you had instead evaluated:
Plot[{-Im[Sinh[1 - I x]], Re[Sinh[1 - I x]]}, {x, -1, 1}]
I have a basic problem in Mathematica which has puzzled me for a while. I want to take the m'th derivative of x*Exp[t*x], then evaluate this at x=0. But the following does not work correct. Please share your thoughts.
D[x*Exp[t*x], {x, m}] /. x -> 0
Also what does the error mean
General::ivar: 0 is not a valid variable.
Edit: my previous example (D[Exp[t*x], {x, m}] /. x -> 0) was trivial. So I made it harder. :)
My question is: how to force it to do the derivative evaluation first, then do substitution.
As pointed out by others, (in general) Mathematica does not know how to take the derivative an arbitrary number of times, even if you specify that number is a positive integer.
This means that the D[expr,{x,m}] command remains unevaluated and then when you set x->0, it's now trying to take the derivative with respect to a constant, which yields the error message.
In general, what you want is the m'th derivative of the function evaluated at zero.
This can be written as
Derivative[m][Function[x,x Exp[t x]]][0]
or
Derivative[m][# Exp[t #]&][0]
You then get the table of coefficients
In[2]:= Table[%, {m, 1, 10}]
Out[2]= {1, 2 t, 3 t^2, 4 t^3, 5 t^4, 6 t^5, 7 t^6, 8 t^7, 9 t^8, 10 t^9}
But a little more thought shows that you really just want the m'th term in the series, so SeriesCoefficient does what you want:
In[3]:= SeriesCoefficient[x*Exp[t*x], {x, 0, m}]
Out[3]= Piecewise[{{t^(-1 + m)/(-1 + m)!, m >= 1}}, 0]
The final output is the general form of the m'th derivative. The PieceWise is not really necessary, since the expression actually holds for all non-negative integers.
Thanks to your update, it's clear what's happening here. Mathematica doesn't actually calculate the derivative; you then replace x with 0, and it ends up looking at this:
D[Exp[t*0],{0,m}]
which obviously is going to run into problems, since 0 isn't a variable.
I'll assume that you want the mth partial derivative of that function w.r.t. x. The t variable suggests that it might be a second independent variable.
It's easy enough to do without Mathematica: D[Exp[t*x], {x, m}] = t^m Exp[t*x]
And if you evaluate the limit as x approaches zero, you get t^m, since lim(Exp[t*x]) = 1. Right?
Update: Let's try it for x*exp(t*x)
the mth partial derivative w.r.t. x is easily had from Wolfram Alpha:
t^(m-1)*exp(t*x)(t*x + m)
So if x = 0 you get m*t^(m-1).
Q.E.D.
Let's see what is happening with a little more detail:
When you write:
D[Sin[x], {x, 1}]
you get an expression in with x in it
Cos[x]
That is because the x in the {x,1} part matches the x in the Sin[x] part, and so Mma understands that you want to make the derivative for that symbol.
But this x, does NOT act as a Block variable for that statement, isolating its meaning from any other x you have in your program, so it enables the chain rule. For example:
In[85]:= z=x^2;
D[Sin[z],{x,1}]
Out[86]= 2 x Cos[x^2]
See? That's perfect! But there is a price.
The price is that the symbols inside the derivative get evaluated as the derivative is taken, and that is spoiling your code.
Of course there are a lot of tricks to get around this. Some have already been mentioned. From my point of view, one clear way to undertand what is happening is:
f[x_] := x*Exp[t*x];
g[y_, m_] := D[f[x], {x, m}] /. x -> y;
{g[p, 2], g[0, 1]}
Out:
{2 E^(p t) t + E^(p t) p t^2, 1}
HTH!