geom

Euclidean Stuff (E²)

Hyperbolic Stuff (H²)

Tiling of the Double Torus: This picture (not animation) shows the regular 8-gon fundamental domain of the double torus in the Poincaré disc, tiled by congruent (hyperbolic) triangles.

restart: with(plots):
T := sqrt(2): R := sqrt((T-1)/2): r := sqrt((T+1)/2):
an1 := plot([cos(t),sin(t),t=0..2*Pi],axes=none,color=blue,filled=true):
                                # blue unit disc
for k from 0 to 1 do
  an2[k] := plot([R*cos(t/4+Pi)+r/T,R*sin(t/4+Pi)+r/T,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,k,k,0),filled=true):
  an3[k] := plot([R*cos(t/4+5*Pi/4),R*sin(t/4+5*Pi/4)+r,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,(k+1)mod 2,(k+1)mod 2,0),filled=true):
  an4[k] := plot([R*cos(t/4+3*Pi/2)-r/T,R*sin(t/4+3*Pi/2)+r/T,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,k,k,0),filled=true):
  an5[k] := plot([R*cos(t/4)-r/T,R*sin(t/4)-r/T,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,k,k,0),filled=true):
  an6[k] := plot([R*cos(t/4+Pi/4),R*sin(t/4+Pi/4)-r,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,(k+1)mod 2,(k+1)mod 2,0),filled=true):
  an7[k] := plot([R*cos(t/4+Pi/2)+r/T,R*sin(t/4+Pi/2)-r/T,t=k*Pi..(k+1)*Pi],
            color=COLOR(RGB,k,k,0),filled=true):
end do:                        # outside black and yellow tiles
an8 := plot([R*cos(t/4+3*Pi/4)+r,R*sin(t/4+3*Pi/4),t=0..2*Pi],
    color=blue,filled=true):
an9 := plot([R*cos(t/4+7*Pi/4)-r,R*sin(t/4+7*Pi/4),t=0..2*Pi],
    color=blue,filled=true):   # re-bluing the areas that got covered
k:=0:                          # putting together the outside tiles
an11:=display(an7[k],an6[k],an5[k],an4[k],an3[k],an2[k],an1):
k:=1:                          # and the other half outside tiles
an11:=display(an9,an8,an7[k],an6[k],an5[k],an4[k],an3[k],an2[k],an11):
r:=2^(1/4):R:=sqrt(r^2-1):
for k from 0 to 7 do
  an10[k]:= plot([R*cos(t)+r*cos(Pi/8+k*Pi/4),R*sin(t)+r*sin(Pi/8+k*Pi/4),
            t=Pi+k*Pi/4..5*Pi/4+k*Pi/4],color=COLOR(RGB,k mod 2,k mod 2,0),
            filled=true):
  an11:=display(an10[k],an11): # the curved edges of the inside tiles
end do:
R:=2^(1/2)-sqrt(2-sqrt(2)):
for k from 0 to 3 do
  an12[k]:=plot([cos(Pi/4+k*Pi/2)*t,sin(Pi/4+k*Pi/2)*t,t=0..R],
           color=COLOR(RGB,k mod 2,k mod 2,0),filled=true):
  an11:=display(an12[k],an11): # the flat edges of the inside tiles
end do:
display(an11,scaling=constrained);

Existence of Hyperbolic Fundamental Domain: This demonstrates the existence of appropriate regular fundamental domains for surfaces of genus > 1 in H².

restart: with(plots):

n := 36:                       # frames
m := 4:                        # 2m-sided domain

an1 := plot([cos(t),sin(t),t=0..2*Pi],color=blue,
    scaling=constrained,view=[-1..1,-1..1]):
for k from 0 to n-1 do
 f := k+.999:                  # fudge...want k from 1 to n
 r := sqrt(n/f)/cos(Pi/(2*m)): # center of hyperbolic lines
 R := sqrt(r^2-1):             # radius
 y := -(-1/2*r+1/2*r*cos(Pi/m)+
   1/2*sqrt(-r^2+r^2*cos(Pi/m)^2+
   2*R^2+2*R^2*cos(Pi/m))-(1/2*r-
   1/2*r*cos(Pi/m)+1/2*sqrt(-r^2+
   r^2*cos(Pi/m)^2+2*R^2+2*R^2*cos(Pi/m)))
   *cos(Pi/m))/sin(Pi/m);
 p := arcsin(y/R):             # angle of intersection
 an2[k]:=plot([0,0,t=0..1]):
 for j from 0 to 2*m-1 do
  an[k][j] := plot([R*cos(t+Pi+j*Pi/m)+r*cos(j*Pi/m),
      R*sin(t+Pi+j*Pi/m)+r*sin(j*Pi/m),t=-p..p],
      axes=none,color=red,scaling=constrained):
  an2[k] := display(an2[k],an[k][j],view=[-1..1,-1..1]):
 end do:
