rayshader_and_gdlaio.R

# easy height data for rayshader
# remotes::install_github("hypertidy/topography")
library(gdalio)
library(topography)
library(sf)
library(rayshader)
library(scico)
library(dplyr)
# ------ get data -------------
# Get county data for England and Wales
eng_wales_counties <- read_sf("http://geoportal1-ons.opendata.arcgis.com/datasets/687f346f5023410ba86615655ff33ca9_0.geojson") %>%
  st_make_valid() %>%
  st_transform(27700)

# Get Wales sf for the masking task. Save for later
wales <- eng_wales_counties %>%
  filter(grepl("W",ctyua16cd) ) %>%
  st_union()

# ----- Functions ------------
# set gdalio extent
set_gdalio_sf <- function(aoi, res){
  bounds <- aoi %>%
    st_bbox() 
  grid0 <- list(extent = c(bounds$xmin, bounds$xmax, bounds$ymin, bounds$ymax), 
                dimension = c((bounds$xmax-bounds$xmin)/res,
                              (bounds$ymax-bounds$ymin)/res), 
                projection = st_crs(aoi)$wkt)
  gdalio_set_default_grid(grid0)
}

# convert gdalio data to rayshader friendly matrix
gdalio_rayshader <- function(dsn, ...) {
  v <- gdalio_data(dsn, ...)
  g <- gdalio_get_default_grid()
  
  m <- matrix(v[[1]], g$dimension[1])[,g$dimension[2]:1, drop = F]
  
  rotate <- function(x) t(apply(x, 2, rev))
  rotate(rotate(m))|>
    apply(2,rev)
}

# colour palette function
berlinBias<- function(n=255, bias=2){
  pal <-colorRampPalette(scico(n, palette = 'berlin'),
                                          bias=bias)
  return(pal(n))
}

# ----- Commands ---------

# set gdalio extent and resolution
set_gdalio_sf(wales, 100)

# get matrix data with gdalio
wales_aws <- gdalio_rayshader(topography_source("aws"))

# get water area matrix
wales_wat <- wales_aws
wales_wat[wales_wat < 0] = 0

# RAYSHADE!
wales_shade <- wales_aws %>%
  height_shade(texture=berlinBias(bias=0.4)) %>%
  add_shadow(texture_shade(wales_aws, detail=0.6, contrast = 3,
                           brightness = 6),0.3) %>%
  add_shadow(ray_shade(wales_aws, sunaltitude=45, sunangle=225, zscale=80,
                       multicore=T),0.2) %>%
  add_overlay(generate_waterline_overlay(wales_wat), alphalayer=0.5) 

# save it.
wales_shade %>%
  save_png(filename = 'rayshade_exports/wales_berlin2')