在闪亮的应用程序主体中将文件夹结构显示为框而不是弹出窗口
Display a folder structure in shiny app body as a box not a pop-up
我想在我闪亮的应用程序中有一个框，用户可以浏览到文件夹结构和 select 要下载的文件。
我试过 shinyFiles 但文件 selection 是一个弹出窗口 window，我只能下载一个文件 :
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton('files', label='File select', title='Please select a file', multiple=T) ,
verbatimTextOutput('rawInputValue'),
verbatimTextOutput('filepaths') ,
downloadButton("downloadFiles", "Download Files")
)
server <- function(input, output) {
roots = c(wd = 'H:/')
shinyFileChoose(input, 'files',
roots = roots,
filetypes=c('', 'txt' , 'gz' , 'md5' , 'pdf' , 'fasta' , 'fastq' , 'aln'))
output$rawInputValue <- renderPrint({str(input$files)})
output$filepaths <- renderPrint({parseFilePaths(roots, input$files)})
output$downloadFiles <- downloadHandler(
filename = function() {
as.character(parseFilePaths(roots, input$files)$name)
},
content = function(file) {
fullName <- as.character(parseFilePaths(roots, input$files)$datapath)
file.copy(fullName, file)
}
)
}
shinyApp(ui = ui , server = server)
我想要的是让文件 selection 选项像
在 ui 内，不是新的（弹出窗口）window !
这是我在评论中提到的应用程序的第一个版本。它的优点是只有当用户选择这个文件夹时才加载文件夹的内容，并且只加载第一个后代，没有递归。
App文件夹结构：
C:\PATH\TO\MYAPP
| global.R
| server.R
| ui.R
|
\---www
navigator.css
navigator.js
文件global.R:
library(shiny)
library(jsTreeR)
library(htmlwidgets)
library(magrittr)
library(shinyFiles)
roots <- c(wd = "C:/SL/MyPackages/", getVolumes()())
文件server.R:
shinyServer(function(input, output, session){
shinyDirChoose(
input, "rootfolder", roots = roots,
allowDirCreate = FALSE, defaultRoot = "wd"
)
RootFolder <- eventReactive(input[["rootfolder"]], {
parseDirPath(roots, input[["rootfolder"]])
})
output[["choice"]] <- reactive({
isTruthy(RootFolder())
})
outputOptions(output, "choice", suspendWhenHidden = FALSE)
output[["navigator"]] <- renderJstree({
req(isTruthy(RootFolder()))
jstree(
nodes = list(
list(
text = RootFolder(),
type = "folder",
children = FALSE,
li_attr = list(
class = "jstree-x"
)
)
),
types = list(
folder = list(
icon = "fa fa-folder gold"
),
file = list(
icon = "far fa-file red"
)
),
checkCallback = TRUE,
theme = "default",
checkboxes = TRUE,
search = TRUE,
selectLeavesOnly = TRUE
) %>% onRender("function(el, x){tree = $(el).jstree(true);}")
})
observeEvent(input[["path"]], {
lf <- list.files(input[["path"]], full.names = TRUE)
fi <- file.info(lf, extra_cols = FALSE)
x <- list(
elem = as.list(basename(lf)),
folder = as.list(fi[["isdir"]])
)
session$sendCustomMessage("getChildren", x)
})
Paths <- reactive({
vapply(
input[["navigator_selected_paths"]], `[[`,
character(1L), "path"
)
})
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
output[["dwnld"]] <- downloadHandler(
filename = "myfiles.zip",
content = function(file){
zip(file, files = Paths())
}
)
})
文件ui.R:
shinyUI(fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "navigator.css"),
tags$script(src = "navigator.js")
),
br(),
conditionalPanel(
condition = "!output.choice",
fluidRow(
column(
width = 12,
shinyDirButton(
"rootfolder",
label = "Browse to choose a root folder",
title = "Choose a folder",
buttonType = "primary",
class = "btn-block"
)
)
)
),
conditionalPanel(
condition = "output.choice",
style = "display: none;",
fluidRow(
column(
width = 6,
jstreeOutput("navigator")
),
column(
width = 6,
tags$fieldset(
tags$legend(
tags$h1("Selections:", style = "float: left;"),
downloadButton(
"dwnld",
class = "btn-primary btn-lg",
icon = icon("save"),
style = "float: right;"
)
),
verbatimTextOutput("selections")
)
)
)
)
))
文件navigator.css:
.jstree-default .jstree-x.jstree-closed > .jstree-icon.jstree-ocl,
.jstree-default .jstree-x.jstree-leaf > .jstree-icon.jstree-ocl {
background-position: -100px -4px;
}
.red {
color: red;
}
.gold {
color: gold;
}
.jstree-proton {
font-weight: bold;
}
.jstree-anchor {
font-size: medium;
}
文件navigator.js:
var tree;
$(document).ready(function () {
var Children = null;
Shiny.addCustomMessageHandler("getChildren", function (x) {
Children = x;
});
$("#navigator").on("click", "li.jstree-x > i", function (e) {
var $li = $(this).parent();
if (!$li.hasClass("jstree-x")) {
alert("that should not happen...");
return;
}
var id = $li.attr("id");
var node = tree.get_node(id);
if (tree.is_leaf(node) && node.original.type === "folder") {
var path = tree.get_path(node, "/");
Shiny.setInputValue("path", path);
var interval = setInterval(function () {
if (Children !== null) {
clearInterval(interval);
for (var i = 0; i < Children.elem.length; i++) {
var isdir = Children.folder[i];
var newnode = tree.create_node(id, {
text: Children.elem[i],
type: isdir ? "folder" : "file",
children: false,
li_attr: isdir ? { class: "jstree-x" } : null
});
}
Children = null;
setTimeout(function () {
tree.open_node(id);
}, 10);
}
}, 100);
}
});
});
（我是 jsTreeR 的作者，我想我会为这个文件夹导航器做一个 Shiny 模块并将其包含在包中。）
编辑
我改进了应用程序，它现在使用 proton 主题，我觉得它更漂亮：
要使用此应用程序，您首先需要更新版本的软件包：
remotes::install_github("stla/jsTreeR")
三个文件有一些变化：
- server.R:
shinyServer(function(input, output, session){
shinyDirChoose(
input, "rootfolder", roots = roots,
allowDirCreate = FALSE, defaultRoot = "wd"
)
RootFolder <- eventReactive(input[["rootfolder"]], {
parseDirPath(roots, input[["rootfolder"]])
})
output[["choice"]] <- reactive({
isTruthy(RootFolder())
})
outputOptions(output, "choice", suspendWhenHidden = FALSE)
output[["navigator"]] <- renderJstree({
req(isTruthy(RootFolder()))
jstree(
nodes = list(
list(
text = RootFolder(),
type = "folder",
children = FALSE,
li_attr = list(
class = "jstree-x"
)
)
),
types = list(
folder = list(
icon = "fa fa-folder gold"
),
file = list(
icon = "far fa-file red"
)
),
checkCallback = TRUE,
theme = "proton",
checkboxes = TRUE,
search = TRUE,
selectLeavesOnly = TRUE
)
})
observeEvent(input[["path"]], {
lf <- list.files(input[["path"]], full.names = TRUE)
fi <- file.info(lf, extra_cols = FALSE)
x <- list(
elem = as.list(basename(lf)),
folder = as.list(fi[["isdir"]])
)
session$sendCustomMessage("getChildren", x)
})
Paths <- reactive({
vapply(
input[["navigator_selected_paths"]], `[[`,
character(1L), "path"
)
})
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
output[["dwnld"]] <- downloadHandler(
filename = "myfiles.zip",
content = function(file){
zip(file, files = Paths())
}
)
})
- navigator.css:
.jstree-proton {
font-weight: bold;
}
.jstree-anchor {
font-size: medium;
}
.jstree-proton .jstree-x.jstree-closed > .jstree-icon.jstree-ocl,
.jstree-proton .jstree-x.jstree-leaf > .jstree-icon.jstree-ocl {
background-position: -101px -5px;
}
.jstree-proton .jstree-checkbox.jstree-checkbox-disabled {
background-position: -37px -69px;
}
.red {
color: red;
}
.gold {
color: gold;
}
- navigator.js:
$(document).ready(function () {
var tree;
var Children = null;
Shiny.addCustomMessageHandler("getChildren", function (x) {
Children = x;
});
$navigator = $("#navigator");
$navigator.one("ready.jstree", function (e, data) {
tree = data.instance;
tree.disable_checkbox("j1_1");
tree.disable_node("j1_1");
});
$navigator.on("after_open.jstree", function (e, data) {
tree.enable_checkbox(data.node);
tree.enable_node(data.node);
});
$navigator.on("after_close.jstree", function (e, data) {
tree.disable_checkbox(data.node);
tree.disable_node(data.node);
});
$navigator.on("click", "li.jstree-x > i", function (e) {
var $li = $(this).parent();
if (!$li.hasClass("jstree-x")) {
alert("that should not happen...");
return;
}
var id = $li.attr("id");
var node = tree.get_node(id);
if (tree.is_leaf(node) && node.original.type === "folder") {
var path = tree.get_path(node, "/");
Shiny.setInputValue("path", path);
var interval = setInterval(function () {
if (Children !== null) {
clearInterval(interval);
for (var i = 0; i < Children.elem.length; i++) {
var isdir = Children.folder[i];
var newnode = tree.create_node(id, {
text: Children.elem[i],
type: isdir ? "folder" : "file",
children: false,
li_attr: isdir ? { class: "jstree-x" } : null
});
if (isdir) {
tree.disable_checkbox(newnode);
tree.disable_node(newnode);
}
}
Children = null;
setTimeout(function () {
tree.open_node(id);
}, 10);
}
}, 100);
}
});
});
编辑 2
新版本的包提供了一个Shiny模块，可以方便地渲染这样一个'tree navigator'（甚至几个）。这是包中给出的示例：
library(shiny)
library(jsTreeR)
css <- HTML("
.flexcol {
display: flex;
flex-direction: column;
width: 100%;
margin: 0;
}
.stretch {
flex-grow: 1;
height: 1px;
}
.bottomright {
position: fixed;
bottom: 0;
right: 15px;
min-width: calc(50% - 15px);
}
")
ui <- fixedPage(
tags$head(
tags$style(css)
),
class = "flexcol",
br(),
fixedRow(
column(
width = 6,
treeNavigatorUI("explorer")
),
column(
width = 6,
tags$div(class = "stretch"),
tags$fieldset(
class = "bottomright",
tags$legend(
tags$h1("Selections:", style = "float: left;"),
downloadButton(
"dwnld",
class = "btn-primary btn-lg",
style = "float: right;",
icon = icon("save")
)
),
verbatimTextOutput("selections")
)
)
)
)
server <- function(input, output, session){
Paths <- treeNavigatorServer(
"explorer", rootFolder = getwd(),
search = list( # (search in the visited folders only)
show_only_matches = TRUE,
case_sensitive = TRUE,
search_leaves_only = TRUE
)
)
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
}
shinyApp(ui, server)
我想在我闪亮的应用程序中有一个框，用户可以浏览到文件夹结构和 select 要下载的文件。
我试过 shinyFiles 但文件 selection 是一个弹出窗口 window，我只能下载一个文件 :
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton('files', label='File select', title='Please select a file', multiple=T) ,
verbatimTextOutput('rawInputValue'),
verbatimTextOutput('filepaths') ,
downloadButton("downloadFiles", "Download Files")
)
server <- function(input, output) {
roots = c(wd = 'H:/')
shinyFileChoose(input, 'files',
roots = roots,
filetypes=c('', 'txt' , 'gz' , 'md5' , 'pdf' , 'fasta' , 'fastq' , 'aln'))
output$rawInputValue <- renderPrint({str(input$files)})
output$filepaths <- renderPrint({parseFilePaths(roots, input$files)})
output$downloadFiles <- downloadHandler(
filename = function() {
as.character(parseFilePaths(roots, input$files)$name)
},
content = function(file) {
fullName <- as.character(parseFilePaths(roots, input$files)$datapath)
file.copy(fullName, file)
}
)
}
shinyApp(ui = ui , server = server)
我想要的是让文件 selection 选项像
在 ui 内，不是新的（弹出窗口）window !
这是我在评论中提到的应用程序的第一个版本。它的优点是只有当用户选择这个文件夹时才加载文件夹的内容，并且只加载第一个后代，没有递归。
App文件夹结构：
C:\PATH\TO\MYAPP
| global.R
| server.R
| ui.R
|
\---www
navigator.css
navigator.js
文件global.R:
library(shiny)
library(jsTreeR)
library(htmlwidgets)
library(magrittr)
library(shinyFiles)
roots <- c(wd = "C:/SL/MyPackages/", getVolumes()())
文件server.R:
shinyServer(function(input, output, session){
shinyDirChoose(
input, "rootfolder", roots = roots,
allowDirCreate = FALSE, defaultRoot = "wd"
)
RootFolder <- eventReactive(input[["rootfolder"]], {
parseDirPath(roots, input[["rootfolder"]])
})
output[["choice"]] <- reactive({
isTruthy(RootFolder())
})
outputOptions(output, "choice", suspendWhenHidden = FALSE)
output[["navigator"]] <- renderJstree({
req(isTruthy(RootFolder()))
jstree(
nodes = list(
list(
text = RootFolder(),
type = "folder",
children = FALSE,
li_attr = list(
class = "jstree-x"
)
)
),
types = list(
folder = list(
icon = "fa fa-folder gold"
),
file = list(
icon = "far fa-file red"
)
),
checkCallback = TRUE,
theme = "default",
checkboxes = TRUE,
search = TRUE,
selectLeavesOnly = TRUE
) %>% onRender("function(el, x){tree = $(el).jstree(true);}")
})
observeEvent(input[["path"]], {
lf <- list.files(input[["path"]], full.names = TRUE)
fi <- file.info(lf, extra_cols = FALSE)
x <- list(
elem = as.list(basename(lf)),
folder = as.list(fi[["isdir"]])
)
session$sendCustomMessage("getChildren", x)
})
Paths <- reactive({
vapply(
input[["navigator_selected_paths"]], `[[`,
character(1L), "path"
)
})
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
output[["dwnld"]] <- downloadHandler(
filename = "myfiles.zip",
content = function(file){
zip(file, files = Paths())
}
)
})
文件ui.R:
shinyUI(fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "navigator.css"),
tags$script(src = "navigator.js")
),
br(),
conditionalPanel(
condition = "!output.choice",
fluidRow(
column(
width = 12,
shinyDirButton(
"rootfolder",
label = "Browse to choose a root folder",
title = "Choose a folder",
buttonType = "primary",
class = "btn-block"
)
)
)
),
conditionalPanel(
condition = "output.choice",
style = "display: none;",
fluidRow(
column(
width = 6,
jstreeOutput("navigator")
),
column(
width = 6,
tags$fieldset(
tags$legend(
tags$h1("Selections:", style = "float: left;"),
downloadButton(
"dwnld",
class = "btn-primary btn-lg",
icon = icon("save"),
style = "float: right;"
)
),
verbatimTextOutput("selections")
)
)
)
)
))
文件navigator.css:
.jstree-default .jstree-x.jstree-closed > .jstree-icon.jstree-ocl,
.jstree-default .jstree-x.jstree-leaf > .jstree-icon.jstree-ocl {
background-position: -100px -4px;
}
.red {
color: red;
}
.gold {
color: gold;
}
.jstree-proton {
font-weight: bold;
}
.jstree-anchor {
font-size: medium;
}
文件navigator.js:
var tree;
$(document).ready(function () {
var Children = null;
Shiny.addCustomMessageHandler("getChildren", function (x) {
Children = x;
});
$("#navigator").on("click", "li.jstree-x > i", function (e) {
var $li = $(this).parent();
if (!$li.hasClass("jstree-x")) {
alert("that should not happen...");
return;
}
var id = $li.attr("id");
var node = tree.get_node(id);
if (tree.is_leaf(node) && node.original.type === "folder") {
var path = tree.get_path(node, "/");
Shiny.setInputValue("path", path);
var interval = setInterval(function () {
if (Children !== null) {
clearInterval(interval);
for (var i = 0; i < Children.elem.length; i++) {
var isdir = Children.folder[i];
var newnode = tree.create_node(id, {
text: Children.elem[i],
type: isdir ? "folder" : "file",
children: false,
li_attr: isdir ? { class: "jstree-x" } : null
});
}
Children = null;
setTimeout(function () {
tree.open_node(id);
}, 10);
}
}, 100);
}
});
});
（我是 jsTreeR 的作者，我想我会为这个文件夹导航器做一个 Shiny 模块并将其包含在包中。）
编辑
我改进了应用程序，它现在使用 proton 主题，我觉得它更漂亮：
要使用此应用程序，您首先需要更新版本的软件包：
remotes::install_github("stla/jsTreeR")
三个文件有一些变化：
- server.R:
shinyServer(function(input, output, session){
shinyDirChoose(
input, "rootfolder", roots = roots,
allowDirCreate = FALSE, defaultRoot = "wd"
)
RootFolder <- eventReactive(input[["rootfolder"]], {
parseDirPath(roots, input[["rootfolder"]])
})
output[["choice"]] <- reactive({
isTruthy(RootFolder())
})
outputOptions(output, "choice", suspendWhenHidden = FALSE)
output[["navigator"]] <- renderJstree({
req(isTruthy(RootFolder()))
jstree(
nodes = list(
list(
text = RootFolder(),
type = "folder",
children = FALSE,
li_attr = list(
class = "jstree-x"
)
)
),
types = list(
folder = list(
icon = "fa fa-folder gold"
),
file = list(
icon = "far fa-file red"
)
),
checkCallback = TRUE,
theme = "proton",
checkboxes = TRUE,
search = TRUE,
selectLeavesOnly = TRUE
)
})
observeEvent(input[["path"]], {
lf <- list.files(input[["path"]], full.names = TRUE)
fi <- file.info(lf, extra_cols = FALSE)
x <- list(
elem = as.list(basename(lf)),
folder = as.list(fi[["isdir"]])
)
session$sendCustomMessage("getChildren", x)
})
Paths <- reactive({
vapply(
input[["navigator_selected_paths"]], `[[`,
character(1L), "path"
)
})
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
output[["dwnld"]] <- downloadHandler(
filename = "myfiles.zip",
content = function(file){
zip(file, files = Paths())
}
)
})
- navigator.css:
.jstree-proton {
font-weight: bold;
}
.jstree-anchor {
font-size: medium;
}
.jstree-proton .jstree-x.jstree-closed > .jstree-icon.jstree-ocl,
.jstree-proton .jstree-x.jstree-leaf > .jstree-icon.jstree-ocl {
background-position: -101px -5px;
}
.jstree-proton .jstree-checkbox.jstree-checkbox-disabled {
background-position: -37px -69px;
}
.red {
color: red;
}
.gold {
color: gold;
}
- navigator.js:
$(document).ready(function () {
var tree;
var Children = null;
Shiny.addCustomMessageHandler("getChildren", function (x) {
Children = x;
});
$navigator = $("#navigator");
$navigator.one("ready.jstree", function (e, data) {
tree = data.instance;
tree.disable_checkbox("j1_1");
tree.disable_node("j1_1");
});
$navigator.on("after_open.jstree", function (e, data) {
tree.enable_checkbox(data.node);
tree.enable_node(data.node);
});
$navigator.on("after_close.jstree", function (e, data) {
tree.disable_checkbox(data.node);
tree.disable_node(data.node);
});
$navigator.on("click", "li.jstree-x > i", function (e) {
var $li = $(this).parent();
if (!$li.hasClass("jstree-x")) {
alert("that should not happen...");
return;
}
var id = $li.attr("id");
var node = tree.get_node(id);
if (tree.is_leaf(node) && node.original.type === "folder") {
var path = tree.get_path(node, "/");
Shiny.setInputValue("path", path);
var interval = setInterval(function () {
if (Children !== null) {
clearInterval(interval);
for (var i = 0; i < Children.elem.length; i++) {
var isdir = Children.folder[i];
var newnode = tree.create_node(id, {
text: Children.elem[i],
type: isdir ? "folder" : "file",
children: false,
li_attr: isdir ? { class: "jstree-x" } : null
});
if (isdir) {
tree.disable_checkbox(newnode);
tree.disable_node(newnode);
}
}
Children = null;
setTimeout(function () {
tree.open_node(id);
}, 10);
}
}, 100);
}
});
});
编辑 2
新版本的包提供了一个Shiny模块，可以方便地渲染这样一个'tree navigator'（甚至几个）。这是包中给出的示例：
library(shiny)
library(jsTreeR)
css <- HTML("
.flexcol {
display: flex;
flex-direction: column;
width: 100%;
margin: 0;
}
.stretch {
flex-grow: 1;
height: 1px;
}
.bottomright {
position: fixed;
bottom: 0;
right: 15px;
min-width: calc(50% - 15px);
}
")
ui <- fixedPage(
tags$head(
tags$style(css)
),
class = "flexcol",
br(),
fixedRow(
column(
width = 6,
treeNavigatorUI("explorer")
),
column(
width = 6,
tags$div(class = "stretch"),
tags$fieldset(
class = "bottomright",
tags$legend(
tags$h1("Selections:", style = "float: left;"),
downloadButton(
"dwnld",
class = "btn-primary btn-lg",
style = "float: right;",
icon = icon("save")
)
),
verbatimTextOutput("selections")
)
)
)
)
server <- function(input, output, session){
Paths <- treeNavigatorServer(
"explorer", rootFolder = getwd(),
search = list( # (search in the visited folders only)
show_only_matches = TRUE,
case_sensitive = TRUE,
search_leaves_only = TRUE
)
)
output[["selections"]] <- renderPrint({
cat(Paths(), sep = "\n")
})
}
shinyApp(ui, server)