Shiny生物多样性应用中互相关联文本输入实现问题

完整修改代码 #

################################################################################
## 下载并加载包管理器pacman ----
if(!require(pacman)) {
    install.packages("pacman")
    library(pacman)
}

################################################################################
# 下载并加载所需包 ----
pacman::p_load(
    shiny, glue, plotly, leaflet, 
    shinythemes, tidyverse, shinyWidgets
)

################################################################################
## 加载预处理数据 ----
final_data <- read_csv("https://raw.githubusercontent.com/Karuitha/shiny_karuitha/master/final_data.csv",
                       col_types = 'ccddccdd')

# 构建唯一的俗名-学名映射表（去重，避免重复配对）
species_mapping <- final_data %>%
    distinct(vernacularName, scientificName) %>%
    arrange(vernacularName)

################################################################################
## 创建UI ----
ui <- fluidPage(
    
    ## 头部面板
    headerPanel(HTML("<h1 style='color: grey'>波兰与德国物种分布情况</h1>")),
    
    ## 主题选择器
    shinythemes::themeSelector(),
    
    ## 侧边栏布局
    sidebarLayout(
        
        sidebarPanel(
            
            HTML("<h3>用户输入</h3>"),
            
            ## 俗名输入（带自动补全）
            HTML("<h4>输入俗名</h4>"),
            selectizeInput(inputId = "vernacularname", 
                          label = "选择或输入俗名",
                          choices = sort(unique(species_mapping$vernacularName)),
                          selected = "Box bug",
                          width = "100%",
                          options = list(
                              create = FALSE, # 禁止用户创建新选项
                              placeholder = "输入俗名搜索",
                              highlight = TRUE
                          )
            ),
            
            ## 学名输入（带自动补全）
            HTML("<h4>输入学名</h4>"),
            selectizeInput(inputId = "scientificname", 
                          label = "选择或输入学名",
                          choices = sort(unique(species_mapping$scientificName)),
                          selected = "Acer platanoides",
                          width = "100%",
                          options = list(
                              create = FALSE,
                              placeholder = "输入学名搜索",
                              highlight = TRUE
                          )
            ),
            
            ## 年份选择
            HTML("<h4>选择年份</h4>"),
            selectInput(inputId = "year", 
                        label = "选择年份",
                        choices = sort(unique(final_data$year)),
                        selected = 2020,
                        multiple = FALSE)
            
        ),
        
        ## 主面板：地图输出
        mainPanel(
            leafletOutput("mymap", width = "100%", height = "800px")
        )
        
    )
    
)

################################################################################
## 创建Server逻辑 ----
server <- function(input, output, session){
    
    # 监听俗名输入变化，自动填充学名
    observeEvent(input$vernacularname, {
        req(input$vernacularname)
        matched_sci <- species_mapping %>%
            filter(vernacularName == input$vernacularname) %>%
            pull(scientificName) %>%
            unique()
        
        # 仅当匹配结果存在且当前学名输入不匹配时更新
        if(length(matched_sci) > 0 && input$scientificname != matched_sci){
            updateSelectizeInput(session, "scientificname", selected = matched_sci)
        }
    }, ignoreInit = FALSE)
    
    # 监听学名输入变化，自动填充俗名
    observeEvent(input$scientificname, {
        req(input$scientificname)
        matched_ver <- species_mapping %>%
            filter(scientificName == input$scientificname) %>%
            pull(vernacularName) %>%
            unique()
        
        # 仅当匹配结果存在且当前俗名输入不匹配时更新
        if(length(matched_ver) > 0 && input$vernacularname != matched_ver){
            updateSelectizeInput(session, "vernacularname", selected = matched_ver)
        }
    }, ignoreInit = FALSE)
    
    ## 响应式数据过滤
    this_data <- reactive({
        req(input$vernacularname, input$year)
        final_data %>% 
            filter(vernacularName == input$vernacularname,
                   year == input$year)
    })
    
    ## 渲染Leaflet地图
    output$mymap <- renderLeaflet({
        leaflet(this_data()) %>%
            addProviderTiles('OpenStreetMap.HOT') %>%
            addCircleMarkers(
                color = "red", 
                radius = ~ individualCount^0.3,
                stroke = TRUE,
                fillOpacity = 0.8,
                popup = ~paste(
                    "<strong> 国家: </strong>", country, "<br>",
                    "<strong> 地点: </strong>", locality, "<br>",
                    "<strong> 数量: </strong>", individualCount, "<br>"
                )
            )
    })
    
}

################################################################################
## 运行应用 ----
shinyApp(ui, server)
################################################################################

关键改进说明 #

1. 构建物种映射表

   • 从原始数据中提取唯一的vernacularName与scientificName配对，避免重复数据导致的匹配错误。

2. 自动补全输入框

   • 使用selectizeInput替代普通textInput，自带搜索过滤功能，用户输入时会自动显示相似名称列表供选择。
   • 通过options参数配置禁用用户创建新选项，确保输入内容始终来自数据中的合法物种名称。

3. 双向自动填充逻辑

   • 用observeEvent分别监听两个输入框的变化，当用户选择或输入其中一个名称时，通过映射表查找对应的另一个名称，并用updateSelectizeInput更新输入框。
   • 添加判断条件避免循环更新（只有当目标输入框当前值与匹配结果不一致时才执行更新）。

4. 数据过滤优化

   • 保留原有的数据过滤逻辑，确保地图仅展示选中物种和年份的分布数据。

内容的提问来源于stack exchange，提问作者John Karuitha