(*^ ::[paletteColors = 128; automaticGrouping; currentKernel; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = Left Header, nohscroll, cellOutline, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, L1, 12; fontset = Left Footer, cellOutline, blackBox, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; next21StandardFontEncoding; ] :[font = input; preserveAspect; ] <> 2 3 (1 - 4 a ) ArcCos[---------------------------------] 2 -3 a Sqrt[(----------- + <<2>>) <<1>>] 2 3 (1 - 4 a ) :[font = input; preserveAspect; startGroup; ] Cos[%] // Simplify :[font = output; output; inactive; preserveAspect; endGroup; ] (3^(1/2)*a)/ (2*((a^2*(1 - a^2))/(-1 + 4*a^2)^4)^(1/2)* (-1 + 4*a^2)^2) ;[o] Sqrt[3] a --------------------------------- 2 2 a (1 - a ) 2 2 2 Sqrt[------------] (-1 + 4 a ) 2 4 (-1 + 4 a ) :[font = input; preserveAspect; startGroup; ] sols = Solve[N[%==Cos[Pi/7]],a] :[font = output; output; inactive; preserveAspect; endGroup; ] {{a -> 0.2757977789799765}, {a -> -0.2757977789799765}} ;[o] {{a -> 0.275798}, {a -> -0.275798}} :[font = input; preserveAspect; startGroup; ] p1 = Projective[N[p /. %[[1]]]] :[font = output; output; inactive; preserveAspect; endGroup; ] Projective[{0.2757977789799765, 0.4776957658079711}] ;[o] Projective[{0.275798, 0.477696}] :[font = input; preserveAspect; startGroup; ] p2= Projective[{%[[1,1]],0}] :[font = output; output; inactive; preserveAspect; endGroup; ] Projective[{0.2757977789799765, 0}] ;[o] Projective[{0.275798, 0}] :[font = input; preserveAspect; startGroup; ] p3=Projective[{0,0}] :[font = output; output; inactive; preserveAspect; endGroup; ] Projective[{0, 0}] ;[o] Projective[{0, 0}] :[font = input; preserveAspect; ] SetOptions[Convert, Model -> PoincareBall]; :[font = input; preserveAspect; startGroup; ] Show[Graphics[{ UnitCircle, Line[{p1,p2,p3,p1}] }, AspectRatio -> Automatic]] :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 282; pictureHeight = 282; ] %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.47619 0.5 0.47619 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath %%Object: Graphics [ ] 0 setdash 0 setgray gsave grestore 0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto closepath clip newpath gsave 0.004 setlinewidth newpath 0.5 0.5 0.47619 0 365.73 arc stroke gsave 0.57161 0.62402 moveto 0.56696 0.5 lineto stroke 0.56696 0.5 moveto 0.5 0.5 lineto stroke 0.5 0.5 moveto 0.57161 0.62402 lineto stroke grestore grestore % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup; ] The Unformatted text for this cell was not generated. Use options in the Actions Preferences dialog box to control when Unformatted text is generated. ;[o] -Graphics- :[font = input; preserveAspect; startGroup; ] Distance[p1,p2] :[font = output; output; inactive; preserveAspect; endGroup; ] 0.5452748317535451 ;[o] 0.545275 :[font = input; preserveAspect; startGroup; ] {q1,q2,q3} = Convert[#,PoincareBall]& /@ {p1,p2,p3} :[font = output; output; inactive; preserveAspect; endGroup; ] {PoincareBall[{0.1503713093731898, 0.2604507478350228}], PoincareBall[{0.1406259299643202, 0}], PoincareBall[{0, 0}]} ;[o] {PoincareBall[{0.150371, 0.260451}], PoincareBall[{0.140626, 0}], PoincareBall[{0, 0}]} :[font = input; preserveAspect; startGroup; ] Distance[q1,q2] :[font = output; output; inactive; preserveAspect; endGroup; ] 0.5452748317535457 ;[o] 0.545275 :[font = text; inactive; preserveAspect; ] We'll build up the reflection in each of the three sides. The reflection in side p2-p3 takes a positive frame including Vector[{0,0},{1,0}] to a negative frame including the same vector. :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[{0,0},{1,0}]]] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{0, -1, 0}, {1, 0, 0}, {0, 0, 1}}]] ;[o] Minkowski[Frame[{{0, -1, 0}, {1, 0, 0}, {0, 0, 1}}]] :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[{0,0},{1,0}]],-1] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{0, 1, 0}, {1, 0, 0}, {0, 0, 1}}]] ;[o] Minkowski[Frame[{{0, 1, 0}, {1, 0, 0}, {0, 0, 1}}]] :[font = input; preserveAspect; startGroup; ] r23=Isometry[%%,%] :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{1, 0, 0}, {0, -1, 0}, {0, 0, 1}}] ;[o] Isometry[{{1, 0, 0}, {0, -1, 0}, {0, 0, 1}}] :[font = input; preserveAspect; startGroup; ] %.PoincareBall[{.3,.4}] :[font = output; output; inactive; preserveAspect; endGroup; ] PoincareBall[{0.3, -0.4000000000000002}] ;[o] PoincareBall[{0.3, -0.4}] :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[Peel[q2],{0,1}]]] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{1.040349236829868, 0., 0.2869260088811912}, {0, 1., 0}, {0.2869260088811913, 0, 1.040349236829868}}]] ;[o] Minkowski[Frame[{{1.04035, 0., 0.286926}, {0, 1., 0}, {0.286926, 0, 1.04035}}]] :[font = text; inactive; preserveAspect; ] Peel[q2] peels off the label, PoincareBall. First would also work. :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[Peel[q2],{0,1}]],-1] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{-1.040349236829868, 0., -0.2869260088811912}, {0, 1., 0}, {0.2869260088811913, 0, 1.040349236829868}}]] ;[o] Minkowski[Frame[{{-1.04035, 0., -0.286926}, {0, 1., 0}, {0.286926, 0, 1.04035}}]] :[font = input; preserveAspect; startGroup; ] r12=Isometry[%%,%] //Chop :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{-1.164653069144979, 0, 0.5970065087323749}, {0, 1., 0}, {-0.5970065087323749, 0, 1.164653069144979}}] ;[o] Isometry[{{-1.16465, 0, 0.597007}, {0, 1., 0}, {-0.597007, 0, 1.16465}}] :[font = text; inactive; preserveAspect; ] Now find the inverse transformation. We expect the same, since this is a reflection. :[font = input; preserveAspect; startGroup; ] Inverse[%] :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{-1.164653069144979, 0, 0.5970065087323749}, {0, 1., 0}, {-0.5970065087323749, 0, 1.164653069144979}}] ;[o] Isometry[{{-1.16465, 0, 0.597007}, {0, 1., 0}, {-0.597007, 0, 1.16465}}] :[font = input; preserveAspect; startGroup; ] %.PoincareBall[{0,0}] :[font = output; output; inactive; preserveAspect; endGroup; ] PoincareBall[{0.2757977789799765, 0}] ;[o] PoincareBall[{0.275798, 0}] :[font = input; preserveAspect; startGroup; ] {Distance[q2,q3],Distance[q2,%]} :[font = output; output; inactive; preserveAspect; endGroup; ] {0.2831281533676582, 0.2831281533676588} ;[o] {0.283128, 0.283128} :[font = text; inactive; preserveAspect; ] Reflection preserves distances. :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[Peel[q1],-Peel[q1]]]] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{-0.866025403784439, 0.5, -(2.775557561562892*10^-17)}, {-0.5994400936445289, -1.038260698286169, -0.6612969858348408}, {0.3306484929174204, 0.5726999891790501, 1.198880187289058}}]] ;[o] -17 Minkowski[Frame[{{-0.866025, 0.5, -2.77556 10 }, {-0.59944, -1.03826, -0.661297}, {0.330648, 0.5727, 1.19888}}]] :[font = input; preserveAspect; startGroup; ] CompleteFrame[PoincareBall[Vector[Peel[q1],-Peel[q1]]],-1] :[font = output; output; inactive; preserveAspect; endGroup; ] Minkowski[Frame[{{0.866025403784439, -0.5, 2.775557561562892*10^-17}, {-0.5994400936445289, -1.038260698286169, -0.6612969858348408}, {0.3306484929174204, 0.5726999891790501, 1.198880187289058}}]] ;[o] -17 Minkowski[Frame[{{0.866025, -0.5, 2.77556 10 }, {-0.59944, -1.03826, -0.661297}, {0.330648, 0.5727, 1.19888}}]] :[font = input; preserveAspect; startGroup; ] r13=Isometry[%%,%] // Chop :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{-0.5000000000000002, 0.866025403784439, 0}, {0.866025403784439, 0.5, 0}, {0, 0, 1.000000000000001}}] ;[o] Isometry[{{-0.5, 0.866025, 0}, {0.866025, 0.5, 0}, {0, 0, 1.}}] :[font = input; preserveAspect; startGroup; ] r13.r23.r13.r23.r13.r23 // Chop :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{1., 0, 0}, {0, 1., 0}, {0, 0, 1.000000000000002}}] ;[o] Isometry[{{1., 0, 0}, {0, 1., 0}, {0, 0, 1.}}] :[font = input; preserveAspect; startGroup; ] r23.r12.r23.r12 // Chop :[font = output; output; inactive; preserveAspect; endGroup; ] Isometry[{{1., 0, 0}, {0, 1., 0}, {0, 0, 1.}}] ;[o] Isometry[{{1., 0, 0}, {0, 1., 0}, {0, 0, 1.}}] :[font = input; preserveAspect; startGroup; ] r12.r13.r12.r13.r12.r13.r12.r13.r12.r13.r12.r13.r12.r13 // Chop :[font = output; output; inactive; preserveAspect; endGroup; endGroup; ] Isometry[{{1., 0, 0}, {0, 0.999999999999999, 0}, {0, 0, 1.00000000000001}}] ;[o] Isometry[{{1., 0, 0}, {0, 1., 0}, {0, 0, 1.}}] :[font = subsection; inactive; preserveAspect; startGroup; ] Points near the circle at infinity :[font = text; inactive; preserveAspect; ] Find where the geodesic determined by this vector intersects the sphere by walking 100 units along it, we get pretty close to the boundary; in the future there may be a special function to do this right. :[font = input; preserveAspect; startGroup; ] Drag[PoincareBall[Vector[Peel[q2],{0,1}]],100] //N :[font = output; output; inactive; preserveAspect; endGroup; ] PoincareBall[Vector[{0.2757977789799765, 0.961215680848847}, {1.025774559859318*10^-16, 1.40258118713154*10^-43}]] ;[o] PoincareBall[Vector[{0.275798, 0.961216}, -16 -43 {1.02577 10 , 1.40258 10 }]] :[font = input; preserveAspect; startGroup; ] Distance[q2,First /@ %] :[font = output; output; inactive; preserveAspect; endGroup; ] 0. + 0.2794195724391683*I ;[o] 0. + 0.27942 I :[font = text; inactive; preserveAspect; endGroup; ] This should be 100, but because of roundoff the point defined above is actually slightly outside the ball, with unpredictable consequences ^*)