Как я могу сделать цветовую гамму в mapdeck статической - PullRequest
Новая
       15

Как я могу сделать цветовую гамму в mapdeck статической

2 голосов
/ 02 октября 2019

Я разрабатываю блестящее приложение, которое шаг за шагом показывает время и показывает количество осадков на карте. Я читаю данные о погоде за весь день и использую реактивность, отфильтровывая данные за час и рисуя их как график рассеяния, используя mapdeck_update для обновления данных. Цветовая шкала изменяется всякий раз, когда карта обновляется в зависимости от диапазона данных за этот час. То, что я хочу, это статическая цветовая шкала, основанная на диапазоне данных за день. Возможно ли это?

Я пытался использовать ручные цвета, но по какой-то причине они не работают 

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)

Обратите внимание, как изменяется диапазон цветовой шкалы в легенде, но цвет точекоставайся почти таким же. Я хочу, чтобы цвет представлял мин-макс всего набора данных (а не только час), чтобы я мог видеть изменение интенсивности при переходе через каждый час. Спасибо.

1 Ответ

0 голосов
/ 03 октября 2019

Хороший вопрос;вы правы, вам нужно создать легенду, чтобы она оставалась статичной, иначе она будет обновляться каждый раз при обновлении значений в графике.

В ручной легенде должны использоваться те же цвета, что и на карте. Карта окрашивается в library(colourvalues). Таким образом, вы можете использовать это, чтобы сделать цвета вне карты, а затем использовать результаты в качестве ручной легенды 

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)

Теперь этот объект js_legend имеет правильный формат JSON для карты, чтобы отобразить его каклегенда 

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":[""]}}

Вот она у тебя в блестящем 

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

...