Shiny仪表盘：实现SelectInput切换时多州物种统计InfoBox动态展示

要实现三个州的InfoBox都显示对应物种的统计值，你需要统一数据处理逻辑，并为每个InfoBox添加针对性的统计代码，同时按照要求的格式输出文本。以下是修改后的完整代码：

suppressPackageStartupMessages(library(tidyverse))
library(sf)
library(shiny)
library(shinydashboard)

ungulates = c("elk", "mule deer", "pronghorn")
regions = c("AZ", "NV", "WY")

ung_shape1 <- tibble("species" = rep(ungulates[1], 5), "state" = rep(regions[1], 5))
ung_shape2 <- tibble("species" = rep(ungulates[1], 3), "state" = rep(regions[2], 3))
ung_shape3 <- tibble("species" = rep(ungulates[1], 4), "state" = rep(regions[3], 4))
ung_shape4 <- tibble("species" = rep(ungulates[2], 6), "state" = rep(regions[1], 6))
ung_shape5 <- tibble("species" = rep(ungulates[2], 7), "state" = rep(regions[2], 7))
ung_shape6 <- tibble("species" = rep(ungulates[2], 4), "state" = rep(regions[3], 4))
ung_shape7 <- tibble("species" = rep(ungulates[3], 4), "state" = rep(regions[1], 4))
ung_shape8 <- tibble("species" = rep(ungulates[3], 2), "state" = rep(regions[2], 2))

all_ung <- bind_rows(ung_shape1, ung_shape2, ung_shape3, ung_shape4, ung_shape5, ung_shape6, ung_shape7, ung_shape8)
geomt <- tibble(x = runif(n=35), y = runif(n = 35))
ung_sff <- bind_cols(all_ung, geomt)
ung_sf <- ung_sff %>% st_as_sf(coords = c("x", "y"))

ui <- dashboardPage(skin = "red", 
                    dashboardHeader(title = "Ungulates"), 
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      fluidRow(
                        box(width = 10, title = "Select input",
                            status = "primary", solidHeader = TRUE,
                            br(),
                            selectInput("ungul", "Choose a species",
                                        choices = unique(ung_sf$species)))
                      ),
                      br(), br(), br(),
                      fluidRow(
                        infoBoxOutput("azCount"),
                        infoBoxOutput("nvCount"),
                        infoBoxOutput("wyCount")
                      )
                    )
)

server <- function(input, output, session){
  
  # 创建响应式数据：根据选择的物种筛选数据，去除几何信息
  filtered_data <- reactive({
    ung_sf %>% 
      select(species, state) %>% 
      st_drop_geometry() %>% 
      filter(species == input$ungul)
  })
  
  # Arizona的InfoBox
  output$azCount <- renderInfoBox({
    az_data <- filtered_data() %>% filter(state == "AZ")
    count <- nrow(az_data)
    display_text <- paste("Arizona AZ", input$ungul, count)
    
    infoBox(
      title = "Arizona", 
      value = display_text,
      icon = icon("tree"), 
      color = "maroon"
    )
  })
  
  # Nevada的InfoBox
  output$nvCount <- renderInfoBox({
    nv_data <- filtered_data() %>% filter(state == "NV")
    count <- nrow(nv_data)
    display_text <- paste("Nevada NV", input$ungul, count)
    
    infoBox(
      title = "Nevada", 
      value = display_text,
      icon = icon("tree"), 
      color = "navy"
    )
  })
  
  # Wyoming的InfoBox
  output$wyCount <- renderInfoBox({
    wy_data <- filtered_data() %>% filter(state == "WY")
    count <- nrow(wy_data)
    display_text <- paste("Wyoming WY", input$ungul, count)
    
    infoBox(
      title = "Wyoming", 
      value = display_text,
      icon = icon("tree"), 
      color = "olive"
    )
  })
}

shinyApp(ui, server)

关键修改说明 #

• 响应式数据复用：创建filtered_data响应式表达式，统一处理物种筛选和去除几何信息的逻辑，避免重复代码，提升效率。
• 针对性统计：每个InfoBox的代码中，单独筛选对应州的数据，用nrow()获取该州所选物种的数量。
• 格式匹配：通过paste()拼接出要求的格式文本（如"Arizona AZ elk 5"），作为InfoBox的value参数传入。
• 修复原逻辑问题：原代码中head(countaz, 1)的方式无法准确获取对应州的统计值，改用直接筛选对应州后计数的方式，逻辑更清晰准确。

内容的提问来源于stack exchange，提问作者Intrepid Nutrepidation