如何将Shiny的select输入转换为数值以计算平均得分

实现方案 #

核心逻辑是批量读取所有输入值，统一做分值映射后按板块分组计算平均分，完全适配30道题的批量处理需求，输出的平均分均为数值类型可直接用于后续计算。

完整可运行的修改后代码 #

library(shiny)
library(tidyverse)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)

ui <- fluidPage(
  title = "个性化问卷",
  useShinyjs(),
  useShinydashboard(),
  tabsetPanel(
    tabPanel("答题页",
             sidebarLayout(
               sidebarPanel(
                 h2("板块1"),
                 selectInput("q1", "问题1",
                             choices = c("", "非常低", "低",
                                         "中等", "高")),
                 selectInput("q2", "问题2",
                             choices = c("", "非常低", "低",
                                         "中等", "高")),
                 h2("板块2"),
                 selectInput("q3", "问题3",
                             choices = c("", "非常低", "低",
                                         "中等", "高")),
                 selectInput("q4", "问题4",
                             choices = c("", "非常低", "低",
                                         "中等", "高"))
               ),
               mainPanel(textOutput("section1_results"),
                         textOutput("section2_results"),
                         textOutput("overall_results"))
               
             ))))


server <- function(input, output) {
  # 统一处理所有题目的得分映射，无需逐个调用输入
  all_scores <- reactive({
    # 批量读取所有输入值，转换为数据框格式
    tibble(
      input_id = names(input),
      input_val = unlist(reactiveValuesToList(input))
    ) %>%
      # 筛选符合「q+数字」命名规则的题目输入，排除其他无关输入的干扰
      filter(str_detect(input_id, "^q\\d+$")) %>%
      # 提取题目序号，按规则划分板块，30道题只需修改此处的映射规则即可
      mutate(
        q_num = as.integer(str_remove(input_id, "^q")),
        section = case_when(
          q_num %in% 1:2 ~ "板块1",
          q_num %in% 3:4 ~ "板块2",
          # 更多板块直接加规则即可，比如q5~q10归为板块3：q_num %in% 5:10 ~ "板块3"
          TRUE ~ NA_character_
        ),
        # 按要求用case_when做分值映射，空选项自动设为NA
        score = case_when(
          input_val == "非常低" ~ 1,
          input_val == "低" ~ 2,
          input_val == "中等" ~ 3,
          input_val == "高" ~ 4,
          TRUE ~ NA_real_
        )
      )
  })
  
  # 计算板块1平均分，数值类型
  section_1 <- reactive({
    all_scores() %>%
      filter(section == "板块1") %>%
      pull(score) %>%
      mean(na.rm = TRUE) %>%
      # 全为空的情况返回NA，避免出现NaN
      replace(is.nan(.), NA)
  })
  
  # 计算板块2平均分，数值类型
  section_2 <- reactive({
    all_scores() %>%
      filter(section == "板块2") %>%
      pull(score) %>%
      mean(na.rm = TRUE) %>%
      replace(is.nan(.), NA)
  })
  
  # 计算总体平均分，数值类型
  overall <- reactive({
    all_scores() %>%
      pull(score) %>%
      mean(na.rm = TRUE) %>%
      replace(is.nan(.), NA)
  })
  
  output$section1_results <- renderText(paste0("你在板块1的平均得分为：", section_1()))
  output$section2_results <- renderText(paste0("你在板块2的平均得分为：", section_2()))
  output$overall_results <- renderText(paste0("你的总体平均得分为：", overall()))
  
}

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

如果你希望保留选项的英文显示，只需将case_when中分值映射的匹配字符串替换为对应的英文（"Very Low"、"Low"等）即可，逻辑完全通用。

方案亮点 #

• 完全适配批量题目：只要你的输入ID遵循统一前缀+数字的命名规则，不管多少道题都不需要逐个调用输入，仅需修改板块划分的映射规则即可。
• 符合工具偏好：分值映射全程使用dplyr::case_when实现，符合tidy生态的编码习惯。
• 输出格式达标：所有平均分返回值均为数值类型，可直接代入后续计算逻辑，全空的场景会自动返回NA无报错。

内容的提问来源于stack exchange，提问作者J.Sabree