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]
Related
I want to prove the expression Limit[Sin[x*x] *Exp[-x*x]*x, x -> Infinity] ==0
So I do this Normal[ Series[ Sin[x*x] *Exp[-x*x]*x, {x, 0, 40}]].And the result
imply the expression will be infinity.
That is odd, and I make some change. Let t=x^2, then the expression will be Limit[Sin[t] *Exp[-t]*Sqrt[t], t -> Infinity]. I try again Normal[ Series[Sin[x] *Exp[-x]*Sqrt[x], {x, 0, 40}]]. That's the answer I need.
The right series
I can't figure out what's wrong. Why I can't generate series directly?
I wnat to say thay f, f1 and f2 should be the same, but they looks like this:
f=f1,but f2 diffuse
Normal[Series[Sin[x*x]*Exp[-x*x]*x, {x, 0, 40}]]
with t = x^2 is equivalent to
Normal[Series[Sin[t]*Exp[-t]*x, {x, 0, 40}]]
because x != Sqrt[x^2] e.g. for `x = -2
Results for negative t are not plotted.
Plot[Sin[t]*Exp[-t]*Sqrt[t], {t, -8, 8}]
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
I've gotten stuck getting my euler angles out my rotation matrix.
My conventions are:
Left-handed (x right, z back, y up)
YZX
Left handed angle rotation
My rotation matrix is built up from Euler angles like (from my code):
var xRotationMatrix = $M([
[1, 0, 0, 0],
[0, cx, -sx, 0],
[0, sx, cx, 0],
[0, 0, 0, 1]
]);
var yRotationMatrix = $M([
[ cy, 0, sy, 0],
[ 0, 1, 0, 0],
[-sy, 0, cy, 0],
[ 0, 0, 0, 1]
]);
var zRotationMatrix = $M([
[cz, -sz, 0, 0],
[sz, cz, 0, 0],
[ 0, 0, 1, 0],
[ 0, 0, 0, 1]
]);
Which results in a final rotation matrix as:
R(YZX) = | cy.cz, -cy.sz.cx + sy.sx, cy.sz.sx + sy.cx, 0|
| sz, cz.cx, -cz.sx, 0|
|-sy.cz, sy.sz.cx + cy.sx, -sy.sz.sx + cy.cx, 0|
| 0, 0, 0, 1|
I'm calculating my euler angles back from this matrix using this code:
this.anglesFromMatrix = function(m) {
var y = 0, x = 0, z = 0;
if (m.e(2, 1) > 0.999) {
y = Math.atan2(m.e(1, 3), m.e(3, 3));
z = Math.PI / 2;
x = 0;
} else if (m.e(2, 1) < -0.999) {
y = Math.atan2(m.e(1, 3), m.e(3, 3));
z = -Math.PI / 2;
x = 0;
} else {
y = Math.atan2(-m.e(3, 1), -m.e(1, 1));
x = Math.atan2(-m.e(2, 3), m.e(2, 2));
z = Math.asin(m.e(2, 1));
}
return {theta: this.deg(x), phi: this.deg(y), psi: this.deg(z)};
};
I've done the maths backwards and forwards a few times, but I can't see what's wrong. Any help would hugely appreciated.
Your matrix and euler angles aren't consistent. It looks like you should be using
y = Math.atan2(-m.e(3, 1), m.e(1, 1));
instead of
y = Math.atan2(-m.e(3, 1), -m.e(1, 1));
for the general case (the else branch).
I said "looks like" because -- what language is this? I'm assuming you have the indexing correct for this language. Are you sure about atan2? There is no single convention for atan2. In some programming languages the sine term is the first argument, in others, the cosine term is the first argument.
The last and most important branch of the anglesFromMatrix function has a small sign error but otherwise works correctly. Use
y = Math.atan2(-m.e(3, 1), m.e(1, 1))
since only m.e(3, 1) of m.e(1, 1) = cy.cz and m.e(3, 1) = -sy.cz should be inverted. I haven't checked the other branches for errors.
Beware that since sz = m.e(2, 1) has two solutions, the angles (x, y, z) used to construct the matrix m might not be the same as the angles (rx, ry, rz) returned by anglesFromMatrix(m). Instead we can test that the matrix rm constructed from (rx, ry, rz) does indeed equal m.
I worked on this problem extensively to come up with the correct angles for a given matrix. The problem in the math comes from the inability to determine a precise value for the SIN since -SIN(x) = SIN(-x) and this will affect the other values of the matrix. The solution I came up with comes up with two equally valid solutions out of eight possible solutions. I used a standard Z . Y . X matrix form but it should be adaptable to any matrix. Start by findng the three angles from: X = atan(m32,m33): Y = -asin(m31) : Z = atan(m21,m11) : Then create angles X' = -sign(X)*PI+X : Y'= sign(Y)*PI-Y : Z = -sign(Z)*pi+Z . Using these angles create eight set of angle groups : XYZ : X'YZ : XYZ' : X'YZ' : X'Y'Z' : XY'Z' : X'Y'Z : XY'Z
Use these set to create the eight corresponding matrixes. Then do a sum of the difference between the unknown matrix and each matrix. This is a sum of each element of the unknown minus the same element of the test matrix. After doing this, two of the sums will be zero and those matrixes will represent the solution angles to the original matrix. This works for all possible angle combinations including 0's. As 0's are introduced, more of the eight test matrixes become valid. At 0,0,0 they all become idenity matrixes!
Hope this helps, it worked very well for my application.
Bruce
update
After finding problems with Y = -90 or 90 degrees in the solution above. I came up with this solution that seems to reproduce the matrix at all values!
X = if(or(m31=1,m31=-1),0,atan(m33+1e-24,m32))
Y = -asin(m31)
Z = if(or(m31=1,m31=-1),-atan2(m22,m12),atan2(m11+1e-24,m21))
I went the long way around to find this solution, but it wa very enlightening :o)
Hope this helps!
Bruce
I have a grass texture:
I use it in my 2d-game. I want to animate it by code, without any predefined animations.
The grass should interact with wind. So when the wind is stronger, the grass should stoop into need side more.
First version of animation I made using sinusoid function, but such animation is a bit ugly, because the base of the grass moves left/right like all another part of picture. And with sinusoid I'm not able to regulate stoop of the image.
Any advices?
This is what you may get easily by shifting pixels:
Although probably not very useful for you, here is a Mathematica program:
f[l_, sh_] := Module[{c = l, k = (Dimensions#l)[[1]]},
For[i = 1, i <= k, i++,
c[[i]] = RotateRight[l[[i]], IntegerPart[(k + 1 - i)/sh]]];
Return[c];]
b = ArrayPad[ImageData#a, {{40}, {40}, {0}}, {1, 1, 1}];
Export["c:\\anim.gif",
{Image#b, Image#f[b, 7],
Image#f[b, 5], Image#f[b, 3],
Image#f[b, 5], Image#f[b, 7], Image#b}, "DisplayDurations" -> .3]
Edit
But you can get a better effect by applying a circular transform:
b = Image#ArrayPad[ImageData#a, {{40, 0}, {40}, {0}}, {1, 1, 1}];
f[image_, angleMult_] := ImageForwardTransformation[image, (
fi = ArcTan[Abs[#[[2]]/(#[[1]] - .5)]];
fi1 = angleMult fi (#[[1]]^2 + #[[2]]^2)/2;
{(1/2 - Sin[fi1] #[[2]] - Cos[fi1]/2 +
Cos[fi1] #[[1]]), -Sin[fi1]/2 + Sin[fi1] #[[1]] +
Cos[fi1] #[[2]]}) &]
t = Table[f[b, x], {x, 0, .2, .02}];
t1 = Reverse#t;
Export["c:\\anim.gif", Join[t, t1], "DisplayDurations" -> .15];
Import["c:\\anim.gif", "Animation"]
You could just shift the rows, so that e.g. every 3rd row is shifted 1px to the right, beginning with the bottom.
How are you displaying the texture? When using a billboard you could manipulate the vertices of the billboard and even triangulate the billboard for more control.
I am trying to figure out a way to move two points, X and Y, independently of one another along the edges of an equilateral triangle with vertices A, B, and C. There are also some collision rules that need to be taken into account:
(1) If X is at a vertex, say vertex A, then Y cannot be on A or on the edges adjacent to it. i.e., Y can only be on vertices B or C or the edge BC.
(2) If X is on an edge, say AB, then Y cannot be on A, nor B, nor any of the edges adjacent to A and B. i.e., Y must be on vertex C
I have figured out how to move the two points along the triangle using a pair of sliders, but I can't figure out how to implement the collision rules. I tried using the Exclusions option for Slider but the results are not what I expect. I would prefer to drag the points along the triangle rather than using sliders, so if someone knows how to do that instead it would be helpful. Ideally, I would be able to
move the two points from a vertex to either one of the edges instead of coming to a stop at one of them. Here is my code so far.
MyTriangle[t_] :=
Piecewise[{{{-1, 0} + (t/100) {1, Sqrt[3]},
100 > t >= 0}, {{0, Sqrt[3]} + (t/100 - 1) {1, -Sqrt[3]},
200 > t >= 100},
{{1, 0} + (t/100 - 2) {-2, 0}, 300 >= t >= 0}}]
excluded[x_] := \[Piecewise] {
{Range[0, 99]~Join~Range[201, 299], x == 0},
{Range[0, 199], x == 100},
{Range[101, 299], x == 200},
{Range[0, 199]~Join~Range[201, 299], 0 < x < 100},
{Range[1, 299], 100 < x < 200},
{Range[0, 99]~Join~Range[101, 299], 200 < x < 300}
}
{Dynamic[t], Dynamic[x]}
{Slider[Dynamic[t], {0, 299, 1}, Exclusions -> Dynamic[excluded[x]]], Dynamic[t]}
{Slider[Dynamic[x], {0, 299, 1}, Exclusions -> Dynamic[excluded[t]]], Dynamic[x]}
Dynamic[Graphics[{PointSize[Large], Point[MyTriangle[t]],
Point[MyTriangle[x]],
Line[{{-1, 0}, {1, 0}, {0, Sqrt[3]}, {-1, 0}}]},
PlotRange -> {{-1.2, 4.2}, {-.2, 2}}]]
How about something like:
MyTriangle[t_]:=Piecewise[{
{{-1,0}+t {1,Sqrt[3]},1>t>=0},
{{0,Sqrt[3]}+(t-1) {1,-Sqrt[3]},2>t>=1},
{{1,0}+(t-2) {-2,0},3>=t>=0},{0,True}}]
and
Column[{
{Slider[Dynamic[x], {0, 3, .01}], Dynamic[x]},
{Slider[Dynamic[y], {0, 3, .01}], Dynamic[y]},
Dynamic[x = Mod[x, 3]; Which[
x==0.,Which[0.<=y<1.,y=1.,2.<y<=3.,y=2.],0.<x<1.,y=2.,
x==1.,Which[1.<=y<2.,y=2.,0.<y<=1.,y=0.],1.<x<2.,y=0.,
x==2.,Which[2.<=y<3.,y=0.,1.<y<=2.,y=1.],2.<x<3.,y=1.];
Graphics[{PointSize[Large], Point[MyTriangle /# {x, y}],
Line[{{-1, 0}, {1, 0}, {0, Sqrt[3]}, {-1, 0}}]}]]}]