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()