E8 in Coxeter plane

E8_Coxeter.R

# https://github.com/SuperJason/python/blob/96989d1681085a87a0d7f488d926a1677cd7041f/famous_math_graphics/e8.py

# Roots of the form (+-1, +-1, 0, 0, 0, 0, 0, 0),
# signs can be chosen independently and the two non-zeros can be anywhere.
library(arrangements)
combs <- combinations(8L, 2L)
vs11 <- NULL
for(i in 1L:nrow(combs)){
  comb <- combs[i, ]
  for(x in c(-2, 2)){
    for(y in c(-2, 2)){
      zeros <- rep(0, 8L)
      zeros[comb[1L]] <- x
      zeros[comb[2L]] <- y
      vs11 <- rbind(vs11, zeros)
    }
  }
}

# Roots of the form 1/2 * (+-1, +-1, ..., +-1), signs can be chosen
# independently except that there must be an even number of -1s.
vs22 <- NULL
grd <- as.matrix(expand.grid(rep(list(c(-1, 1)), 8)))
for(i in 1:nrow(grd)){
  v <- grd[i, ]
  if(sum(v) %% 4 == 0){
    vs22 <- rbind(vs22, v)
  }
}

vertices <- rbind(vs11, vs22)

# Connect a root to its nearest neighbors,
# two roots are connected if and only if they form an angle of pi/3.
edges <- NULL
for(i in 1L:(nrow(vertices)-1L)){
  v1 <- vertices[i, ]
  for(j in (i+1L):nrow(vertices)){
    v2 <- vertices[j, ]
    if(c(crossprod(v1-v2)) == 8){
      edges <- rbind(edges, c(i, j))
    }
  }
}

# --- Step two: compute a basis of the Coxeter plane ---

# A set of simple roots listed by rows of 'delta'
delta <- rbind(
  c(1, -1, 0, 0, 0, 0, 0, 0),
  c(0, 1, -1, 0, 0, 0, 0, 0),
  c(0, 0, 1, -1, 0, 0, 0, 0),
  c(0, 0, 0, 1, -1, 0, 0, 0),
  c(0, 0, 0, 0, 1, -1, 0, 0),
  c(0, 0, 0, 0, 0, 1, 1, 0),
  c(-.5, -.5, -.5, -.5, -.5, -.5, -.5, -.5),
  c(0, 0, 0, 0, 0, 1, -1, 0)
)

# Dynkin diagram of E8:
# 1---2---3---4---5---6---7
#                 |
#                 8
# where vertex i is the i-th simple root.

# The Cartan matrix:
cartan <- tcrossprod(delta)

# Now we split the simple roots into two disjoint sets I and J
# such that the simple roots in each set are pairwise orthogonal.
# It's obvious to see how to find such a partition given the
# Dynkin graph above: I = [1, 3, 5, 7] and J = [2, 4, 6, 8],
# since roots are not connected by an edge if and only if they are orthogonal.
# Then a basis of the Coxeter plane is given by
# u1 = sum (c[i] * delta[i]) for i in I,
# u2 = sum (c[j] * delta[j]) for j in J,
# where c is an eigenvector for the minimal
# eigenvalue of the Cartan matrix.
eig <- eigen(cartan)

# The eigenvalues returned by eigen() are in descending order
# and the eigenvectors are listed by columns.
ev <- eig$vectors[, 8L]
u1 <- rowSums(vapply(c(1L, 3L, 5L, 7L), function(i){
  ev[i] * delta[i, ]
}, numeric(8L)))
u2 <- rowSums(vapply(c(2L, 4L, 6L, 8L), function(i){
  ev[i] * delta[i, ]
}, numeric(8L)))

# Gram-Schmidt u1, u2 and normalize them to unit vectors.
u1 <- u1 / sqrt(c(crossprod(u1)))
u2 <- u2 - c(crossprod(u1, u2)) * u1
u2 <- u2 / sqrt(c(crossprod(u2)))

# projections on the Coxeter plane
proj <- function(v){
  c(c(crossprod(v, u1)), c(crossprod(v, u2)))
}
points <- t(apply(vertices/2, 1L, proj))

