Hello and thanks in advance,
I came upon an issue trying to plot a piecewise function in Mathematica. When entered directly into the Plot function, the piecewise did NOT plot. However, when I defined the piecewise as a variable, it did plot. Why is this issue occurring and can I still join my plot? (I would like to join it by setting exclusions to none)
The following is my code: (I define a Maxwell strain function and am trying to model the plastic deformation of a polymer over multiple stress cycles)
z = 2*10^10;
h = 10^12;
MaxwellStrain[s_, t_] := s/z + (s*t)/h;
stress = {0, 10^7, -10^7, 5*10^6, 10^7, -5*10^6};
time = {0, 100, 200, 300, 400, 500};
strainList = Join[{0}, Table[MaxwellStrain[stress[[i + 1]], t - time[[i]]], {i, 1, 5}]];
Plot[
Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
,
{t, 0, 500}
]
x = Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
Plot[x, {t, 0, 500}]
The following is my output: (first plot doesn't show, the second does)
output:
Thank you for the help,
SV
Related
I am trying to visualize the result of numerical integration in Wolfram Mathematica using DensityPlot. But dark artifacts appear inside the circle on the graph, this is incorrect. How to fix this?
f[u_, v_]:=(1/1.2)*(1/(3.14159*0.02^2)*E^(-((x-u)^2+(y-v)^2)/0.02^2)+0.2/(3.14159*2^2)*E^(-((x-u)^2+(y-v)^2)/2^2));
i[x_, y_]:=NIntegrate[f[u, v],{u, v} \[Element] Disk[{0,0},2.5], AccuracyGoal -> 30];
DensityPlot[i[x, y], {x, -3, 3}, {y, -3, 3},ColorFunction->"SunsetColors",PlotPoints -> 20, PlotLegends -> Automatic]
Link to the image: https://postimg.cc/47MJTYj7
Well, that is not an artifact, or is it. First I'd like to point out that f is a function of u, v, x and y. So the way it is programmed is not very clean. Now to the main problem. There are two Gaussian peaks. One is very broad, the other very sharp. In many cases the numerical integral just does not get points near the sharp peak, therefore not detecting it. As the rest is smooth and easy, no subset is generated and the integral is just missing this contribution. Luckily, there is an option specifically for this. MinRecursion: NIntegrate may miss sharp peaks of integrands:.... So this works
g[x_, y_, s_] := Exp[ -( x^2 + y^2 ) / s^2] / (s^2 Pi)
f[x_, y_, u_, v_] := g[ x - u, y - v, 0.02 ] / 1.2 + 0.2 g[ x - u, y - v, 2 ]
i[x_, y_] := NIntegrate[ f[x, y, u, v], {u, v} \[Element] Disk[{0, 0}, 2.5], MinRecursion -> 5]
nn = 30;
t = Table[i[x, y], {x, -3, 3, 6/nn}, {y, -3, 3, 6/nn}];
ListDensityPlot[t, ColorFunction -> "SunsetColors", PlotLegends -> Automatic]
Takes quite some time, though. Probably, it would be better to split this up in two integrals and invest some thought on the integration boundaries.
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.
Excuse me I am new to Wolfram. I have seen people asking questions about how to do convolution of a function with itself in Wolfram. However, I wonder how to do it multiple times in a loop. That is to say I want to do f20* i.e. f*f*f*f*....f totaling 20 f. How to implement it?
Here is my thinking. Of course do not work....
f[x_] := Piecewise[{{0.1`, x >= 0 && x <= 10}, {0, x < 0}, {0, x > 10}}];
g = f;
n = 19;
For[i = 1, i <= n, i++, g = Convolve[f[x], g, x, y]]; Plot[
g[x], {x, -10, n*10 + 10}, PlotRange -> All]
Could anybody help me?
My new code after revising agentp's code
f[x_] := Piecewise[{{0.1, x >= 0 && x <= 10}, {0, x < 0}, {0,x > 10}}];
n = 19;
res = NestList[Convolve[#, f[x], x, y] /. y -> x &, f[x], n];
Plot[res, {x, -10, (n + 1)*10 + 10}, PlotRange -> All,PlotPoints -> 1000]
My buggy image
maybe this?
Nest[ Convolve[#, f[x], x, y] /. y -> x &, f[x] , 3]
If that's not right maybe show what you get by hand for n=2 or 3.
res = NestList[ Convolve[#, f[x], x, y] /. y -> x &, f[x] , 10];
Plot[res, {x, 0, 100}, PlotRange -> All]
this gets very slow with n, I don't have the patience to run it out to 20.
Your approach is nearly working. You just have to
make sure to copy f by value before entering the loop, because otherwise you face infinite recursion.
Assign the result of Convolve to a function which takes a parameter.
This is the code with the mentioned changes:
f[x_] := Piecewise[{{0.1, x >= 0 && x <= 10}, {0, x < 0}, {0, x > 10}}];
g[x_] = f[x];
n = 20;
For[i = 1, i <= n, i++, g[y_] = Convolve[f[x], g[x], x, y]];
Plot[g[x], {x, -10, n*10 + 10}, PlotRange -> All]
Edit: While this works, agentp's answer is more consise and i suspect also faster.
Mathematica: Filling an infinitely deep potential well
Comment: The proper page for Mathematica questions is this one
I would like to visualize a potential well for a particle in a box in Mathematica similar to the second picture from Wikipedia here.
I have defined my function piecewise
(*Length of the box*)
L = 4;
(*Infinitly deep potential well between 0 and L*)
V[x_] := Piecewise[{
{\[Infinity], x <= 0},
{0, 0 < x < L},
{\[Infinity], L <= x}}]
and would like to obtain a plot function which gives a filled area where the potential goes to infinity.
Unfortunately my tries end up in shaded areas between the "zero region" of the potential, while I would like to have the shading in the infinity region.
Table[Plot[V[x], {x, -5, 10},
Filling -> f], {f, {Top, Bottom, Axis, 0.3}}]
The problem is that Infinity is too much for plot. So let's just give it some other big number. But to prevent it from rescaling the y axis we need to be specific with the upper plot range
Block[{\[Infinity] = 1*^1},
Plot[V[x], {x, -5, 10}, Filling -> Bottom,
PlotRange -> {Automatic, 1}]
]
Alternatively you could plot V[x]/.\[Infinity]->1*^1 instead of Block but I like Block's way better
Just give it values instead of infinity:
(*Length of the box*)L = 4;
(*Infinitly deep potential well between 0 and L*)
V[x_] := Piecewise[{{1, x <= 0}, {0, 0 < x < L}, {1, L <= x}}]
Plot[V[x], {x, -5, 10}, Filling -> Bottom]
Another way using graphic primitives:
wellLeft = 0;
leftBorder = wellLeft - 1;
rightBorder = L + 1;
wellRight = L;
top = 5;
Graphics[{
Hue[0.67, 0.6, 0.6],
Opacity[0.2],
Rectangle[{leftBorder, 0}, {wellLeft, top}],
Rectangle[{wellRight, 0}, {rightBorder, top}]
}, Axes -> True]
I programmed a Euler function but misread the instructions, so now I have to make a new one, but I can't figure it out.
I have made the following automatic Euler function.
f[x_, y_] := -x y^2;
x0 = 0;
y0 = 2;
xend = 2;
steps = 20;
h = (xend - x0)/steps // N;
x = x0;
y = y0;
eulerlist = {{x, y}};
For[i = 1, i <= steps, y = f[x, y]*h + y;
x = x + h;
eulerlist = Append[eulerlist, {x, y}];
i++
]
Print[eulerlist]
But it just generates the list I have specified.
I would like to have a Euler function which is able to generate this form:
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
I don't seem to get any further.
It is not clear what you are asking, but if what you want is to be able to input
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
and get
{{0,2},{0.1,2.},{0.2,1.96},{0.3,1.88317},{0.4,1.77678},{0.5,1.6505},{0.6,1.51429},{0.7,1.37671},{0.8,1.24404},{0.9,1.12023},{1.,1.00728},{1.1,0.905822},{1.2,0.815565},{1.3,0.735748},{1.4,0.665376},{1.5,0.603394},{1.6,0.548781},{1.7,0.500596},{1.8,0.457994},{1.9,0.420238},{2.,0.386684}}
Then you need to write a function definition like this:
Euler[y0_, f_, {x0_, xend_}, steps_Integer?Positive] := (* body *)
Notice the underscores to denote patterns, the := to denote delayed evaluation and the pattern specification Integer?Positive.
As for the body of the function -- oh my goodness could you have picked a less Mathematica-style approach? Perhaps not. Procedural loops and Append are almost never the best way to do anything in Mathematica.
Here is a better solution.
Euler[y_, y0_, f_, {x_, x0_, xend_}, steps_Integer?Positive] :=
With[{h = N[(xend - x0)/steps], ff = Function[{x, y}, f]},
NestList[{#[[1]] + h, ff[#[[1]], #[[2]]]*h + #[[2]]} &, {x0, y0},
steps]]
Euler[y, 2, -x y^2, {x, 0, 2}, 20]
{{0, 2}, {0.1, 2.}, {0.2, 1.96}, {0.3, 1.88317}, {0.4,
1.77678}, {0.5, 1.6505}, {0.6, 1.51429}, {0.7, 1.37671}, {0.8,
1.24404}, {0.9, 1.12023}, {1., 1.00728}, {1.1, 0.905822}, {1.2,
0.815565}, {1.3, 0.735748}, {1.4, 0.665376}, {1.5, 0.603394}, {1.6,
0.548781}, {1.7, 0.500596}, {1.8, 0.457994}, {1.9, 0.420238}, {2.,
0.386684}}
If you want something that outputs Euler[y, 2, -x y^2, {x, 0, 2}, 20], then typing it into the notebook is the quickest method.