end do:
an3 := plots[display]([seq(an2[k],k=0..n-1)],insequence=true):
display(an3,an1);

Poincaré Hyperbolic Isometries: The following code defines inversions in circles which represent lines in the hyperbolic plane (Poincaré disc model), using them to create three images of orientation preserving hyperbolic isometries. The code is split into four essential parts.

The first part defines the functions needed, of which f, inversion in a predefined circle (reflection in a hyperbolic line) is the most important. A few hyperbolic lines correspond to Euclidean lines, and the reflections in these are defined in the function g. As special cases of the special case we define also hx and hy, the reflections in the x- and y-axes. It should be noted that we do not use some of these definitions for these images; they are included so that the entire set of hyperbolic reflections, which generate the group of hyperbolic isometries, might be set down for posterity. This section of code ends with the definitions of a number of objects that appear in each of the three images.

The second block of code, separated from the first by a blank line, demonstrates hyperbolic rotations by drawing the first image. It is interesting to note that the reflections are generated by simply applying f, g, hx, or hy to the figure. I.e., since the figure is p(x,y), and the reflection in line 0 is f(0,x,y), then the figure reflected in line 0 is just f(0,p(x,y)). Two reflections in intersecting lines produce a rotation, just as they do in the Euclidean plane.

The third block of code, again separated by a blank line, generates the second image, demonstrating hyperbolic translations.

The final block of code generates the third image. This image demonstrates a third kind of orientation preserving hyperbolic isometry which has no equivalent in the Euclidean plane; it is neither a rotation nor a translation.

restart: with(plots):
R := i -> sqrt(1+r[i]^2):         # radius of circle defining (hyp) line
xx := i -> R(i)*cos(phi[i]):      # x-coord. center of circle
yy := i -> R(i)*sin(phi[i]):      # y-coord. center of circle
c := i -> cot(theta[i]):          # cotangent theta_i
t := i -> tan(theta[i]):          # tangent theta_i
f := (i,x,y) -> (xx(i)+r[i]/((x-xx(i))^2+(y-yy(i))^2)*(x-xx(i)),
                 yy(i)+r[i]/((x-xx(i))^2+(y-yy(i))^2)*(y-yy(i))):
                                  # defines an inversion in circle i
g := (i,x,y) -> ((c(i)*x-t(i)*x+2*y)/(c(i)+t(i)),
                 (t(i)*y-c(i)*y+2*x)/(t(i)+c(i))):
                                  # refl. in line thru 0 w/angle theta_i
hx := (x,y) -> (x,-y):            # reflection in the x-axis
hy := (x,y) -> (-x,y):            # reflection in the y-axis
r[0]:=1:phi[0]:=0:                # constants for (hyp) line 0
r[1]:=1:phi[1]:=Pi/6:             # constants for (hyp) line 1
r[2]:=1:phi[2]:=Pi/2:             # constants for (hyp) line 2
p:=(x,y)->(.25+cos(2*t)/12,sin(3*t)/24-.3):           # the green figure
an0:=plot([cos(t),sin(t),t=0..2*Pi],color=blue,scaling=constrained,axes=none):
an1:=plot([p(x,y),t=0..2*Pi],color=green):            # the green figure

for i from 0 to 1 do
  an2[i]:=plot([xx(i)+r[i]*cos(t),yy(i)+r[i]*sin(t),
          t=3*Pi/4+i*Pi/6..5*Pi/4+i*Pi/6],color=red): # the red lines
end do:
an3:=plot([f(0,p(x,y)),t=0..2*Pi],color=blue):        # refl. figure
an4:=plot([f(1,f(0,p(x,y))),t=0..2*Pi],color=green):  # twice refl. figure
display(an0,an1,an2[0],an2[1],an3,an4);               # draw rotation

an2:=plot([f(0,p(x,y)),t=0..2*Pi],color=blue):        # the y-axis
an3:=plot([xx(0)+r[0]*cos(t),yy(0)+r[0]*sin(t),
          t=3*Pi/4..5*Pi/4],color=red):               # (hyp) line 0
an4:=plot([f(0,0,t),t=-1..1],color=red):              # y-axis refl. in line 0
an5:=plot([f(0,hy(p(x,y))),t=0..2*Pi],color=green):   # twice reflected figure
display(an0,an1,an2,an3,an4,an5);                     # draw translation

