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

Interactive directory input in Shiny app (R)

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

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

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

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

  • 该应用程序的用户不是技术人员,他们不知道该文件夹中的哪些文件被该应用程序使用。
  • 所选文件夹可能包含其他文件夹,其中包含所需文件,因此即使 fileInput 界面启用了 multiple 选项,也无法一次选择所有文件。
  • 文件夹/文件结构不是我可以更改的,它是从医疗设备上按原样下载的,因此我唯一能从用户那里得到的就是指定父文件夹,其余的应该在 R 中完成代码。


    这是一个基于使用 "webkitdirectory" 属性的工作示例。目前该属性已被 Chrome、Opera 和 Safari(移动和桌面)支持,应该会在 9 月发布的 Firefox 49 中得到支持。
    更多关于这里。它也适用于子目录。

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

    ui.R

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
        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'>")
        )

        )

    服务器.R

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
        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

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    window.pressed = function(){
            var a = document.getElementById('fileIn');
            if(a.value ==="")
            {
                noFile.innerHTML ="No folder choosen";
            }
            else
            {
                noFile.innerHTML ="";
            }
        };

    getFolders.js

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
         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);

        });

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


    你试过 shinyFiles 包吗?
    有一个小部件可让您选择目录。
    作为输出,您将获得该目录的路径,然后您可以使用该路径访问文件。
    这是一个如何工作的示例。

    服务器

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    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()))
    })

    用户界面

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    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")
      )

    )))

    希望这会有所帮助。