I am trying to model in Mathematica the concentration (density) of an intersection of two graphs, eggs[x,y,z,t] and sperm[x,y,z,t]. The issue arises when one tries to implement an equation describing the graph's boundaries (sperm[x,y,z,t] == eggs[x,y,z,t]) into either DensityPlot3D or say the RegionFunction -> Function[{x,y,z,t},func] specifier. The methodology works for ContourPlot3D, however, DensityPlot3D is much more suitable for the task, as I am trying to animate the solutions and have the color of the graph be the concentration variable (4D output of sperm and egg equations).
Here is my code for the ContourPlot3D process:
In[1]:= sperm[x_,y_,z_,t_]= 1/Sqrt[4*Pi*t]*E^((-x^2-y^2-z^2)/(4*t));
eggs[x_,y_,z_,t_]=1/Sqrt[4*Pi*t]*E^((-(x+3)^2-(y+3)^2-(z+3)^2)/(4*t));
Animate[ContourPlot3D[sperm[x, y, z, t] == eggs[x, y, z, t], {x, -10, 10}, {y, -10, 10}, {z, -10, 10}], {t, 0, 10}]
The output normally crashes the system and thus cannot be uploaded here.
Here is my attempt to apply this method to the DensityPlot3D:
In[2]:= Animate[DensityPlot3D[sperm[x, y, z, t] == eggs[x, y, z, t], {x, -10, 10}, {y, -10, 10}, {z, -10, 10}], {t, 0, 10}]
The output is only a blank 3D plot.
After researching, I had found that RegionFunction (and RegionPlot3D) only seems to use inequalities, and the first argument in DensityPlot3D uses a function that is not in the form of an equation. I had tried to bypass this by doing something like
f = Solve[sperm[x, y, z, t] == eggs[x, y, z, t], {x, y, z, t}, Reals]
and inputting that variable as the first argument, but this did not help, as the result was still considered to be an equation (a complicated one at that).
So, my question is: How can I implement the equation as a boundary for DensityPlot3D?
EDIT: So it turns out the first argument can actually take in equations, as I was able to achieve an animation for s[x, y, t] == e[x, y, t].
Here is the code:
In[1]:= s[x_, y_, t_] = 1/Sqrt[4*Pi*t]*E^((-(x + 0)^2 - (y + 0)^2)/(4*t));
e[x_, y_, t_] = 1/Sqrt[4*Pi*t]*E^((-(x + 3)^2 - (y + 3)^2)/(4*t));
Animate[DensityPlot[s[x, y, t] == e[x, y, t], {x, -10, 10}, {y, -10, 10}, ColorFunction -> "TemperatureMap"], {t, 0, 10}]
I cannot figure out how to save the animation on here, and the picture is not uploading here.
Nevertheless, the problem then is simply the following: Why is DensityPlot3D a blank graph for the "4D" case?
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 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}]
Suppose this code in Mathematica:
w[w1_] := NDSolve[{y''[x] + y[x] == 2, y'[0] == 0, y[0] == w1},y[x], {x, 0, 30}];
Manipulate[Plot[Evaluate[{y[x], y'[x]} /. w[w1]], {x, 0, 30}], {w1, -2, 3}]
The code works this way: A slidebar (in Manipulate) controls one initial condition (value of y[0]) of differential equation saved in variable w and when it is changed, the solution is plotted. This works fine, but I have a problem with plotting the first derivative of the solution (y'[x]). Instead of a function graph there is just simply blank space and nothing is plotted, even I checked it in Mathematica help, where the example code
s = NDSolve[{y''[x] + Sin[y[x]] y[x] == 0, y[0] == 1, y'[0] == 0}, y, {x, 0, 30}]
Plot[Evaluate[{y[x], y'[x], y''[x]} /. s], {x, 0, 30},PlotStyle -> Automatic]
works. Does anybody know where's the problem?
I found the problem, it is just in NDSolve it is needed to write
w[w1_] := NDSolve[{y''[x] + y[x] == 2, y'[0] == 0, y[0] == w1},y, {x, 0, 30}]
y instead of y[x] and everything works.
I am trying to plot 1/r (r-hat) using VectorPlot in Mathematica by decomposing r-hat into x-hat and y-hat.
I am using:
[Chi][x_, y_] := Sqrt[x^2 + y^2]
[Phi][x_, y_] := ArcTan[y/x]
and then plotting the above function in x,y plane.
But, for x<0 and y<0, the vectors do not have the correct sign because the unit vectors have different sign in each of the quadrants. I tried defining a piecewise function to get around this without success.
VectorPlot[ 1/Sqrt[x x + y y] {Cos[ArcTan[x, y]], Sin[ArcTan[x, y]]},
{x, -2, 2}, {y, -2, 2},
RegionFunction -> Function[{x, y, vx, vy, n}, Sqrt[x x + y y] > 1/3],
VectorPoints -> 10]
How can I write the code in mathematica to see the result like this:
As you see we have the complex function w=f(z), where z=x+iy and w=u+iv.
In this example w=sin z, and we see the image of vertical line x=c is hyperbola. (Left)
and the image of horizontal line y=c is an elliptic. (Right)
This picture took from the book "Complex Variables and Applications, by James Ward Brown, Ruel Vance Churchill", 8th edition: pages 331 and 333 or third edition pages 96-97
Something like this?
ClearAll[u, v, f];
f[z_] := Sin[z]
u[x_, y_] := Re#f[x + I*y];
v[x_, y_] := Im#f[x + I*y];
EDIT: This just produces the whole thing. If you want to just see what happens for a single path parallel to the imaginary axis, try
ParametricPlot[{u[5, y], v[5, y]}, {y, -3, 3}]
or for the same parallel to the real axis try
ParametricPlot[{u[x, 1], v[x, 1]}, {x, -3, 3}]
EDIT2: Interactive:
ClearAll[u, v, f];
f[z_] := Sin[z]
u[x_, y_] := Re#f[x + I*y];
v[x_, y_] := Im#f[x + I*y];
Manipulate[
Show[
Graphics[{Line[{p1, p2}]}, PlotRange \[Rule] 3, Axes \[Rule] True],
ParametricPlot[
{u[p1[[1]] + t (p2[[1]] - p1[[1]]),
p1[[2]] + t (p2[[2]] - p1[[2]])],
v[p1[[1]] + t (p2[[1]] - p1[[1]]),
p1[[2]] + t (p2[[2]] - p1[[2]])]},
{t, 0, 1},
PlotRange \[Rule] 3]],
{{p1, {0, 1}}, Locator},
{{p2, {1, 2}}, Locator}]
(ugly, yes, but no time to fix it now). Typical output:
or
The idea is that you can vary the line on the left hand side of the figures you give (by clicking around the plot, which amounts to clicking on the Argand diagram...) and see the corresponding images.
Depending on what you want to do with the representations, it might sometimes be helpful to visualize the Riemann surface in 3D. Here's the surface for w=sin(z) in 3D, neatly showing the branch cuts and the different branches (same as acl's first plot, but in 3D).
ParametricPlot3D[
Evaluate[{Re#Sin[z], Im#Sin[z], y} /. z -> x + I y], {x, -2,
2}, {y, -2, 2}]