Re: Help needed on how plot a stereographic projection
- To: mathgroup at smc.vnet.net
- Subject: [mg130976] Re: Help needed on how plot a stereographic projection
- From: Bob Hanlon <hanlonr357 at gmail.com>
- Date: Fri, 31 May 2013 03:37:38 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-outx@smc.vnet.net
- Delivered-to: mathgroup-newsendx@smc.vnet.net
- References: <20130530101424.F340969EC@smc.vnet.net>
ClearAll[stereographicProjection];
stereographicProjection::usage =
"stereographicProjection[complexnumber] will return the stereoprojection
of \
a complex point considering the Riemann sphere";
SyntaxInformation[stereographicProjection] = {"ArgumentsPattern" -> {_}};
stereographicProjection[complexnumber_] :=
Module[{abs2 = Abs[complexnumber]^2},
If[abs2 == Infinity, {0, 0, 1}, {Re[complexnumber]/(1 + abs2),
Im[complexnumber]/(1 + abs2), abs2/(1 + abs2)}]]
t1 = Timing[tab3Old = Table[stereographicProjection[
(s + 1)/(s^2 (s - 1)) /. {s -> I w}],
{w, -1000, 1000, 0.1}] // Quiet;];
To speed up the calculation of tab3Old
(s + 1)/(s^2 (s - 1)) /. {s -> I w} //
ComplexExpand // Simplify
(I - w)/(w^2 (I + w))
t2 = Timing[tab3New = stereographicProjection[
(I - #)/(#^2 (I + #))] & /@
Range[-1000, 1000, 0.1] //
Quiet;];
Verifying that tab3New is identical to tab3Old and calculated faster
{tab3Old == tab3New, t2[[1]]/t1[[1]]}
{True, 0.58843}
To color the line you could break the line up into small line segments and
color each line segment separately. However, this would significantly slow
down the graphic generation and display. First, thin out the data where it
is dense.
Length[tab3New]
20001
Length[tab3NewRev =
Last /@ (SortBy[#, Abs[.5 - #[[-1]]] &] & /@
Split[tab3New, Abs[#1[[-1]] - #2[[-1]]] < 0.001 &])]
65
Generating and setting colors for line segments
g4 = {Hue[#[[1, -1]]], Line[#]} & /@
Partition[tab3NewRev, 2, 1];
Show[
ParametricPlot3D[
{Cos[p] Sin[t], Sin[p] Sin[t], 1 + Cos[t]}/2,
{p, 0, 2 Pi}, {t, 0, Pi},
PlotStyle -> Opacity[0.5],
Mesh -> Automatic],
Graphics3D[{
Gray,
Table[Line[{{-1, y, 0}, {1, y, 0}}], {y, -1, 1, .25}],
Table[Line[{{x, -1, 0}, {x, 1, 0}}], {x, -1, 1, .25}],
Table[Line[{{-1, -1, z}, {-1, 1, z}}], {z, 0, 1, .25}],
Table[Line[{{-1, y, 0}, {-1, y, 1}}], {y, -1, 1, .25}],
Table[Line[{{-1, 1, z}, {1, 1, z}}], {z, 0, 1, .25}],
Table[Line[{{x, 1, 0}, {x, 1, 1}}], {x, -1, 1, .25}],
Line[{{0, 0, 0}, {0, 0, 1}}],
Darker[Magenta],
AbsoluteThickness[3],
g4,
Red,
PointSize[.02],
Tooltip[
Point[{stereographicProjection[-1]}],
"Projection of -1"]}],
ImageSize -> Large,
AxesLabel -> {"x", "y", "z"},
PlotRange -> {{-1, 1}, {-1, 1}, {-0, 1}},
BoxRatios -> {1, 1, 1/2}]
See additional comments interleaved below.
Bob Hanlon
On Thu, May 30, 2013 at 4:00 PM, Eduardo M. A. M.Mendes <
emammendes at gmail.com> wrote:
> Hello****
>
> ** **
>
> Many many thanks.****
>
> ** **
>
> A couple of questions if I may:
>
> **a) **Does the ToolTip command means that if the mouse over -1 the
> msg =93Project of -1=94will show up? It does not seem to work for me. T=
he
> only thing I can is to rotate the figure.
>
The object that has a Tooltip has to be rotated into direct view for the
mouse to be "over it" and the Tooltip to display.
> ****
>
> **b) **Is there a way to change the line color (tab3) from cold
> (blue) to hot (read) as goes from 0 to infinity and 0 to =96infinity?
>
Break the line up into small line segments and color each line segment
separately. However, this will significantly slow down drawing the plot
unless you thin out the data.
> ****
>
> **c) **Is there a way to get grid lines on the planes x-y,y-z,z-x?
>
Draw lines
> ****
>
> **d) **Another way, faster, to generate tab3.****
>
>
> see above
> Once more, thank you. ****
>
> ** **
>
> Ed****
>
> ** **
>
> ** **
>
> *From:* Bob Hanlon [mailto:hanlonr357 at gmail.com]
> *Sent:* Thursday, May 30, 2013 4:03 PM
> *To:* Eduardo M. A. M. Mendes
> *Cc:* MathGroup
> *Subject:* Re: Help needed on how plot a stereographic
> projection****
>
> ** **
>
> Use of ComplexExpand on real values (output of Re, Im, or Abs) is
> unnecessary.****
>
>
> ClearAll[stereographicProjection];****
>
>
> stereographicProjection::usage =
> "stereographicProjection[complexnumber] will return the stereoprojectio=
n
> of \
> a complex point considering the Riemann sphere";****
>
>
> SyntaxInformation[stereographicProjection] = {"ArgumentsPattern" -> {_}=
};*
> ***
>
>
> stereographicProjection[complexnumber_] :=
> Module[
> {abs2 = Abs[complexnumber]^2},
> If[abs2 == Infinity,
> {0, 0, 1},
> {Re[complexnumber]/(1 + abs2),
> Im[complexnumber]/(1 + abs2),
> abs2/(1 + abs2)}]]****
>
>
> tab3 = Table[
> stereographicProjection[
> (s + 1)/(s^2 (s - 1)) /. {s -> I w}],
> {w, -1000, 1000, 0.1}] // Quiet;****
>
>
> Show[
> ParametricPlot3D[
> {Cos[p] Sin[t], Sin[p] Sin[t], 1 + Cos[t]}/2,
> {p, 0, 2 Pi}, {t, 0, Pi},
> PlotStyle -> Opacity[0.5],
> Mesh -> Automatic],
> Graphics3D[{
> Darker[Magenta],
> AbsoluteThickness[3],
> Tooltip[Line[tab3],
> "Projection of (s+1)/(s^2 (s-1))"],
> Red,
> PointSize[.02],
> Tooltip[Point[{stereographicProjection[-1]}],
> "Projection of -1"]}],
> ImageSize -> Large,
> AxesLabel -> {"x", "y", "z"},
> PlotRange -> {{-1, 1}, {-1, 1}, {0, 1}},
> BoxRatios -> {1, 1, 1/2}]****
>
> ** **
>
> ** **
>
> Bob Hanlon****
>
> ** **
>
> ** **
>
> On Thu, May 30, 2013 at 6:14 AM, Eduardo M. A. M. Mendes <
> emammendes at gmail.com> wrote:****
>
> Hello
>
> Although I have been using Mathematica for more than year, I feel that I
> haven't barely scratched the surface of what Mathematica can do.
>
> The following example gives the result that I need but the outcome is ugl=
y
> and slow.
>
> ClearAll[stereographicProjection];
>
> stereographicProjection::usage="stereographicProjection[complexnumber]
> will return the stereoprojection of a complex point considering the Riema=
nn
> sphere";
>
> SyntaxInformation[stereographicProjection]={"ArgumentsPattern"->{_}};
>
> stereographicProjection[complexnumber_]:=
> Module[{a1,a2,a3},
> If[ComplexExpand[Abs[complexnumber]]==Infinity,
> a1=0;a2=0;a3=1,
> =
>
> a1=ComplexExpand[Re[complexnumber]]/(1+ComplexExpand[Abs[complexnumber]=
]^2);
>
>
> a2=ComplexExpand[Im[complexnumber]]/(1+ComplexExpand[Abs[complexnumber]=
]^2);
> =
>
> a3=ComplexExpand[Abs[complexnumber]]^2/(1+ComplexExpand[Abs[complexnumb=
er]]^2)];
> {a1,a2,a3}
> ]
>
> tab3=Table[stereographicProjection[(s+1)/(s^2 (s-1))/.{s-> I
> \[Omega]}],{\[Omega],-1000,1000,0.1}];
>
> =
> Show[ContourPlot3D[x^2+y^2+(z-1/2)^2==(1/2)^2,{x,-1,1},{y,-1,1},{z,0,=
1},Mesh->Automatic,AxesLabel->
> =
> {"x","y","z"},BoxRatios->{1,1,1/2},ImageSize-> =
> Large],ListPointPlot3D[tab3,PlotStyle->Directive[PointSize[Large],Magenta=
],ImageSize->
> =
> Large],ListPointPlot3D[{stereographicProjection[-1]},PlotStyle->Directive=
[PointSize[0.02],Red]],ImageSize->
> Large]
>
> a) Is there another way of getting the same plot?
> b) How to get the points of tab3 connected?
> c) How to change the opacity of the sphere?
>
>
> Improvements, suggestion and critiscims are welcome.
>
> Many thanks
>
> Ed
>
> ****
>
> ** **
>
- References:
- Help needed on how plot a stereographic projection
- From: "Eduardo M. A. M. Mendes" <emammendes@gmail.com>
- Help needed on how plot a stereographic projection