当 input$files 参数更改时，R闪亮的observeEvent（）无法隔离反应性

Question

我遇到了一个关于 R shiny observeEvent() 的问题。我必须上传三个 csv 表格文件以分别显示在不同的标签面板中。我设置了一个 selectInput 来设置是否显示表头。最后我给出一个 actionButton(ui)-observeEvent(server) 来决定是否运行显示过程。但是我发现selectInput只是跳过了observeEvent()，动态改变了show。就是observeEvent失效了。我不知道为什么。我希望selectInput可以在actionButton()的控制之下。我怀疑 observeEvent() 是否是执行这项工作的好选择。希望有人能帮助我！提前致谢。这是我的演示代码

# get 3 test uploaded files
data(mtcars)
test1 <- mtcars[,c(1:3)]
test2 <- mtcars[,c(5:8)]
test3 <- mtcars[c(1:3),]
write.csv(test1,file = "test1.csv")
write.csv(test2,file = "test2.csv")
write.csv(test3,file = "test3.csv")

# shiny part

library(shiny)
ui <- fluidPage(
  # useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      fileInput(
        inputId = "files", 
        label = "Choose CSV File", 
        multiple = TRUE,
        accept = c("text/csv",
                   "text/comma-separated-values,text/plain",
                   ".csv")
      ),
      tags$hr(),
      selectInput("type", "Choose Data:", choices = c('Noheader'=TRUE,'Header'=FALSE)),
      tags$hr(),
      actionButton("update", "show",class = "btn btn-primary btn-lg",icon = icon("refresh"), width  =  "120px"),
   
    ),
    mainPanel(
      uiOutput("mytabs"),
      textOutput("text_null", container = h4)
   
    )
  )
)

server <- function(input, output, session){
  values <- reactiveValues(file_data=NULL)
  filedata <- reactive({
    req(input$files)
    upload = list()
    
    for(nr in 1:length(input$files[, 1])){
      raw_name <- sub(".csv$", "",input$files[[nr, 'name']])
      upload[[raw_name]] <- read.csv(file = input$files[[nr, 'datapath']],header =  as.logical(input$type))
    }
    return((upload))
  })

  
  observe({
    output$mytabs = renderUI({
      values$file_data <- filedata()
      nTabs <- length(filedata())
      tabNames <- names(values$file_data)
      myTabs = lapply(1: nTabs, function(i) {
        tabPanel( tabNames[i],
                 tags$div(class = "group-output",
                          tags$br(), 
                          tableOutput(paste0("Group",i))#))
        )
        )
      })
      do.call(tabsetPanel, myTabs)
    })
  })

  observeEvent(input$update, {
   
    values$file_data <- filedata()
    nn_Tabs <- length(filedata())
    progress <<- shiny::Progress$new()
    on.exit(progress$close())
    progress$set(message = "Begin to process data", value = 0)
   
    for (i in 1: nn_Tabs){
      local({ 
        my_n <- i
        TableName <- paste0("Group",my_n)
        output[[TableName]] <- renderTable({ values$file_data[[my_n]] })
        print(values$file_data[[my_n]])
        progress$inc(1/nn_Tabs, detail = ", Please wait...")
      })
    }
    progress$set(message = "Finished!", value = 1)
  })
  
}

shinyApp(ui, server)

Answer 1

问题是您将output$mytabs 包装在observe 中。我不确定为什么这也会影响您在renderUI 调用中生成的output$Group1 等的内容，并否决observeEvent。无论如何，你不需要observe，当依赖改变时输出会自动更新：

# get 3 test uploaded files
data(mtcars)
test1 <- mtcars[,c(1:3)]
test2 <- mtcars[,c(5:8)]
test3 <- mtcars[c(1:3),]
write.csv(test1,file = "test1.csv")
write.csv(test2,file = "test2.csv")
write.csv(test3,file = "test3.csv")

# shiny part

library(shiny)
ui <- fluidPage(
  # useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      fileInput(
        inputId = "files", 
        label = "Choose CSV File", 
        multiple = TRUE,
        accept = c("text/csv",
                   "text/comma-separated-values,text/plain",
                   ".csv")
      ),
      tags$hr(),
      selectInput("type", "Choose Data:", choices = c('Noheader'=TRUE,'Header'=FALSE)),
      tags$hr(),
      actionButton("update", "show",class = "btn btn-primary btn-lg",icon = icon("refresh"), width  =  "120px"),
      
    ),
    mainPanel(
      uiOutput("mytabs"),
      textOutput("text_null", container = h4)
      
    )
  )
)

server <- function(input, output, session){
  values <- reactiveValues(file_data=NULL)
  filedata <- reactive({
    req(input$files)
    upload = list()
    
    for(nr in 1:length(input$files[, 1])){
      raw_name <- sub(".csv$", "",input$files[[nr, 'name']])
      upload[[raw_name]] <- read.csv(file = input$files[[nr, 'datapath']],header =  as.logical(input$type))
    }
    return((upload))
  })
  
  

    output$mytabs = renderUI({
      values$file_data <- filedata()
      nTabs <- length(filedata())
      tabNames <- names(values$file_data)
      myTabs = lapply(1: nTabs, function(i) {
        tabPanel( tabNames[i],
                  tags$div(class = "group-output",
                           tags$br(), 
                           tableOutput(paste0("Group",i))#))
                  )
        )
      })
      do.call(tabsetPanel, myTabs)
    })
  
  observeEvent(input$update, {
    
    values$file_data <- filedata()
    nn_Tabs <- length(filedata())
    progress <<- shiny::Progress$new()
    on.exit(progress$close())
    progress$set(message = "Begin to process data", value = 0)
    
    for (i in 1: nn_Tabs){
      local({ 
        my_n <- i
        TableName <- paste0("Group",my_n)
        output[[TableName]] <- renderTable({ values$file_data[[my_n]] })
        print(values$file_data[[my_n]])
        progress$inc(1/nn_Tabs, detail = ", Please wait...")
      })
    }
    progress$set(message = "Finished!", value = 1)
  })
  
}

shinyApp(ui, server)

---

编辑

我认为这个解决方案更符合您的要求。也许可以将最后的observe 语句优化为更好的编码模式：

# get 3 test uploaded files
data(mtcars)
test1 <- mtcars[,c(1:3)]
test2 <- mtcars[,c(5:8)]
test3 <- mtcars[c(1:3),]
write.csv(test1,file = "test1.csv")
write.csv(test2,file = "test2.csv")
write.csv(test3,file = "test3.csv")

# shiny part

library(shiny)
ui <- fluidPage(
  # useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      fileInput(
        inputId = "files", 
        label = "Choose CSV File", 
        multiple = TRUE,
        accept = c("text/csv",
                   "text/comma-separated-values,text/plain",
                   ".csv")
      ),
      tags$hr(),
      selectInput("type", "Choose Data:", choices = c('Noheader'=TRUE,'Header'=FALSE)),
      tags$hr(),
      actionButton("update", "show",class = "btn btn-primary btn-lg",icon = icon("refresh"), width  =  "120px"),
      
    ),
    mainPanel(
      uiOutput("mytabs"),
      textOutput("text_null", container = h4)
      
    )
  )
)

server <- function(input, output, session){
  values <- reactiveValues(file_data=NULL)
  filedata <- eventReactive(input$update, {
    req(input$files)
    upload = list()
    
    for(nr in 1:length(input$files[, 1])){
      raw_name <- sub(".csv$", "",input$files[[nr, 'name']])
      upload[[raw_name]] <- read.csv(file = input$files[[nr, 'datapath']],header =  as.logical(input$type))
    }
    return((upload))
  })
  
  
  
  output$mytabs = renderUI({
    values$file_data <- filedata()
    nTabs <- length(filedata())
    tabNames <- names(values$file_data)
    myTabs = lapply(1: nTabs, function(i) {
      tabPanel( tabNames[i],
                tags$div(class = "group-output",
                         tags$br(), 
                         tableOutput(paste0("Group",i))#))
                )
      )
    })
    do.call(tabsetPanel, myTabs)
  })
  
  observe({
    
    values$file_data <- filedata()
    nn_Tabs <- length(filedata())
    progress <<- shiny::Progress$new()
    on.exit(progress$close())
    progress$set(message = "Begin to process data", value = 0)
    
    for (i in 1: nn_Tabs){
      local({ 
        my_n <- i
        TableName <- paste0("Group",my_n)
        output[[TableName]] <- renderTable({ values$file_data[[my_n]] })
        print(values$file_data[[my_n]])
        progress$inc(1/nn_Tabs, detail = ", Please wait...")
      })
    }
    progress$set(message = "Finished!", value = 1)
  })
  
}

shinyApp(ui, server)