Mathematica does not evaluate the integral - wolfram-mathematica

I have the following Mathematica Code, But it does not give me anything as the output. Can someone help me.
\[Alpha] = 3;
F[s_] := Exp[-A*s^(2/\[Alpha])];
integral = Re[Assuming[{A > 0, t > 0, {t, A} \[Element] Reals},
Integrate[F[s]*Exp[s*t] /. s -> I*y, {y, 0, Infinity}]/Pi]]
I also want to run the following code:
\[Alpha] = 4;
f[s_] := Exp[-A*s^(2/\[Alpha])];
integral =Re[Assuming[{A > 0, t > 0, {t, A} \[Element] Reals},
Integrate[f[s]*Exp[s*t] /. s -> I*y, {y, -Infinity, Infinity}]/Pi]]
here A is give by
A = Pi*\[Lambda]*P^(2/\[Alpha])*Gamma[1 + 2/\[Alpha]]*Gamma[1 - 2/\[Alpha]];
Lambda and P are known values.

At least under version 10 this seems to work
α = 3;
A = Pi*λ*P^(2/α)*Gamma[1+2/α]*Gamma[1-2/α];
integral = Re[Assuming[{A > 0, t > 0},
Integrate[Exp[-A*(I*y)^(2/α)]*Exp[I*y*t], {y, 0, Infinity}]]/Pi]
α = 4;
A = Pi*λ*P^(2/α)*Gamma[1+2/α]*Gamma[1-2/α];
integral = Re[Assuming[{A > 0, t > 0},
Integrate[Exp[-A*(I*y)^(2/α)]*Exp[I*y*t], {y, -Infinity, Infinity}]]/Pi]
If you can provide more information about the values of P and λ then perhaps Re can do more.

Related

Wolfram Mathematica - Minimization of an absolute error with respect to two parameters

I want to minimize the absolute error between numerical solutions of two nonlinear ODEs. Here is the code I use:
\[Epsilon] = 10^-6;
Delta[t_] := 1/(Sqrt[\[Pi]] \[Epsilon]) Exp[-(t/\[Epsilon])^2]
f[t_] := 1/2 (1 + Tanh[100 t])
solw = NDSolve[{w''[t] + (w[t] + w[t]^2) w'[t] == f[t], w[0] == 0,
w'[0] == 0}, w, {t, 0, 2 \[Pi]}, Method -> "MethodOfLines"];
wsol[t_] := Evaluate[w[t] /. solw]
solG = ParametricNDSolve[{G''[t] + (G[t] + G[t]^2) G'[t] ==
s2 Delta[t], G[0] == 0, G'[0] == 0}, G, {t, 0, 2 \[Pi]}, {s2},
Method -> "MethodOfLines"];
GGreen[t_, s2_] := Evaluate[G[s2][t] /. solG]
Gsol[t_, s1_, s2_] :=
s1 NIntegrate[GGreen[\[Tau], s2] f[t - \[Tau]], {\[Tau], 0, t},
Method -> "LocalAdaptive"]
Then, I discretize the absolute error in time:
Table[Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]
and use the command:
NMinimize[
Max[Table[
Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]], s1, s2]
However, this does not work because s2 is not specified in the NIntegrate in Gsol.
Is there a way to minimize
Table[Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]]
with respect to s1 and s2 simultaneously?
For the sake of simplicity, s2 can be restricted to [-2,2].
Here is an answer.
\[Epsilon] = 10^-6;
Delta[t_] := 1/(Sqrt[\[Pi]] \[Epsilon]) Exp[-(t/\[Epsilon])^2]
f[t_] := 1/2 (1 + Tanh[100 t])
solw = NDSolve[{w''[t] + Exp[w[t]] == f[t], w[0] == 0, w'[0] == 0},
w, {t, 0, 2 \[Pi]}, Method -> "MethodOfLines"];
wsol[t_] := Evaluate[w[t] /. solw]
solG = ParametricNDSolve[{G''[t] + Exp[G[t]] == s2 Delta[t],
G[0] == 0, G'[0] == 0}, G, {t, 0, 2 \[Pi]}, {s2},
Method -> "MethodOfLines"];
GGreen[t_, s2_] := Evaluate[G[s2][t] /. solG]
Gsol[t_, s1_, s2_] :=
s1 NIntegrate[GGreen[\[Tau], s2] f[t - \[Tau]], {\[Tau], 0, t},
Method -> "LocalAdaptive"]
interpol =
ListInterpolation[
Table[Gsol[t, s1, s2], {t, 0, 1, 0.1}, {s2, -5, 5, 0.1}], {{0,
1}, {-5, 5}}];
NMinimize[{Max[
Table[Abs[wsol[t] - interpol[t, s2]], {t, 0, 1, 0.1}]], -5 <= s2 <=
5}, {s1, s2}]
However, one needs to be careful with choosing the range of s2 in the NMinimize. For -1 <= 2 <=2 the solution is better than for -3 <= s2 <=3. This means that there might be a better solution.

Solving stochastic differential equations

Below code is used to solve a stochastic equation numerically in Mathematica for one particle. I wonder if there is a way to generalize it to the case of more than one particle and average over them. Is there anyone who knows how to do that?
Clear["Global`*"]
{ a = Pi, , b = 2 Pi, l = 5, k = 1};
ic = x#tbegin == 1;
tbegin = 1;
tend = 400;
interval = {1, 25};
lst := NestWhileList[(# + RandomVariate#TruncatedDistribution[interval,
StableDistribution[1, 0.3, 0, 0, 1]]) &, tbegin, # < tend &];
F[t_] := Piecewise[{{k, Or ## #}}, -k] &[# <= t < #2 & ###
Partition[lst, 2]];
eqn := x'[t] == (F#(t)) ;
sol = NDSolveValue[{eqn, ic}, x, {t, tbegin, tend},
MaxSteps -> Infinity];
Plot[sol#t, {t, tbegin, tend}]
First[First[sol]]
Plot[sol'[t], {t, tbegin, tend}]
Plot[F[t], {t, tbegin, tend}]

Problems with Mathematica Plotting using Piecewise

I am trying to plot using piecewise in one of my problems and I have two variables: x and psi. However, the respective functions are only valid for a defined range of "x" and the psi range is the same. I am trying to make a 3D plot of these -- and I basically just have Plot3D[p,{x,0,1},{psi,0.01,1}] ---> These ranges are for the entire plot range and my x range for the respective functions is already defined in the Piecewise function.
I get the following error: saying that Plot::exclul: ...... must be a list of equalities or \ real-valued functions.
Can anyone please help me with this. I am trying to follow the same procedure as: How can I use Piecewise[] with a variable number of graphs/intervals
But, I don't know what to do about the plotting part.
Thanks.
The following is my code:
j = 10;
s = 0; r = 0;
K[x_, psi_] :=
Sum[Sin[n*Pi*x]*
Sin[n*Pi*
psi]*(2*Exp[-(n*Pi)^2*
Abs[s + r]] - (Exp[-(n*Pi)^2*Abs[s - r]] -
Exp[-(n*Pi)^2*(s + r)])/(n*Pi)^2 ), {n, 1, j}];
TL[x_, psi_] = Integrate[K[x - y, psi]*y, {y, -10, 10}];
TU[x_, psi_] = Integrate[K[x - y, psi]*(1 - y), {y, -10, 10}];
eq = {TL[x, psi], TU[x, psi]};
cond = {{0 <= x <= 0.5, 0.01 <= psi <= 1}, {0.5 < x <= 1,
0.01 <= psi <= 1}};
p = Piecewise[{eq, cond}];
Plot3D[p, {x, 0, 1}, {psi, 0.01, 1}]
Here is a working version:
time = AbsoluteTime[];
j = 10; s = 0; r = 0;
K[x_, psi_] :=
Sum[Sin[n*Pi*x]*Sin[n*Pi*psi]*
(2*Exp[-(n*Pi)^2*Abs[s + r]] -
(Exp[-(n*Pi)^2*Abs[s - r]] -
Exp[-(n*Pi)^2*(s + r)])/(n*Pi)^2), {n, 1, j}];
TL[x_, psi_] := Integrate[K[x - y, psi]*y, {y, -10, 10}];
TU[x_, psi_] := Integrate[K[x - y, psi]*(1 - y), {y, -10, 10}];
Plot3D[Piecewise[
{{TL[x, psi], 0 <= x <= 0.5}, {TU[x, psi], 0.5 < x <= 1}}],
{x, 0, 1}, {psi, 0.01, 1}]
ToString[Round[AbsoluteTime[] - time]] <> " seconds"

DSolve for a specific interval

I am trying to solve an D-equation and do not know y[0], but I know y[x1]=y1.
I want to solve the DSolve only in the relevant xrange x=[x1, infinitny].
How could it work?
Attached the example that does not work
dsolv2 = DSolve[{y'[x] == c*0.5*t12[x, l2]^2 - alpha*y[x], y[twhenrcomesin] == zwhenrcomesin, x >= twhenrcomesin}, y[x], x]
dsolv2 = Flatten[dsolv2]
zsecondphase[x_] = y[x] /. dsolv2[[1]]
I am aware that DSolve does not allow the inequality condition but I put it in to explain you what I am looking for (t12[x,l2] will give me a value only depending on x since l2 is known).
EDIT
t12[j24_, lambda242_] := (cinv1 - cinv2)/(cop2 - cop1 + (h2*lambda242)*E^(p*j24));
cinv1 = 30; cinv2 = 4; cinv3 = 3; h2 = 1.4; h3 = 1.2; alpha = 0.04; z = 50; p = 0.06; cop1 = 0; cop2 = 1; cop3 = 1.3; teta2 = 0.19; teta3 =0.1; co2 = -0.6; z0 = 10;l2 = 0.1;
Your equation is first order and linear, so you can get a very general solution :
generic = DSolve[{y'[x] == f[x] - alpha*y[x], y[x0] == y0}, y[x], x]
Then you can substitute your specific term :
c = 1;
x0 = 1;
y0 = 1;
solution[x_] = generic[[1, 1, 2]] /. {f[x_] -> c*0.5*t12[x, l2]^2}
Plot[solution[x], {x, x0, 100}]
What is wrong with this example?
t12[x_] := Exp[-x .01] Sin[x];
dsolv2 = Chop#DSolve[{y'[x] == c*0.5*t12[x]^2 - alpha*y[x], y[1] == 1}, y[x], x];
Plot[y[x] /. dsolv2[[1]] /. {alpha -> 1, c -> 1}, {x, 1, 100}, PlotRange -> Full]
Edit
Regarding your commentary:
Try using a piecewise function to restrict the domain:
t12[x_] := Piecewise[{{ Exp[-x .01] Sin[x], x >= 1}, {Indeterminate, True}}] ;
dsolv2 = Chop#DSolve[{y'[x] == c*0.5*t12[x]^2 - alpha*y[x], y[1] == 1}, y[x], x];
Plot[y[x] /. dsolv2[[1]] /. {alpha -> 1, c -> 1}, {x, 1, 100}, PlotRange -> Full]

Plot Complex Lines with mathematica

z1=a;
z2=b;
z3=c;
z[t_]=z1+(z2-z1)t;
z[t_]=z1+(z3-z1)t;
z[t_]=z2+(z3-z2)t;
I want to plot these lines with Mathematica on Unit circle. What will I do?
You could do something like this:
(*Represent your complexes as vectors*)
z1 = {5, 3};
z2 = {.5, .1};
z3 = {-.1, .25};
za[t_] = z1 + (z2 - z1) t;
zb[t_] = z1 + (z3 - z1) t;
zc[t_] = z2 + (z3 - z2) t;
(*Find the parameter boundaries*)
s = t /. Union[Solve[Norm[za[t]] == 1, t],
Solve[Norm[zb[t]] == 1, t],
Solve[Norm[zc[t]] == 1, t]
];
(*And Plot*)
Show[ParametricPlot[{za[t], zb[t], zc[t]}, {t, Min[s], Max[s]},
RegionFunction -> Function[{x, y}, x^2 + y^2 < 1],
PlotRange -> {{-1, 1}, {-1, 1}}],
Graphics#Circle[]
]

Resources