Search code examples
rshinymapdeck

How can I make the color scale in mapdeck static


I am developing a shiny app which steps through time by each hour and shows the precipitation on a mapdeck map. I read in the weather data for the entire day and using reactivity filtering the data for the hour and plotting them as scatterplot using mapdeck_update to update the data. The color scale changes whenever the map updates based on the range of data in that hour. What I want is a static color scale based on the data range for the day. Is it possible?

I have tried using manual colors but for some reason they are not working

library(mapdeck)
ui <- fluidPage(
fluidRow(sliderInput(inputId = "hr",label = "Hour",min = 1,max = 3,value = 1)),
fluidRow(mapdeckOutput(outputId = "wx"))
)

sr <- function(input, output, session) {
mydata <- read.table(header=TRUE, sep=",",text="
ROW,COL,Center Latitude,Center Longitude,vil_int_36,hr
28,439,23.669885449218786,-97.2498101160108,20,1
41,433,24.37845221074034,-97.59803936272704,21,1
59,441,25.35333762373948,-97.11966878019186,22,1
61,441,25.461905262766468,-97.11878391116397,23,1
62,443,25.515163854569053,-96.99946877404128,24,1
29,439,23.724265738052193,-97.24945283742396,25,2
43,433,24.48713046908765,-97.59764743717052,26,2
59,442,25.35284441116698,-97.06032252207848,27,2
61,442,25.46141127997772,-97.05937801465758,28,2
62,444,25.514605007836384,-96.94003374232112,29,2
29,440,23.723846594719276,-97.19096992696834,30,3
43,434,24.486897474919978,-97.53876699838483,31,3
60,443,25.406603480942334,-97.00047511628769,32,3
62,441,25.516184831702166,-97.11834002241596,33,3
62,449,25.511327212479294,-96.64286546489153,34,3
")
wx_map <- mapdeck(data=NULL,token = Sys.getenv("MAPBOX_API_TOKEN"),style = 'mapbox://styles/mapbox/dark-v9',zoom = 6, location = c(-97,24.5)) 
observe({
wx_dt <- mydata %>% dplyr::filter(hr == input$hr)


mapdeck_update(map_id = "wx") %>% 
  add_scatterplot(data=wx_dt,lon = "Center.Longitude",lat = "Center.Latitude",radius = 15000,fill_colour = "vil_int_36",legend = TRUE,layer_id = "wxlyr",update_view = FALSE,focus_layer=FALSE)
})
output$wx <- renderMapdeck(wx_map)
}

shinyApp(ui, sr)

Notice how the range of color scale in the legend changes but the color of the dots stay almost the same. I want the color to represent the min-max of the entire data set (not just the hour) so that I can see change in intensity while stepping through each hour. Thank you.


Solution

  • Good question; you're right you need to create a manual legend so it remains static, otherwise it will update each time the values in the plot update.

    The manual legend needs to use the same colours as the map. The map gets coloured by library(colourvalues). So you can use this to make the colours outside of the map, then use the results as the manual legend

    l <- colourvalues::colour_values(
      x = mydata$vil_int_36
      , n_summaries = 5
    )
    
    legend <- mapdeck::legend_element(
      variables = l$summary_values
      , colours = l$summary_colours
      , colour_type = "fill"
      , variable_type = "category"
    )
    
    js_legend <- mapdeck::mapdeck_legend(legend)
    

    Now this js_legend object is in the correct JSON format for the map to render it as a legend

    js_legend
    # {"fill_colour":{"colour":["#440154FF","#3B528BFF","#21908CFF","#5DC963FF","#FDE725FF"],"variable":["20.00","23.50","27.00","30.50","34.00"],"colourType":["fill_colour"],"type":["category"],"title":[""],"css":[""]}}
    

    Here it is in your shiny

    library(mapdeck)
    library(shiny)
    ui <- fluidPage(
      fluidRow(sliderInput(inputId = "hr",label = "Hour",min = 1,max = 3,value = 1)),
      fluidRow(mapdeckOutput(outputId = "wx"))
    )
    
    sr <- function(input, output, session) {
      mydata <- read.table(header=TRUE, sep=",",text="
    ROW,COL,Center Latitude,Center Longitude,vil_int_36,hr
    28,439,23.669885449218786,-97.2498101160108,20,1
    41,433,24.37845221074034,-97.59803936272704,21,1
    59,441,25.35333762373948,-97.11966878019186,22,1
    61,441,25.461905262766468,-97.11878391116397,23,1
    62,443,25.515163854569053,-96.99946877404128,24,1
    29,439,23.724265738052193,-97.24945283742396,25,2
    43,433,24.48713046908765,-97.59764743717052,26,2
    59,442,25.35284441116698,-97.06032252207848,27,2
    61,442,25.46141127997772,-97.05937801465758,28,2
    62,444,25.514605007836384,-96.94003374232112,29,2
    29,440,23.723846594719276,-97.19096992696834,30,3
    43,434,24.486897474919978,-97.53876699838483,31,3
    60,443,25.406603480942334,-97.00047511628769,32,3
    62,441,25.516184831702166,-97.11834002241596,33,3
    62,449,25.511327212479294,-96.64286546489153,34,3
    ")
    
      ## create a manual legend
      l <- colourvalues::colour_values(
        x = mydata$vil_int_36
        , n_summaries = 5
      )
    
      legend <- mapdeck::legend_element(
        variables = l$summary_values
        , colours = l$summary_colours
        , colour_type = "fill"
        , variable_type = "category"
      )
      js_legend <- mapdeck::mapdeck_legend(legend)
      ### --------------------------------
    
      wx_map <- mapdeck(
        style = 'mapbox://styles/mapbox/dark-v9'
        , zoom = 6
        , location = c(-97,24.5)
        ) 
      observe({
        wx_dt <- mydata %>% dplyr::filter(hr == input$hr)
        mapdeck_update(map_id = "wx") %>% 
          add_scatterplot(
            data = wx_dt
            , lon = "Center.Longitude"
            , lat = "Center.Latitude"
            , radius = 15000
            , fill_colour = "vil_int_36"
            , legend = js_legend
            , layer_id = "wxlyr"
            , update_view = FALSE
            , focus_layer = FALSE
            )
      })
      output$wx <- renderMapdeck(wx_map)
    }
    
    shinyApp(ui, sr)
    

    enter image description here