Rayshader Test | Scotland Inpatients (Oct – Dec 2018)

ray.R

# remotes::install_github("tylermorganwall/rayshader")
library(rayshader) # rayshader_0.11.4
library(ggplot2)
library(sf)
library(tidyverse)
library(rmapshaper)
library(viridis)

#### DATA IMPORT ####
# inpatient numbers, by health board, Oct-Dec 2018
# https://www.isdscotland.org/Health-Topics/Hospital-Care/Publications/2019-05-28/Acute-Hospital-Publication/data-explorer/
inpats <- read_csv("trend_data_multiple_location.csv") %>%
  filter(Quarter == "Oct - Dec-18") %>%
  mutate(Location = str_sub(Location, start = 5),
         Location = str_replace(Location, "&", "and")) # remove "NHS" prefix + replace ampersands for matching purposes


#### MAP SETUP ####
# https://spatialdata.gov.scot/geonetwork/srv/eng/catalog.search#/metadata/f12c3826-4b4b-40e6-bf4f-77b9ed01dc14
scot <- st_read("SG_NHS_HealthBoards_2019") %>%
  ms_simplify(., drop_null_geometries = TRUE, keep = 5e-4) %>% # simplifed polys looks better in 3D
  ms_filter_islands(., min_area = 1e7) %>% # goodbye Millport
  st_transform(crs = "+proj=longlat +datum=WGS84 +ellps=WGS84") %>% # reproject onto decimal lat/long w' WGS84 spheroid reference
  left_join(select(inpats, Location, Number), by = c("HBName" ="Location")) # attach inpatient data


#### GGPLOT SETUP ####
gg_scot = ggplot(scot) +
  geom_sf(mapping = aes(fill = Number), color = NA) + # set color="black" for extruded facets to be black
  scale_fill_viridis("inpatients", direction = 1, 
                     breaks = c(1e4, 2e4, 3e4, 4e4), 
                     labels = c("10,000", "20,000", "30,000", "40,000")) +
  theme_bw() + 
  theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(),
        panel.grid = element_blank(),panel.border = element_blank())
# gg_scot


#### PLOT_GG ####
plot_gg(gg_scot, 
        width = 6, height = 6,
        scale = 300,
        windowsize = c(1440, 810),
        multicore = TRUE,  
        offset_edges = TRUE,
        raytrace = TRUE,
        lineantialias = TRUE)

#### CAMERA ####
pic_dir <- file.path(getwd(), "pics")
output_video <- "output.mp4"

