Shiny app(R)中的交互式目录输入

Question

我正在构建一个闪亮的应用程序,需要用户在本地计算机上选择一个文件夹,其中包含应用程序要处理的文件.

我正在使用这里提出的解决方案.这在本地计算机上工作正常,但如果将应用程序部署到shinyapps服务器则不起作用.该解决方案的作者证实,它仅用于与本地Shiny应用程序一起使用,因为它使OS shell调用显示目录对话框.

我想知道目录对话框是否有不同的解决方案,这将适用于已部署的Shiny应用程序(我正在部署到shinyapps.io).

编辑:请注意我不能使用fileInput接口有两个原因:

1. 该应用程序的用户不是技术人员,他们不知道该应用程序使用该文件夹中的哪些文件.
2. 所选文件夹可能包含所需文件所在的其他文件夹,因此即使fileInput接口multiple启用了该选项,也无法一次选择所有文件.

文件夹/文件结构不是我可以更改的,它是从医疗设备原样下载的,因此我唯一可以期待用户的是指定父文件夹,其余的应该在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(移动和桌面)的支持,Firefox 49将在9月份发布.更多关于这里.它也适用于子目录.

它需要在ui.R中使用tags关键字.我已经通过上传三个csv文件进行了测试,每个文件包含三个被昏迷分开的数字.使用Chrome和Opera在本地和shinyapps.io上进行测试.这是代码:

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);

    });

如果这有帮助,请告诉我.