Mapping a picture on a donut or a Hopf torus

Posted on June 30, 2022 by Stéphane Laurent

The donut torus

Given a number $$s \geqslant 1$$, the following map: $(u, v) \mapsto (x, y, z) = \frac{\Bigl(s\cos\frac{u}{s}, s\sin\frac{u}{s}, \sin v\Bigr)}{\sqrt{s^2+1}-\cos v}$ is a conformal parameterization of the torus (the donut), where $$-s\pi \leqslant u < s\pi$$ and $$\pi \leqslant v < \pi$$. I found it in this paper by J.M. Sullivan. The number $$s$$ is the ratio of the major radius over the minor radius.

The conformality of the map has the following consequence: you can easily map a doubly periodic image on the torus in such a way that it will perfectly fit on the torus.

Mapping a checkerboard

Let me show what I mean. The code below generates a mesh of the torus with a checkerboard mapped on its surface:

library(rgl)
library(Rvcg) # to use vcgUpdateNormals()

torusMesh <- function(s, nu, nv){
nu <- as.integer(nu)
nv <- as.integer(nv)
nunv <- nu * nv
vs      <- matrix(NA_real_, nrow = 3L, ncol = nunv)
tris1   <- matrix(NA_integer_, nrow = 3L, ncol = nunv)
tris2   <- matrix(NA_integer_, nrow = 3L, ncol = nunv)
u_ <- seq(-pi*s, pi*s, length.out = nu + 1L)[-1L]
v_ <- seq(-pi, pi, length.out = nv + 1L)[-1L]
scosu_ <- s * cos(u_ / s)
ssinu_ <- s * sin(u_ / s)
sinv_ <- sin(v_)
w     <- sqrt(s*s + 1) - cos(v_)
jp1_ <- c(2L:nv, 1L)
j_ <- 1L:nv
color <- NULL
for(i in 1L:(nu-1L)){
i_nv <- i*nv
rg <- (i_nv - nv + 1L):i_nv
vs[, rg] <- rbind(
scosu_[i] / w,
ssinu_[i] / w,
sinv_     / w
)
color <- c(
color,
if(mod(floor(5 * u_[i] / (pi*s)), 2) == 0){
ifelse(
floor(5 * v_ / pi) %% 2 == 0, "yellow", "navy"
)
}else{
ifelse(
floor(5 * v_ / pi) %% 2 == 0, "navy", "yellow"
)
}
)
k1 <- i_nv - nv
k_ <- k1 + j_
l_ <- k1 + jp1_
m_ <- i_nv + j_
tris1[, k_] <- rbind(m_, l_, k_)
tris2[, k_] <- rbind(m_, i_nv + jp1_, l_)
}
i_nv <- nunv
rg <- (i_nv - nv + 1L):i_nv
vs[, rg] <- rbind(
scosu_[nu] / w,
ssinu_[nu] / w,
sinv_      / w
)
color <- c(
color,
ifelse(
floor(5 * v_ / pi) %% 2 == 0, "yellow", "navy"
)
)
k1 <- i_nv - nv
l_ <- k1 + jp1_
k_ <- k1 + j_
tris1[, k_] <- rbind(j_, l_, k_)
tris2[, k_] <- rbind(j_, jp1_, l_)
tmesh <- tmesh3d(
vertices    = vs,
indices     = cbind(tris1, tris2),
homogeneous = FALSE,
material    = list("color" = color)
)
vcgUpdateNormals(tmesh)
}

Let’s see:

mesh <- torusMesh(s = sqrt(2), nu = 500, nv = 500)

open3d(windowRect = c(50, 50, 562, 562), zoom = 0.85)
bg3d("gainsboro")
shade3d(mesh)

Now you surely see what I mean.

Mapping a Gray-Scott picture

I am a fan of the Fronkonstin blog. Maybe you already see this article about the Gray-Scott reaction-diffusion model (it appeared on R-bloggers). It shows how to generate some beautiful pictures which are doubly periodic. So let’s map such a picture on the donut:

......

