Tag Info

Hot answers tagged

11

Okay, this is a bit of an embarassment. Here is a very small modification of the original code. I simply made explicit option settings, made a denominator to Sin explicitly real, that kind of thing. My tests show the same timing as the original, give or take an iota. ie = 200; ez = ConstantArray[0., {ie + 1}]; hy = ConstantArray[0., {ie}]; fdtd1d = ...


6

Referring to your own answer there is a much simpler form that you may use, recalling: Collect[expr, var, h] applies h to the expression that forms the coefficient of each term obtained. sol = x[t] /. s[[1]]; Collect[sol, _C, Simplify] (E^(I t ωd) f0)/(m ω0^2 + I m β ωd - m ωd^2) + E^(-(1/2) t (β + Sqrt[β^2 - 4 ω0^2])) C[1] + E^(1/2 t (-β + ...


6

It works in V10 with G defined as in the update to the question but not in V9. It works in both versions of Mathematica if G is undefined. So there are two ways to get the solution in V9: 1) Compute the solution with a symbolic G and then define G; 2) Rationalize G, solve, and numericize the result with N: G = (1.86559*10^38 lambda)/(1 + (0.338476 ...


6

Vb3[x_] := If[x < -L, 10^10, If[-0.1*L < x < 0.1*L, U, 0]]; u = NDSolve[{(-hbar^2/(2*me)) f''[x] == (2.40986*^-20 - Vb3[x]) f[x], f[L] == 0, f'[-L] == 0.1}, f, {x, -L, L}, Method -> {"DiscontinuityProcessing" -> False}] Plot[f[k] /. u, {k, -L, L}]


6

Ok, at first you don't solve your equation properly, the grid spacing is not enough for the entire time range. So first increase resolution, e.g.: tmax = 10; mdfun = NDSolveValue[ {D[h[x, t], t] + D[h[x, t]^-1*D[h[x, t], x], x] + D[h[x, t]^3*D[h[x, t], {x, 3}], x] == 0, h[0, t] == h[2 Sqrt[2] \[Pi], t], h[x, 0] == 1 + 1/10*Sin[x/Sqrt[2]]}, h, {x, 0, ...


5

For NDSolve, an InterpolatingFunction might be sufficient. Here are smooth versions of UnitStep and UnitBox, with a smoothing "radius" of epsilon. us[epsilon_] := Interpolation[{{{-epsilon}, 0, 0}, {{epsilon}, 1, 0}}, "ExtrapolationHandler" -> {If[# < -epsilon, 0, 1] &, "WarningMessage" -> False}]; ub[epsilon_] := Interpolation[ ...


4

Instead of giving screenshots you should copy your code and paste to this section properly. Ok, now I give a general approach to solve this problem. In[1]:= DSolve[x''[t] + x[t] == 0, x[t], t] Out[1]= {{x[t] -> C[1] Cos[t] + C[2] Sin[t]}} Well, Mathematica does the job well and easy. Your problem shouldn't be that hard. Let's see: In[2]:= eqn = ...


4

Well, that was easy: Block[{Simplify = FullSimplify}, DSolve[{x''[t] + x[t]^3 == 0, x'[0] == 0, x[0] == x0}, x[t], t] ] // FullSimplify (* {{x[t] -> x0 JacobiCD[(t x0)/Sqrt[2], -1]}} *) DSolve uses Simplify to check the solution, and Simplify is not up to the task. So I used Block to replace it with FullSimplify, which will reduce the DE to True ...


4

Try to solve the problem numerically beta = 0.2; As you have observed, the problem is not solved in symbolic form: Solution = DSolve[{y''[x] == -y[x] - beta*Sign[y'[x]], y[0] == 1, y'[0] == -1}, y[x], x] (* -> DSolve[{(y^\[Prime]\[Prime])[x] == -0.2 Sign[Derivative[1][y][x]] - y[x], y[0] == 1, Derivative[1][y][0] == -1}, y[x], x] *) Now ...


4

You need the magic of "Pseudospectral": sol = With[{nxy = 250}, NDSolve[gnm, {u, v}, {x, -L, L}, {t, 0, tmax}, Method -> {"MethodOfLines", "SpatialDiscretization" -> {"TensorProductGrid", "MaxPoints" -> nxy, "MinPoints" -> nxy, "DifferenceOrder" -> "Pseudospectral"}}]]; Animate[Plot[Through[{Re, Im}@#] & /@ {u[x, t], ...


4

It's pretty straightforward to make this work, so I'll just post my interpretation of what you're trying to do. In addition to neglecting to define the velocities and accelerations in terms of the positions, you also had some typos in there (capital XX etc.). There was also a redundant initial condition for XX[td] that I removed. It's important to define the ...


4

Manipulate[{sx = NDSolve[{x''[t] + (2 k1)/m (x[t] - a) == 0, x[0] == x0, x'[0] == vx0}, x[t], {t, 0, 10}]; sy = NDSolve[{y''[t] + (2 k2)/m (y[t] - a) == 0, y[0] == y0, y'[0] == vy0}, y[t], {t, 0, 10}]; Graphics[{Disk[{Evaluate[x[t] /. sx][[1]], Evaluate[y[t] /. sy][[1]]}, 0.4]}, PlotRange -> 6] /. t ...


3

Edit 2: I think I've figured out how NDSolve constructs the solution, which has been incorporated in the revision below. Introduction The term -beta Sign[y'[x]] is discontinuous when beta != 0, so the IVP is not guaranteed to have a solution. NDSolve does not indicate that, but it is obvious. In such cases NDSolve automatically processes the ...


3

You could start with sol = DSolve[{c'[t] == t^2 c[t]^3}, c[t], t] plot = (c[t] /. sol /. C[1] -> #) & /@ Range@3; Plot[plot, {t, -3, -1.}, GridLines -> Automatic] Update To include C[1] = 20 plot = (c[t] /. sol /. C[1] -> #) & /@ {0, 10, 20} // Transpose; Plot[plot, {t, -6, 0}, GridLines -> Automatic, PlotLegends -> {" ...


3

If you correct the Syntax from deltaP to deltap[] there is no problem: sol1 = DSolve[(miuP*F*D[deltaP[x], x]) + (Dp* D[deltaP[x], {x, 2}]) + (G*Exp[-alpha*x]) == (deltaP[x]/Tp), deltaP[x], x] (* {{deltaP[x] -> (2*Dp*G* ...) a long Expression, with two constants C[1], C[2] *) Regards, Wolfgang


3

One way to tackle the problem is to recognize that the solution is one giant sum with three terms. You can then convert this sum to a list, simplify the terms individually, and sum all elements of the list back together. sol = x[t] /. s[[1]]; Total[ FullSimplify[ Apply[ List , sol ] ] ] But this "hack" is somewhat unelegant, because it might fail if ...


2

Concerning the follow-up question in a comment: ...just for curiosity, if someone knows how to impose a positive codomain to not yet known function, I would very much like to know. One way is to define the system so that x'[t] is positive whenever x[t] < 0. Then when x[t] reaches 0, it will be stuck at 0, unless x'[t] becomes positive for x[t] > ...


2

Higher-order, nonlinear differential equation are usually difficult. We can solve the general equation and try to solve the initial condition for the constants of integration. sol = DSolve[{x''[t] + x[t]^3 == 0}, x, t]; Solve::ifun: Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution ...


2

In version 9 you can use Part to access the parts of an InterpolatingFunction: points = {{0, 0}, {1, 1}, {2, 3}, {3, 4}, {4, 3}, {5, 0}}; ifun = Interpolation[points] (* InterpolatingFunction[{{0,5}},<>] *) {ifun[[3]], ifun[[4]]} (* {{{0,1,2,3,4,5}},{{0},{1},{3},{4},{3},{0}}} *) You can also access Properties of ifun using (not ifun["Properties"] ...


2

For the initial integral, why do you have any reason to believe that there is any sort of closed form? As for the simpler integral, if you do: Assuming[ x > 0 && c > 0 && t > 0, Integrate[BesselJ[0, s], {s, x + c t, x - c t}]] It returns: 1/2 (\[Pi] (-c t + x) BesselJ[1, c t - x] StruveH[0, c t - x] - \[Pi] (c t + x) ...


2

Wolfgang's answer #3 It seems apropriate to create a new answer because the idea of my second answer is not taken up here. Abstract We present here the complete analytic solution of the problem. First we consider the problem with the sharp step replaced by a smooth one. Then a study of the phase space trajectories of the system will give the key insight ...


2

Wolfgang's answer #4, 03.10.14 Reformulation of problem and solution The following brief answer #4 presents finally the complete exact solution of the problem. It is based on all the intermediate results obtained so far, and therefore presents only the final results without derivations. First of all, I have simplified the problem without loss of ...


2

Just to address your question, of what can be done. This: expr1 = MapAt[ Collect[Expand[#], {F[t], F[t]^2, J[t], J[t]^2}] &, (F'[t] == d*(Q[t] - R[t]) /. R[t] -> x*q*A[t]*B[t] + f*M[t]) /. M[t] -> b0 + b1*H[t] /. Q[t] -> (A[t] - 1)*B[t] /. H[t] -> m0 + m1*L[t] - m2*G[t] /. G[t] -> v*F[t] /. {A[t] -> a0 ...


2

I think you are missing a parenthesis. This works: Plot[Evaluate[{X[t], Y[t], Z[t]} /. sol /. {C[1] -> 1}], {t, 0, 50}] If you want a 3D plot you should write: ParametricPlot3D[Evaluate[{X[t], Y[t], Z[t]} /. sol /. {C[1] -> 1}], {t, 0, 50}] Hope this helps


2

Not a complete answer but might give some ideas. As noted, it is impossible to enforce the inequality since it can conflict with the equations. One possibility might be to cap k[t] and force the derivative to vanish when it hits the cap. Below is code that could be used. constraint1 = k'[t] == (inv[t] - 0.04 k[t])* Piecewise[{{1, 5 10^6 - k[t] > ...


1

Yes, make X, Y, and Z functions of t. And use Equal instead of Set or SetDelayed. Example with Z[t] = Exp[t]: Block[{Z = Exp}, DSolve[{X[t] == a + b Y[t], Y'[t] == c + d Z[t]}, {X[t], Y[t]}, t] ] (* {{X[t] -> a + b (d E^t + c t + C[1]), Y[t] -> d E^t + c t + C[1]}} *)


1

You can do it like this, but your system is Stiff: p[t] = {p1[t], p2[t]}; p'[t] = {p1'[t], p2'[t]}; A[t_] = {{p1[t], 1}, {1, p2[t]}}; NDSolve[Flatten@{Thread[p'[t] == A[t].p[t]], Thread[p[t] == {1, 0}] /. t -> 0}, {p1, p2}, {t, 0, 1}] NDSolve::ndsz: At t == 0.9040861047003397`, step size is effectively zero; singularity or stiff ...


1

I am not an expert on this (solving non-linear odes'). But to put all what I saw here in stead of in comment is easier. Basically, you have a non-linear ode with singularity when y(0)=0 as well due to the initial conditions. You can see this part like this: de = y[x] (2 + y[x]) y''[x] + 2 x y[x] (2 + y[x]) y'[x]/(-1 + x^2) - (1 + 2 y[x]) y'[x]^2 + 4 (1 + ...


1

Your code for your model is wrong. As others are saying, your forcing function is $\cos(\omega t)$. Therefore, you simply use NDSolve to obtain solution. eq =theta''[t] + b/(m L0^2) theta'[t] + g/L0 Sin[theta[t]] -T0 Cos[w t]/(m L0^2); ic = {theta'[0] == Pi, theta[0] == 1}; b = 0.22; m = 1; L0 = 1; g = 9.8; w = 1; T0 = 1; sol = First@NDSolve[{eq == 0, ic}, ...


1

One can access Reduce through Solve via the Solve option Method -> Reduce. To get this through DSolve, we can use SetOptions. opts = Options[Solve]; SetOptions[Solve, Method -> Reduce]; DSolve[u'[t] == u[t]/(4 + u[t]^2), u[t], t] // FullSimplify SetOptions[Solve, opts]; (* long messy answer that looks quite like rcollyer's and Simon Wood's, ...



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