# Tag Info

15

Here's my attempt. To get the matrix representing the Laplacian I use LaplacianFilter on an array of symbols and CoefficientArrays to extract the coefficients. n = 200; shape = ArrayPad[ConstantArray[0, {n/2, n/2}], {{0, n/2}, {0, n/2}}, 1]; shapeVector = Flatten @ Position[Flatten @ shape, 1]; symbolArray = Array[x, {n, n}]; symbolLaplacian = ...

12

While the other answers are nice, the icon deserves a closer look: Note, in particular, that four of the six edges are not constrained by the ostensible Dirichlet boundary conditions, nor is it clear that they solve a Neumann problem. And indeed, as I noted in the comments this is supported by the OP's first link. In short, to produce the logo, they took ...

11

I had this laying around from a course in numerical linear algebra I taught a few years ago. Here's a matrix whose nonzero elements describe the basic shape. size = 50; nw = Partition[Table[i, {i, 1, size^2}], size]; sw = Partition[Table[i, {i, size^2 + 1, 2*size^2}], size]; se = Partition[Table[i, {i, 2*size^2 + 1, 3*size^2}], size]; L = ...

8

One can get a hint of the issue by seeing that DSolve[{1/a D[f[a, b], a] == 1, D[f[a, b], b] == 1}, f[a, b], {a, b}] can't be solved, but DSolve[{ D[f[a, b], a] == a, D[f[a, b], b] == 1}, f[a, b], {a, b}] (* {f[a, b] -> a^2/2 + b + C[1]}} *) can. But there are the same system! (multiplying by a both sides of the first equation in the first case ...

7

You can use the options VectorScale and VectorStyle of VectorPlot. To create the slope field for the first order equation $y'=f(x,y)$, I usually do something like so. f = Exp[-x] - y; VectorPlot[{1, f}, {x, -2, 2}, {y, -2, 2}, VectorScale -> {0.03, Automatic, None}, VectorStyle -> {Gray, Arrowheads[0]}]

7

Yes, you can simply replace each occurrence of Arrow with Line like this: VectorPlot[{y, -x}, {x, -3, 3}, {y, -3, 3}] /. Arrow -> Line To understand how this works, please read the documentation for ReplaceAll and also take a look at FullForm[VectorPlot[...]]. The point is to see that the plot is just a bunch of graphics directives and therefore we ...

7

I agree with Rahul that, since you've got a single, one dimensional equation indexed by a single parameter, a bifurcation diagram is a natural way to visualize this situation. If you want an animation or dynamic image, you might highlight one particular phase line as a function of $a$. You could also display the slope field of the system right along side of ...

5

Not sure if I understand the physics of the problem. But to use the EulerEquations, you need to call the VariationalMethods. Below is my edit of your code: Needs["VariationalMethods"] lim = 6 T = 0.5*x'[t]^2 V = Sqrt[x[t]^2]^n L = T - V eqn[n_] = EulerEquations[L, x[t], t] soln = x[t] /. (First@ NDSolve[{eqn[#], x[0] == 2, x'[0] == 0}, x, {t, 0, 10}] ...

5

You are trying to exactly solve the Ginzburg-Landau equation with potential 1-\frac{1}{r^2}. No wonder that you fail: it has no analytical solution. At least no solution that I would hear about, and I am in this business already for some time. One reason to see that it has no non-trivial exact solution is that when you fix its boundary conditions in another ...

5

Let' s do this problem using just quaternions. First, let's see how we multiply quaternions together, remember that each component has those "imaginary" objects that multiply in a specific way, this can be replaced by just defining a new quarternion cross product that behaves the same way. We will keep the differential equations real so we ...

4

