Stereo plotting in R

2020/01/06

Here’s another neat trick I picked up from Julien Sprott’s book on Strange Attractors: that good ole’ 90s 3D effect you get if you focus outside of the image and frustratingly wait for that image to appear.

The technique I will use is called Cross-eyed stereo viewing, which works by the viewer crossing their eyes inwards. Let’s start with an example to see where we’re going.

To generate pretty pictures, I will mostly use the same technique as in my post about 2D quadratic iteraded map attractors, but now for 3D dittos. In short: I will use the quadratic_3d() function to generate interesting 3D data to plot.

library(tidyverse)
theme_set(theme_void() + theme(legend.position = 'none'))

quadratic_3d <- function(a, x, y, z) {
  xn1 <- a[ 1] + a[ 2]*x + a[ 3]*x*x + a[ 4]*x*y + a[ 5]*x*z + a[ 6]*y + a[ 7]*y*y + a[ 8]*y*z + a[ 9]*z + a[10]*z*z
  yn1 <- a[11] + a[12]*x + a[13]*x*x + a[14]*x*y + a[15]*x*z + a[16]*y + a[17]*y*y + a[18]*y*z + a[19]*z + a[20]*z*z
  zn1 <- a[21] + a[22]*x + a[23]*x*x + a[24]*x*y + a[25]*x*z + a[26]*y + a[27]*y*y + a[28]*y*z + a[29]*z + a[30]*z*z
  
  c(xn1, yn1, zn1)
}

iterate <- function(step_fn, a, x0, y0, z0, iterations) {
  x <- rep(x0, iterations)
  y <- rep(y0, iterations)
  z <- rep(z0, iterations)
  
  for(n in 1:(iterations - 1)) {
    xyz <- step_fn(a, x[n], y[n], z[n])
    x[n+1] <- xyz[1]
    y[n+1] <- xyz[2]
    z[n+1] <- xyz[3]
  }
  
  tibble(x = x, y = y, z = z) %>%
    mutate(n = row_number())
}

normalize_xyz <- function(df) {
  range <- with(df, max(max(x) - min(x), max(y) - min(y), max(x) - min(z)))
  
  df %>%
    mutate(x = (x - min(x)) / range,
           y = (y - min(y)) / range,
           z = (z - min(z)) / range)
  
}

I will show you how to use the code above in a bit. First though, let’s practice on a picture!

This is a stereo image. Even though the two copies look very much alike, there are subtle differences between them. When you look at them the right way, a third image will appear that magically combinees them into a single 3D image. Here’s how I do to see it.

I slightly cross my eyes while watching emptily in the distance “through” the image. As I do, I start to see doubles making for four strings in total. Now I need to put two of these on top of each others which takes some frustrating practice. Here’s a few tips.

Hopefully you’ll get it; if not you might want to try Google. It took me some time to get it first, but it gets much easier with practice and during a session!

That sweet stereo

The technique to render these images is surprisingly easy. The basis of you being able to see in three dimensions at all is that your eyes are placed slightly appart. When you look at a scene, the 2D projection that enters one eye is slightly different from the one to the other eye. When we here shift our two images in the right way, we “pre-process” the 3D-to-2D image entering each eye, which creates the illusion of depth.

Princples1

As a walk-through example, I’ll use another plot: the Lorenz Attractor. First we need to generate the (x, y, z) points

lorenz <- function(iterations, sigma = 10, rho = 28, beta = 8/3, x0 = 0.5, y0 = 1, z0 = 1.2, dt = 0.01) {
  x <- rep(x0, iterations)
  y <- rep(y0, iterations)
  z <- rep(z0, iterations)
  
  for (i in 1:(iterations-1)) {
    xd <- sigma * (y[i] - x[i])
    yd <- x[i] * (rho - z[i]) - y[i]
    zd <- x[i] * y[i] - beta * z[i]
    
    x[i+1] <- x[i] + xd * dt
    y[i+1] <- y[i] + yd * dt
    z[i+1] <- z[i] + zd * dt
  }
  
  tibble(x = x,
         y = y,
         z = z)
}

# Generate the Lorenz attractor
data <- lorenz(100000, dt = 0.001)

# And rotate it a bit -- it looks better this angle
th <- pi * (2 - 1/4)
rotation_matrix <- matrix(
  c( cos(th), 0, sin(th),
           0, 1,       0,
    -sin(th), 0, cos(th)),
  ncol = 3, byrow = TRUE)

data <- as.data.frame(as.matrix(data) %*% rotation_matrix) %>%
  `colnames<-`(c('x', 'y', 'z')) %>%
  mutate(iteration = row_number())

I’ll plot x on the horizontal axis, y on the vertical axis, and I’d like z to denote depth. Time to implement the actual shift. The mathematics is quite simple:

\[x = x + \frac{ez}{D-z}\]

where

That’s it! Note that we shift only horizontally. You need to look at the picture head on for the effect to work.

The algorithm then becomes:

data_with_shift <- data %>%
  mutate(depth = 0.5 * (z - min(x)) / (max(z) - min(z)),
         shift = 6 * depth / (60 - depth))

bind_rows(data_with_shift %>%
            mutate(pos = 'left',
                   x = x - shift / 2),
          data_with_shift %>%
            mutate(pos = 'right',
                   x = x + shift / 2)) %>%
  ggplot(aes(x, y)) +
    geom_point(aes(color = iteration), size = 0, shape = 20, alpha = 0.15) +
    scale_color_gradient(low = 'white') +
    facet_wrap(~ pos, ncol = 2) +
    theme(panel.background = element_rect(color = '#444444', fill = 'black'),
          plot.background = element_rect(fill = 'black'))

I find it easier to see the image with a black background and lighter shapes. I also draw a thin border around each image, which I use as reference lines when I try to align the two images.

End

If you want to go hunting for 3D images yourself, there is code for 3D hunting that match my description in the 2D post hidden in this documents original .Rmd notebook.

  1. Image credit: Wikipedia↩