i got a shiny app where the User must select a file to be processed further.
The shinyFilesButton lets me do exactly that - BUT, the file selection always starts at the root directory (in my case C:). Is it possible to let the file selection start at a specific directory? For example, i would like the file selection to start at "C:\Users\admin\Documents"
This would greatly improve usability.
Thank in advance!
Patrick
MWE
library(shiny)
# Define UI ----
ui <- fluidPage(
shinyFilesButton("filePath", "Please Select File", title = "Select File", multiple = FALSE,
buttonType = "default", class = NULL),
br(),
br(),
textOutput("inputFile")
)
# Define server logic ----
server <- function(input, output, session) {
volumes = getVolumes()
observe({
shinyFileChoose(input, "filePath", roots = volumes, session = session)
if(!is.null(input$filePath)){
# browser()
input_file_selected <- parseFilePaths(volumes, input$filePath)
output$inputFile <- renderText({
paste("File Path: ", as.character(input_file_selected$datapath))
})
}
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
This is the role of the roots option:
shinyFileChoose(input, "filePath", roots = c(Documents = "C:/Users/admin/Documents"), session = session)
Related
i've built an app that allow users to paste a folder path so that files inside that folder can be listed and selected. The app works when i set the path globally but i really need users to be able to stipulate their path. The path needs to be a network path as we use Azure/Databricks...
library(dplyr)
library(shinyWidgets)
library(shinythemes)
library(DT)
fpath <- '/dbfs/dbfs/Analytics/ShinyApp' #example path
# Define UI
ui <- fluidPage(
theme = shinytheme("spacelab"),
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
selectInput("selectfile", "Select File to Analyse",choice = list.files("ppath", pattern = ".csv")) #list of files should show up here
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
observeEvent(input$Setpath,{
output$ppath <-reactive({paste0(input$v_inpath)})
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
In the mainPanel, i can see the path being pasted correctly as text (as you can see i'm using verbatimTextOutput("ppath")). The list of files contained in the specified folder should show up but it does not work as no list is available... Thank you in advance for your help
You need renderUI
You should avoid to put an output element inside an observer
You could use the shinyFiles package or the jsTreeR package to select the path
Code:
library(shiny)
# Define UI
ui <- fluidPage(
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
uiOutput("selectfileUI")
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
output[["selectfileUI"]] <- renderUI({
req(input[["Setpath"]])
files <- list.files(input[["v_inpath"]], pattern = ".csv")
selectInput("selectfile", "Select File to Analyse", choices = files)
})
output[["ppath"]] <- renderPrint({
input[["v_inpath"]]
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
EDIT: feedback
Also, you can use the shinyFeedback package to print a message when the path is not valid:
library(shiny)
library(shinyFeedback)
# Define UI
ui <- fluidPage(
useShinyFeedback(), # don't forget this line
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
uiOutput("selectfileUI")
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
Check <- eventReactive(input[["Setpath"]], {
dir.exists(input[["v_inpath"]])
})
Files <- reactive({
req(Check())
list.files(input[["v_inpath"]], pattern = ".csv")
})
observeEvent(input[["Setpath"]], {
hideFeedback("v_inpath")
show <- !Check() || length(Files()) == 0
if(show) {
if(Check()) {
text <- "No CSV file in this folder"
} else {
text <- "Invalid path"
}
showFeedbackWarning("v_inpath", text)
} else {
hideFeedback("v_inpath")
}
})
output[["selectfileUI"]] <- renderUI({
req(Files())
selectInput("selectfile", "Select File to Analyse", choices = Files())
})
output[["ppath"]] <- renderPrint({
input[["v_inpath"]]
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
I'm currently rewriting a big shinyapp and I try to shift as much as possible into modules.
At some point, the user can choose weather to use stuff that is inside box a) or inside box b).
I know how to toggle or remove / restore a box in shiny, but I ran across a problem when using shinymodules: Inside the ui-function, I have a radiobutton, and the server-function should just observe its's value and hide or show a box according to the input. Well, the actual box to hide or show ist not inside the module because it is filled with another module.
Please see the code below for an example, you'll see that the box won't be removed or restored or whatever.
Maybe someone has an idea how to fix this or sees where I make a mistake?
Thank you!
# ui ----
testUI <- function(id){
tagList(
radioGroupButtons(NS(id, "switch"), label = NULL, individual = T,
choices = c("show", "dont show"), selected = "dont show"),
)
}
# server ----
testServer <- function(id, boxid){
moduleServer(id, function(input, output, session){
observeEvent(input$switch, {
if(input$switch == "show"){
updateBox(id = boxid, action = "restore", session = session)
} else {
updateBox(id = boxid, action = "remove", session = session)
}
})
})
}
# testing ----
testApp <- function(){
# create ui
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
testUI("zg"),
box(id = "mybox", title = "I am a box",
strong("some content")
) # end box
) # end dashboardBody
) # end dahsboardPage
# create server
server <- function(input, output, session){
testServer("zg", boxid = "mybox")
}
# start server
shinyApp(ui, server)
}
# start small app for testing (comment if not in use)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
testApp()
Normally, in order to use a updateXXX function in a module, the widget to be updated must be in the UI part of the module.
But that does not work with updateBox, I don't know why (I think the package author should add something in the implementation). See the example below. The updateRadioButtons works, but not the updateBox.
testUI <- function(id){
ns <- NS(id)
tagList(
radioButtons( # this widget will be updated
ns("switch"), label = NULL,
choices = c("show", "dont show"), selected = "show"
),
box( # this widget will *not* be updated
id = ns("mybox"), title = "I am a box", strong("some content")
)
)
}
# server ----
testServer <- function(id, boxid){
moduleServer(id, function(input, output, session){
observeEvent(input$switch, {
if(input$switch == "show"){
updateBox(id = boxid, action = "restore", session = session)
updateRadioButtons(session, "switch", label = "HELLO")
} else {
updateBox(id = boxid, action = "remove", session = session)
updateRadioButtons(session, "switch", label = "GOODBYE")
}
})
})
}
I'm trying to write a small shiny app where the user can select multiple folders through a button. The number of folders selected varies according to the needs of the user. The selection of one folder works. If I set "multiple = TRUE", then also only one folder is selected. Does anyone have an idea how I can select multiple folders with a single button?
Here is my code:
library(shiny)
library(shinydashboard)
library(shinyFiles)
library(shinyWidgets)
ui <- fluidPage(
shinyDirButton("preinfolder", "Choose a folder" ,
title = "Please select a folder:",
buttonType = "default", class = NULL,
icon = icon("folder", lib = "font-awesome"), multiple = TRUE),
textOutput("prein_txt_file")
)
server <- function(input, output, session) {
volumes = getVolumes()()
observe({
shinyDirChoose(input, "preinfolder", roots = volumes, session = session)
if(!is.null(input$preinfolder)){
# browser()
preinfolder_selected<-parseDirPath(volumes, input$preinfolder)
output$prein_txt_file <- renderText(preinfolder_selected)
}})
}
shinyApp(ui, server)
Thanks for any idea
I am still trying to solve the problem. I want a list of selected folders.
For my previous solution, I can select multiple folders but only from one parent folder.
library(shiny)
library(shinydashboard)
library(shinyFiles)
library(shinyWidgets)
ui <- fluidPage(
shinyDirButton("preinfolder", "Choose a folder" ,
title = "Please select a folder:",
buttonType = "default", class = NULL,
icon = icon("folder", lib = "font-awesome"), multiple = TRUE),
uiOutput(outputId = "sel_subfolder"),
textOutput("prein_txt_file")
)
server <- function(input, output, session){
volumes = getVolumes()()
observe({
shinyDirChoose(input, "preinfolder", roots = volumes, session = session)
if(!is.null(input$preinfolder)){
# browser()
preinfolder_selected<-parseDirPath(volumes, input$preinfolder)
output$prein_txt_file <- renderText(preinfolder_selected)
}})
df <- reactive({
if(is.null(input$preinfolder)) {
return(NULL)
} else {
fol <- parseDirPath(volumes, input$preinfolder)
return(fol)
}
})
output$sel_subfolder <- renderUI({
if(is.null(df())) {
return(NULL)
} else if(!is.null(df())) {
return(tags$div(align = "left",
class = "multicol",
checkboxGroupInput(inputId = "sel_subfolder",
label = "Select subfolder",
choices = unlist(list.files(parseDirPath(volumes, input$preinfolder))))))
}
})
}
shinyApp(ui, server)
I am still looking for a solution how to create a list of multiple folders with one input button.
This is the solution I found (a bit convoluted but it works).
You basically pass the selected folder to a updateCheckboxGroupInput function that appends the folder to a list of previously chosen ones
library(shiny)
library(shinyFiles)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
shinyDirButton('fld','Choose...','Choose a folder'),
actionButton("submitbutton", "Add folder", class = "btn btn-primary"),
checkboxGroupInput('chosenfolders','Chosen folders...')
),
mainPanel(
verbatimTextOutput("selected")
)
)
)
server <- function(input, output, session) {
volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
shinyDirChoose(input, 'fld', session=session,
root=volumes, filetypes=c('txt'))
datasetInput <- reactive({
inputfolders <- c(input$chosenfolders,
parseDirPath(volumes, input$fld))
updateCheckboxGroupInput(session, 'chosenfolders',
choices = inputfolders,
selected = inputfolders)
print(list('Input folders' = inputfolders))
})
output$selected <- renderPrint({
if (input$submitbutton>0) {
isolate(datasetInput())
} else {
return("Server is ready for calculation.")
}
})
}
shinyApp(ui = ui, server = server)
I have this Shiny script:
library(shiny)
source("oss_datamanip.R")
# Define UI ----
ui <- fluidPage(
titlePanel("Prime Awards Analysis for the OSS Team"),
sidebarPanel(fluidRow(
column(12, textInput("text", h4("Please enter a DUNS number: "),
value = "Enter text...")),
column(12, textInput("text", h4("Please enter the file path where you would like your output to be saved: "),
value = "Enter text...")))),
mainPanel(textOutput("duns"),
textOutput("file_path")),
actionButton("script", "Run the Script")
)
# Define server logic ----
server <- function(input, output, session){
observe({
user.input <<- input$duns
output.dir <<- input$file_path
})
source("oss_datamanip.R")
}
# Run the app ----
shinyApp(ui = ui, server = server)
and I want to have the user input from the Shiny app update the R script before it runs. Is this possible? How would I go about doing this?
I want my Shiny app to allow user specify a path to a folder (locally) and display the selected path. The following code works but I can't figure out how to hide "character(0)" in verbatimTextOutput until the folder was selected. I tried conditional panel (see commented out in my code) but can't figure out what to use as a condition here (because shinyDirButton is not a standard action button...). Thank you!
library(shiny)
library(shinyFiles)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
mainPanel(
shinyDirButton("dir", "Input directory", "Upload"),
#conditionalPanel(
#condition = "???",
verbatimTextOutput('dir')
#)
)
)
server <- function(input, output) {
shinyDirChoose(input, 'dir', roots = c(home = '~'), filetypes = c('', 'txt','bigWig',"tsv","csv","bw"))
dir <- reactive(input$dir)
output$dir <- 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)
The closest question I was able to find is this but it doesn't solve my problem: R conditionalPanel reacts to output
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)