R/Shiny 实现选中复选框标签传入函数列选择字段的方案问询

核心修改说明 #

• 修正原代码的UI语法错误，调整组件嵌套结构，将checkboxGroupInput替换为和服务端更新函数匹配的checkboxGroupButtons控件
• 直接使用input$additem作为列选择参数，该控件的返回值本身就是用户选中的列名组成的字符向量，完美匹配[,]选择语法的要求
• 增加非空、长度校验，避免用户未选中列或仅选中1列时，alpha计算抛出错误

完整修改后代码 #

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(stringr)
library(psych)

ui <- fluidPage(
  br(),
  fileInput("archive", "Upload file", accept = c(".xlsx")),
  # 选项选择控件，替换为和更新函数匹配的checkboxGroupButtons
  checkboxGroupButtons("additem", "Select Items", choices = NULL),
  box(
    width = 12,
    verbatimTextOutput("calfa")
  )
)

server <- function(input, output, session) {
  # 上传数据表
  csv <- reactive({
    req(input$archive)
    inFile <- input$archive
    df <- read_xlsx(inFile$datapath)
    return(df)
  })
  
  # 提取上传文件名（去除后缀）
  reactive_my_path <- reactive({
    req(input$archive)
    return(sub(".xlsx$", "", basename(input$archive$name)))
  })
  
  # 动态更新可选列名
  observe({
    req(csv())
    updateCheckboxGroupButtons(session,
                               "additem",
                               paste('Column names in:', reactive_my_path()),
                               choices = names(csv()))
  })
  
  # 计算alpha
  output$calfa <- renderPrint({
    # 校验：用户必须至少选择2列才能计算克朗巴赫alpha
    req(input$additem, length(input$additem)>=2)
    # 直接用input$additem替换原来的写死列名
    int <- csv()[, input$additem]
    int <- na.omit(int) 
    psych::alpha(int, check.keys = TRUE) 
  })
}

shinyApp(ui, server)

关键修改位置说明 #

原来的写死列选择代码：

int<-csv()[,c("checkbox1","checkbox2")]

替换为：

req(input$additem, length(input$additem)>=2)
int <- csv()[, input$additem]

input$additem会实时返回用户选中的所有复选框的标签值，也就是你上传的Excel表的列名，直接传入列选择位置即可完成动态替换。

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