输入$ files参数更改时,r闪亮的observeEvent()无法隔离反应性

时间:2020-08-29 06:55:35

标签: r shiny

我在R闪亮的observeEvent()上遇到了一个问题。我必须上传三个csv表文件才能分别显示在不同的选项卡上。而且我设置了一个selectInput来设置是否显示表头。最后,我给出一个actionButton(ui)-observeEvent(server)来决定是否运行显示过程。但是我发现selectInput只是跳过了watchEvent(),动态地改变了显示,也就是说watchEvent是无效的,我不知道为什么,我希望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)

1 个答案:

答案 0 :(得分:3)

问题在于您将output$mytabs包裹在observe中。我不确定为什么这也会影响您在output$Group1调用中生成并否决renderUI的{​​{1}}等内容。无论如何,您不需要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
相关问题