I am trying to solve this system of eqs
dw(v,t)/dt =2g(v,t) w(t,v)
g(t,v)= Pi/2 (v^2)d g0(v,t)/dt
d go(v,t)/dt + d/dv[dw/dt *1/v^3)]=0
initial conditions
f0= (a/(Pi)^0.5)*e^[v^2/ve^2] + (b/(Pi)^0.5)*e^[(v - u)^2/ve^2]
a^2 + b^2 = 1
f0=go(v,0)
w(v,0)=0
This is my code
Here I am initializing some variables and defining f0 that is g(v,t=0).
a = 0.5;
b = (3^0.5)/2;
ve = 1;
u = 1;
f0[v_] = (a/(Pi)^0.5)Exp[v^2/ve^2] + (b/(Pi)^0.5)Exp[(v - u)^2/ve^2];
u1 = Log[((1 - a^2)/a^2)^0.5]/(2*u) + u/2;
u2 = 3u/2 - Log[((1 - a^2)/a^2)^0.5]/(2u);
f0[u1]
f0[u2]
Here I am using a system of 3 eqs for 3 functions and equating g(v,0)=f0
sol = NDSolve[{
D[go[v, t], t] + D[D[w[v, t], t], v]/(v^3) + (-3v^(-4))D[w[v, t], t] == 0,
g[v, t] == Pi/2 (v^2) D[go[v, t], v],
go[v, 0] == f0[v],
D[w[v, t], t] == 2g[v, t]w[v, t],
w[v, 0] == 0},
{go[v, t], W[v, t]},
{v, u1, u2},
{t, 0, 10000000000}]
And it is returning errors like
The PDE is convection dominated and the result may not be stable.
Adding artificial diffusion may help
"No DirichletCondition or Robin-type NeumannValue was specified for
{g}; the result may not be unique"
The PDE is convection dominated and the result may not be stable.
Adding artificial diffusion may help.
enter image description here
I failed to do the following expression and make it give accurate results if any one can help me I will be glade. I attached my expression in a pic "want this" and my trial as "my trial". the correct answer must equal 0.119 when a=1, b=10, m=3, n=6. thanks a lot in advance.
a = 1
b = 10
m = 3
n = 6
a^1 b^n (Sum[
Sum[Sum[Sum[(-1)^(k + v - n + m + 1)
If[k == 0, 1,
SeriesCoefficient[Series[(-Log[1 - x])^k, {x, 0, 30}],
p + k]] If[n - k - 2 == 0, 1,
SeriesCoefficient[
Series[(-Log[1 - x])^(n - k - 2), {x, 0, 30}],
q + (n - k - 2)]]
Binomial[n - m - 1, k] Binomial[b - 1,
v] (-PolyGamma[0, -1 + 1/a - k + n + q] +
PolyGamma[0, 2/a + n + p + q + v])/(a (1 + k + p + v) +
1), {q, 0, 30 - (n - k - 2)}], {p, 0, 30 - k}], {v, 0,
b - 1}], {k, 0, n - m - 1}])/((m - 1)! (n - m - 1)!)
I found the solution for the problem. the problem was when the value of k was 0 the coefficient will not equal 1 but the whole expression must be found from the start for a value of k that will start from 1 and an expression when the value of k is 0. yet I failed to solve it using MATHEMATICA but by doing the above I succeed to get the correct result. thank you all for your precious time and opinions.
I'm solving and plotting the equations of motion for the double pendulum using Mathematica's NDSolve.
I've successfully plotted the Angular position using a standard plot. But when I come to use the parametric plot for the position of each mass. I get no errors but simply no plot.
eqn1 = 2 th''[t] + Sin[th[t] - ph[t]] (ph'[t])^2 + Cos[th[t] - ph[t]] (ph''[t]) + (2 g/l) Sin[th[t]]
eqn2 = ph''[t] + Sin[th[t] - ph[t]] (th'[t])^2 + Cos[th[t] - ph[t]] (th''[t]) + (g/l) Sin[th[t]]
eqnA = eqn1 /. {g -> 10, l -> 1}
eqnB = eqn2 /. {g -> 10, l -> 1}
sol = NDSolve[{eqnA == 0, eqnB == 0, th[0] == 0.859, th'[0] == 0, ph[0] == 0.437, ph'[0] == 0}, {th, ph}, {t, 0, 10}]
Plot[{th[t], ph[t]} /. sol, {t, 0, 10}]
r1 = {lSin[th[t]] + lSin[ph[t]], -lCos[th[t]] - lCos[ph[t]]} /. {l -> 1, g -> 10}
ParametricPlot[r1 /. sol, {t, 0, 10}]
Replace
r1 = {lSin[th[t]] + lSin[ph[t]], -lCos[th[t]] - lCos[ph[t]]} /. {l->1, g->10}
with
r1 = {l*Sin[th[t]] + l*Sin[ph[t]], -l*Cos[th[t]] - l*Cos[ph[t]]} /. {l->1, g->10}
and your ParametricPlot should appear.
One useful trick you might remember, when any plot doesn't appear you can try replacing the plot with Table and see what it shows. Often the table of data provides the needed hint about why the plot isn't appearing.
I'm trying to fit 2 paramters (p & alpha) using a function with 3 paramters (T,p,alpha). The function is dependent on a series of other functions (derivative, integral, logs, etc.). I get this error: is not a list of real numbers with dimensions {111} at {a,b} = {1.,1.}.
Here is the code:
deltaData = {{1.00, 0}, {0.96, 0.3416}, {0.92, 0.4749}, {0.88, 0.5715}, {0.84, 0.648}, {0.80, 0.711}, {0.76, 0.764}, {0.72, 0.8089}, {0.66, 0.864}, {0.62, 0.8939}, {0.58, 0.919}, {0.54, 0.9399}, {0.50, 0.9569}, {0.46, 0.9704}, {0.42, 0.9809}, {0.38, 0.9885}, {0.34, 0.9938}, {0.30, 0.9971}, {0.26, 0.9989}, {0.22, 0.9997}, {0.16, 1}, {0.14, 1}};
deltaFit = NonlinearModelFit[deltaData, (1 + a*T + c*T^2 + e*T^3 + g*T^4 + i*T^5 + k*T^6)/(1 + b*T + d*T^2 + f*T^3 + h*T^4 + j*T^5 + l*T^6), {a, b, c, d, e, f, g, h, i, j, k, l}, T];
data = {{0.203, 0.031}, {0.203, 0.030}, {0.246, 0.055}, {0.267, 0.072}, {0.300, 0.105}, {0.300, 0.105}, {0.330, 0.147}, {0.373, 0.214}, {0.397, 0.255}, {0.415, 0.293}, {0.445, 0.351}, {0.477, 0.430}, {0.493, 0.463}, {0.520, 0.538}, {0.541, 0.590}, {0.582, 0.717}, {0.589, 0.733}, {0.625, 0.847}, {0.645, 0.911}, {0.685, 1.029}, {0.688, 1.043}, {0.730, 1.181}, {0.751, 1.247}, {0.782, 1.338}, {0.793, 1.375}, {0.830, 1.472}, {0.856, 1.531}, {0.878, 1.585}};
AlphaBCS = 1.746;
(* Functions to obtain fit function *)
delta[T_, p_, alpha_] := p*deltaFit[T] + (1 - p)*deltaFit[T]/alpha;
fx[T_, x_, p_, alpha_] := (Exp[AlphaBCS/T*(x^2 + delta[T, p, alpha]^2)^(1/2)] + 1)^(-1);
Ses[T_, p_, alpha_] := -6*AlphaBCS/Pi^2*NIntegrate[fx[T, x, p, alpha]*Log[fx[T, x, p, alpha]] + (1 - fx[T, x, p, alpha])*Log[1 - fx[T, x, p, alpha]], {x, 0, 100}];
dSes[T_, p_, alpha_] = D[Ses[T, p, alpha], T];
Ces[T_, p_, alpha_] := T*dSes[T, p, alpha];
(* Test Plot *)
Show[ListPlot[data], Plot[Ces[T, 0.5, 1.746], {T, 0.015, .95}], Frame -> True]
(* Fit *)
nlm = NonlinearModelFit[data, Ces[T, p, alpha], {{p, 0.5}, {alpha, 0.5}}, T];
Normal[nlm]
nlm["ParameterTable"]
Show[ListPlot[data], Plot[nlm[T], {T, 0.015, .95}], Frame -> True]
Does anyone know how I can get the fit working (get the correct values for p & alpha)?
We have the system:
x'[t] == x[t] - 5 y[t] + z[t]
y'[t] == 3 x[t] - 3 y[t] - 3 z[t]
z'[t] == -2 x[t] + 10 y[t] + 4 z[t]
and the initial conditions:
x[0] == .01
y[0] == 3
z[0] == 0
I produced the specific plot:
eqn = {x'[t] == x[t] - 5 y[t] + z[t], y'[t] == 3 x[t] - 3 y[t] - 3 z[t],
z'[t] == -2 x[t] + 10 y[t] + 4 z[t]};
sol = NDSolve[{eqn, x[0] == .01, y[0] == 3, z[0] == 0}, {x[t], y[t],
z[t]}, {t, -5, 5}]
{xde[t_], yde[t_], zde[t_]} = {x[t], y[t], z[t]} /. Flatten[sol]
ParametricPlot3D[{xde[t], yde[t], zde[t]}, {t, 0, 10},
AxesLabel -> {"x", "y", "z"},
PlotRange -> {{-15, 15}, {-15, 15}, {-15, 15}}]
I know how when pick a random point to plot the whole trajectory, but I can't find a way to animate a point moving along the trajectory that was plotted.
In this particular example the point should be at t == 0 and move along until t == 2.
This quite easy in Mathematica - use an interactive interface:
Animate[Show[ParametricPlot3D[{xde[t], yde[t], zde[t]}, {t, 0, 10},
AxesLabel -> {"x", "y", "z"},
PlotRange -> {{-5, 15}, {-5, 5}, {-5, 15}}],
Graphics3D[{Red, PointSize[.05], Point[{xde[T], yde[T], zde[T]}]}]], {T, 0, 2}]