gyro: Hyperbolic Geometry

# ~~ triakis icosahedron ~~
edges <- rbind(
  c(24, 30),
  c(15, 24),
  c(15, 30),
  c(21, 24),
  c(21, 30),
  c(15, 21),
  c(17, 22),
  c(15, 22),
  c(15, 17),
  c(22, 30),
  c(17, 30),
  c(2, 10),
  c(10, 15),
  c(2, 15),
  c(10, 17),
  c(2, 17),
  c(4, 6),
  c(6, 15),
  c(4, 15),
  c(2, 6),
  c(2, 4),
  c(13, 21),
  c(13, 15),
  c(4, 13),
  c(4, 21),
  c(27, 31),
  c(18, 27),
  c(18, 31),
  c(27, 29),
  c(29, 31),
  c(18, 29),
  c(20, 29),
  c(18, 20),
  c(12, 20),
  c(12, 29),
  c(12, 18),
  c(9, 12),
  c(9, 18),
  c(3, 9),
  c(3, 12),
  c(3, 18),
  c(3, 11),
  c(11, 18),
  c(11, 16),
  c(3, 16),
  c(16, 18),
  c(16, 23),
  c(18, 23),
  c(23, 31),
  c(16, 31),
  c(21, 28),
  c(28, 31),
  c(21, 31),
  c(28, 30),
  c(30, 31),
  c(29, 32),
  c(30, 32),
  c(29, 30),
  c(31, 32),
  c(26, 30),
  c(26, 29),
  c(17, 26),
  c(17, 29),
  c(12, 19),
  c(17, 19),
  c(12, 17),
  c(19, 29),
  c(8, 17),
  c(8, 12),
  c(2, 8),
  c(2, 12),
  c(3, 5),
  c(2, 5),
  c(2, 3),
  c(5, 12),
  c(1, 2),
  c(1, 3),
  c(1, 4),
  c(3, 4),
  c(7, 16),
  c(4, 7),
  c(4, 16),
  c(3, 7),
  c(4, 14),
  c(14, 16),
  c(14, 21),
  c(16, 21),
  c(25, 31),
  c(21, 25),
  c(16, 25)
)

faces <- rbind(
  c(24, 15, 30),
  c(24, 30, 21),
  c(24, 21, 15),
  c(22, 15, 17),
  c(22, 17, 30),
  c(22, 30, 15),
  c(10, 15, 2),
  c(10, 2, 17),
  c(10, 17, 15),
  c(6, 15, 4),
  c(6, 4, 2),
  c(6, 2, 15),
  c(13, 15, 21),
  c(13, 21, 4),
  c(13, 4, 15),
  c(27, 18, 31),
  c(27, 31, 29),
  c(27, 29, 18),
  c(20, 18, 29),
  c(20, 29, 12),
  c(20, 12, 18),
  c(9, 18, 12),
  c(9, 12, 3),
  c(9, 3, 18),
  c(11, 18, 3),
  c(11, 3, 16),
  c(11, 16, 18),
  c(23, 18, 16),
  c(23, 16, 31),
  c(23, 31, 18),
  c(28, 31, 21),
  c(28, 21, 30),
  c(28, 30, 31),
  c(32, 30, 29),
  c(32, 29, 31),
  c(32, 31, 30),
  c(26, 29, 30),
  c(26, 30, 17),
  c(26, 17, 29),
  c(19, 17, 12),
  c(19, 12, 29),
  c(19, 29, 17),
  c(8, 12, 17),
  c(8, 17, 2),
  c(8, 2, 12),
  c(5, 2, 3),
  c(5, 3, 12),
  c(5, 12, 2),
  c(1, 3, 2),
  c(1, 2, 4),
  c(1, 4, 3),
  c(7, 4, 16),
  c(7, 16, 3),
  c(7, 3, 4),
  c(14, 16, 4),
  c(14, 4, 21),
  c(14, 21, 16),
  c(25, 21, 31),
  c(25, 31, 16),
  c(25, 16, 21)
)

