如何在Shiny应用中当Checked列值为FALSE时弹出提示窗口

现有一段Shiny应用代码，运行后会在浏览器中展示多列数据，其中"Checked"列的值为TRUE或FALSE，由Checked = file.exists(File)生成。需求是：当Checked值存在FALSE时，弹出提示窗口显示"file(s) do not exist"；值全为TRUE时不执行任何操作。尝试用if()语句实现但报错，寻求解决方案。

在Shiny中实现弹窗提示，需结合observeEvent()监听数据变化，配合showModal()生成警告窗口，具体实现如下：

• 用observeEvent()监听data()的输出，每次数据更新时触发检查逻辑
• 检查Checked列是否存在FALSE值，若存在则弹出警告弹窗
• 添加removeModal()避免重复弹窗，确保交互体验

修改后的完整代码如下：

library(shiny)
library(dplyr)
library(tidyr)
library(stringr)
library(jsonlite)
library(openxlsx)

r=sort(list.dirs(path = '/ESS_mounts/atoto/data/demultiplex/', full.names = FALSE, recursive = FALSE), decreasing = TRUE)

ui <- fluidPage(
  titlePanel("toto Report"),
  sidebarPanel(
    selectInput('RunID','Choose an toto RunID:', r),
    selectInput('StudyID','Choose StudyID:', NULL),
    downloadButton("download", "Download .xlsx"),
    width=3
  ),
  mainPanel(
    tableOutput('data'),
    width=9
  )
)

server <- function(input, output, session) {
  study <- reactive({
    s=read.csv(paste0('/Server/data/demultiplex/',input$RunID,'/SampleSheet.csv'), skip=suppressWarnings(grep('[Data]',readLines(paste0('/Server/data/demultiplex/',input$RunID,'/SampleSheet.csv')), fixed=TRUE)))
    m=s %>%
      pull(Sample_Project) %>%
      unique()
    m
  })

  observe({
    updateSelectInput(session = session, inputId = 'StudyID', choices = study())
  })

  data <- reactive({
    j=fromJSON(paste0('/Server/data/demultiplex/',input$RunID,'/Stats/Stats.json'))
    s=read.csv(paste0('/Server/data/demultiplex/',input$RunID,'/SampleSheet.csv'), colClasses=c('Sample_Name'='character'), skip=suppressWarnings(grep('[Data]',readLines(paste0('/Server/data/demultiplex/',input$RunID,'/SampleSheet.csv')), fixed=TRUE)))
    t=j$ConversionResults$DemuxResults %>%
      bind_rows(.id = 'Lane') %>%
      rename(TotalYield = Yield,) %>%
      unnest(cols = c(IndexMetrics, ReadMetrics)) %>%
      rename(Read=ReadNumber) %>%
      mutate(Q30 = 100*YieldQ30/Yield) %>%
      select(SampleName,Lane,Read,NumberReads,Yield,Q30)
    m=s %>%
      mutate(index2 = ifelse("index2" %in% names(.), index2, NA), SampleSheetRow = row_number(), Instrument = str_split(j$RunId,'_')[[1]][2], Side = substr(str_split(j$RunId,'_')[[1]][4],1,1), RunNumber = str_pad(j$RunNumber, width=4, pad=0), RunID = j$RunId, Flowcell = j$Flowcell) %>%
      rename(Index1 = index, Index2 = index2, LibraryName = Description, StudyID = Sample_Project, SampleName = Sample_Name) %>%
      select(StudyID,SampleName,LibraryName,Index1,Index2,Instrument,Side,RunNumber,RunID,Flowcell,SampleSheetRow) %>%
      right_join(t, by = 'SampleName') %>%
      mutate(File = paste0('/Server/data/demultiplex/',RunID,'/',StudyID,'/',LibraryName,'/',LibraryName,'_',Instrument,'_',RunNumber,'_',SampleName,'_S',SampleSheetRow,'_L00',Lane,'_R',Read,'_001.fastq.gz'), Checked = file.exists(File)) %>%
      filter(StudyID == input$StudyID ) %>%
      mutate(SampleName = str_replace(SampleName,'_' ,'-'))
    m
  })

  # 添加弹窗提示逻辑
  observeEvent(data(), {
    req(data())
    # 检查是否存在文件缺失
    if(any(!data()$Checked)) {
      # 移除已存在的弹窗避免重复
      removeModal()
      showModal(modalDialog(
        title = "警告",
        "file(s) do not exist",
        easyClose = TRUE,
        footer = modalButton("确定")
      ))
    } else {
      # 无缺失时移除可能存在的弹窗
      removeModal()
    }
  })

  output$data <- renderTable({
    data()
  }, rownames = TRUE)

  output$download <- downloadHandler(
    filename = function() {
      paste0(input$StudyID, '_', input$RunID, '.xlsx')
    },
    content = function(file) {
      write.xlsx(data(), file, colNames = TRUE, overwrite = TRUE)
    }
  )
}

shinyApp(ui, server)

关键修改说明 #

在server函数中新增了observeEvent()块：

• req(data())确保数据加载完成后再执行检查
• any(!data()$Checked)判断是否存在文件缺失
• showModal()生成带确认按钮的警告弹窗，easyClose = TRUE允许点击弹窗外部关闭
• removeModal()避免重复触发弹窗，保证交互逻辑清晰

内容的提问来源于stack exchange，提问作者Manu G.