fcolor <- colorRamp(viridisLite::magma(255L))
getColors <- function(B){
rgbs <- fcolor(B)
rgb(rgbs[, 1L], rgbs[, 2L], rgbs[, 3L], maxColorValue = 255)
}

X <- iterate_Gray_Scott(X, L, DA, DB, 500)
Colors <- getColors(c(X[,,2L]))

mesh <- torusMesh(s = sqrt(2), nu = 600, nv = 600)
mesh[["material"]] <- list("color" = Colors)

open3d(windowRect = c(50, 50, 562, 562), zoom = 0.85)
bg3d("gainsboro")
shade3d(mesh)

Beautiful!

The Hopf torus

We can similarly map a picture on a Hopf torus, with this conformal parameterization:

HT <- function(h, nlobes, t, phi){
# the spherical curve
p1 <- sin(h * cos(nlobes*t))
p2 <- cos(t) * cos(h * cos(nlobes*t))
p3 <- sin(t) * cos(h * cos(nlobes*t))
# parameterization
yden <- sqrt(2*(1+p1))
y1 <- (1+p1)/yden
y2 <- p2/yden
y3 <- p3/yden
cosphi <- cos(phi)
sinphi <- sin(phi)
x1 <- cosphi*y1
x2 <- sinphi*y1
x3 <- cosphi*y2 - sinphi*y3
x4 <- cosphi*y3 + sinphi*y2
return(rbind(x1/(1-x4), x2/(1-x4), x3/(1-x4)))
}

Checkerboard

The code to construct the mesh with the checkerboard is similar to the one for the donut torus:

HopfTorusMesh <- function(h, nlobes, nu, nv){
nu <- as.integer(nu)
nv <- as.integer(nv)
vs    <- matrix(NA_real_, nrow = 3L, ncol = nu*nv)
tris1 <- matrix(NA_integer_, nrow = 3L, ncol = nu*nv)
tris2 <- matrix(NA_integer_, nrow = 3L, ncol = nu*nv)
u_ <- seq(-pi, pi, length.out = nu + 1L)[-1L]
v_ <- seq(-pi, pi, length.out = nv + 1L)[-1L]
jp1_ <- c(2L:nv, 1L)
j_ <- 1L:nv
color <- NULL
for(i in 1L:(nu-1L)){
i_nv <- i*nv
vs[, (i_nv - nv + 1L):i_nv] <- HT(h, nlobes, u_[i], v_)
color <- c(
color,
if(mod(floor(10 * u_[i] / pi), 2) == 0){
ifelse(
floor(10 * v_ / pi) %% 2 == 0, "yellow", "navy"
)
}else{
ifelse(
floor(10 * v_ / pi) %% 2 == 0, "navy", "yellow"
)
}
)
k1 <- i_nv - nv
k_ <- k1 + j_
l_ <- k1 + jp1_
m_ <- i_nv + j_
tris1[, k_] <- rbind(k_, l_, m_)
tris2[, k_] <- rbind(l_, i_nv + jp1_, m_)
}
i_nv <- nu*nv
vs[, (i_nv - nv + 1L):i_nv] <- HT(h, nlobes, pi, v_)
color <- c(
color,
ifelse(
floor(10 * v_ / pi) %% 2 == 0, "yellow", "navy"
)
)
k1 <- i_nv - nv
k_ <- k1 + j_
l_ <- k1 + jp1_
tris1[, k_] <- rbind(k_, l_, j_)
tris2[, k_] <- rbind(l_, jp1_, j_)
vcgUpdateNormals(tmesh3d(
vertices    = vs,
indices     = cbind(tris1, tris2),
homogeneous = FALSE,
material    = list("color" = color)
))
}

mesh <- HopfTorusMesh(h = 0.4, nlobes = 4, nu = 500, nv = 500)

open3d(windowRect = c(50, 50, 562, 562), zoom = 0.85)
bg3d("gainsboro")
shade3d(mesh)

I really like it.

Gray-Scott picture

To map the Gray-Scott picture, we proceed as for the donut torus. Here is the result: