当用户单击复选框闪亮 R 时附加文件

Question

我有一个闪亮的 R 应用程序，我只想在用户单击“附加”复选框时附加文件，否则如果用户选择文件输入，它应该只选择单个文件。所以每次用户选择文件输入时，它应该继续覆盖数据帧，除非当应该附加文件时，checkbox.input 为真。现在我正在附加文件，但那是在 R 中而不是在闪亮中。其次，如果表的列数是假设不等于 12。

ui <- fluidPage(
  titlePanel("Client Files Portal"),
  sidebarLayout(
  sidebarPanel(
  selectInput(inputId = "dataset",
                  label = "Select File Type:",
                  choices = c("MA", "AGR","SS","OW","SA","UN","AD","AL","AV")),
      
      fileInput("file1", "Choose a file:", accept = ".txt"),
      checkboxInput("append", "Append", FALSE),
      actionButton("action", "Validate",ignoreInit = TRUE),
    ),
    
    mainPanel(
      textOutput("summary")
    )
  ))
server <- function(input, output) {
  options(shiny.maxRequestSize=3000*1024^2) 
    observeEvent(input$file1, {
    output$summary <- renderText({ 
      paste("Validation Summary", input$dataset)
    })
    })
  observeEvent(input$action, {
    if (input$dataset=="MA"){
      MA<- data.frame()
      ma_i<- data.frame()
      MA_in<- data.frame()
      req(input$file1)
      inFile <- input$file1
      if (is.null(inFile))
        return(NULL)
      ma_i<- read.delim(inFile$datapath,sep="|", header = FALSE)
      stopifnot("Column Mismatch:No. of columns for MA must be 12"=ncol(ma_i)==12)
      MA<-ma_i
      answer<-winDialog("yesno", "Append another MA File?")
      while (answer=='YES') {
        fname <- file.choose()
        ma_i <- read.delim(fname,header=FALSE,sep="|" )
        stopifnot("Column Mismatch:No. of columns for MA must be 12"=ncol(ma_i)==12)
        MA<-rbind(MA,ma_i)
        answer<-winDialog("yesno", "Append another MA File?")  
      } 
      MA_in<-MA
  }  })
    }
    shinyApp(ui = ui, server = server)

Answer 1

这个可重现的示例接受一个输入文件并用它呈现一个表格。如果列不是 12，那么它会显示一条消息（但应用程序仍在运行）。此外，如果选择了追加，则新数据将与前一个数据一起追加。

library(shiny)
library(tidyverse)
library(DT)

#create dataset with 12 columns
rerun(3, iris) %>% 
    reduce(bind_cols) %>%
    select(1:12) %>% 
    write_delim(file = 'iris_12_cols.txt', delim = '|')

ui <- fluidPage(
    titlePanel("Client Files Portal"),
    sidebarLayout(
        sidebarPanel(
            selectInput(inputId = "dataset",
                        label = "Select File Type:",
                        choices = c("MA", "AGR","SS","OW","SA","UN","AD","AL","AV")),
            
            fileInput("file1", "Choose a file:", accept = ".txt"),
            checkboxInput("append", "Append", FALSE),
            actionButton("action", "Validate and Show",ignoreInit = TRUE),
        ),
        
        mainPanel(
            DTOutput("summary")
        )
    ))
server <- function(input, output) {
    options(shiny.maxRequestSize=3000*1024^2) 
    
    #this will remember the last data to append it if the checkbox is selected.
    data_uploaded <- reactiveValues()
    
    observeEvent(input$action, {
            req(input$file1)
        
                
            inFile <- input$file1
            #update reactiveValues with the new data
            data <-  read_delim(inFile$datapath, delim = "|")
            
            #Check that ncols is 12 otherwide print a message and perform no further actions
            if (ncol(data) != 12) {
                showModal(modalDialog(
                    title = "Total number of columns must be 12",
                    paste0("Total columns are ", ncol(data), ' but must be 12.\nPlease upload another file to continue.'),
                    easyClose = TRUE,
                    footer = NULL
                ))
            } else if (!input$append) {
                   
                   #overwrite last data
                   data_uploaded$MA <- data 
                   
                   #render a new table 
                   output$summary <- renderDT({ 
                       data_uploaded$MA
                   })
                  
            } else {
                   #append
                   data_uploaded$MA  <- rbind(data_uploaded$MA, data)
                   
                   #render the data appended
                   output$summary <- renderDT({ 
                       data_uploaded$MA
                   })
                
               }
            }) 
            
            
}

shinyApp(ui = ui, server = server)