inst/doc/upscaling.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")
}

## -----------------------------------------------------------------------------
require(callr)
rp_list <- lapply(lapply(as.list(4000+1:2), c, list(tmpGridFile=tmpGridFile)), r_bg, func=function(port, tmpGridFile) {
  # read a stars grid
  weatherData <- stars::read_stars(tmpGridFile, proxy = FALSE, sub = "t")
  names(weatherData) <- "t"
  sf::st_crs(weatherData) <- "+proj=longlat"
  colorFunction <- leaflet::colorNumeric("viridis", c(250, 310))
  colorFunctionWithAlpa <- function(x, alpha = 1) {
    paste0(colorFunction(x), as.character(as.raw(
      as.numeric(alpha) * 255
    )))
  }
  starsTileServer::starsTileServer$new(weatherData, colorFun = colorFunctionWithAlpa)$run(port = port)
})



## -----------------------------------------------------------------------------
require(leaflet)
require(leaflet.extras)
map <- leaflet() %>%
  addTiles() %>%
  enableTileCaching() %>%
  addTiles(
    "http://127.0.0.1:400{s}/map/t/{z}/{x}/{y}?level=900&time=2000-04-27 01:00:00&alpha=0.5",
    options = tileOptions(useCache = TRUE, crossOrigin = TRUE, subdomains = '12')
  ) %>%
  setView(zoom = 3, lat = 30, lng = 30)

## ---- eval=FALSE--------------------------------------------------------------
#  map

## ----plot_map_image, echo=FALSE-----------------------------------------------
mapview::mapshot(map, file = f <- tempfile(fileext = ".png"), delay = 9, vwidth = 500, vheight = 400)
magick::image_read(f)

## -----------------------------------------------------------------------------
lapply(rp_list, function(x)x$read_output())
lapply(rp_list, function(x)x$finalize())


## ---- code=readLines(system.file("compose/Dockerfile", package = "starsTileServer")), eval=F----
#  FROM rocker/geospatial
#  MAINTAINER Bart
#  RUN install2.r -n 5 plumber stars; \
#  	rm -rf /tmp/downloaded_packages
#  RUN R --quiet -e 'install.packages("starsdata", repos = "http://pebesma.staff.ifgi.de", type = "source")'
#  RUN R --quiet   -e "remotes::install_gitlab('bartk/starsTileServer')"
#  EXPOSE 3436
#  COPY script.R script.R
#  RUN R --quiet   -e "source('script.R')"
#  ENTRYPOINT ["R", "--quiet", "-e", "server<-readRDS('server.rds') ;server$run( port=3436, host='0.0.0.0', swagger=T)"]

## ---- code=readLines(system.file("compose/script.R", package = "starsTileServer")), eval=F----
#  require(stars)
#  require(starsTileServer)
#  s5p <- system.file(
#    "sentinel5p/S5P_NRTI_L2__NO2____20180717T120113_20180717T120613_03932_01_010002_20180717T125231.nc",
#    package = "starsdata"
#  )
#  nit <- read_stars(
#    s5p,
#    along = NA,
#    sub = c(
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/nitrogendioxide_total_column",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/nitrogendioxide_total_column_precision",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/nitrogendioxide_total_column_precision_kernel",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/number_of_iterations",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/number_of_spectral_points_in_retrieval",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/oxygen_oxygen_dimer_slant_column_density",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/oxygen_oxygen_dimer_slant_column_density_precision",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/ozone_slant_column_density",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/ozone_slant_column_density_precision",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/processing_quality_flags",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/ring_coefficient",
#      "//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/ring_coefficient_precision"
#    ),
#    curvilinear = c("//PRODUCT/longitude", "//PRODUCT/latitude"),
#    driver = NULL
#  )
#  names(nit) <-
#    sub("//PRODUCT/SUPPORT_DATA/DETAILED_RESULTS/", "", names(nit))
#  for (i in seq(length(names(nit)))) {
#    nit[[i]][nit[[i]] > 9e+36] <- NA
#  }
#  st_crs(nit) <- 4326
#  
#  server <- starsTileServer$new(nit)
#  # we save the server here as there should only be one version (sampling of color scales would otherwise result in differently colored tiles)
#  saveRDS(server, "server.rds")

## -----------------------------------------------------------------------------
system.file("compose/Dockerfile", package = "starsTileServer")
system.file("compose/script.R", package = "starsTileServer")

## ---- eval=F------------------------------------------------------------------
#  require(leaflet)
#  leaflet() %>%
#    addTiles() %>%
#    fitBounds(0, 30, 20, 40) %>%
#    addTiles(urlTemplate = "http://127.0.0.1:6081/map/nitrogendioxide_total_column/{z}/{x}/{y}?alpha=.4")