You have written cosinstead of Cos[], and also forgotten to enclose the objective functions in a list: sol = NDSolve[{l1 (m1 (g*Sin[P[t]] + l1*P''[t]) + m2 (g*Sin[P[t]] + l1*P''[t] + l2 (Sin[P[t] - Q[t]] Q'[t]^2 + Cos[P[t] - Q[t]] Q''[t]))) == 0, l2 m2 (g*Sin[P[t]] + l1 (-Sin[P[t] - Q[t]] P'[t]^2 + Cos[Q[t] - Q[t]] P''[t]) + ...

3

It seems you're back =) Well the problem with your code up there is that Mathematica is not expanding "Abs'[x[t]]" as well as you're missing "Needs["VariationalMethods"]". One variant is to "Trick" Mathematica a bit and change the potential energy term in the Lagrangian by writing $\left|x\right|$ as $\sqrt{x^2}$. Using "EulerEquations" you could then do ...

3

You can just solve it like we do by hand. Finding equation of motion from Lagrangian is really only one line: Clear[x, t, n] ke = 0.5*x'[t]^2; pe = Sqrt[x[t]^2]^n; lagrangian = ke - pe; eq = D[D[lagrangian, x'[t]], t] - D[lagrangian, x[t]] == 0; sol[p_] := x[t] /. First@NDSolve[{eq /. n -> p, x[0] == 2, x'[0] == 0}, x, {t, 0, 10}] Plot[Evaluate[sol[2]], ...

3

Since you have just two variables, $x$ and $a$, you can make a 2D plot: f[x_, a_] := -x^4 + 5 a x^2 - 4 a^2; Show[StreamPlot[{f[x, a], 0}, {x, -4, 4}, {a, -1, 1}, StreamPoints -> Fine], ContourPlot[f[x, a] == 0, {x, -4, 4}, {a, -1, 1}, ContourStyle -> ColorData[1, 2]]] My explanatory comment below was incorrect, so I'm including a corrected ...

2

That means the boundary conditions defined should fit the the range of t and r in NDSolve command. You have 4 values: {t,0,10} and {r,0,100}, so you have to define the conditions at these 4 values. Here you define at r = s = 1 but you run r from 0 to 100. You need to define the boundary condition at r = 0 and at r = 100. But I don't know which boundary ...

2

No direct way I'm aware of to do this: as far as I know, when the initial NDSolve is evaluated, those options a plugged into an internal slot and can't be tinkered. However, perhaps something like this would serve your purpose: low = NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 5}, WorkingPrecision -> \$MachinePrecision, ...

1

As it is already mentioned in the comments, the initial condition Derivative[1, 0][u][0.001, x] == 0, should not appear there. After it removal the equation is solved as expected: eps4 = 0; phi6m4V = NDSolveValue[{D[u[t, x], x, x] - D[u[t, x], t]/ Sqrt[t^2 + x^2] == -6 u[t, x]^5 + (8 + 4 eps4) u[t, x]^3 - (2 + 4 eps4) u[t, x], ...

1

In addition to what Szabolcs wrote, you mentioned that the solution doesn't look like what you want it to be. Here is the solution using tmax = 2: tmax = 2; s = NDSolve[{P1'[t] == -0.01 0.99995 P2[t] - Pbar2[t] P3[t] + Pbar3[t] P2[t], P2'[t] == -0.01 (-0.99995 P1[t] - 0.01 P3[t]) - Pbar3[t] P1[t] + Pbar1[t] P3[t], P3'[t] == -0.01 ...

1

You indicated in the comments below your question that your goal is to plot v1 and v2 against t. The following code does that using NDSolve. I corrected the capital-V error in your definition of j and added some initial conditions. Clear[j, v, s] j[v_] = v[t] + v[t]^2; τ = 1; s = 0.1; ip = 0; sol = NDSolve[{v1'[t] == -v1[t]/τ + (j[v2]*s) + ip, ...

1

I think you have to specify the dimension of X when you solve this kind of equations, mathematica can't just deduce it from the fact that {0,9.81} has dimension 2, however the behaviour of NDSolve is still quite curious, try with: X[t_] := {x1[t], x2[t]}; vec = {0, 9.81}; conditions1 = {Norm[X[t]]^2 == 1, X[0] == {1, 0}, X'[0] == {0, 1}}; conditions2 = ...

Only top voted, non community-wiki answers of a minimum length are eligible