Question

是否可以使用leaflet.js创建向下钻取功能，即类似于http://jvectormap.com/examples/drill-down/？我想有一些插件可以使这成为可能。如果是这样，你能指点我的例子或提供基本代码吗？

我已经在Google和传单文档上进行了一些搜索，例如http://leafletjs.com/reference.html和http://leafletjs.com/plugins.html，但找不到任何内容。

编辑：我发现了这个有用的帖子：https://github.com/rstudio/leaflet/issues/41。我正在使用RStudio提供的R中的传单包。我从一个国家到另一个国家都有一个信息控制的深入了解。但是，它仍然需要大量的工作。任何关心帮助的人，请参阅https://github.com/efh0888/leafletDrilldown。自述文件包含您需要的所有信息。您还可以在https://efh0888.shinyapps.io/leafletDrilldown查看实时应用。谢谢！

Answer 1

请参阅Choropleth example了解如何使用Leaflet执行click⇢fitsbounds技术。

Answer 2

github上现在有一个R包“ leafdown”，它提供了钻取功能。可以在这里找到：https://hoga-it.github.io/leafdown/index.html。

一个基本示例：

devtools::install_github("hoga-it/leafdown")

library(leafdown)
library(leaflet)
library(shiny)
library(dplyr)
library(shinyjs)
ger1 <- raster::getData(country = "Germany", level = 1)
ger2 <- raster::getData(country = "Germany", level = 2)
ger2@data[c(76, 99, 136, 226), "NAME_2"] <- c(
  "Fürth (Kreisfreie Stadt)",
  "München (Kreisfreie Stadt)",
  "Osnabrück (Kreisfreie Stadt)",
  "Würzburg (Kreisfreie Stadt)"
)
spdfs_list <- list(ger1, ger2)

ui <- shiny::fluidPage(
  tags$style(HTML(".leaflet-container {background: #ffffff;}")),
  useShinyjs(),
  actionButton("drill_down", "Drill Down"),
  actionButton("drill_up", "Drill Up"),
  leafletOutput("leafdown", height = 600),
)


# Little helper function for hover labels
create_labels <- function(data, map_level) {
  labels <- sprintf(
    "<strong>%s</strong><br/>%g € per capita</sup>",
    data[, paste0("NAME_", map_level)], data$GDP_2014
  )
  labels %>% lapply(htmltools::HTML)
}


server <- function(input, output) {
  my_leafdown <- Leafdown$new(spdfs_list, "leafdown", input)
  update_leafdown <- reactiveVal(0)
  
  observeEvent(input$drill_down, {
    my_leafdown$drill_down()
    update_leafdown(update_leafdown() + 1)
  })
  
  observeEvent(input$drill_up, {
    my_leafdown$drill_up()
    update_leafdown(update_leafdown() + 1)
  })
  
  output$leafdown <- renderLeaflet({
    update_leafdown()
    meta_data <- my_leafdown$curr_data
    curr_map_level <- my_leafdown$curr_map_level
    if (curr_map_level == 1) {
      data <- meta_data %>% left_join(gdp_2014_federal_states, by = c("NAME_1" = "Federal_State"))
    } else {
      data <- meta_data %>% left_join(gdp_2014_admin_districts, by = c("NAME_2" = "Admin_District"))
    }
    
    my_leafdown$add_data(data)
    labels <- create_labels(data, curr_map_level)
    my_leafdown$draw_leafdown(
      fillColor = ~ colorNumeric("Blues", GDP_2014)(GDP_2014),
      weight = 2, fillOpacity = 0.8, color = "grey", label = labels,
      highlight = highlightOptions(weight = 5, color = "#666", fillOpacity = 0.7)
    ) %>%
      addLegend("topright",
                pal = colorNumeric("Blues", data$GDP_2014),
                values = data$GDP_2014,
                title = "GDP per capita (2014)",
                labFormat = labelFormat(suffix = "€"),
                opacity = 1
      )
  })
}


shinyApp(ui, server)

使用RStudio包和Shiny进行宣传

2 个答案: