r - 如何在 R Shiny 中限制每天一次将文件导入到 shinyApp？

Question

我想每天上传更新的csv文件。上传csv文件后，上传图标应消失，valueBox 应显示相关值。这是下面的代码：

library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- dashboardPage(
    dashboardHeader(title = "Upload Stats"),
    dashboardSidebar(),
    dashboardBody(
        box(
            title = "UPTIME:", width = 12, 
    div(column(width = 4, fileInput(inputId = "file", label = "import", accept = ".csv")),
        column(width = 8, valueBoxOutput("stats"))
            )
        ) 
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    output$stats <- renderValueBox({
        req(input$file)
        data <- read.csv(input$file$datapath)
        valueBox("scr1", sum(data[,2]), width = 12)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

上述代码每次访问闪亮仪表板时都会接受csv文件。目前，每次有人打开 URL/仪表板时，它都会显示上传图标。我希望上传图标应该显示，直到csv文件没有上传到 shinyApp。上传后，它应该会消失并显示“valueBox()”，其值取决于上传的文件。有人可以帮助我如何编写该控制代码吗？

标签： rshiny

Answer 1

由于您的应用程序将由可以访问 URL 的多个人使用，因此简单的方法是创建一个全局 .rds文件，只要导入 .csv 文件，所有用户都可以访问该文件。

 data <- read.csv(input$file$datapath)

 # Create a folder named srcdata under www folder in your app directory
 # Save the data object as a .rds file with system date appended to the file name
 saveRDS(data,paste0("www/srcdata/data_",Sys.Date()))

但是，我们每天只需要创建一次这个.rds文件。如果当前日期的文件已经存在，我们可以

1. 跳过此步骤，直接读取文件
2. 隐藏 UI 中的输入字段

所以代码变成了

filePresent <- list.files("www/srcdata/", pattern = paste0("data_",Sys.Date()))

# if file is present, disable the input field and read from the saved .rds
# if file is not present, show the input field

 if(length(filePresent)==1){
        data <- readRDS(paste0("www/srcdata/data_",Sys.Date()))
        filedata$notPresent <- FALSE
      }else{
        shinyjs::show("file")
      }

在这里，我们shinyjs用于显示和隐藏字段。所以你需要安装那个包（如果还没有的话）并在你的代码中调用它。此外，此代码应在每次应用程序初始化时运行，以便用户可以看到数据（如果有保存的文件）或看到输入字段以导入文件。

我已经更新了代码来实现这个

library(shiny)
library(shinydashboard)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- dashboardPage(
  dashboardHeader(title = "Upload Stats"),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    box(
      title = "UPTIME:", width = 12, 
      div(column(width = 4, hidden(fileInput(inputId = "file", label = "import", accept = ".csv"))),
          column(width = 8, valueBoxOutput("stats"))
      )
    ) 
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  filedata <- reactiveValues(notPresent = TRUE)

  observeEvent(filedata$notPresent,{
    if(filedata$notPresent){

      filePresent <- list.files("www/srcdata/", pattern = paste0("data_",Sys.Date()))

      if(length(filePresent)==1){
        data <- readRDS(paste0("www/srcdata/data_",Sys.Date()))
        filedata$notPresent <- FALSE
      }else{
        shinyjs::show("file")
      }

    }

  })
  output$stats <- renderValueBox({
    req(input$file)
    data <- read.csv(input$file$datapath)
    saveRDS(data,paste0("www/srcdata/data_",Sys.Date()))
    valueBox("scr1", sum(data[,2]), width = 12)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

希望这可以帮助！