Re: Help needed on how plot a stereographic projection
- To: mathgroup at smc.vnet.net
- Subject: [mg130991] Re: Help needed on how plot a stereographic projection
- From: "Eduardo M. A. M. Mendes" <emammendes at gmail.com>
- Date: Sat, 1 Jun 2013 06:28:08 -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> <CAEtRDSf8_7Q2P9ZPa35BnC0=a6-aV9PdB4dHLe-sP2ma3r7B1w@mail.gmail.com> <003701ce5d70$66934190$33b9c4b0$@gmail.com> <CAEtRDScnb9jQR2TVWK0zAqKJRg9E+2=OEqDhHg=LMgnJO6dv9w@mail.gmail.com>
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 at 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 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 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 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 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 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 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
>
>
>
>
>