Updating addImageQuery() value after change in reactive() choice

Question

In a shiny app that includes a leaflet map with a raster, it is possible to get the value of a pixel at mouse position.

In that same shiny app it is possible to select from a list of rasters to decide which you want to display.

What I can't figure out how to do is make the shiny app continue to give the user the raster value at the mouse position after changing to a new raster layer. The code below is a sample of this.

When the shiny app opens and window is maximized, the raster value at the mouse cursor is displayed. Once you switch to a new raster, this no longer is displayed. I am stumped on how to change this so that the raster value at the mouse for the newly selected raster is shown. The closest I've come to this issue in previous posts is raster values on mouseover.

library(raster)
library(leaflet)
library(shiny)
library(mapview)
# Create raster data 
# Each raster represents the average of multiple rasters
# during a weekly period.  
# In this example, there are five weeks represented
# create an extent object
myext <- extent(707900, 980000,540000,1100000)
mycrs <-  "+proj=aea +lat_1=42.122774 +lat_2=49.01518 +lat_0=45.568977 
+lon_0=-84.455955 +x_0=1000000 +y_0=1000000 +ellps=GRS80 
+towgs84=0,0,0,0,0,0,0 +units=m +no_defs"

r1 <- raster(ncol=50, nrow=75, ext=myext, crs=mycrs)
values(r1) <-rnorm(3750, 0, 2)
r2 <- raster(ncol=50, nrow=75, ext=myext, crs=mycrs)
values(r2) <-rnorm(3750, 0, 2)
r3 <- raster(ncol=50, nrow=75, ext=myext, crs=mycrs)
values(r3) <-rnorm(3750, 0, 2)
r4 <- raster(ncol=50, nrow=75, ext=myext, crs=mycrs)
values(r4) <-rnorm(3750, 0, 2)
r5 <- raster(ncol=50, nrow=75, ext=myext, crs=mycrs)
values(r5) <-rnorm(3750, 0, 2)

# create list of rasters that the use can choose from in the shiny app
myras <- list(r1, r2, r3, r4, r5) 
modis.rasters <- stack(myras) 

# set up color display
# #this sets up the color palette and is the reverse Spectral with 10 levels
my.max<- 10
x <- -10:my.max # this is the observed range for chlorophyll in the data
names(modis.rasters) <- c("Week of 2016-04-01", "Week of 2016-04-08","Week of 
2016-04-15", "Week of 2016-04-22", "Week of 2016-04-29")
pal1 <- colorNumeric(palette = c("#5E4FA2", "#3288BD", "#66C2A5", "#ABDDA4", 
"#E6F598", "#FEE08B", "#FDAE61", "#F46D43", "#D53E4F", "#9E0142" ), domain = 
x,na.color = "transparent")

# Create a map for use in shiny app
map <- leaflet() %>% addTiles() %>%
  setView(lng = -86.0589, lat = 43, zoom =7) %>%
  addLegend(pal=pal1, values = values(modis.rasters), 
        title ='Random normal variate (mean=0, SD=2)', position="bottomleft",
        opacity=1)%>% 
  addMouseCoordinates(style = "basic")


# Now set up the UI 
ui <- shinyUI(fluidPage(

     titlePanel("Stuff"),

     # Generate a row with a sidebar
     sidebarLayout(      

       # Define the sidebar with one input
       # Here "period" is a weekly time period/raster
       sidebarPanel(
         selectInput("period", "Choose a time period:", 
                 choices=names(modis.rasters)),
         hr(),
         helpText("Some raster data that I will replace.",
              br(),
              width=8)
       ),
       # Create a spot for the map
       mainPanel(leafletOutput('raster_map', width=800,height=900))  
     )
)
)

# Define a server for the Shiny app
server <- shinyServer(function(input, output){ 

  # Fill in the spot we created for a map
  output$raster_map = renderLeaflet({ 
    map %>% 
      addRasterImage(reactiveRaster(), colors=pal1, layerId =input$period,
                 opacity=0.5)%>%
      addImageQuery(reactiveRaster(), type="mousemove", digits=2, 
                position="topright", layerId=input$period)
})

  reactiveRaster <- reactive({modis.rasters[[input$period]]}) 
  # add the selected raster to the map
  observe({ 
    leafletProxy("raster_map") %>% 
      clearImages() %>% 
      addRasterImage(reactiveRaster(), colors=pal1, layerId =input$period,
                     opacity=0.5)
  })
  })
shinyApp(ui = ui, server = server)

Updating addImageQuery() value after change in reactive() choice

Answers (1)

Related Questions