inst/doc/using_functions.R

In starsTileServer: A Dynamic Tile Server for R

## ---- include = FALSE---------------------------------------------------------
NOT_CRAN <- identical(tolower(Sys.getenv("NOT_CRAN")), "true")
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = NOT_CRAN
)

## ----download, echo=FALSE-----------------------------------------------------
if (!file.exists(tmpGridFile <- "~/ownCloudUva/test.nc")) {
  tmpGridFile <- tempfile(fileext = ".nc")
  download.file("https://surfdrive.surf.nl/files/index.php/s/Z6YoTyzyyAsmgGS/download", tmpGridFile, extra = "-q", method = "wget")
}

## ----asfdf--------------------------------------------------------------------
windDirFun <- function(grd,
                       level = c("875", "900", "925"),
                       time = "2000-04-28 23:00:00") {
  weather <- read_stars(options("tmpGridFile")[[1]], proxy = T)
  st_crs(weather) <- 4326
  bbox <- st_bbox(
    st_transform(
      st_as_sf(grd),
      st_crs(weather)
    )
  )
  levelDim <- which(as.character(st_get_dimension_values(weather, "level")) == level[1])
  timeDim <- which(as.character(st_get_dimension_values(weather, "time")) == time[1])
  u <-
    abind::adrop(st_warp(st_crop(st_as_stars(
      weather["u"] %>%
        slice(level, levelDim) %>%
        slice(time, timeDim)
    ), bbox), grd))
  v <-
    abind::adrop(st_warp(st_crop(st_as_stars(
      weather["v"] %>%
        slice(level, levelDim) %>%
        slice(time, timeDim)
    ), bbox), grd))
  return(sqrt(u^2 + v^2))
}

## ----asdf---------------------------------------------------------------------

colFun <- function(x, alpha = 1, maxColor = 25) {
  cfun <- leaflet::colorNumeric("RdYlBu", domain = c(-as.numeric(maxColor), 0))
  paste0(
    suppressWarnings(cfun(-x)),
    as.character(as.raw(as.numeric(alpha) * 255))
  )
}
attr(colFun, "colorType") <- "numeric"

## ----setup--------------------------------------------------------------------
library(starsTileServer)
require(callr)

rp <- r_bg(args = list(tmpGridFile = tmpGridFile, windDirFun = windDirFun, colFun = colFun), function(tmpGridFile, windDirFun, colFun) {
  require(sf)
  require(stars)
  require(dplyr)
  options(tmpGridFile = tmpGridFile)
  starsTileServer::starsTileServer$new(windDirFun,
    colorFun = colFun
  )$run(port = 5645, docs = T)
})

## ----startupPause, echo=F-----------------------------------------------------
Sys.sleep(35)
stopifnot(rp$is_alive())

## ----plot_map-----------------------------------------------------------------
require(leaflet)
require(leaflet.extras)
require(magrittr)
m <- leaflet() %>%
  addTiles() %>%
  enableTileCaching() %>%
  addTiles(
    "http://127.0.0.1:5645/map/{z}/{x}/{y}?level=900&alpha=.2&time=2000-04-28 23:00:00",
    options = tileOptions(useCache = TRUE, crossOrigin = TRUE)
  ) %>%
  addLegend(pal = readRDS(url("http://127.0.0.1:5645/map/colorfunctionnoalpha")), values = 0:20) %>%
  setView(zoom = 3, lat = 30, lng = 5)

## ----plot_map_image, echo=FALSE-----------------------------------------------
f <- tempfile(fileext = ".png")
mapview::mapshot(m, file = f, delay = 11, vwidth = 700, vheight = 600)
magick::image_read(f)

## ----remove_server------------------------------------------------------------
message(rp$read_error())
message(rp$read_output())
rp$finalize()