R shiny observeEvent() cannot isolate the reactivity when input$files parameters changes

Question

I met a problem abount R shiny observeEvent(). I have to upload three csv table files to separately show at different tabpanels. And I set a selectInput to set if to show header of table. At last I give a actionButton(ui)-observeEvent(server) to decide whether to run the showing process. But I find the selectInput just skip the observeEvent(), dynamicly change the show.That is observeEvent is invalidted.I dont'know why.I want selectInput can be under control of actionButton(). I doubt if observeEvent() is a good option to execute the job. Hope somebody can help me! Thanks in advance. Here is my demo code

# 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

Problem polega na tym, że zawijasz output$mytabsplik observe. Nie jestem pewien, dlaczego wpływa to również na zawartość output$Group1itp., Które generujesz w renderUIwywołaniu i unieważnia observeEvent. W każdym razie nie potrzebujesz observe, dane wyjściowe są automatycznie aktualizowane, gdy zmienia się zależność:

# 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)

---

Edytować

Myślę, że to rozwiązanie jest bardziej tym, czego chcesz. Może można zoptymalizować ostatnią observeinstrukcję, aby uzyskać lepszy wzorzec kodowania:

# 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)