Держите масштаб карты (внутри того же города), изменяя атрибуты в глянцевом | mapdeck - PullRequest
Новая
       13

Держите масштаб карты (внутри того же города), изменяя атрибуты в глянцевом | mapdeck

1 голос
/ 12 января 2020

Я пытаюсь создать shinyapp, используя mapdeck, который отображает переменную на основе некоторых атрибутов. По сути, я выбираю город, а затем выбираю активность и порог времени, чтобы получить желаемую карту. Воспроизводимый код ниже (обязательно используйте API-интерфейс mapbox): 

library(shiny)
library(dplyr)
library(mapdeck)
library(sf)


ui <- shinyUI(fluidPage(
  selectInput(inputId = "city",
              label = h1("Pick city:"),
              choices = c("Belo Horizonte" = "bho",
                          "Fortaleza" = "for"),
              selected = "bho"),
  selectInput(inputId = "activity",
              label = h1("Pick activity:"),
              choices = c("TT", "ST"),
              selected = "TT"),
  sliderInput(inputId = "time",
              label = h1("Pick time threshold:"),
              min = 30, max = 120,
              step = 30, value = 30,
              animate = TRUE),
  mapdeckOutput("map")
)
)



# SERVER --------------------------------------------------------------------------------------

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


  data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")

  centroids <- data.frame(sigla_muni = c("for", "bho"),
                          lon = c(-38.52770, -43.95988),
                          lat = c( -3.785656, -19.902739))

  # register mapbox api key
  mapdeck::set_token("YOUR_API")

  # reactive for the city
  city_filtered <- reactive({
    data %>% filter(sigla_muni == input$city)
  })

  # reactive for the activity
  activity_filtered <- reactive({
    city_filtered() %>% dplyr::filter(activity == input$activity)
  })


  # Reactive for time threshold
  time_filtered <- reactive({

    activity_filtered() %>% dplyr::filter(time_threshold == input$time)

  })

  # initialize baseMap
  output$map <- renderMapdeck({

    mapdeck(location = c(-43.95988, -19.902739), zoom = 0)

  })



  #  
  observe({

    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")

    a <- mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = time_filtered(),
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )


  })


}

)


shinyApp(ui = ui, server = server)

Я хочу использовать классные переходы карты, предоставляемые mapdeck, поэтому я создаю базовую карту с нулевым увеличением и затем использую mapdeck_view Функция внутри моего shiny::observer, так что я могу получить хороший переход всякий раз, когда я открываю карту или выбираю другой город. Я устанавливаю представления на основе центроидов городов.

Проблема заключается в том, что представление (и переход) также обновляется всякий раз, когда я изменяю масштаб в одном и том же городе, а затем выбираю другие атрибуты (разные действия или другой временной порог). ). У меня sh был способ сохранить карту в том же масштабе, пока я менял атрибуты в пределах одного и того же города, имея переход только при смене города.

Я пытался играть с shiny::isolate внутри моего наблюдатель, но не удалось (в данном случае ничего не произошло): 

observe({

    isolate({
    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")

    })

    a <- mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = time_filtered(),
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess_cum",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )


  })

Цените любую помощь. Спасибо!

1 Ответ

1 голос
/ 12 января 2020

Я думаю, вам нужны данные о городе, а также данные о времени и активности разных наблюдателей. Это похоже на достижение желаемого поведения. 

  observe({
    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")
  })

  observeEvent({c(input$time, input$activity, input$city)},{

    print(" -- changing -- ")
    sf <- time_filtered()
    print( unique( sf$sigla_muni ) )
    print( unique( sf$time_threshold ) )
    print( unique( sf$activity )  )

    mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = sf,
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )
  })
...