I am very new to Mathematica. I have started learning it only last month. I would like to graph the image of some complex valued polynomials with some provided conditions. For example: $$ p(z_1,z_2,z_3)=z_1z_2^2 +z_2z_3+z_1z_3,$$ given that $|z_1|=1, |z_2|=2=|z_3|$.
-
1$\begingroup$ mathematica.stackexchange.com/questions/30687/… $\endgroup$– nufaieMar 31, 2019 at 16:41
-
3$\begingroup$ Possible duplicate of Draw the image of a complex region $\endgroup$– MarcoBMar 31, 2019 at 17:22
-
1$\begingroup$ Do you want to draw the image or do you want a symbolic-algebraic description of the image? $\endgroup$– Michael E2Mar 31, 2019 at 18:48
-
1$\begingroup$ People here generally like users to post code as Mathematica code instead of just images or TeX, so they can copy-paste it. It makes it convenient for them and more likely you will get someone to help you. You may find this meta Q&A helpful $\endgroup$– Michael E2Mar 31, 2019 at 18:50
-
$\begingroup$ @Michael E2, Great point! I've updated my answer to include the algebraic description as well. Thank you! $\endgroup$– mjwMar 31, 2019 at 19:27
4 Answers
On the boundary of the image the Jacobian will be singular:
Clear[r, s, t, u, v, w];
Block[{z1 = Exp[I r], z2 = 2 Exp[I s], z3 = 2 Exp[I t]},
expr = ComplexExpand[ReIm[z1 z2^2 + z2 z3 + z1 z3]]]
(* {4 Cos[r+2 s]+2 Cos[r+t]+4 Cos[s+t], 4 Sin[r+2 s]+2 Sin[r+t]+4 Sin[s+t]} *)
sub = {r + t -> u, s + t -> v, r + 2 s -> w};(* see simplified Jacobian *)
jac = D[expr, {{r, s, t}}]; (* Jacobian is 2 x 3 *)
singRST = Equal @@ Divide @@ jac // Simplify (* Singular if rows are proportional *)
singUVW = singRST /. sub // Simplify
(* Solve cannot solve the system, unless we cut it into bite-size pieces *)
solv = Solve[singUVW[[;; 2]], v] /. C[1] -> 0;
singUW = singUVW[[2 ;;]] /. solv // Simplify;
solu = Solve[#, u] & /@ singUW;
(*
-((2 Sin[r + 2 s] + Sin[r + t])/(2 Cos[r + 2 s] + Cos[r + t])) ==
-((2 Sin[r + 2 s] + Sin[s + t])/(2 Cos[r + 2 s] + Cos[s + t])) ==
-((Sin[r + t] + 2 Sin[s + t])/(Cos[r + t] + 2 Cos[s + t]))
-((Sin[u] + 2 Sin[w])/(Cos[u] + 2 Cos[w])) ==
-((Sin[v] + 2 Sin[w])/(Cos[v] + 2 Cos[w])) ==
-((Sin[u] + 2 Sin[v])/(Cos[u] + 2 Cos[v]))
*)
(* fix sub so that it works on a general expression *)
invsub = First@Solve[Equal @@@ sub, {u, v, w}];
sub = First@Solve[Equal @@@ invsub, {r, s, t}];
(*some u solutions are complex*)
realu = List /@ Cases[Flatten@solu, _?(FreeQ[#, Complex] &)];
boundaries = PiecewiseExpand /@
Simplify[
TrigExpand@Simplify[Simplify[expr /. sub] /. solv] /. realu //
Flatten[#, 1] &, 0 <= w < 2 Pi];
ParametricPlot[boundaries // Evaluate, {w, 0, 2 Pi}]
Well, it's only a start, since you have to check in the interior boundaries to see whether they might be holes. But @HenrikSchumacher has done that already.
-
$\begingroup$ Amazing idea to look for critical points of the Jacobian. Good job! $\endgroup$ Mar 31, 2019 at 20:55
-
$\begingroup$ In my Mathematica do I have to load some packages as I am not getting any graph? $\endgroup$– XYZABCApr 1, 2019 at 4:59
-
$\begingroup$ @XYZ, did you try running it in a newly opened Mathematica notebook? If it didn't work there, please mention what version number you are using. $\endgroup$ Apr 1, 2019 at 6:46
-
$\begingroup$ @XYZABC It seems there may have been two problems. Copying and pasting from the site to M messed up some newlines, which changed the meaning of
%
. The other was that I added a line but put it in out of order in the edit. I've removed all the%
and replaced them with variables. It should be fixed now. $\endgroup$ Apr 1, 2019 at 11:46 -
$\begingroup$ Could you please explain me the code singRST = Equal @@ Divide @@ jac // Simplify Or maybe give me some reference so that I can go through it. $\endgroup$– XYZABCApr 1, 2019 at 14:39
By letting $z_1,z_2,z_3$ trace out circles, we can see some beautiful curves that live within that blob!
p[z1_, z2_, z3_] := z1 z2^2 + z2 z3 + z1 z3;
q[t_][a1_, a2_, b1_, b2_, c1_, c2_] :=
p[Exp[ I (a1 t + a2)], 2 Exp[ I (b1 t + b2)], 2 Exp[ I (c1 t + c2)]];
Manipulate[
ParametricPlot[{Re[q[ t][a1, a2, b1, b2, c1, c2]],
Im[q[ t][a1, a2, b1, b2, c1, c2]]}, {t, 0, 2 \[Pi]},
Axes -> False, Frame -> True, PlotRange -> {{-12, 12},{-12, 12}}],
{a1, -5, 5},{a2, 0, 2 \[Pi]},{b1, -5, 5},{b2, 0, 2 \[Pi]},
{c1, -5, 5},{c2, 0, 2 \[Pi]}]
Here is a look at the analytical form of these curves:
Manipulate[
ComplexExpand@ReIm[q[t][a1, a2, b1, b2, c1, c2]],
{a1, -5, 5}, {a2, 0, 2 \[Pi]}, {b1, -5, 5}, {b2, 0, 2 \[Pi]},
{c1, -5, 5}, {c2, 0, 2 \[Pi]}]
or
Manipulate[
FullSimplify[q[t][a1, a2, b1, b2, c1, c2]], {a1, -5, 5}, {a2, 0,
2 \[Pi]}, {b1, -5, 5}, {b2, 0, 2 \[Pi]}, {c1, -5, 5}, {c2, 0, 2 \[Pi]}]
Not very elegant, but this might give you a coarse idea.
z1 = Exp[I r];
z2 = 2 Exp[I s];
z3 = 2 Exp[I t];
expr = ComplexExpand[ReIm[z1 z2^2 + z2 z3 + z1 z3]];
f = {r, s, t} \[Function] Evaluate[expr];
R = DiscretizeRegion[Cuboid[{-1, -1, -1} Pi, {1, 1, 1} Pi],
MaxCellMeasure -> 0.0125];
pts = f @@@ MeshCoordinates[R];
triangles = MeshCells[R, 2, "Multicells" -> True][[1]];
Graphics[{
Red, Disk[{0, 0}, 10],
FaceForm[Black], EdgeForm[Thin],
GraphicsComplex[pts, triangles]
},
Axes -> True
]
Could be the disk of radius 10...
-
$\begingroup$ The image is clearly a subset of the disk of radius 10. Perhaps somebody could prove that this is the region or show a point that is not included. $\endgroup$– mjwApr 1, 2019 at 16:41
Here's another numerical approach, similar to @Henrik's, but without the mesh overhead. It can be generalized to more variables easily. It requires some manual intervention to code the constraints on the variables.
poly = z1 z2^2 + z2 z3 + z1 z3;
vars = Variables[poly];
constrVars = Thread[vars -> {1, 2, 2} Array[Exp[I #] &@*Slot, Length@vars]]
(* {z1 -> E^(I #1), z2 -> 2 E^(I #2), z3 -> 2 E^(I #3)} *)
polyFN = poly /. constrVars // Evaluate // Function;
Graphics[{
PointSize[Tiny],
polyFN @@ RandomReal[{0, 2 Pi}, {Length@vars, 5 10^4}] // ReIm // Point},
Frame -> True]
We can see ghosts of some of the boundaries
in my other answer.