vertices <- rbind(
  c(-0.299169631850424, -0.0194789139180638, 0.00891725809586894),
  c(-0.289611949266183, 0.0698367826153536, -0.185370227660882),
  c(-0.280991925125174, 0.105501754479499, 0.181734136814288),
  c(-0.26373666435599, -0.229662391526403, 0.0285050251603779),
  c(-0.23648412867205, 0.184077773080337, -0.0123306343848149),
  c(-0.220285771573088, -0.130557200951906, -0.156174294693998),
  c(-0.212193733375886, -0.0970767477747254, 0.188444524351244),
  c(-0.1188584968287, 0.198804437248412, -0.190554106916132),
  c(-0.110766458631505, 0.232284890422322, 0.154064712130515),
  c(-0.108847361578435, 0.00434932924818334, -0.279454378052918),
  c(-0.0957541687381721, 0.0585218404440131, 0.278150584325798),
  c(-0.0889159241295477, 0.338027566990148, -0.030752252890723),
  c(-0.0845569662822443, -0.276805191607745, -0.0786792193149636),
  c(-0.0795558116377906, -0.256113133587523, 0.134306924016879),
  c(-0.0609963257216091, -0.204279413060464, -0.278682163611144),
  c(-0.0470488336757664, -0.146572276376093, 0.315305175527903),
  c(0.0470488336744298, 0.1465722763758, -0.315305175528347),
  c(0.0609963257217297, 0.204279413060379, 0.278682163611927),
  c(0.0795558116368941, 0.25611313358822, -0.134306924018219),
  c(0.0845569662845112, 0.276805191608941, 0.0786792193146899),
  c(0.0889159241313768, -0.338027566989877, 0.0307522528903342),
  c(0.0957541687366009, -0.0585218404455047, -0.278150584326427),
  c(0.10884736157873, -0.00434932924856558, 0.279454378054558),
  c(0.11076645863083, -0.232284890423498, -0.154064712128455),
  c(0.118858496830776, -0.198804437248567, 0.19055410691574),
  c(0.212193733374808, 0.0970767477753568, -0.188444524352489),
  c(0.220285771573414, 0.130557200951887, 0.156174294693058),
  c(0.236484128672217, -0.184077773080217, 0.012330634385639),
  c(0.26373666435568, 0.229662391528111, -0.0285050251620337),
  c(0.280991925124037, -0.10550175448007, -0.18173413681397),
  c(0.289611949266398, -0.069836782614709, 0.185370227662137),
  c(0.299169631850128, 0.0194789139169681, -0.00891725809544017)
)

library(gyro)
library(rgl)
library(trekcolors)

s <- 0.2
open3d(windowRect = c(50, 50, 562, 562))
view3d(30, 30, zoom = 0.65)
for(i in 1:nrow(faces)){
  triangle <- faces[i, ]
  A <- vertices[triangle[1], ]
  B <- vertices[triangle[2], ]
  C <- vertices[triangle[3], ]
  gtriangle <- gyrotriangle(
    A, B, C, s,
    palette = trek_pal("starfleet"), bias = 0.2, interpolate = "linear"
  )
  shade3d(gtriangle)
}
for(i in 1:nrow(edges)){
  edge <- edges[i, ]
  A <- vertices[edge[1], ]
  B <- vertices[edge[2], ]
  gtube <- gyrotube(A, B, s, radius = 0.006)
  shade3d(gtube, color = "darkgreen")
}
spheres3d(vertices, radius = 0.009, color = "darkgreen")


# animation ####
M <- par3d("userMatrix")
movie3d(
  par3dinterp(
    time = seq(0, 1, len = 9),
    userMatrix = list(
      M,
      rotate3d(M, pi, 1, 0, 0),
      rotate3d(M, pi, 1, 1, 0),
      rotate3d(M, pi, 1, 1, 1),
      rotate3d(M, pi, 0, 1, 1),
      rotate3d(M, pi, 0, 1, 0),
      rotate3d(M, pi, 1, 0, 1),
      rotate3d(M, pi, 0, 0, 1),
      M
    )
  ),
  fps = 120,
  duration = 1,
  dir = ".",
  movie = "zzpic",
  convert = FALSE,
  clean = FALSE,
  webshot = FALSE
)

command <-
  "gifski --fps=8 --frames=zzpic*.png -o triakisIcosahedron.gif"
system(command)

pngfiles <- list.files(pattern = "^zzpic?.*png$")
file.remove(pngfiles)