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

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

The problem is that you wrap output$mytabs in an observe. I'm not sure why this influences also the content of the output$Group1 etc. you generate in the renderUI call and overrules the observeEvent. Anyway, you don't need the observe, outputs are automatically updated when a dependency changes:
# 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)
Edit
I think this solution is more what you want. Maybe one can optimise the last observe statement to a better coding pattern:
# 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)