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"
Related
Does anyone know what does /; mean for example:V[n_][i_/;i<=imax,0];=V[n][i,0]=0 in Mathematica?
It's part of a program to draw the eletrical potential function of a rectangular metal trough using the finite-difference methods.
Here's the improved one, but still cannot work.
V[0][i_, j_] := 0;
tol = 0.0025;
imax = 20; jmax = 20;
V[n_][i_, 0] := V[n][i, 0] = 0;
V[n_][i_, jmax] := V[n][i, jmax] = 100*Sin[0.05*Pi*i];
V[n_][0, j_] := V[n][0, j] = 0;
V[n_][imax, j_] := V[n][imax, j] = 0;
V[n_][i_, j_] := V[n][i, j] = (1/4)*(V[n - 1][i + 1, j] +
V[n - 1][i - 1, j] + V[n - 1][i, j + 1] + V[n - 1][i, j - 1]);
For[m = 1, Max[Table[Abs[V[m][i, j] - V[m - 1][i, j]], {i, 1, imax - 1}, {j, 1, jmax - 1}]] >= tol, m++;
If[m > 20, Break[]]];
Print[m];
Show[ListPlot3D[Table[V[m][i, j], {j, 0, 20}, {i, 0, 20}]], BoxRatios -> {1, 1, 0.85}, PlotRange -> {0, 1}, Axes -> True, AxesLabel -> {"x", "y", "V"}]
I've already get the point through the reference of Wolfram. And here is the web
https://reference.wolfram.com/language/ref/Condition.html. Thanks for #agentp help
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}]
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]
I'm trying to calculate the fourier transform of a gaussian beam. Later I want to ad some modifications to the following example code. With the required stepsize of 1e-6 the calculation with 8 kernel takes 1244s on my workstation. The most consuming part is obviously the generation of uaperture. Has anyone ideas to improve the performance? Why does mathematica not create a packed list from my expression, when I'm having both real and complex values in it?
uin[gx_, gy_, z_] := Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
Developer`ToPackedArray[
ParallelTable[
w0/w Exp[-(x^2 + y^2)/w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 +
I \[Zeta]*0], {x, gx}, {y, gy}]
]
]
AbsoluteTiming[
dx = 1*^-6;
gx = Range[-8*^-3, 8*^-3, dx];
gy = gx;
d = 15*^-3;
uaperture = uin[gx, gy, d];
ufft = dx*dx* Fourier[uaperture];
uout = RotateRight[
Abs[ufft]*dx^2, {Floor[Length[gx]/2], Floor[Length[gx]/2]}];
]
Thanks in advance,
Johannes
You can speed it up by first vectorizing it (uin2), then compiling it (uin3):
In[1]:= L1 = {0.1, 0.2, 0.3};
In[2]:= uin[gx_, gy_, z_] :=
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
ParallelTable[
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 +
I \[Zeta]*0], {x, gx}, {y, gy}]
]
In[3]:= uin2[gx_, gy_, z_] :=
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k, x, y},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
{x, y} = Transpose[Outer[List, gx, gy], {3, 2, 1}];
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 + I \[Zeta]*0]
]
In[4]:= uin3 =
Compile[{{gx, _Real, 1}, {gy, _Real, 1}, z},
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k, x, y},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
{x, y} = Transpose[Outer[List, gx, gy], {3, 2, 1}];
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 + I \[Zeta]*0]
],
CompilationOptions -> {"InlineExternalDefinitions" -> True}
];
In[5]:= dx = 1*^-5;
gx = Range[-8*^-3, 8*^-3, dx];
gy = gx;
d = 15*^-3;
In[9]:= r1 = uin[gx, gy, d]; // AbsoluteTiming
Out[9]= {67.9448862, Null}
In[10]:= r2 = uin2[gx, gy, d]; // AbsoluteTiming
Out[10]= {28.3326206, Null}
In[11]:= r3 = uin3[gx, gy, d]; // AbsoluteTiming
Out[11]= {0.4190239, Null}
We got a ~160x speedup even though this is not running in parallel.
Results are the same:
In[12]:= r1 == r2
Out[12]= True
There's a tiny difference here due to numerical errors:
In[13]:= r2 == r3
Out[13]= False
In[14]:= Max#Abs[r2 - r3]
Out[14]= 5.63627*10^-14
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[]
]