Shiny 应用程序 (R) 中的交互式目录输入

Question

我正在构建一个闪亮的应用程序，它要求用户 select 本地计算机上的一个文件夹，其中包含应用程序要处理的文件。

我正在使用 here 提出的解决方案。这在本地机器上运行良好，但如果应用程序部署到 shinyapps 服务器上则不起作用。此解决方案的作者确认它仅设计用于本地 Shiny 应用程序，因为它会调用 OS shell 来显示目录对话框。

我想知道目录对话框是否有不同的解决方案，它适用于已部署的 Shiny 应用程序（我正在部署到 shinyapps.io）。

已编辑：请注意我不能使用 fileInput 界面有两个原因：

该应用的用户不是技术人员，他们不知道该应用使用了文件夹中的哪些文件。
selected 文件夹可能包含所需文件所在的其他文件夹，因此不可能一次 select 所有文件，即使 fileInput 接口具有 multiple 选项已启用。

folder/files 结构不是我可以更改的，它是从医疗设备按原样下载的，因此我唯一可以期望用户指定父文件夹，其余的应该是在 R 代码中完成。

Answer 1

您是否尝试过 shinyFiles 软件包？有一个小部件可以让您选择一个目录。作为输出，您将获得该目录的路径，您可以使用该目录访问文件。这是它如何工作的示例。

服务器

library(shiny)
library(shinyFiles)

shinyServer(function(input, output, session) {

  # dir
  shinyDirChoose(input, 'dir', roots = c(home = '~'), filetypes = c('', 'txt'))
  dir <- reactive(input$dir)
  output$dir <- renderPrint(dir())

  # path
  path <- reactive({
    home <- normalizePath("~")
    file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
  })

  # files
  output$files <- renderPrint(list.files(path()))
})

ui

library(shiny)
library(shinyFiles)

shinyUI(fluidPage(sidebarLayout(

  sidebarPanel(
    shinyDirButton("dir", "Chose directory", "Upload")
  ),

  mainPanel(
    h4("output$dir"),
    verbatimTextOutput("dir"), br(),
    h4("Files in that dir"),
    verbatimTextOutput("files")
  )

)))

希望对您有所帮助。

Answer 2

这是一个基于使用 "webkitdirectory" 属性的工作示例。目前该属性被 Chrome、Opera 和 Safari（移动和桌面）支持，并且应该在 9 月发布的 Firefox 49 中支持。有关此 here 的更多信息。它也适用于子目录。

需要在ui.R中使用tags关键字。我通过上传三个 csv 文件对其进行了测试，每个文件包含三个由逗号分隔的数字。在本地和 shinyapps.io 上使用 Chrome 和 Opera 进行了测试。这是代码：

ui.R

    library(shiny)
    library(DT)

    shinyUI(tagList(fluidPage(theme = "bootstrap.css",
                      includeScript("./www/text.js"),
                      titlePanel("Folder content upload"),

                      fluidRow(
                              column(4,
                                     wellPanel(
                                             tags$div(class="form-group shiny-input-container", 
                                                      tags$div(tags$label("File input")),
                                                      tags$div(tags$label("Choose folder", class="btn btn-primary",
                                                                          tags$input(id = "fileIn", webkitdirectory = TRUE, type = "file", style="display: none;", onchange="pressed()"))),
                                                      tags$label("No folder choosen", id = "noFile"),
                                                      tags$div(id="fileIn_progress", class="progress progress-striped active shiny-file-input-progress",
                                                               tags$div(class="progress-bar")
                                                      )     
                                             ),
                                             verbatimTextOutput("results")
                                     )
                              ),
                              column(8,
                                     tabsetPanel(
                                             tabPanel("Files table", dataTableOutput("tbl")),
                                             tabPanel("Files list", dataTableOutput("tbl2"))
                                     )
                              )
                      )
    ),
    HTML("<script type='text/javascript' src='getFolders.js'></script>")
    )

    )

server.R

    library(shiny)
    library(ggplot2)
    library(DT)

    shinyServer(function(input, output, session) {
            df <- reactive({
                    inFiles <- input$fileIn
                    df <- data.frame()
                    if (is.null(inFiles))
                            return(NULL)
                    for (i in seq_along(inFiles$datapath)) {
                            tmp <- read.csv(inFiles$datapath[i], header = FALSE)  
                            df <- rbind(df, tmp)
                    }
                    df

            })
            output$tbl <- DT::renderDataTable(
                    df()
            )
            output$tbl2 <- DT::renderDataTable(
                    input$fileIn
            )
            output$results = renderPrint({
                    input$mydata
            })

    })

text.js

window.pressed = function(){
        var a = document.getElementById('fileIn');
        if(a.value === "")
        {
            noFile.innerHTML = "No folder choosen";
        }
        else
        {
            noFile.innerHTML = "";
        }
    };

getFolders.js

     document.getElementById("fileIn").addEventListener("change", function(e) {

            let files = e.target.files;
            var arr = new Array(files.length*2);
            for (let i=0; i<files.length; i++) {

            //console.log(files[i].webkitRelativePath);
            //console.log(files[i].name);
            arr[i] = files[i].webkitRelativePath;
            arr[i+files.length] = files[i].name;


            }

            Shiny.onInputChange("mydata", arr);

    });

如果有帮助请告诉我。

Shiny 应用程序 (R) 中的交互式目录输入

Interactive directory input in Shiny app (R)

directory

r

shiny

shiny-server

服务器

ui