Drexel dragonThe Math ForumDonate to the Math Forum



Search All of the Math Forum:

Views expressed in these public forums are not endorsed by Drexel University or The Math Forum.


Math Forum » Discussions » Software » comp.soft-sys.math.mathematica

Topic: Help needed on how plot a stereographic projection
Replies: 7   Last Post: May 31, 2013 3:18 AM

Advanced Search

Back to Topic List Back to Topic List Jump to Tree View Jump to Tree View   Messages: [ Previous | Next ]
Bob Hanlon

Posts: 906
Registered: 10/29/11
Re: Help needed on how plot a stereographic projection
Posted: May 31, 2013 3:16 AM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply


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@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@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@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
>
> ****
>
> ** **
>






Point your RSS reader here for a feed of the latest messages in this topic.

[Privacy Policy] [Terms of Use]

© Drexel University 1994-2014. All Rights Reserved.
The Math Forum is a research and educational enterprise of the Drexel University School of Education.