p:=(x,y)->(cos(2*t)/12+.2,sin(3*t)/24+.2):            # redefines green figure
an1:=plot([p(x,y),t=0..2*Pi],color=blue):
for i from 0 to 1 do
  an2[i]:=plot([xx(2*i)+r[2*i]*cos(t),yy(2*i)+r[2*i]*sin(t),
        t=3*Pi/4+i*Pi/2..5*Pi/4+i*Pi/2],color=red):   # the red lines
  an3[i]:=plot([f(2*i,p(x,y)),t=0..2*Pi],color=green):# refl. green fig.
  an[i]:=display(an2[i],an3[i]):
end do:
display(an0,an1,an[0],an[1]);                         # draw isometry 3

Beltrami-Klein Hyperbolic Isometries: This code is identical to the last with one subtle exception: the new second line defines the map from the Poincaré model to the Klein model; the map is then used in each plot statement. Hence this code produces the same picture, but in the Klein model.

restart: with(plots):
pk := (x,y) -> (2*x/(1+x^2+y^2),2*y/(1+x^2+y^2)):
                                  # map from poincare to klein model
R := i -> sqrt(1+r[i]^2):         # radius of circle defining (hyp) line
xx := i -> R(i)*cos(phi[i]):      # x-coord. center of circle
yy := i -> R(i)*sin(phi[i]):      # y-coord. center of circle
c := i -> cot(theta[i]):          # cotangent theta_i
t := i -> tan(theta[i]):          # tangent theta_i
f := (i,x,y) -> (xx(i)+r[i]/((x-xx(i))^2+(y-yy(i))^2)*(x-xx(i)),
                 yy(i)+r[i]/((x-xx(i))^2+(y-yy(i))^2)*(y-yy(i))):
                                  # defines an inversion in circle i
g := (i,x,y) -> ((c(i)*x-t(i)*x+2*y)/(c(i)+t(i)),
                 (t(i)*y-c(i)*y+2*x)/(t(i)+c(i))):
                                  # refl. in line thru 0 w/angle theta_i
hx := (x,y) -> (x,-y):            # reflection in the x-axis
hy := (x,y) -> (-x,y):            # reflection in the y-axis
r[0]:=1:phi[0]:=0:                # constants for (hyp) line 0
r[1]:=1:phi[1]:=Pi/6:             # constants for (hyp) line 1
r[2]:=1:phi[2]:=Pi/2:             # constants for (hyp) line 2
p:=(x,y)->(.25+cos(2*t)/12,sin(3*t)/24-.3):           # the green figure
an0:=plot([pk(cos(t),sin(t)),t=0..2*Pi],color=blue,scaling=constrained,axes=none):
an1:=plot([pk(p(x,y)),t=0..2*Pi],color=green):        # the green figure

for i from 0 to 1 do
  an2[i]:=plot([pk(xx(i)+r[i]*cos(t),yy(i)+r[i]*sin(t)),
          t=3*Pi/4+i*Pi/6..5*Pi/4+i*Pi/6],color=red): # the red lines
end do:
an3:=plot([pk(f(0,p(x,y))),t=0..2*Pi],color=blue):    # refl. figure
an4:=plot([pk(f(1,f(0,p(x,y)))),t=0..2*Pi],color=green):  # twice refl. figure
display(an0,an1,an2[0],an2[1],an3,an4);               # draw rotation

an2:=plot([pk(f(0,p(x,y))),t=0..2*Pi],color=blue):    # the y-axis
an3:=plot([pk(xx(0)+r[0]*cos(t),yy(0)+r[0]*sin(t)),
          t=3*Pi/4..5*Pi/4],color=red):               # (hyp) line 0
an4:=plot([pk(f(0,0,t)),t=-1..1],color=red):          # y-axis refl. in line 0
an5:=plot([pk(f(0,hy(p(x,y)))),t=0..2*Pi],color=green):   # twice reflected figure
display(an0,an1,an2,an3,an4,an5);                     # draw translation

p:=(x,y)->(cos(2*t)/12+.2,sin(3*t)/24+.2):            # redefines green figure
an1:=plot([pk(p(x,y)),t=0..2*Pi],color=blue):
for i from 0 to 1 do
  an2[i]:=plot([pk(xx(2*i)+r[2*i]*cos(t),yy(2*i)+r[2*i]*sin(t)),
        t=3*Pi/4+i*Pi/2..5*Pi/4+i*Pi/2],color=red):   # the red lines
  an3[i]:=plot([pk(f(2*i,p(x,y))),t=0..2*Pi],color=green):# refl. green fig.
  an[i]:=display(an2[i],an3[i]):
end do:
display(an0,an1,an[0],an[1]);                         # draw isometry 3

Projective Stuff (P²)

Spherical Stuff (S²)

Platonic Tilings: This link contains MAPLE code for producing graphs of the Platonic tilings of the unit sphere. It includes instructions for demonstrating the self duality of the tetrahedral tiling, and numerous other relationships between the others.