Shiny中满足条件时筛选数据集的实现方法

现有Shiny应用默认选中「No」选项，需求是当用户选择「Yes」时，地图仅展示参与人数至少为500的邮政编码区域，核心是在数据筛选逻辑中加入条件判断。

修改后完整代码 #

ui <- fluidPage(
  fluidRow(
    sidebarPanel(width=2,
                 radioButtons(
                   inputId = "ProjectID",
                   label = strong("Project ID"),
                   selected = "18",
                   choices = sort(unique(IDD_nhmap$ProjectID))
                 ),
                 
                 selectInput(
                   inputId = "Zip",
                   label = "Zip Codes With atleast 500 participants",
                   selected = "No",
                   selectize = TRUE,
                   multiple = FALSE,
                   choices = c("Yes", "No")),
                 
    ),
    ######################
  mainPanel(
    fluidRow(
      column(width = 6, shinyjs::useShinyjs(), leafletOutput("IDD_int_map1", height = "500px"))

    )
    
  ), # this closes mainPanel
   ), # this closes fluidRow
  br(),
  br()

) # this closes ui

####################################
server <- function(input, output, session) {
  #ACS_Blacks
  IDD_mapdata_ <- reactive ({
    out_map <- IDD_nhmap %>%
      filter(ProjectID %in% input$ProjectID)
    
    # 根据Zip选项添加筛选条件
    if(input$Zip == "Yes"){
      out_map <- out_map %>% filter(Zip_Black >= 500)
    }
    
    return(out_map)
  })
  
  IDD_mapdata_1 <- reactive ({
    out_map_1 <- lat_long %>%
      filter (ProjectID %in% input$ProjectID) 
    return(out_map_1)
  })
  
  output$IDD_int_map1 <- renderLeaflet ({
    # 基于筛选后的数据集设置颜色比例尺
    filtered_data <- IDD_mapdata_()
    npal2 <- colorNumeric(palette = "Greens",
                          domain = filtered_data$Zip_Black)
    
    labels <- sprintf(
      "<strong>Zip Code=%s </strong> <br/> Count = %s <br/> Percentage = %s ",
      filtered_data$Zip,
      filtered_data$Zip_Black,
      filtered_data$state_black
    ) %>%
      lapply(htmltools::HTML)
    
    leaflet (filtered_data, options = leafletOptions(zoomSnap = 0.25, zoomDelta =
                                                      0.25)) %>%
      addProviderTiles("CartoDB.Positron",
                       options = providerTileOptions(opacity = 2)) %>%
      clearControls() %>%
      clearShapes() %>%
      addPolygons(
        fillColor = ~npal2(Zip_Black),
        stroke = T,
        weight = 1,
        smoothFactor = 0.2,
        fillOpacity = 1,
        color = "black",
        label = labels,
        labelOptions = labelOptions(
          interactive = TRUE,
          style = list(
            'direction' = 'auto',
            'color' = 'black',
            'font-family' = 'sans-serif',
            'box-shadow' = '3px 3px rgba(0,0,0,0.25)',
            'font-size' = '14px',
            'border-color' = 'rgba(0,0,0,0.5)'
          )
        ),
        highlightOptions = highlightOptions(
          weight = 2,
          bringToFront = T,
          fillOpacity = 0.7
        )
      ) %>%
      setView(lng = IDD_mapdata_1()$long,
              lat = IDD_mapdata_1()$lat,
              zoom = 8) %>%
      addLegend(
        position = "topright",
        opacity = 1,
        values = filtered_data$Zip_Black,
        pal = npal2,
        title = "African American (ACS)",
        labFormat = labelFormat()
      ) %>%
      addTiles(options = tileOptions(opacity = 2))
  })
}
shinyApp(ui, server)

关键修改说明 #

• 数据筛选逻辑：在IDD_mapdata_响应式函数中新增if判断，当input$Zip为「Yes」时，筛选Zip_Black >= 500的行（若参与人数对应其他列名，请替换为实际列名）
• 颜色比例尺适配：将颜色比例尺npal2的domain从原始数据集改为筛选后的数据，确保颜色范围匹配当前展示内容
• 图例同步更新：图例的values使用筛选后的数据，避免出现与地图无关的颜色区间
• 性能优化：提前将筛选后的数据集赋值给filtered_data，减少重复调用响应式函数的次数

应用界面预览 #

内容的提问来源于stack exchange，提问作者Nader Mehri