Shiny App Server无法接收输入变量，请求问题排查

核心错误点 #

1. 输入ID不匹配：UI中月份选择框的inputId是"month"，但server里错误使用input$mon获取值，导致无法读取用户选择；
2. 调试语句位置错误：browser()放在server函数顶层，仅在App启动时执行一次，不会响应按钮点击，需移至observeEvent内部；
3. 绘图函数未返回结果：proc函数生成了ggplot对象utilchart但未返回，renderPlot无法获取到要渲染的图形；
4. 全局变量污染风险：buildtab函数中使用<<-赋值全局变量df1/df2，易引发意外问题，改为函数返回值更安全。

修正后的完整代码 #

# 加载依赖包
library(shiny)
library(readxl)
library(dplyr)
library(ggplot2)
library(stringr)

# 前置数据处理逻辑
path = "I:\\PMO\\EPIC TRAINING\\Epic Training\\2024\\Sustainable Jan 2024  - Dec 2024.xlsx"

d1 <- read_excel(path, sheet = "Staff - Courses", col_names = TRUE)

trapp <- d1[c(2:5)]
trapp <- trapp[rowSums(is.na(trapp)) != ncol(trapp), ]
rm(d1)

d1sheets <- as.data.frame(excel_sheets(path = path))
d1sheets <- as.data.frame(d1sheets[c(1:12),])
colnames(d1sheets) <- c("Month")

dt <- Sys.Date()
cm <- as.numeric(format(dt,'%m'))
lm <- cm - 1
nm <- cm + 1

dflm <- read_excel(path, sheet = lm, skip = 1)
dfcm <- read_excel(path, sheet = cm, skip = 1)
dfnm <- read_excel(path, sheet = nm, skip = 1)

cleandf <- function(x) {
  x <- x[c(1:11)]
  x <- subset(x, select = -c(3, 5:8) )
  
  x %>%
    mutate_if(is.character, str_trim)
}

dflm <- cleandf(dflm)
dfcm <- cleandf(dfcm)
dfnm <- cleandf(dfnm)

mon <- as.data.frame(d1sheets[c(lm,cm,nm),])
colnames(mon) <- c("Month")
rm(d1sheets)

applist <- trapp[2]
applist <- as.data.frame(unique(applist))
applist <- applist[order(applist$`Application 1`),, drop=FALSE]
colnames(applist) <-  c("Apps")
apps <- applist
rownames(apps) = NULL
rm(applist)

# 修正proc函数：移除全局赋值，返回绘图对象
proc <- function (mx, selected_app) {
  
  colnames(trapp) <-  c("Trainer","App1","App2","App3")
  
  aptr1 <- filter(trapp, App1 == selected_app)
  aptr2 <- filter(trapp, App2 == selected_app)
  aptr3 <- filter(trapp, App3 == selected_app)
  
  ap1 <- aptr1[1]
  ap2 <- aptr2[1]
  ap3 <- aptr3[1]
  
  apptrainer <- rbind(ap1, ap2, ap3) %>%
    mutate_if(is.character, str_trim) %>%
    unique() %>%
    arrange(Trainer)
  
  rm(aptr1, aptr2, aptr3, ap1, ap2, ap3)
  
  # 选择对应月份的schedule
  if (mx == mon[1,1]) {
    schedule <- dflm
  } else if (mx == mon[2,1]) {
    schedule <- dfcm
  } else if (mx == mon[3,1]) {
    schedule <- dfnm
  } else {
    stop("Invalid month selected")
  }
  
  cnt1 <- nrow(apptrainer)
  cnt2 <- nrow(schedule)
  
  # 重写buildtab：返回数据框，避免全局变量
  buildtab <- function(x) {
    df <- data.frame(
      Application = character(),
      Course = character(),
      Date = character(),
      Duration = numeric(),
      Trainer = character(),
      stringsAsFactors = FALSE
    )
    
    p <- 1
    for(i in 1:cnt1) {
      h <- apptrainer[i, ]$Trainer
      
      for(n in 1:cnt2) {
        j <- if(x == 1) schedule$Trainer1[n] else schedule$`Trainer 2`[n]
        
        if (!is.na(j) && h == j) {
          app <- schedule$Application[n]
          course <- schedule$Name[n]
          course_date <- as.numeric(schedule$`Session Date`[n]) %>%
            as.Date(origin = "1899-12-30") %>%
            format("%m/%d/%y")
          duration <- as.numeric(schedule$Hours[n])
          
          df[p, ] <- list(app, course, course_date, duration, j)
          p <- p + 1
        }
      }
    }
    return(df)
  }
  
  df1 <- buildtab(1)
  df2 <- buildtab(2)
  
  df <- rbind(df1, df2)
  
  h <- df %>%
    arrange(Trainer, Application) %>%
    aggregate(Duration ~ Trainer + Application, ., sum)
  
  h1 <- paste("Trainer Classroom Hours by Application", ": ", mx)
  s <- ggplot(h, aes(x=Trainer, y = Duration, fill = Application))
  
  utilchart <- s + 
    geom_bar(stat='identity') + 
    theme(
      plot.margin=unit(c(1,1,1,2),"cm"), 
      text = element_text(size=11), 
      axis.text.x = element_text(angle=60, hjust=1)
    ) + 
    ggtitle(h1) + 
    xlab("Trainers") + 
    ylab("Hours") +
    labs(fill = "Course")
  
  return(utilchart) # 返回绘图对象
}

# 修正UI与server
ui <- fluidPage(
  titlePanel("Utilization"),
  sidebarLayout(
    sidebarPanel(    
      width = 2,
      p("Select a month and application, then click Submit"),
      selectizeInput(inputId = "month", label = NULL, choices = mon$Month, selected = NULL, multiple = FALSE, options = NULL),
      selectizeInput(inputId = "apps", label = NULL, choices = apps$Apps, selected = NULL, multiple = FALSE, options = NULL),
      actionButton("do", "Submit")
    ),
    mainPanel(
      plotOutput(outputId = "plot", height = '900px')
    )
  )
)

server <- function(input, output) {
  observeEvent(input$do, {
    browser() # 移至此处，点击按钮时触发调试
    x1 <- input$month # 修正input ID
    x2 <- input$apps
    
    output$plot <- renderPlot({
      proc(x1, x2)
    })
  })
}

shinyApp(ui = ui, server = server)

额外说明 #

• 修正了proc函数的参数名（将apps改为selected_app），避免与全局变量apps重名引发混淆；
• 简化了apptrainer的处理逻辑，用链式调用替代分步操作；
• 重写buildtab函数，通过返回值传递数据，彻底移除全局变量df1/df2，降低代码耦合度；
• 添加了月份匹配的else分支，避免无匹配时的潜在错误。

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