Solving a matrix differential equation with Mathematica - math

I need to solve this equation in Mathematica:
d/dx v(x) = A . v(x)
here v is the column vector {v1(x),v2(x),v3(x),v4(x)} and
A is a 4 x 4 matrix.
I want to solve for the functions v1, v2, v3, v4 with any initial conditions.
The range of x is from 0 to 1000.
How do I write Mathematica code for this type of differential equation using NDSolve?

So, if you have some horrible matrix
A = RandomReal[0.1, {4, 4}]; (* A horrible matrix *)
which we make anti-symmetric (so the solution is oscillatory)
A = A - Transpose#A;
Define the vector of functions and their initial conditions
v[x_] := {v1[x], v2[x], v3[x], v4[x]};
init = v[0] == RandomReal[1, 4]
Then the NDSolve command looks like
sol = NDSolve[LogicalExpand[v'[x] == A.v[x] && init],
{v1, v2, v3, v4}, {x, 0, 1000}]
And the solutions can be plotted with
Plot[Evaluate[v[x] /. sol], {x, 0, 1000}]
Note that that the above differential equation is a linear, first order equation with constant coefficients, so is simply solved using a matrix exponential.
However, if the matrix A was a function of x, then analytic solutions become hard, but the numerical code stays the same.
For example, try:
A = RandomReal[1/10, {4, 4}] - Exp[-RandomReal[1/100, {4, 4}] x^2];
A = A - Transpose#A;
Which can produce solutions like

I wanted to do the same with a matrix instead of a vector v. As long as equation for it can be read correctly without knowing that this symbol represents a vector or a matrix, NDSolve deduced its character from initial condition, however in case when dimensionality of variable is explicit:
M'[t]==a[t]*IdentityMatrix[2]+M[t]
it fails.
An "ordinary" solution is to define matrix explicitly and flatten it when giving as a list of variables.
However I omitted this issue (and many relatex syntax problems) just introducing a reduntant variable which only role is to be the identity matrix but without introducing a list (matrix is 2d list, so Mathematica acts as while adding lists to each other, generating the error):
eqn = {w'[t] == a[t]*identity[t] + w[t], a'[t] == 2, identity'[t] == {{0, 0}, {0, 0}}}
init={ w[0] == {{1, 2}, {2, 1}}, a[0] == 1, identity[0] == {{1, 0}, {0, 1}}}
sol = NDSolve[eqn&&init, {w, a, identity}, {t, 0, 1}]
Some evidence of work:
Plot[{Evaluate[w[t] /. sol][[1, 1, 1]], Evaluate[w[t] /. sol][[1, 1, 2]]}, {t, 0, 1}]

Try something like this (I do not have Mathematica on my home notebook :))
NDSolve[Transpose[{v1[x],v2[x],v3[x],v4[x]}']=={{a11,a12,a13,a14},{a21,a22,a23,a24},{a31,a32,a33,a34},{a41,a42,a43,a44}}.Transpose[{v1[x],v2[x],v3[x],v4[x]}], {v1,v2,v3,v4},{x,0,1000}]
ps: you can rewrite it in a different way, replacing your record as a set of equations
{v1'[x]==a11*v1[x]+a12*v2[x]+a13*v3[x]+a14*v4[x],v2'[x]==a21*v1[x]+a22*v2[x]+a23*v3[x]+a24*v4[x], and so on..} if you want )

Related

How to make a diagonal tensor and why doesn't Tensorflow linalg.tensor_diag do that?

What I would consider a diagonal tensor is a tensor t of shape (d1, ..., dr) which is all zero except when the components are equal.
So t[i,j,k,l] = 0 unless i == j == k == l.
A function to create such a tensor should take in a shape (d1, ..., dr) and a vector [a1, ..., ak] of length min(d1, ..., dr), placing these values along the diagonal.
I would like to do this in Tensorflow, and the most relevant function I could find was tf.linalg.tensor_diag, but it doesn't do what I want. For instance, the diagonal input is a tensor, and the output tensor always has twice the rank, and so it can never output tensors of odd rank.
The documentation says "Given a diagonal, this operation returns a tensor with the diagonal and everything else padded with zeros", but I don't know how to square that with its actual behavior.
My question is two parts:
What is the best way in TF to do create what I am calling a diagonal tensor. Is there another name for this?
Why does linalg.tensor_diag work like this? What is the intended use?
Here is an example output:
>>> tf.linalg.tensor_diag([1,2],[3,4]])
<tf.Tensor: shape=(2, 2, 2, 2), dtype=int32, numpy=
array([[[[1, 0],
[0, 0]],
[[0, 2],
[0, 0]]],
[[[0, 0],
[3, 0]],
[[0, 0],
[0, 4]]]], dtype=int32)>```
So this is a little tricky to think about but I'll try to explain the thinking.
If you do tf.linalg.tensor_diag([1,2,3,4]) this is intuitively gives a matrix with that diagonal:
[[1, 0, 0, 0],
[0, 2, 0, 0],
[0, 0, 3, 0],
[0, 0, 0, 4]]
Notice you went from rank 1 to rank 2 doing this, the rank doubled. So to "diagonalize" it's going to end up doubling the rank.
Now your question, tf.linalg.tensor_diag([[1,2],[3,4]]) What you're passing in is a matrix so rank 2
[[1, 2],
[3, 4]]
But now, how should this be diagonalized? So it's rank 2 and following the pattern means we'll end up with something of rank 4. In the previous example diagonalize sort of "pulled up" the vector into the higher rank. And each step of "pulling up" took a single value from the diagonal and put it there.
So this matrix will also be "pulled up" and each step of the way leaving a value. So it's going to make 4 squares of [[0,0],[0,0]] and drop the value in each one. This would give us
[[1,0],
[0,0]]
[[0,2],
[0,0]]
[[0,0],
[3,0]]
[[0,0],
[0,4]]
Lastly things will be "grouped" if they were originally (like [1,2] idk how better to say this) so that gives the final result of
[
[
[[1,0],
[0,0]] ,
[[0,2],
[0,0]]
],
[
[[0,0],
[3,0]] ,
[[0,0],
[0,4]]
]
]
Which indeed gives us a rank 4 result 👍
Note: You may want to look into the other diag function for more of you're trying to do

Prolog recursively multiply

I'm trying to multiply two numbers in Prolog recursively i.e. 3*4 = 3+3+3+3 = 12.
My code is :
mult(0,Y,Y).
mult(X,Y,Z) :-
NewX is X-1,
Z is Y + mult(NewX,Y,Z).
but I keep either in an infinite loop or being told mult is not a function.
What you here constructed is a predicate. A predicate is not the same as a function in computer science, you can not write A is B + some_pred(C), or at least not as far as I know in ISO Prolog, and definitely not without adding some extra logic.
In order to pass values, one uses variables. We can thus call the mult/3 predicate recursively, and use a variable that will be unified with the result. We can then perform arithmetic with it, like:
mult(0, _, 0).
mult(X, Y, Z) :-
X1 is X - 1,
mult(X1, Y, Z1),
Z is Y + Z1.
Note that you can not reassign a (different) value to a variable. So if, like you did in the question, use Z twice, then given Y is not 0, this will fail.
The above is however still not sufficient, since it will produce a result, but then get stuck in an infinite loop since if it calls (eventually) mult(0, 4, Z) (4 is here just a value), there are two ways to resolve this: with the base case, and with the recursive case.
We thus need a "guard" for the second case, like:
mult(0, _, 0).
mult(X, Y, Z) :-
X > 0,
X1 is X - 1,
mult(X1, Y, Z1),
Z is Y + Z1.
We then obtain for example:
?- mult(14, 25, Z).
Z = 350 ;
false.
One can improve the speed of this mult/3 predicate by implementing a version with an accumulator. I leave this as an exercise.

Mathematica piecewise function bad plot rendering

I wanted to plot a user-defined Piecewise function (pagoda function) in Mathematica 10.2.
It seems straightforward to me unfortunately the easy command leads to a bad result.
My first approach was:
f[x_] := Piecewise[{{0, x <= -1}, {-Abs[x] + 1, -1 < x < 1}, {0,
x >= 1}}]
Plot3D[ 5*f[x]*f[y], {x, -1.5, 1.5}, {y, -1.5, 1.5}]
I also tried to set MaxRecursion which lead to more terrible results in a few cases (e.g. 2,3).
Can anybody tell me how to plot this function in a smooth nice way?
Thanks,
Felix
As far as I can remember, making visible gaps was introduced as a feature. Before that, piecewise or discontinuous functions were plotted like this:
Plot[Piecewise[{{x, x <= 1}, {3, x > 1}}], {x, 0, 3}, Exclusions -> None]
That behavior gives the wrong impression. I would have to check when this was default or if I'm completely off here. Anyway, as already noted in the comments, you can use the Exclusions option to get connected graphs.
You don't need to increase PlotPoints because Mathematica will (hopefully always) recognize the boundaries of the pieces as places where it needs to recursively increase points. Therefore, the MaxRecursion option is far more important to give a smooth plot. This example was rendered with only 10 points, but a recursion value of 5:
Therefore, your function renders extremely well even with 10 plot-points when the recursion is high enough. Look how many subdivisions you get on the cracks
Plot3D[5*f[x]*f[y], {x, -1.5, 1.5}, {y, -1.5, 1.5}, PlotRange -> All,
Exclusions -> None, PlotPoints -> 10, MaxRecursion -> 6, Mesh -> All]
Finally, note that the gaps are not restricted to Piecewise functions. As you can verify yourself, UnitStep will also show gaps. You can try it with your example by using an undocumented function to turn everything to UnitStep:
Simplify`PWToUnitStep[5*f[x]*f[y]]
(*
5 (1 - Abs[x]) (1 - Abs[y]) (1 - UnitStep[-1 - x]) (1 -
UnitStep[-1 + x]) (1 - UnitStep[-1 - y]) (1 - UnitStep[-1 + y])
*)
With all due respect to #halirutan, by itself MaxRecursion set to 6 was not enough in the following plot to adjust the peak values of a piecewise function to be a monotonic increasing sequence:
This improved, when, in addition, I set PlotPoints to 240, as follows.
However, that does not completely solve all the display problems. For example, note in the plots above, that the initial value y = 0, is not correctly plotted as a blue vertical line despite use of Exclusions->None. Moreover, the grid lines, which are Dotted, do not display as dots, but as dashes which run off below the x-axis. All of these problems can be solved, probably more efficiently, by generating the points or dots as list data and using ListPlot or, as in this case ListLogPlot and using Joined->True when appropriate. That is low level solution, but is needed in more complicated plots to obtain a plot with shorter run time and more accessible control over the display features.

Dynamic is not working properly

I'm having some troubles with the Dynamic command in Mathematica, the next code shows an interactive graphic of the function f(x) = 1 - x^2. The graphic's title also shows the current area under the curve (definite integral) which is modified using the slider.
Manipulate[Show[Plot[1 - x^2, {x, 0, 1}, PlotLabel -> Integrate[1 - x^2, {x, 0, Limite - 0.000000000001}]],
Plot[-x^2 + 1, {x, 0, Limite}, PlotRange -> {0, 1}, Filling -> Axis] ], {Limite, 0.000000000001, 1}, LocalizeVariables -> False]
I would like to show the current area using this command:
Integrate[1 - x^2, {x, 0, Dynamic[Limite]}]
but the result is not what i expected. Mathematica evaluates this like
0.529 - (0.529)^3 / 3
which is correct but i don't understand why it displays an expression instead of a single number. The //FullSimplify and//N commands just don't solve the problem.
Is there a better way to obtain the result?
Am I using the Dynamic command correctly?
Thanks!
With your example the Integrate command is performed once with a symbolic upper limit. When the value of that upper limit changes the integral is not recomputed. You will get your desired result if you move the Dynamic[] wrapper from the iterator specification and wrap it around the Integrate command, which will cause the integral to be recomputed whenever Limite changes.
Dynamic[Integrate[1 - x^2, {x, 0, Limite}]]

Sketching solution curves for differential equations

I have a few differential equations that I'd like to draw solutions for, for a variety of start values N_0
Here are the equations:
dN\dt= bN^2 - aN
dN\dt = bN^2 (1 - N\K) - aN
How would I go about it?
I don't really care about the language is used. In terms of dedicated math I have mathematica and matlab on my computer. I've got access to maple. I have to do more of this stuff, and I'd like to have examples from any language, as it'll help me figure out which one I want to use and learn it.
I'll pretend the first one cannot be solved analytically so as to show how one would go about playing with a general ODE in mathematica.
Define
p1[n0_, a_, b_, uplim_: 10] :=(n /. First#NDSolve[
{n'[t] == b*n[t]^2 - a*n[t], n[0] == n0},n, {t, 0, uplim}]
which returns the solution of the ODE, i.e., a = p1[.1, 2., 3.] and then e.g. a[.3] tells you n(.3). One can then do something like
Show[Table[ans = p1[n0, 1, 1];
Plot[ans[t], {t, 0, 10}, PlotRange \[Rule] Full],
{n0, 0, 1, .05}], PlotRange \[Rule] {{0, 5}, {0, 1}}]
which plots a few solutions with different initial values:
or, to gain some insight into the solutions, one can interactively manipulate the values of a, b and n0:
Manipulate[
ans = p1[n0, a, b];
Plot[ans[t], {t, 0, 10},PlotRange -> {0, 1}],
{{n0, .1}, 0, 1},
{{a, 1}, 0, 2},
{{b, 1}, 0, 2}]
which gives something like
with the controls active (i.e. you move them and the plot changes; try it live to see what I mean; note that you can set parameters for which the initial conditions gives diverging solutions).
Of course this can be made arbitrarily more complicated. Also in this particular case this ODE is easy enough to integrate analytically, but this numerical approach can be applied to generic ODEs (and many PDEs, too).
Adding to the several good answers, if you just want a quick sketch of an ODE's solutions for many starting values, for guidance, you can always do a one-line StreamPlot. Suppose a==1 and b==1, and dy/dx == x^2 - x.
StreamPlot[{1, x^2 - x}, {x, -3, 3}, {y, -3, 3}]
StreamStyle -> "Line" will give you just lines, no arrows.
In Mathematica you use NDSolve (unless it can be solved analytically, in which case you use DSolve. So for your first equation I tried:
b = 1.1; a = 2;
s = NDSolve[{n'[t] == b n[t]^2 - a n[t], n[0] == 1}, n, {t, 0, 10}];
Plot[Evaluate[n[t] /. s], {t, 1, 10}, PlotRange -> All]
I didn't know what to use for a, b or N0, but I got this result:
If you're happy to solve the equations numerically, MATLAB has a set of ODE solvers that might be useful. Check out the documentation for the ode45 function here.
The general approach is to define an "ode function" that describes the right-hand-side of the differential equations. You then pass this function, along with initial conditions and an integration range to the ode solvers.
One attractive feature of this type of approach is that it extends in a straight-forward way to complex systems of coupled ODE's.
Hope this helps.

Resources