# Using tiles in shiny

In this manual we will discuss an example of using `starsTileServer` for serving map tiles in a shiny app. It shows the ability to visualize different layers and dynamically change layers. To do this we will use a sample dataset from the ERA5 weather model, that includes different variables and pressure levels.

    library(starsTileServer)

The sample dataset can be retrieved with the following code using the `ecmwfr` R package:

    require(ecmwfr)
    request <-
      list(
        "dataset_short_name" = "reanalysis-era5-pressure-levels",
        "product_type" = "reanalysis",
        "variable" = c("temperature", "geopotential", "u_component_of_wind", "v_component_of_wind"),
        "pressure_level" = c("875", "900", "925"),
        "year" = "2000",
        "month" = "04",
        "day" = as.character(27:29),
        "time" = sprintf("%02i:00", 0:23),
        "area" = "64/-130/-64/144",
        "format" = "netcdf",
        "target" = "ecmwfData.nc"
      )
    # make sure you use your own uid and key ( https://cds.climate.copernicus.eu/#!/home )
    wf_set_key("uid_to_replace", "key_to_replace", service = "cds")
    ncfile <- wf_request(
      user = "uid_to_replace",
      request = request,
      transfer = TRUE,
      path = "~",
      verbose = FALSE
    )

## Starting the tileserver

To set up the tile server we need the grid file loaded. Additionally a color function can be added. This function needs to have the same format as the color as the color mapping functions in `leaflet`.

    weatherData <- stars::read_stars(tmpGridFile)
    #> t, z, u, v,
    sf::st_crs(weatherData) <- "+proj=longlat"

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

The tileserver needs to run in a separate process. On a personal computer this can easily be achieved by running two R processes at the same time. An alternative approach is to use `callr` to start a separate process.

    # note the process is ran in the background, do not forget to close it as it might use quite a bit of memory.
    # I have made the experience that callr seems to work poorly if the process is rather verbose
    require(callr)
    rp <- r_bg(args = list(grid = weatherData, colFun = colFun), function(grid, colFun) {
      starsTileServer::starsTileServer$new(grid, colFun)$run(port = 3746, docs = TRUE)
    })

The process will print an url where documentation an testing for the server is available:

    message(rp$read_error())
    #> Running plumber API at http://127.0.0.1:3746
    #> Running swagger Docs at http://127.0.0.1:3746/__docs__/

# Shiny app

Now a small example of some interaction based on a shiny example. First we create UI, this consists of a few selection options to change the map features.

    require(shiny)
    #> Loading required package: shiny
    require(leaflet)
    require(stars)
    #> Loading required package: stars
    #> Loading required package: abind
    #> Loading required package: sf
    #> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
    weather <- stars::read_stars(tmpGridFile, proxy = T)
    #> t, z, u, v,

    ui <- fluidPage(
      # Application title
      titlePanel("Web map"),
      sidebarLayout(
        # Sidebar with a slider input
        sidebarPanel(
          sliderInput("alpha", "Transparancy", 0, 1, .6, .01),
          selectInput("attr", "Attribute", choices = c("u", "v")),
          sliderInput(
            "time",
            "Time",
            value = min(st_get_dimension_values(weather, 4)),
            min = min(st_get_dimension_values(weather, 4)),
            max = max(st_get_dimension_values(weather, 4)),
            step = 3600,
            timezone = "+0000",
            animate = animationOptions(5000)
          ),
          selectInput("level", "level (mb)", choices = as.character(st_get_dimension_values(weather, 3))),
          sliderInput("colRange", "Range", -50, 50, c(-20, 20))
        ),
        # Show a plot of the generated distribution
        mainPanel(leafletOutput("map"))
      )
    )

We use the following shiny server function:

    server <- function(input, output, session) {
      # This reactive creates the URL to the tileserver, it include the different input variables in requests to the server
      # The debounce ensures the URL does not get updated to frequent
      url <- reactive({
        sprintf(
          "http://127.0.0.1:3746/map/%s/{z}/{x}/{y}?level=%s&alpha=%f&time=%s&min=%f&max=%f",
          input$attr,
          input$level,
          input$alpha,
          strftime(input$time, tz = "UTC", format = "%Y-%m-%d %H:%M:%S"),
          min(input$colRange),
          max(input$colRange)
        )
      }) %>% debounce(100)
      # This reactive downloads the color function from the server and prepares it for adding as a legend to the leaflet map
      colorFunction <- reactive({
        f <- readRDS(base::url(sprintf("http://127.0.0.1:3746/map/%s/colorfunctionnoalpha", input$attr)))
        at <- attributes(f)
        if (is.finite(max(colrange()))) {
          formals(f)$max <- max(colrange())
        }
        if (is.finite(min(colrange()))) {
          formals(f)$min <- min(colrange())
        }
        attributes(f) <- at
        f
      })
      colrange <- reactive(range(input$colRange))
      output$map <- renderLeaflet({
        leaflet() %>%
          addTiles() %>%
          fitBounds(-50, -30, 50, 50)
      })
      # This observer changes the tile layer as soon as the url is updated
      observe({
        leafletProxy("map") %>%
          clearGroup("wind") %>%
          addTiles(url(),
            group = "wind",
            options = tileOptions(useCache = TRUE, crossOrigin = TRUE)
          )
      })
      # This observe changes the legend as soon as it is updated
      observe({
        s <- seq(min(colrange()), max(colrange()), length.out = 20)
        leafletProxy("map") %>%
          clearControls() %>%
          addLegend(
            pal = colorFunction(),
            values = s,
            title = input$attr,
            position = "bottomleft"
          )
      })
    }

The app can be create using the regular shiny functionality

    app <- shinyApp(ui, server)

The result of this shiny app looks as follows:

To wrap up we close the tile server

    rp$finalize()