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 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?
What is the best way of plotting several functions with different domains into the same plot? Is there a way to do this with plot2d, or do I have to use draw2d instead?
I especially like the possibility in plot2d to give several functions in a list, whereas I would have to add the different functions in draw2d as separate parameters, if I understand the documentation correctly.
An example of what I mean:
f(x, a) := sqrt(a) * exp(-(x-a)^2);
fmax(x) := sqrt(x);
In this example I would like to plot f(x, a) for several a (e.g. using makelist(f(x, a), a, [0, 0.5, 1, 2, 5])) from -1 to 10 and fmax from 0 to 5 (to show where the maxima of the f(x, a) family of curves are located).
You can try draw2d
f(x, a) := sqrt(a) * exp(-(x-a)^2);
fmax(x) := sqrt(x);
flist: makelist(f(x, a), a, [0, 0.5, 1, 2, 5]);
par: map(lambda([f], explicit(f, x, -1, 10)), flist);
par: append([explicit(fmax, x, 0, 5), color=red], par);
load(draw);
apply(draw2d, par);
One approach I am not particularly happy with is to declare the functions with smaller domains as parametric curves, with the x axis parameter being simply x:
f(x, a) := sqrt(a) * exp(-(x-a)^2);
fmax(x) := sqrt(x);
plot2d(endcons([parametric, x, fmax(x), [x, 0, 5], [nticks, 80]],
makelist(f(x, a), a, [0, 1/2, 1, 2, 5])),
[x, -1, 10]);
This was frustrating me for hours but I found a way to have multiple differently domained functions on the same graph.
wxplot2d([if x < 0 then -x else sin(x), if x > -1 then x^2],[x,-%pi,%pi],[y,-2,2]);
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}]
I am working on a geometry problem that requires finding the intersection of two parabolic arcs in any rotation. I was able to intesect a line and a parabolic arc by rotating the plane to align the arc with an axis, but two parabolas cannot both align with an axis. I am working on deriving the formulas, but I would like to know if there is a resource already available for this.
I'd first define the equation for the parabolic arc in 2D without rotations:
x(t) = ax² + bx + c
y(t) = t;
You can now apply the rotation by building a rotation matrix:
s = sin(angle)
c = cos(angle)
matrix = | c -s |
| s c |
Apply that matrix and you'll get the rotated parametric equation:
x' (t) = x(t) * c - s*t;
y' (t) = x(t) * s + c*t;
This will give you two equations (for x and y) of your parabolic arcs.
Do that for both of your rotated arcs and subtract them. This gives you an equation like this:
xa'(t) = rotated equation of arc1 in x
ya'(t) = rotated equation of arc1 in y.
xb'(t) = rotated equation of arc2 in x
yb'(t) = rotated equation of arc2 in y.
t1 = parametric value of arc1
t2 = parametric value of arc2
0 = xa'(t1) - xb'(t2)
0 = ya'(t1) - yb'(t2)
Each of these equation is just a order 2 polynomial. These are easy to solve.
To find the intersection points you solve the above equation (e.g. find the roots).
You'll get up to two roots for each axis. Any root that is equal on x and y is an intersection point between the curves.
Getting the position is easy now: Just plug the root into your parametric equation and you can directly get x and y.
Unfortunately, the general answer requires solution of a fourth-order polynomial. If we transform coordinates so one of the two parabolas is in the standard form y=x^2, then the second parabola satisfies (ax+by)^2+cx+dy+e==0. To find the intersection, solve both simultaneously. Substituting in y=x^2 we see that the result is a fourth-order polynomial: (ax+bx^2)^2+cx+dx^2+e==0. Nils solution therefore won't work (his mistake: each one is a 2nd order polynomial in each variable separately, but together they're not).
It's easy if you have a CAS at hand.
See the solution in Mathematica.
Choose one parabola and change coordinates so its equation becomes y(x)=a x^2 (Normal form).
The other parabola will have the general form:
A x^2 + B x y + CC y^2 + DD x + EE y + F == 0
where B^2-4 A C ==0 (so it's a parabola)
Let's solve a numeric case:
p = {a -> 1, A -> 1, B -> 2, CC -> 1, DD -> 1, EE -> -1, F -> 1};
p1 = {ToRules#N#Reduce[
(A x^2 + B x y + CC y^2 + DD x + EE y +F /. {y -> a x^2 } /. p) == 0, x]}
{{x -> -2.11769}, {x -> -0.641445},
{x -> 0.379567- 0.76948 I},
{x -> 0.379567+ 0.76948 I}}
Let's plot it:
Show[{
Plot[a x^2 /. p, {x, -10, 10}, PlotRange -> {{-10, 10}, {-5, 5}}],
ContourPlot[(A x^2 + B x y + CC y^2 + DD x + EE y + F /. p) ==
0, {x, -10, 10}, {y, -10, 10}],
Graphics[{
PointSize[Large], Pink, Point[{x, x^2} /. p /. p1[[1]]],
PointSize[Large], Pink, Point[{x, x^2} /. p /. p1[[2]]]
}]}]
The general solution involves calculating the roots of:
4 A F + 4 A DD x + (4 A^2 + 4 a A EE) x^2 + 4 a A B x^3 + a^2 B^2 x^4 == 0
Which is done easily in any CAS.