Question

我想实施美国的钻取热图。类似于：Highchart link

但我想在

中给定的深入热图中显示我自己的数据

R +闪亮。

我无法理解如何使用给定的示例来处理我的数据。我能够在R闪亮上实现给定的例子，但我不知道如何为州和县获取我自己的数据。我有excel格式的数据，我想在地图上显示。

我对JS和CSS比较陌生，我认为挑战只在于此。我不了解AJAX，如果没有它就可以实现，那就太棒了。

有人建议我使用JSON文件导入我自己的数据，但我不能这样做。

Answer 1

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)

在R + Shiny中钻取地图

1 个答案: