R shiny 當 input$files 參數改變時，observeEvent() 無法隔離反應

Question

我遇到了關於 R shiny observeEvent() 的問題。 我必須上傳三個 csv 表格文件以分別顯示在不同的標簽面板中。 我設置了一個 selectInput 來設置是否顯示表的 header。 最后我給了一個actionButton(ui)-observeEvent(server)來決定是否運行顯示進程。 但是我發現selectInput只是跳過了observeEvent()，動態的改變了顯示。也就是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調用中生成並否決observeEvent的output$Group1等的內容。 無論如何，您不需要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)