我试图根据点击上面的leaflet map 中所选的县来划分df个数据帧的子集,但我得到了一个空表.

library(shiny)
library(leaflet)
library(sp)
library(rgdal)  # Make sure you have this package installed

# Sample dataframe (replace this with your actual data)
df <- data.frame(
  Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
  Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
  Year = c(2008, 2008, 2008, 2008, 2008, 2008),
  Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
  Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
  Numerator = c(NA, 2618, 124, 0, 0, 13),
  Denominator = c(NA, 532102, 20483, 11, 295, 2466),
  Rate = c(60.3, 49.2, 60.5, 0.0, 0.0, 52.7)
)


# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

ui <- fluidPage(
  titlePanel("County Rate Map"),
  leafletOutput("map"),
  dataTableOutput("dt")
)

server <- function(input, output, session) {
  
  # Merge the USA polygon data with the dataframe
  merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
  
  
  #calls map
  output$map<-renderLeaflet({
    # Load your data for the choropleth
    #data <- read.csv("your_data.csv")  # Replace with the path to your data file
    
    # Merge the data with the US states geojson data
    #merged_data <- merge(us_states, data, by.x = "state", by.y = "State", all.x = TRUE)
    temp <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
    
    # Determine the maximum value excluding NA values
    max_value <- max(temp$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
    
   
    leaflet(temp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label =  lapply(
          paste0(
            "County: ", temp$County, "<br>",
            "Rate: ",temp$Rate, "<br>",
            "Denominator: ", temp$Denominator,"<br>",
            "Numerator:",temp$Numerator
          ),
          HTML
        ),
        labelOptions = labelOptions(
          style = list("font-weight" = "normal"
                       , padding = "3px 8px"
                       , textsize = "15px"
                       , direction = "auto" ))
      ) %>%
      addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
                position = "bottomright")
  })
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    click_county <- input$map_click
    if (is.null(click_county)) {
      return(NULL)
    } else {
      clicked_county <- click_county$id
      subset(df, Geography == clicked_county)
    }
  })
  output$dt<-renderDataTable({
    selected_county_data()
  })
}

shinyApp(ui, server)

推荐答案

你有三个问题.

  1. 您需要使用layerId = temp$NAME_2来设置ID.
  2. 您需要使用input$map_shape_click,而不是‘input$map_click`.
  3. 由于有多个县具有相同的名称(奥兰治至少在加利福尼亚州、新泽西州和纽约州),因此在合并数据时也要使用STATE.

尝尝这个

library(shiny)
library(leaflet)
library(sp)
library(rgdal)  # Make sure you have this package installed
library(raster)

# Sample dataframe (replace this with your actual data)
df <- data.frame(
  Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
  Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
  State = c(rep("California",6)),
  Year = c(2008, 2008, 2008, 2008, 2008, 2008),
  Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
  Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
  Numerator = c(NA, 2618, 124, 0, 0, 13),
  Denominator = c(NA, 532102, 20483, 11, 295, 2466),
  Rate = c(60.3, 49.2, 60.5, 0.0, 0.0, 52.7)
)


# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

ui <- fluidPage(
  titlePanel("County Rate Map"),
  leafletOutput("map"),
  dataTableOutput("dt")
)

server <- function(input, output, session) {
  
  # Merge the USA polygon data with the dataframe
  merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))
  
  
  #calls map
  output$map<-renderLeaflet({
    # Load your data for the choropleth
    #data <- read.csv("your_data.csv")  # Replace with the path to your data file
    
    # Merge the data with the US states geojson data
    #merged_data <- merge(us_states, data, by.x = "state", by.y = "State", all.x = TRUE)
    # temp <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
    temp <- merged_data
    
    # Determine the maximum value excluding NA values
    max_value <- max(temp$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
    
    
    leaflet(temp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        layerId = temp$NAME_2,
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label =  lapply(
          paste0(
            "County: ", temp$NAME_2, "<br>",
            "Rate: ",temp$Rate, "<br>",
            "Denominator: ", temp$Denominator,"<br>",
            "Numerator:",temp$Numerator
          ),
          HTML
        ),
        labelOptions = labelOptions(
          style = list("font-weight" = "normal"
                       , padding = "3px 8px"
                       , textsize = "15px"
                       , direction = "auto" ))
      ) %>%
      addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
                position = "bottomright")
  })
  
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    # click_county <- input$map_click
    click_county <- input$map_shape_click
    
    # print(click_county)
    if (is.null(click_county)) {
      return(NULL)
    } else {
      clicked_county <- click_county$id
      subset(df, Geography == clicked_county)
    }
  })
  output$dt<-renderDataTable({
    selected_county_data()
  })
}

shinyApp(ui, server)

R相关问答推荐

卸载安装了BRM的模型发出的警告

检测(并替换)字符串中的数学符号

如何根据条件计算时差(天)

将复杂的组合列表转换为数据框架

如何在R中添加截止点到ROC曲线图?

R Sapply函数产生的值似乎与for循环方法略有不同

R函数‘paste`正在颠倒其参数的顺序

找出二叉树中每个 node 在R中的深度?

仅 Select 超过9行的CSV文件

为左表中的所有行使用值Fill滚动左连接

函数可以跨多个列搜索多个字符串并创建二进制输出变量

在另一个包中设置断点&S R函数

使用来自嵌套列和非嵌套列的输入的PURRR:MAP和dplyr::Mariate

`-`是否也用于数据帧,有时使用引用调用?

减少雨云面之间的间距并绘制所有统计数据点

以任意顺序提取具有多个可能匹配项的组匹配项

当由base::限定时,`[.factor`引发NextMethod错误

我正在try 创建一个接近cos(X)的值的While循环,以便它在-或+1-E10范围内

使用dqur在不同变量上创建具有多个条件的变量

将R中对象的CSV数组转换为JSON数组