时间戳

首页 > 解决方案 > 保持地图缩放（在同一个城市内），同时改变闪亮|mapdeck的属性

r - 保持地图缩放（在同一个城市内），同时改变闪亮|mapdeck的属性

问题描述

我正在尝试使用mapdeck基于某些属性映射变量来创建一个闪亮的应用程序。基本上，我选择一个城市，然后选择一个活动和一个时间阈值来生成理想的地图。下面的可重现代码（确保使用 mapbox API）：

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这样每当我打开地图或选择不同的城市时，我都可以进行漂亮的过渡。我根据城市质心设置视图。

问题是，每当我在同一个城市内更改缩放然后选择不同的属性（不同的活动或不同的时间阈值）时，视图（和转换）也会更新。我希望有一种方法可以在我更改同一个城市内的属性时使地图保持相同的缩放比例，只有在我更改城市时才会进行转换。

我试图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,
      )


  })

感谢任何帮助。谢谢！

标签： rshinymapdeck

解决方案

我认为您需要不同观察者的城市输入以及时间和活动输入。这似乎可以实现您想要的行为。

  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,
      )
  })

推荐阅读