R Shiny应用文本显示异常：无代码报错但未输出预期内容

背景 #

我正在构建一个简易薪资查询工具，用户输入职位名称、月薪、城市、工作年限、资质信息后，工具需输出其薪资与同地区、同职位、同资质、同工作年限人群的中位数薪资对比结果。

测试数据 #

structure(list(grp = c("Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant"), monthly_income = c(8000, 2500, 8500, 4500, 35000, 5500, 10000, 7000, 12000, 4000), yrs_experience = c(5, NA, NA, NA, 5, NA, 0, 3, 3, NA), location = c("Portland", "Portland", "Seattle", "Portland", "Seattle", "Seattle", "Portland", "Portland", "Portland", "Seattle"), qualifications = c("no_qual_preference", "no_qual_preference", "no_qual_preference", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference"), gender_preferences = c("no_gender_preference", "female", "female", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference")), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))

当前代码（无报错但无预期输出） #

library(shiny)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    selectizeInput(
      "grp",
      "Occupation",
      sort(salary_test_data$grp), 
      choices = append("", sort(unique(
        salary_test_data$grp
      ))),
      selected = "",
      multiple = F
    ),
    selectizeInput("qualifications",
                   "Qualifications",
                   choices = append("", sort(
                     unique(salary_test_data$qualifications)
                   ))),
    verbatimTextOutput("comparison_results"),
    sliderInput(
       "yrs_experience",
      "Years of Experience",
       min = 0,
       max = 9,
       value = 0,
       post = " Year(s)"
     ),
    selectizeInput("location",
                   "City",
                   choices = append("", sort(
                     unique(salary_test_data$location)
                   ))),
    numericInput("monthly_income", "Monthly Pay", value = 0),
    actionButton("compare_btn", "Compare Salary")
  ),

mainPanel(plotOutput("salary_plot")
)
))


server <- function(input, output) {
  comparison_results <-
    eventReactive(input$compare_btn, {
      user_Occupation <- input$grp
      user_experience <- input$yrs_experience
      user_monthly_pay <- input$monthly_income
      user_location <- input$location
      user_qualification <- input$qualifications
      
      filtered_data <- salary_test_data[salary_test_data$grp == user_Occupation &
                                          salary_test_data$location == user_location &
                                          salary_test_data$qualifications == user_qualification &
                                          salary_test_data$yrs_experience == user_experience, ]
      
      if (nrow(filtered_data) > 0) {
        if (user_monthly_pay >= median(filtered_data$monthly_income)) {
          "Your monthly salary is above the median income of workers employed in your profession,
        who share your qualifications, & city"  
        } else {
          "Your monthly salary is below the median income of workers employed in your profession,
        who share your qualifications, & city"
        }
      } else {
        "No data found for the given job title and/or city"
      }
    })
  
  output$comparison_results <- renderText({
    comparison_results()
  })
  
}

问题排查与修复方案 #

1. 核心问题：过滤条件过于严格导致无匹配数据 #

测试数据中yrs_experience字段大量为NA，但代码中过滤时使用salary_test_data$yrs_experience == user_experience，会直接排除所有NA的行。同时，若用户未选择职位/城市/资质（默认选中空字符串""），grp == ""这类条件也无法匹配任何数据，最终触发"No data found..."分支，导致你误以为没有显示结果。

2. UI组件参数错误 #

第一个selectizeInput的参数顺序错误，多余的sort(salary_test_data$grp)会干扰选项渲染，需移除。

3. UI布局不合理 #

verbatimTextOutput放在输入组件中间，视觉上容易被忽略，建议移到按钮下方。

修复后的完整代码 #

library(shiny)
library(dplyr)

# 先加载测试数据
salary_test_data <- structure(list(grp = c("Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant"), monthly_income = c(8000, 2500, 8500, 4500, 35000, 5500, 10000, 7000, 12000, 4000), yrs_experience = c(5, NA, NA, NA, 5, NA, 0, 3, 3, NA), location = c("Portland", "Portland", "Seattle", "Portland", "Seattle", "Seattle", "Portland", "Portland", "Portland", "Seattle"), qualifications = c("no_qual_preference", "no_qual_preference", "no_qual_preference", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference"), gender_preferences = c("no_gender_preference", "female", "female", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference")), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    # 修正selectizeInput参数错误
    selectizeInput(
      "grp",
      "Occupation",
      choices = append("", sort(unique(salary_test_data$grp))),
      selected = "",
      multiple = FALSE
    ),
    selectizeInput(
      "qualifications",
      "Qualifications",
      choices = append("", sort(unique(salary_test_data$qualifications)))
    ),
    sliderInput(
      "yrs_experience",
      "Years of Experience",
      min = 0,
      max = 9,
      value = 0,
      post = " Year(s)"
    ),
    selectizeInput(
      "location",
      "City",
      choices = append("", sort(unique(salary_test_data$location)))
    ),
    numericInput("monthly_income", "Monthly Pay", value = 0),
    actionButton("compare_btn", "Compare Salary"),
    # 移到按钮下方，结果展示更直观
    verbatimTextOutput("comparison_results")
  ),
  mainPanel(plotOutput("salary_plot"))
))

server <- function(input, output) {
  comparison_results <- eventReactive(input$compare_btn, {
    user_Occupation <- input$grp
    user_experience <- input$yrs_experience
    user_monthly_pay <- input$monthly_income
    user_location <- input$location
    user_qualification <- input$qualifications
    
    # 过滤条件优化：允许匹配yrs_experience为NA的行
    filtered_data <- salary_test_data %>%
      filter(
        grp == user_Occupation,
        location == user_location,
        qualifications == user_qualification,
        # 匹配用户输入的年限 或者 数据中无年限记录（NA）
        is.na(yrs_experience) | yrs_experience == user_experience
      )
    
    if (nrow(filtered_data) > 0) {
      median_salary <- median(filtered_data$monthly_income, na.rm = TRUE)
      if (user_monthly_pay >= median_salary) {
        sprintf("你的月薪（%d）高于同职位、同资质、同城市人群的中位数薪资（%d）", 
                user_monthly_pay, median_salary)
      } else {
        sprintf("你的月薪（%d）低于同职位、同资质、同城市人群的中位数薪资（%d）", 
                user_monthly_pay, median_salary)
      }
    } else {
      "未找到匹配的职位、城市或资质数据，请检查输入"
    }
  })
  
  output$comparison_results <- renderText({
    comparison_results()
  })
}

# 运行app
shinyApp(ui, server)

额外优化点 #

• 使用dplyr::filter让过滤逻辑更清晰
• 添加na.rm = TRUE确保中位数计算忽略NA值
• 用sprintf生成更直观的对比文本，包含具体薪资数值

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