# save plot as SVG
svg(filename = "E8_Coxeter.svg", onefile = TRUE)
opar <- par(mar = c(0, 0, 0, 0))
plot(
  points[!duplicated(points), ], pch = 19, cex = 0.3, asp = 1, 
  axes = FALSE, xlab = NA, ylab = NA
)
for(i in 1L:nrow(edges)){
  lines(points[edges[i, ], ], lwd = 0.1)
}
par(opar)
dev.off()

# convert to PNG
rsvg::rsvg_png("E8_Coxeter.svg", file = "E8_Coxeter.png")


# save plot with colors as SVG ####
upoints <- points[!duplicated(points), ]
K <- sqrt(max(apply(upoints, 1L, crossprod)))
points <- points / K
upoints <- upoints / K
fcolor0 <- colorRamp(viridisLite::turbo(50L))
fcolor <- function(u){
  RGB <- fcolor0(u)
  rgb(RGB[, 1L], RGB[, 2L], RGB[, 3L], maxColorValue = 255)
}

svg(filename = "E8_Coxeter_colors.svg", onefile = TRUE)
opar <- par(mar = c(0, 0, 0, 0))
plot(
  upoints, pch = 19, cex = 0.3, asp = 1, 
  axes = FALSE, xlab = NA, ylab = NA
)
for(i in 1L:nrow(edges)){
  edge <- edges[i, ]
  x0 <- points[edge[1L], 1L]
  x1 <- points[edge[2L], 1L]
  y0 <- points[edge[1L], 2L]
  y1 <- points[edge[2L], 2L]
  x <- seq(x0, x1, length.out = 30L)
  y <- seq(y0, y1, length.out = 30L)
  norms <- sqrt(x*x + y*y)[-1L]
  segments(
    head(x, -1L), head(y, -1L), tail(x, -1L), tail(y, -1L), 
    col = fcolor(norms), lwd = 0.1
  )
}
par(opar)
dev.off()

# convert to PNG
rsvg::rsvg_png("E8_Coxeter_colors.svg", file = "E8_Coxeter_colors.png")


# animation with colors ####
upoints <- points[!duplicated(points), ]
K <- sqrt(max(apply(upoints, 1L, crossprod)))
points <- points / K
upoints <- upoints / K
colors <- viridisLite::turbo(100L)
fcolor0 <- colorRamp(c(colors, rev(colors)))
fcolor <- function(u){
  RGB <- fcolor0(u)
  rgb(RGB[, 1L], RGB[, 2L], RGB[, 3L], maxColorValue = 255)
}

u_ <- head(seq(0, 1, length.out = 51L), -1L)
for(k in 1L:length(u_)){
  u <- u_[k]
  svg(filename = "E8_Coxeter_colors.svg", onefile = TRUE)
  opar <- par(mar = c(0, 0, 0, 0))
  plot(
    upoints, pch = 19, cex = 0.3, asp = 1, 
    axes = FALSE, xlab = NA, ylab = NA
  )
  for(i in 1L:nrow(edges)){
    edge <- edges[i, ]
    x0 <- points[edge[1L], 1L]
    x1 <- points[edge[2L], 1L]
    y0 <- points[edge[1L], 2L]
    y1 <- points[edge[2L], 2L]
    x <- seq(x0, x1, length.out = 30L)
    y <- seq(y0, y1, length.out = 30L)
    norms <- sqrt(x*x + y*y)[-1L]
    segments(
      head(x, -1L), head(y, -1L), tail(x, -1L), tail(y, -1L), 
      col = fcolor((norms + u) %% 1), lwd = 0.1
    )
  }
  par(opar)
  dev.off()
  rsvg::rsvg_png(
    "E8_Coxeter_colors.svg", 
    file = sprintf("pic%03d.png", k)
  )
}

library(gifski)
pngs <- list.files(pattern = "^pic")
gifski(
  pngs,
  gif_file = "E8_Coxeter.gif",
  width = 512,
  height = 512,
  delay = 1/15
)

file.remove(pngs)

E8_Coxeter.gif

E8_Coxeter.png

E8_Coxeter_colors.png

E8_Coxeter_other_basis.png

E8_Coxeter_other_basis.R