问题

问题

我正在制作一个允许人们向CSV文件添加数据的应用程序。为了避免我的同事看到任何代码，我希望这个应用程序是服务器端的，例如在shinyapps.io上。目前，我已经尝试过fileinput()和shinyFiles：当我的应用程序在我的本地PC上运行时（参见MWEs），它们可以正常工作，但当我部署到shinyapps.io时就不起作用了。

这种情况能够解决吗，还是总会出现从服务器写入本地目录的问题？

对于fileinput()的MWE

library(shiny)
library(shinyWidgets)
library(dplyr) # 用于bind_rows

# 定义UI
ui = fluidPage(
    fileInput("my_file", "添加到主表", accept = ".csv"), # 文件上传
    actionButton("submit_btn", "提交数据") # 提交按钮
)

# 定义服务器逻辑
server = function(input, output) {
    observeEvent(input$submit_btn, {
        my_data = read.csv(input$my_file$datapath) # 读取我的数据
        my_new_data = bind_rows(my_data, data.frame(5)) # 添加新数据
        write.csv(my_new_data, input$my_file$name) # 写入更新后的文件
        stopApp() # 关闭应用程序
    })
}

# 运行应用程序
shinyApp(ui, server)

这个例子在应用程序在我的本地计算机上运行时可以正常工作，但即使在那种情况下，它也只会将新的.csv文件保存在与应用程序相同的位置。使用input$my_file$datapath也不起作用。当应用程序在shinyapps.io上时，文件不会得到更新。

对于shinyFiles()的MWE

library(shiny)
library(shinyFiles)
library(shinyWidgets)
library(dplyr)

# 定义UI
ui = fluidPage(
    shinyFilesButton("file_upload", "选择CSV文件", title = "上传", multiple = FALSE),
    verbatimTextOutput("file_status", placeholder = TRUE),  # 在上传文件之前将显示占位符文本
    actionButton("submit_btn", "提交数据"),
)

server <- function(input, output, session) {
    
    volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
    shinyFileChoose(input, "file_upload", roots = volumes, filetypes = c('', 'csv'), session = session)
    observe({
        if (!is.null(input$file_upload)) {
            file_info <- parseFilePaths(volumes, input$file_upload)
            output$file_status <- renderText(paste("已选择文件:", file_info$name))
        }
    })

    observeEvent(input$submit_btn, {
        infile = parseFilePaths(volumes, input$file_upload)
        my_data = read.csv(infile$datapath) # 读取我的数据
        my_new_data = bind_rows(my_data, data.frame(5)) # 添加新数据
        write.csv(my_new_data, infile$datapath) # 写入更新后的文件
        stopApp() # 关闭应用程序
    })
}

shinyApp(ui, server)

同样，这在我的本地PC上运行时可以正常工作，但在shinyapps.io上，大多数系统文件在我点击“上传文件”时都没有显示出来。

library(shiny)
library(shinyWidgets)
library(dplyr) # For bind_rows

# Define UI
ui = fluidPage(
    fileInput("my_file", "Add to Master Sheet", accept = ".csv"), # File upload
    actionButton("submit_btn", "Submit data") # Submit button
)

# Define Server Logic
server = function(input, output) {
    observeEvent(input$submit_btn, {
        my_data = read.csv(input$my_file$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, input$my_file$name) # Write the updated file
        stopApp() # Close app
    })
    
}

# Run the application
shinyApp(ui, server)

library(shiny)
library(shinyFiles)
library(shinyWidgets)
library(dplyr)

# Define UI
ui = fluidPage(
    shinyFilesButton("file_upload", "Choose a CSV file", title = "Upload", multiple = FALSE),
    verbatimTextOutput("file_status", placeholder = TRUE),  # Placeholder text will be shown until a file is uploaded
    actionButton("submit_btn", "Submit data"),
)

server <- function(input, output, session) {
    
    volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
    shinyFileChoose(input, "file_upload", roots = volumes, filetypes = c('', 'csv'), session = session)
    observe({
        if (!is.null(input$file_upload)) {
            file_info <- parseFilePaths(volumes, input$file_upload)
            output$file_status <- renderText(paste("Selected file:", file_info$name))
        }
    })

    observeEvent(input$submit_btn, {
        infile = parseFilePaths(volumes, input$file_upload)
        my_data = read.csv(infile$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, infile$datapath) # Write the updated file
        stopApp() # Close app
    })
}

shinyApp(ui, server)

答案1

得分: 2

服务器可以访问用户的本地文件系统/驱动器的想法违反了大多数安全姿态，即使服务器支持，大多数浏览器也不会（也不应该！）允许。相反，让用户上传他们的数据（一个或多个文件），然后对其进行一些操作（可能是交互式的），然后让他们下载结果。

数据设置：

```r
write.csv(mtcars, "mt.csv", row.names=FALSE)

从这里开始一个简单的应用程序：

library(shiny)
ui <- fluidPage(
  shinyjs::useShinyjs(),  # 设置 shinyjs
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      fileInput("infile", "上传文件！"),
      actionButton("act", "对其进行操作！"),
      downloadButton("dwnld", "取回结果！")
    ),
    mainPanel(
      DT::DTOutput("tbl")
    )
  )
)
server <- function(input, output, session) {
  shinyjs::disable("act")
  shinyjs::disable("dwnld")
  userdata <- reactiveVal(NULL)
  observeEvent(input$infile, {
    req(file.exists(input$infile$datapath))
    tmp <- tryCatch(
      read.csv(input$infile$datapath),
      error = function(e) e)
    validate(
      need(!inherits(tmp, "error"), "读取文件时出错")
    )
    shinyjs::enable("act")
    shinyjs::enable("dwnld")
    userdata(tmp)
  })
  observeEvent(input$act, {
    req(userdata())
    dat <- userdata()
    dat[[1]] <- dat[[1]] + 100
    userdata(dat)
  })
  output$tbl <- DT::renderDT({
    req(userdata())
  })
  output$dwnld <- downloadHandler(
    filename = function() {
      sprintf("%s_updated_%s.csv", tools::file_path_sans_ext(input$infile$name),
              format(Sys.Date(), format = "%Y%m%d"))
    },
    content = function(file) {
      write.csv(userdata(), file, row.names = FALSE)
    }
  )
}
shinyApp(ui, server)

我只是使用 shinyjs 来禁用 "进行操作" 和 "下载" 按钮；这不是必需的，但我发现在上传之前就能下载东西的界面可能会有问题。

从这里开始：

点击 "浏览" 并上传我们上面的 mt.csv，

我点击了 "对其进行操作" 几次（这只是为了演示，不是必需的），请注意 mpg 增加了：

点击 "取回结果！" 下载按钮，你将得到一个新的文件名。我会花一些功夫来智能地重命名文件，你可以按照自己的想法命名。

<details>
<summary>英文:</summary>

The notion that the server would have access to the user&#39;s local filesystem/drive is counter to most security postures, and even if the server supported it, most browsers will not (should not!) allow it. Instead, have the user upload their data (one or more files), you do something to it (perhaps interactively), and then have them download the results.

Data setup:

```r
write.csv(mtcars, &quot;mt.csv&quot;, row.names=FALSE)

From here, a simple app:

library(shiny)
ui <- fluidPage(
  shinyjs::useShinyjs(),  # Set up shinyjs
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      fileInput("infile", "Upload something!"),
      actionButton("act", "Do something to it!"),
      downloadButton("dwnld", "Get it back!")
    ),
    mainPanel(
      DT::DTOutput("tbl")
    )
  )
)
server <- function(input, output, session) {
  shinyjs::disable("act")
  shinyjs::disable("dwnld")
  userdata <- reactiveVal(NULL)
  observeEvent(input$infile, {
    req(file.exists(input$infile$datapath))
    tmp <- tryCatch(
      read.csv(input$infile$datapath),
      error = function(e) e)
    validate(
      need(!inherits(tmp, "error"), "Error reading file")
    )
    shinyjs::enable("act")
    shinyjs::enable("dwnld")
    userdata(tmp)
  })
  observeEvent(input$act, {
    req(userdata())
    dat <- userdata()
    dat[[1]] <- dat[[1]] + 100
    userdata(dat)
  })
  output$tbl <- DT::renderDT({
    req(userdata())
  })
  output$dwnld <- downloadHandler(
    filename = function() {
      sprintf("%s_updated_%s.csv", tools::file_path_sans_ext(input$infile$name),
              format(Sys.Date(), format = "%Y%m%d"))
    },
    content = function(file) {
      write.csv(userdata(), file, row.names = FALSE)
    }
  )
}
shinyApp(ui, server)

I'm using shinyjs solely to disable the "do something" and "download" buttons; not required, but I find interfaces that suggest I can download something before uploading something might have problems.

From here, we start with:

Click on "Browse" and upload our mt.csv from above,

I clicked the "do something" several times (this is just for show here, not strictly required), note that mpg is increased:

Click, the Get it back! download button and you'll have a new filename. I go through some effort to rename the file "smartly", you can name it however you want.