2

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.

1 Answers1

1

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

SymbolixAU
  • 25,502
  • 4
  • 67
  • 139
  • Thank you very much @SymbolixAU for the solution. Initially, it threw this error: " 'legend_element' is not an exported object from 'namespace:mapdeck'". Then I installed the development version of mapdeck along with the following dependencies using devtools::install_github: spatialwidget, geojsonsf & jsonify. The dependencies were also development version. Then it worked fine. – Aswin kumar Oct 03 '19 at 19:10
  • @Aswinkumar - yeah sorry, I should have mentioned you need the dev version, along with a link to the [install instructions](https://github.com/SymbolixAU/mapdeck#development-version) – SymbolixAU Oct 03 '19 at 22:00