Display selected folder path in Shiny
In the server function, use renderText instead of renderPrint:
library(shiny)
library(shinyFiles)
# Define UI for application that draws a histogram
ui <- fluidPage( # Application title
mainPanel(
shinyDirButton("dir", "Input directory", "Upload"),
verbatimTextOutput("dir", placeholder = TRUE) # added a placeholder
))
server <- function(input, output) {
shinyDirChoose(
input,
'dir',
roots = c(home = '~'),
filetypes = c('', 'txt', 'bigWig', "tsv", "csv", "bw")
)
dir <- reactive(input$dir)
output$dir <- renderText({ # use renderText instead of renderPrint
parseDirPath(c(home = '~'), dir())
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
input$dir
},
handlerExpr = {
home <- normalizePath("~")
datapath <<-
file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
})
}
# Run the application
shinyApp(ui = ui, server = server)
How to select a directory and output the selected directory in R Shiny
You could consider the shinyFiles package.
On server side you useshinyDirChoose(input, id = 'folder', ...) and then can access the chosen folder via input$folder.
Reproducible example:
library(shiny)
library(shinyFiles)
shinyApp(
shinyUI(bootstrapPage(
shinyDirButton('folder', 'Select a folder', 'Please select a folder', FALSE)
)),
shinyServer(function(input, output) {
shinyDirChoose(input, 'folder', roots=c(wd='.'), filetypes=c('', 'txt'))
observe({
print(input$folder)
})
})
)
Get the path for a folder chosen by user in shiny
That's because you wrote Btn_Folder instead of folder here:
observe({
if(!is.null(input$Btn_Folder)){
shinyDirChoose(input, 'folder', roots=volumes)
dir <- reactive(input$folder)
output$dir <- renderText(as.character(dir()))
}
})
Replace with:
observe({
if(!is.null(input$folder)){
shinyDirChoose(input, 'folder', roots=volumes)
dir <- reactive(input$folder)
output$dir <- renderText(as.character(dir()))
}
})
As a side note, you don't need to define this reactive conductor inside the observer, simply do:
observe({
if(!is.null(input$folder)){
shinyDirChoose(input, 'folder', roots=volumes)
output$dir <- renderText(as.character(input$folder))
}
})
shinyFiles folder selection: display the default folder
Concerning "beyond" displaying you could save the datapath variable in a reactiveValue and set the working directory as the default:
global <- reactiveValues(datapath = getwd())
And the app:
library(shiny)
library(shinyFiles)
ui <- fluidPage( # Application title
mainPanel(
shinyDirButton("dir", "Input directory", "Upload"),
verbatimTextOutput("dir", placeholder = TRUE)
))
server <- function(input, output) {
shinyDirChoose(
input,
'dir',
roots = c(home = '~'),
filetypes = c('', 'txt', 'bigWig', "tsv", "csv", "bw")
)
global <- reactiveValues(datapath = getwd())
dir <- reactive(input$dir)
output$dir <- renderText({
global$datapath
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
input$dir
},
handlerExpr = {
home <- normalizePath("~")
global$datapath <-
file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Display a folder structure in shiny app body as a box not a pop-up
Here is a first version of the app I talked about in my comment. Its advantage is that the contents of a folder are loaded only when the user selects this folder, and only the first descendants are loaded, no recursion.
App folder structure:
C:\PATH\TO\MYAPP
| global.R
| server.R
| ui.R
|
\---www
navigator.css
navigator.js
File global.R:
library(shiny)
library(jsTreeR)
library(htmlwidgets)
library(magrittr)
library(shinyFiles)
roots <- c(wd = "C:/SL/MyPackages/", getVolumes()())
File 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())
}
)
})
File 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")
)
)
)
)
))
File 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;
}
File 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);
}
});
});
(I am the author of jsTreeR and I think I will do a Shiny module for this folder navigator and include it in the package.)
EDIT
I improved the app and it uses the proton theme now, which looks more pretty to me:
To use this app, you first need the updated version of the package:
remotes::install_github("stla/jsTreeR")
There are some changes in three files:
- 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);
}
});
});
EDIT 2
The new version of the package provides a Shiny module allowing to conveniently renders such a 'tree navigator' (or even several ones). This is the example given in the package:
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)
Getting file path from Shiny UI (Not just directory) using browse button without uploading the file
This functionality is available in the shinyFiles package. Have a look at this minimal example:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("Btn_GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
textOutput("txt_file")
)
server <- function(input,output,session){
volumes = getVolumes()
observe({
shinyFileChoose(input, "Btn_GetFile", roots = volumes, session = session)
if(!is.null(input$Btn_GetFile)){
# browser()
file_selected<-parseFilePaths(volumes, input$Btn_GetFile)
output$txt_file <- renderText(as.character(file_selected$datapath))
}
})
}
shinyApp(ui = ui, server = server)
Related Topics
Finding Number of Elements in One Vector That Are Less Than an Element in Another Vector
R: Read in Random Rows from File Using Fread or Equivalent
Removing Row with Duplicated Values in All Columns of a Data Frame (R)
Split a Column to Multiple Columns
Merge Multiple Data.Frames in R with Varying Row Length
Object 'C_Stri_Join' Not Found - Using Knitr in Rstudio
Total Mean & Mean by Groups in R with Dplyr
Rank Vector with Some Equal Values
How to Get a Minimum Value by Group
R Convert String Date (E.G. "October 1, 2014") to Date Format
Removing Unicode Symbols from Column Names
Create All Subvectors of a Certain Length (Moving Window)
Converting Multiple Boolean Columns to Single Factor Column
Control Padding of Grobs Added to Patchwork
Reshape Data from Long to Wide Format - More Than One Variable
How Is Ggplot2 Plus Operator Defined
Filter a Column Which Contains Several Keywords
How to Automate Nested Sections in Rmds Which Include Text, Maps and Tables