Initial conditions with a non-linear ODE in Mathematica - wolfram-mathematica

I'm trying to use Mathematica's NDSolve[] to compute a geodesic along a sphere using the coupled ODE:
x" - (x" . x) x = 0
The problem is that I can only enter initial conditions for x(0) and x'(0) and the solver is happy with the solution where x" = 0. The problem is that my geodesic on the sphere has the initial condition that x"(0) = -x(0), which I have no idea how to tell mathematica. If I add this as a condition, it says I'm adding True to the list of conditions.
Here is my code:
s1 = NDSolve[{x1''[t] - (x1[t] * x1''[t] + x2[t] * x2''[t] + x3[t]*x3''[t]) * x1[t] == 0, x2''[t] - (x1[t] * x1''[t] + x2[t] * x2''[t] + x3[t]*x3''[t]) * x2[t] == 0, x3''[t] - (x1[t] * x1''[t] + x2[t] * x2''[t] + x3[t]*x3''[t]) * x3[t] == 0, x1[0] == 1, x2[0] == 0, x3[0] == 0, x1'[0] == 0, x2'[0] == 0, x3'[0] == 1} , { x1, x2, x3}, {t, -1, 1}][[1]]
I would like to modify this so that the initial acceleration is not zero but -x(0).
Thanks

Well, as the error message says -- NDSolve only accepts initial conditions for derivatives of orders strictly less than the maximal order appearing in the ODE.
I have a feeling this is more of a mathematics question. Mathematically, {x''[0]=-x0, x[0]==x0}, doesn't define a unique solution - you'd have to do something along the lines of {x0.x''[0]==-1, x[0]==x0, x'[0]-x0 x0.x'[0]==v0} for that to work out (NDSolve would still fail with the same error). You do realize you will just get a great circle on the unit sphere, right?
By the way, here is how I would have coded up your example:
x[t_] = Table[Subscript[x, j][t], {j, 3}];
s1 = NDSolve[Flatten[Thread /# #] &#{
x''[t] - (x''[t].x[t]) x[t] == {0, 0, 0},
x[0] == {1, 0, 0},
x'[0] == {0, 0, 1}
}, x[t], {t, -1, 1}]

I fixed this problem through a mathematical rearrangement rather than addressing my original issue:
Let V(t) be a vector field along x(t).
x . V = 0 implies d/dt (x . V) = (x' . V) + (x . V') = 0
So the equation D/dt V = V' - (x . V') x = V' + (x' . V) x holds
This means the geodesic equation becomes: x" + (x' . x') x = 0 and so it can be solved using the initial conditions I originally had.
Thanks a lot Janus for going through and pointing out the various problems I was having including horrible code layout, I learnt a lot through your re-writing as well.

Related

Plot a distribution curve curve in R

What are the alternatives for drawing a simple curve for a function like
0, from -∞ to 0
x^2, from 0 to (3)^(1/3)
1, from (3)^(1/3) to ∞
look that my attempt is incomplet
curve(x^2, from=0, to=(3)^(1/3), xlab="x", ylab="y")
I hope I didn't write a duplicate question.
You need to specify a function that fits your problem:
> f <- function(x) ifelse(x < 0, 0, ifelse(x<3^(1/3), x^2, 1))
> curve(f, from = -5, to = 5)

Trouble with sparse matrices in Mathematica

The following code gives me the first k eigenvalues of a certain big matrix. Because of the symmetries of the matrix, the eigenvalues are in pairs, one positive and the other negative, with the same absolute value. This is indeed the case if I run the code with the exact matrices, without using the sparse version. However when I make them sparse, the resulting eigenvalues appear to lose the sign information, as now the pairs can be both negative, or both positive, depending on the number I put on "nspins" (which controls the size of the matrix). The variable "sparse" controls whether I use sparse matrices or not.
This issue gives me considerable trouble. Can anybody tell me why the sparse version of the computation gives wrong signs, and how to fix it?
sparse = 1; (*Parameter that controls whether I will use sparse \
matrices, 0 means not sparse, 1 means sparse*)
(*Base matrices of my big matrix*)
ox = N[{{0, 1}, {1, 0}}];
oz = N[{{1, 0}, {0, -1}}];
id = N[{{1, 0}, {0, 1}}];
(*Transformation into sparse whether desired*)
If[sparse == 1,
ox = SparseArray[ox];
oz = SparseArray[oz];
id = SparseArray[id];
]
(*Dimension of the big matrix, must be even*)
nspins = 8;
(*Number of eigenvalues computed*)
neigenv = 4;
(*Algorithm to create big matrices*)
Do[
Do[
If[j == i, mata = ox; matc = oz;, mata = id; matc = id;];
If[j == 1,
o[1, i] = mata;
o[3, i] = matc;
,
o[1, i] = KroneckerProduct[o[1, i], mata];
o[3, i] = KroneckerProduct[o[3, i], matc];
];
, {j, 1, nspins}];
, {i, 1, nspins}];
(*Sum of big matrices*)
ham = Sum[o[1, i].o[1, i + 1], {i, 1, nspins - 1}] +
o[1, nspins].o[1, 1] + 0.5*Sum[o[3, i], {i, 1, nspins}];
(*Print the desired eigenvalues*)
Do[Print [Eigenvalues[ham, k][[k]]], {k, 1, neigenv}];

Solving systems of second order differential equations

I'm working on a script in mathematica that will take simulate a string held at either end and plucked, by solving the wave equation via numerical methods. (http://en.wikipedia.org/wiki/Wave_equation#Investigation_by_numerical_methods)
n = 5; (*The number of discreet elements to be used*)
L = 1.0; (*The length of the string that is vibrating*)
a = 1.0/3.0; (*The distance from the left side that the string is \
plucked at*)
T = 1; (*The tension in the string*)
[Rho] = 1; (*The length density of the string*)
y0 = 0.1; (*The vertical distance of the string pluck*)
[CapitalDelta]x = L/n; (*The length of each discreet element*)
m = ([Rho]*L)/n;(*The mass of each individual node*)
c = Sqrt[T/[Rho]];(*The speed at which waves in the string propogate*)
I set all my variables
Y[t] = Array[f[t], {n - 1, 1}];
MatrixForm(*Creates a vector size n-1 by 1 of functions \
representing each node*)
I define my Vector of nodal position functions
K = MatrixForm[
SparseArray[{Band[{1, 1}] -> -2, Band[{2, 1}] -> 1,
Band[{1, 2}] -> 1}, {n - 1,
n - 1}]](*Creates a matrix size n by n governing the coupling \
between each node*)
I create the stiffness matrix relating all the nodal functions to one another
Y0 = MatrixForm[
Table[Piecewise[{{(((i*L)/n)*y0)/a,
0 < ((i*L)/n) < a}, {(-((i*L)/n)*y0)/(L - a) + (y0*L)/(L - a),
a < ((i*L)/n) < L}}], {i, 1, n - 1}]]
I define the initial positions of each node using a piecewise function
NDSolve[{Y''[t] == (c/[CapitalDelta]x)^2 Y[t].K, Y[0] == Y0,
Y'[0] == 0},
Y, {t, 0, 10}];(*Numerically solves the system of second order DE's*)
Finally, This should solve for the values of the individual nodes, but it returns an error:
"NDSolve::ndinnt : Initial condition [Y0 table] is not a number or a rectangular array"
So , it would seem that I don't have a firm grasp on how matrices work in mathematica. I would greatly appreciate it if anyone could help me get this last line of code to run properly.
Thank you,
Brad
I don't think you should use MatrixForm when defining the matrices. MatrixForm is used to format a list of list as a matrix, usually when you display it. Try removing it and see if it works.

How to obtain values from a NMaximize in a For loop

I am using NMaximize to obtain values from an NDSolve function:
Flatten[NDSolve[{x''[t] == (F Cos[\[CapitalOmega] t] -
c x'[t] - (k + \[Delta]kb) x[t] + \[Delta]kb y[t])/m,
y''[t] == (-c y'[t] - (k + \[Delta]kb) y[t] + \[Delta]kb x[t])/m,
x'[0] == 0, y'[0] == 0, x[0] == 0, y[0] == 0}, {x[t], y[t]}, {t, 0, 10}]];
NMaximize[{Evaluate[y[t] /. s], 8 < t < 9}, t]
This is the case of a set of coupled, second order, ordinary differential equations (they were derived by a constant rotational speed gyroscope).
I need to obtain the maximum of the response function after the transient solution has faded and no longer influences the result.
I am trying to use a For loop to obtain the different maximums achieved for a range of "CapitalOmega", say 80 to 130 in steps of 1/2.
Currently I am getting the result in a form:
{a, {t -> b}}
How could This be placed on a list for all the values of "a" obtained from the For loop? This so they can be plotted using
ListLinePlot[]
If for each value of CapitalOmega you are getting some {a,{t->b}} from your NDSolve and you just want the list of 'a' values then
Table[First[NDSolve[...],{CapitalOmega,80,130,1/2}]
should do it. The First will extract the 'a' each time and using Table instead of For will put them in a list for you. If my example isn't exactly what your actual code is then you should still be able to use this idea to accomplish what you want.
Note: When I try to paste just your NDSolve[...] into Mathematica I get
NDSolve::ndnum: Encountered non-numerical value for a derivative at t==0.`.
which may be a real problem or may just be because of how you cut and pasted your posting.

Can't DSolve two-body problem using Mathematica?

EDIT:
#auxsvr is correct that I had the force equations wrong, and about the
-3/2 exponent.
Another way to see this it to simply to 2 dimensions and consider a
force acting from the origin, proportional to 1/r^2 just like gravity,
where r is the distance from the origin.
At (x,y), the force acts in the direction (-x,-y). However, that's
just the direction, not the magnitude. If we use k as the constant of
proportionality, the force is (-kx, -ky).
The magnitude of the force is thus Sqrt[(-kx)^2+(-ky)^2], or
k*Sqrt[x^2+y^2], or k*Sqrt[r^2] or k*r
Since the force magnitude is also 1/r^2, this gives us k= 1/r^3.
The force is thus (-x/r^3, -y/r^3).
Since I was initially using r^2 as my primary quantity, that's (r^2)^(-3/2), which is where the 3/2 comes from.
This effectively invalidates my question, although it still makes an
interesting theoretical discussion.
I retried this Mathematica with the correct equations, but still got
no answer. As other points out, the result is only an ellipse under
certain conditions (could be a parabola or hyperbola in other cases).
Additionally, although the eventual orbit is a conic section, the
initial orbit may spiral in or out until the final conic section orbit
is achieved.
EDIT ENDS HERE
I'm using Mathematica to solve the two-body problem:
DSolve[{
d2[t] == (x1[t]-x0[t])^2 + (y1[t]-y0[t])^2 + (z1[t]-z0[t])^2,
D[x0[t], t,t] == (x1[t]-x0[t])/d2[t],
D[y0[t], t,t] == (y1[t]-y0[t])/d2[t],
D[z0[t], t,t] == (z1[t]-z0[t])/d2[t],
D[x1[t], t,t] == -(x1[t]-x0[t])/d2[t],
D[y1[t], t,t] == -(y1[t]-y0[t])/d2[t],
D[z1[t], t,t] == -(z1[t]-z0[t])/d2[t]
},
{x0,y0,z0,x1,y1,x1,d2},
t
]
But I get back:
There are fewer dependent variables than equations, so the system is overdetermined.
I count 7 equations and 7 dependent variables?
In fact, the system is semi-undetermined, since I don't provide positions and velocities at time 0.
I realize my equations themselves might be wrong for the two-body problem, but I'd still like to know why Mathematica complains about this.
How about NDSolve?
d2[t_] = (-x0[t] + x1[t])^2 + (-y0[t] + y1[t])^2 + (-z0[t] +
z1[t])^2; sol = {x0, y0, z0, x1, y1, z1} /.
NDSolve[{x0''[t] == (-x0[t] + x1[t])/d2[t],
y0''[t] == (-y0[t] + y1[t])/d2[t],
z0''[t] == (-z0[t] + z1[t])/d2[t], x1''[t] == -x0''[t],
y1''[t] == -y0''[t], z1''[t] == -z0''[t], x0[0] == 0, y0[0] == 0,
z0[0] == 0, x1[0] == 1, y1[0] == 0, z1[0] == 0, x0'[0] == -0.5,
y0'[0] == 1, z0'[0] == 0.5, x1'[0] == 0.5, y1'[0] == -1,
z1'[0] == -0.5}, {x0, y0, z0, x1, y1, z1}, {t, 0, 120}][[1]]
r = 3;
Animate[
Graphics3D[
{
PointSize -> 0.05,
Point[{sol[[1]][t], sol[[2]][t], sol[[3]][t]}],
Point[{sol[[4]][t], sol[[5]][t], sol[[6]][t]}],
Red,
Line[Table[{sol[[1]][t1], sol[[2]][t1], sol[[3]][t1]}, {t1, 0, t, 0.1}]],
Green,
Line[Table[{sol[[4]][t1], sol[[5]][t1], sol[[6]][t1]}, {t1, 0, t, 0.1}]]
},
PlotRange -> {{-r, r}, {-r, r}, {-r, r}}
], {t, 0, 120}, AnimationRate -> 4
]
I'm suprised no one else noticed that everyone wrote the equations of motion incorrectly, which is apparent from the plot, because bounded orbits in the gravitational potential of two bodies are always closed (Bertrand's theorem). The correct equations of motion are
{x0''[t] == (-x0[t] + x1[t])/d2[t]^(3/2),
y0''[t] == (-y0[t] + y1[t])/d2[t]^(3/2),
x1''[t] == -x0''[t],
y1''[t] == -y0''[t]}
with
d2[t_]:= (x1[t]-x0[t])^2 + (y1[t]-y0[t])^2
since the motion is planar for central force fields. Also, one must set the initial conditions appropriately, otherwise the centre of mass moves and the orbits are no longer conical sections.

Resources