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: 2   Last Post: Jun 1, 2013 6:07 AM

Advanced Search

Back to Topic List Back to Topic List Jump to Tree View Jump to Tree View  
emammendes@gmail.com

Posts: 143
Registered: 8/22/05
Re: Help needed on how plot a stereographic projection
Posted: Jun 1, 2013 6:07 AM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply


Dear Bob

What can I say? Thank you ever so much.

I will need time to understand some parts of the code though.

Cheers

Ed


On May 31, 2013, at 1:56 AM, Bob Hanlon <hanlonr357@gmail.com> wrote:

> 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 Project of -1 will show up? It does not seem to work for me. The 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 infinity?
>
> 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 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)}]]
>
> 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 ugly and slow.
>
> ClearAll[stereographicProjection];
>
> stereographicProjection::usage="stereographicProjection[complexnumber] will return the stereoprojection of a complex point considering the Riemann 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[complexnumber]]^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.