|
|
Re: Plotter for complex polynomials (complex coefficients)
Posted:
Feb 11, 2012 3:47 PM
|
|
On 2012-02-02 10:01:26 +0000, DrMajorBob said:
> This seems a little faster:
>
> Manipulate[
> Module[{f, z},(*Convert 2D point to complex point*)
> f[z_] = a.{1, I} z^3 + b.{1, I} z^2 + c.{1, I} z + d.{1, I};
> Plot3D[Abs@f[x + y I], {x, -6, 6}, {y, -6, 6}, PlotPoints -> 100,
> MaxRecursion -> 2, Mesh -> 11,
> MeshStyle -> Directive[Gray, AbsoluteThickness[0.01]],
> MeshFunctions -> ({x,
> y} \[Function] (\[Pi] - Abs@Arg[f[x + I y]])/\[Pi]),
> ColorFunctionScaling -> False,
> ColorFunction -> ({x, y} \[Function]
> Hue[0.425 \[LeftFloor]12 (\[Pi] -
> Abs@Arg@f[x + I y])/\[Pi]\[RightFloor]/12, sat, bri]),
> PlotStyle -> Opacity[opac],
> AxesLabel -> {"x", "i y",
> "|f(x + iy)|"}]],(*Item["The complex coefficients"],*){a, {-2, \
> -2}, {2, 2}}, {b, {-2, -2}, {2, 2}}, {c, {-2, -2}, {2,
> 2}}, {d, {-2, -2}, {2, 2}}, {{opac, 0.75, "Opacity"}, 0,
> 1}, {{sat, 0.75, "Saturation"}, 0, 1}, {{bri, 1, "Brightness"}, 0,
> 1}, ControlPlacement -> {Left, Left, Left, Left, Bottom, Bottom,
> Bottom}]
>
> Bobby
Thanks, I incorporated this into the latest plotter.
http://home.comcast.net/~cy56/Mma/ComplexCoeffPlotter.nb
http://home.comcast.net/~cy56/Mma/ComplexCoeffPlotterPic.png
Took me a long time to figure out that the two options
PlotRange -> {{-2, 2}, {-2, 2}, {6, 0}},
PlotRangePadding -> None
have to be in the same "option set" in order to really cut out the
padding, so that the grid will go right through the dots.
Chris
cy56@comcast.net
Manipulate[
Module[
{\[ScriptCapitalC], \[ScriptCapitalH],
f, z,
arg},
\[ScriptCapitalC] = ( \[ScriptCapitalP] \[Function] \
\[ScriptCapitalP] . {1, I}); (*
Convert 2D vector to complex point *)
\[ScriptCapitalH] = ({\
\[ScriptCapitalP], h} \[Function] Append[\[ScriptCapitalP], h]); (*
Convert 2D point \[ScriptCapitalP] to 3D point with height h *)
(* The complex polynomial, with complex coefficients: *)
f[z_] = (\[ScriptCapitalC] @ a) z^3 + (\[ScriptCapitalC] @
b) z^2 + (\[ScriptCapitalC] @ c) z + (\[ScriptCapitalC] @ d);
(* The "complex argument" (i.e., angle),
modified to run from 0 at -\[Pi] to 0.4 at 0 and back again,
in 12 steps: *)
arg[z_] = 1/12 (0.4) Round[12 (\[Pi] - Abs[ Arg[z]])/\[Pi]];
Show[
Graphics3D[
{
Red, Sphere[\[ScriptCapitalH][a, 0], dotR],
Yellow, Sphere[\[ScriptCapitalH][b, 0], dotR],
Green, Sphere[\[ScriptCapitalH][c, 0], dotR],
Blue, Sphere[\[ScriptCapitalH][d, 0], dotR]
}
],
Plot3D[
Abs[f[x + y I]], {x, -3, 3}, {y, -3, 3},
PlotPoints -> plotPts,
MaxRecursion -> maxRecurs,
Mesh -> {12, 5},
MeshStyle -> Directive[Gray, AbsoluteThickness[0.01]],
ColorFunctionScaling -> False,
MeshFunctions -> {
({x, y} \[Function] arg[f[x + y I]]),
({x, y, z} \[Function] z)
},
ColorFunction -> ({x, y} \[Function] Hue[arg[f[x + y I]], sat, bri]),
PlotStyle -> Opacity[opac],
ClippingStyle -> None
],
Lighting -> "Neutral",
Axes -> True,
PlotRange -> {{-2, 2}, {-2, 2}, {6, 0}},
PlotRangePadding -> None,
BoxRatios -> {4, 4, 6},
AxesLabel -> {"x", "y \[ImaginaryI]", "|f(x + iy)|"},
FaceGrids -> {{0, 0, 1}, {0, 0, -1}}
]
],
{{a, {1, 0}}, {-2, -2}, {2, 2}, 0.5},
{{b, {0, 1}}, {-2, -2}, {2, 2}, 0.5},
{{c, {-1, 0}}, {-2, -2}, {2, 2}, 0.5},
{{d, {0, -1}}, {-2, -2}, {2, 2}, 0.5},
{{opac, 0.95, "Opacity"}, 0, 1, 0.125},
{{sat, 0.75, "Saturation"}, 0, 1, 0.125},
{{bri, 1, "Brightness"}, 0, 1, 0.125},
{{plotPts, 100}, 10, 200, 10},
{{maxRecurs, 2}, 1, 4, 1},
{{dotR, 0.05}, 0.01, 0.2, 0.01},
ControlPlacement -> {Left, Left, Left, Left,
Bottom, Bottom, Bottom, Bottom, Bottom, Bottom}
]
|
|