#### EMULATE LINEAR CAMERA MOVES
save_move_frames <- function(move_name, move_length = 1, 
                             fps = 60, pic_dir = file.path(getwd(), "pics"),
                             theta_start = 45, theta_end = 45, 
                             phi_start = 45, phi_end = 45, 
                             zoom_start = NULL, zoom_end = NULL, 
                             fov_start = NULL, fov_end = NULL){
  
  theta <- seq(from = theta_start, to = theta_end, length.out = fps*move_length)
  phi <- seq(from = phi_start, to = phi_end, length.out = fps*move_length)
  
  if(is.null(zoom_start) | is.null(zoom_end)){
    zoom_start <- NULL
    zoom_end <- NULL
    zoom <- NULL
  }
  if(!is.null(zoom_start) & !is.null(zoom_end)){
    zoom <- seq(from = zoom_start, to = zoom_end, length.out = fps*move_length)
  }
  
  if(is.null(fov_start) | is.null(fov_end)){
    fov_start <- NULL
    fov_end <- NULL
    fov <- NULL
  }
  if(!is.null(fov_start) & !is.null(fov_end)){
    fov <- seq(from = fov_start, to = fov_end, length.out = fps*move_length)
  }
  
  # write out frames
  for(frame in 1:(move_length*fps)){
    render_camera(theta = theta[frame], phi = phi[frame], zoom = zoom[frame], fov = fov[frame])
    render_snapshot(file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
  }
}

#### MOVE 0: slight zoom, 1 second
save_move_frames("move00",
                 move_length = 1,
                 theta_start = 0,
                 theta_end = 0,
                 phi_start = 90,
                 phi_end = 90,
                 zoom_start = 1,
                 zoom_end = .9)

#### MOVE 1: face on to zoomed isometric, 1 second
save_move_frames("move01",
                 move_length = 1,
                 theta_start = 0,
                 theta_end = 30,
                 phi_start = 90,
                 phi_end = 30,
                 zoom_start = .9,
                 zoom_end = .4)

#### MOVE 2: pause, .5 second
save_move_frames("move02",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)

#### MOVE 3: rotate 360, 6 seconds
save_move_frames("move03",
                 move_length = 6,
                 theta_start = 30,
                 theta_end = 390, # render_camera takes care of the mod 360
                 phi_start = 30,
                 phi_end = 30,
                 zoom_start = .4,
                 zoom_end = .4)

#### MOVE 4: pause, .5 second
save_move_frames("move04",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)
# render_camera(theta = 30, phi = 30, zoom = .4) # default view for this animation

## RENDERDEPTH
# should move this functionality to save_move_frames() really
#### MOVE 5: focal length 1 > 300, 1.5 second
fps <- 60

move_name <- "move05"
move_length <- 1.5
focallength <- seq(from = 1, to = 300, length.out = fps*move_length)
for(frame in 1:(move_length*fps)){
  render_depth(focallength = focallength[frame], focus = .5,
               filename = file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
}

#### MOVE 6: focal length 300 > 1, .75 second
move_name <- "move06"
move_length <- .75
focallength <- seq(from = 300, to = 1, length.out = fps*move_length)
for(frame in 1:(move_length*fps)){
  render_depth(focallength = focallength[frame], focus = .5,
               filename = file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
}

#### MOVE 7: pause, .5 second
save_move_frames("move07",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)

#### MOVE 8: focus .5 -> .95, 1.5 second
move_name <- "move08"
move_length <- 1.5
focus <- seq(from = .5, to = .95, length.out = fps*move_length) # focus = 1 crashes so using .95
for(frame in 1:(move_length*fps)){
  render_depth(focallength = 1, focus = focus[frame],
               filename = file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
}

#### MOVE 9: focus .95 -> .05, 2 second
move_name <- "move09"
move_length <- 2
focus <- seq(from = .95, to = .05, length.out = fps*move_length) 
for(frame in 1:(move_length*fps)){
  render_depth(focallength = 1, focus = focus[frame],
               filename = file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
}

#### MOVE 10: focus .05 -> .5, .5 second
move_name <- "move10"
move_length <- .5
focus <- seq(from = .05, to = .5, length.out = fps*move_length) 
for(frame in 1:(move_length*fps)){
  render_depth(focallength = 1, focus = focus[frame],
               filename = file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")))
}

#### MOVE 11: pause, .5 second
save_move_frames("move11",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)

#### MOVE 12: animate water depth
# have to iterate over plot_gg objects
move_name <- "move12"
move_length <- 2
waterdepth <- seq(from = 0, to = mean(inpats$Number, na.rm = TRUE)/max(inpats$Number, na.rm = TRUE), 
                  length.out = fps*move_length)
for(frame in 1:(move_length*fps)){
  rgl::clear3d() # clear at start so rgl object remains after last iteration
  plot_gg(gg_scot, 
          width = 6, height = 6,
          scale = 300, 
          windowsize = c(1440, 810),
          multicore = TRUE,  
          offset_edges = TRUE,
          raytrace = TRUE,
          water = TRUE,
          waterdepth = waterdepth[frame],
          lineantialias = TRUE)
  render_camera(theta = 30, phi = 30, zoom = .4)
  render_snapshot(file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")),
                  clear = FALSE)
}

#### MOVE 12b: rotate 360, 6 seconds
save_move_frames("move12b",
                 move_length = 6,
                 theta_start = 30,
                 theta_end = 390, # render_camera / rgl takes care of the mod 360
                 phi_start = 30,
                 phi_end = 30,
                 zoom_start = .4,
                 zoom_end = .4)

#### MOVE 13: pause, .5 second
save_move_frames("move13",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)

#### MOVE 14: shrink all
# have to iterate over plot_gg objects
move_name <- "move14"
move_length <- 2
scale <- seq(from = 300, to = .1, length.out = fps*move_length) # scale = 0 causes artifacts so using .1
wateralpha <- seq(from = .5, to = 0, length.out = fps*move_length) # reducing alpha so water disappears at last frame

for(frame in 1:(move_length*fps)){
  rgl::clear3d()
  plot_gg(gg_scot, 
          width = 6, height = 6,
          scale = scale[frame],
          windowsize = c(1440, 810),
          multicore = TRUE,  
          offset_edges = TRUE,
          raytrace = TRUE,
          water = TRUE,
          waterdepth = mean(inpats$Number, na.rm = TRUE)/max(inpats$Number, na.rm = TRUE),
          wateralpha = wateralpha[frame],
          lineantialias = TRUE)
  render_camera(theta = 30, phi = 30, zoom = .4)
  render_snapshot(file.path(pic_dir, paste0(move_name, "_", str_pad(frame, width=6, side="left", pad="0"), ".png")),
                  clear = FALSE)
}

#### MOVE 15: pause, .5 second
save_move_frames("move15",
                 move_length = .5,
                 theta_start = 30,
                 theta_end = 30,
                 phi_start = 30,
                 phi_end = 30)

#### MOVE 16: back to original position
save_move_frames("move16",
                 move_length = 1,
                 theta_start = 30,
                 theta_end = 0,
                 phi_start = 30,
                 phi_end = 90,
                 zoom_start = .4,
                 zoom_end = 1)

#### MOVE 17: pause, 1 second
save_move_frames("move17",
                 move_length = 1,
                 theta_start = 0,
                 theta_end = 0,
                 phi_start = 90,
                 phi_end = 90)


#### FFMPEG ####
command <- paste0("ffmpeg -y -r ", fps, " -f image2 -s 1440x810 -i ", pic_dir, 
                  "/%*.png -vcodec libx264 -crf 20 -pix_fmt yuv420p ", output_video)
system(command = command)

#### MISC ####
# render_camera(theta = 0, phi = 90, zoom = 1) # face on
# render_camera(theta = 45, phi = 0, zoom = 1) # side on
# render_camera(theta = 45, phi = 45, zoom = 1) # isometric
# render_camera(theta = 30, phi = 30, zoom = .4) # shallow isometric + zoom

ray.R

Quick test of rayshader package (version 0.11.4) using ggplot2 geom_sf map objects, animating with ffmpeg.