I'm having trouble using the shinyFiles package with module. When i'm using it without module it works fine. When i'm using it within module i can't dive into directories (other threads have no positive answer) :
#' #export
dirModule = function(input, output, session, fileRoot = NULL) {
root = c(C = "/")
shinyFileChoose(input, session$ns('files'), roots = root, session = session)
shinyDirChoose(input, session$ns("directory"), session=session, roots = c(home = '/home', root = '/'), filetypes=c(''))
shinyFileSave(input, session$ns("fileSave"), roots = root, session = session)
observeEvent(input$files, { print(parseFilePaths(root, input$files)$datapath) })
observeEvent(input$directory, { print(parseDirPath(root, input$directory)) })
observeEvent(input$fileSave, { print(parseSavePath(root, input$fileSave)$datapath) })
}
#' #export
dirModuleUI = function(id) {
ns = NS(id)
fluidPage(
fluidRow(
shinyFilesButton(ns('files'), label='File select', title='Please select a file', multiple=T),
shinyDirButton(ns("directory"), label="Directory select", title = "Select directory", FALSE),
shinySaveButton(ns("fileSave"), label = "File save", title = "Save file as", filetype=list(text='txt'))
)
)
}
I had the same issue and solved by using the Github version.
You can first install devtools package by install.packages('devtools') and then use devtools::install_github("thomasp85/shinyFiles") to install the latest shinyFiles package.
After that, just get rid of all the session$ns call in your module server function.
Similar post here
It is namespace issue. I stuck here multiple times in different R version and here is the solution in R 3.6.
I cannot get it work in R 3.4 because it always have problem navigate into subfolders.
#' #export
dirModule = function(input, output, session, fileRoot = NULL) {
root = c(C = "/")
shinyFileChoose(input, 'files', roots = root, session = session)
shinyDirChoose(input, "directory", session=session, roots = c(home = '/home', root = '/'), filetypes=c(''))
shinyFileSave(input, "fileSave", roots = root, session = session)
observeEvent(input$files, { print(parseFilePaths(root, input$files)$datapath) })
observeEvent(input$directory, { print(parseDirPath(root, input$directory)) })
observeEvent(input$fileSave, { print(parseSavePath(root, input$fileSave)$datapath) })
}
#' #export
dirModuleUI = function(id) {
ns = NS(id)
fluidPage(
fluidRow(
shinyFilesButton(ns('files'), label='File select', title='Please select a file', multiple=T),
shinyDirButton(ns("directory"), label="Directory select", title = "Select directory", FALSE),
shinySaveButton(ns("fileSave"), label = "File save", title = "Save file as", filetype=list(text='txt'))
)
)
}
Related
I need to get the path of a folder, which will be selected by the user. I tried using shinyFiles but cant get it to work properly.
So far, this code has worked. However, I can get the path from files but not from folders.
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)
I got it from: Getting file path from Shiny UI (Not just directory) using browse button without uploading the file but cannot answer because of reputation.
For choosing a folder change the code to use shinyDirButton and shinyDirChoose.
Also noted that you should reference to roots where running users have permission to access otherwise it will throw errors. Example here is I assign volumes = c(home = 'C:/Users/sinhn/') for trial run on my Windows computer. You can have multiple location as named vector here.
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyDirButton("Btn_GetFolder", "Choose a folder" ,
title = "Please select a folder:", multiple = FALSE,
buttonType = "default", class = NULL),
textOutput("txt_file")
)
server <- function(input,output,session){
volumes = c(home = "C:/Users/sinhn/")
observe({
shinyDirChoose(input, "Btn_GetFolder",
roots = volumes)
})
output$txt_file <- renderText({
file_selected <- parseDirPath(roots = volumes, input$Btn_GetFolder)
})
}
shinyApp(ui = ui, server = server)
Goal
I have five expectations:
Solution using modules
Communication between modules
Dynamic creation of modules
local storage using shinyStore
Export result in dataframe
What has worked so far
This is a continuation of the following question.
I have a Shiny app that currently has two modules, but I have had issues with both of them communicating. The first module Selects any number of species within a Species pool (SpeciesSelect), this module is in the file R/SpeciesSelect.R within my working directory with the following code.
SpeciesSelect_UI <- function(id, SpeciesList){
ns <- NS(id)
tagList(
shiny::selectizeInput(inputId = ns("SpeciesNames"), label = "SpeciesName",
choices = SpeciesList,
multiple = T)
)
}
SpeciesSelect_Server <- function(id){
moduleServer(id, function(input, output, session) {
# return the reactive here
return(reactive({input$SpeciesNames}))
})
}
And the second module (SpeciesCount) would use those species in order to select how you sample them, and in some cases to count them when the method is equal to pinpoint. This is stored in R/SpeciesCount.R and the code is as follows:
SpeciesCount_UI <- function(id, Species){
ns <- NS(id)
tagList(
shinyMobile::f7Card(
f7Flex(
textOutput(ns("SpeciesAgain")),
uiOutput(ns("Sampling_type_ui")),
uiOutput(ns("SpeciesCount"))
)
)
)
}
SpeciesCount_Server <- function(id, Species){
moduleServer(id, function(input, output, session) {
output$SpeciesAgain <- renderText({Species})
ns <- session$ns
output$Sampling_type_ui <- renderUI({
#req(input$SpeciesName)
req(Species)
f7Select(inputId = ns("Sampling_type"),
label = "Sampling type",
choices = c("5m circle", "15m circle", "Pin-point"))
})
output$SpeciesCount <- renderUI({
if (req(input$Sampling_type) == "Pin-point") {
shinyMobile::f7Stepper(inputId = ns("Species1"), label = "Species count", min = 1, max = 1000, step = 1, value = 1)
}
})
})
}
Each of the modules is working well on its own as shown in the following example:
library(shiny)
library(shinyMobile)
library(shinyStore)
source("R/SpeciesCount.R")
source("R/SpeciesSelect.R")
SpeciesList <- c("Species1", "Species2", "Species3", "Species4", "Species5")
ui = f7Page(
title = "Show navbar",
f7SingleLayout(
navbar = f7Navbar("Hide/Show navbar"),
f7Button(inputId = "toggle", "Toggle navbar", color = "red"),
SpeciesSelect_UI(id = "SpeciesList", SpeciesList = SpeciesList),
lapply(seq_along(SpeciesList), function(i) {
SpeciesCount_UI(id = i, Species = SpeciesList[i])
})
)
)
server = function(input, output, session) {
lapply(seq_along(SpeciesList), function(i) {
SpeciesCount_Server(id = i, Species = SpeciesList[i])
})
observeEvent(input$toggle, {
updateF7Navbar()
})
}
shinyApp(ui, server)
I have 4 issues that are not working well, first, the communication between modules, and then looping through the results of the first module to get several of the second module, the localStorage issue, and finally exporting it to a dataframe
Communication between modules and dynamic UI generation
In order to isolate both issues, for the communication problem, I selected only one species and took out the lapply function to see if I can get the SpeciesCount to recognise the output of the SpeciesSelect_Server and incorporate it into the SpeciesCount module, here is the code I ended up with:
library(shiny)
library(shinyMobile)
library(shinyStore)
source("R/SpeciesCount.R")
source("R/SpeciesSelect.R")
LIST <- c("Species1", "Species2", "Species3", "Species4", "Species5")
ui = f7Page(
title = "Show navbar",
f7SingleLayout(
navbar = f7Navbar("Hide/Show navbar"),
f7Button(inputId = "toggle", "Toggle navbar", color = "red"),
SpeciesSelect_UI(id = "SpeciesList", SpeciesList = LIST),
SpeciesCount_UI(id = "SpeciesCount", Species = SpeciesSelected())
)
)
server = function(input, output, session) {
SpeciesSelected <- SpeciesSelect_Server(id = "SpeciesList")
SpeciesCount_Server(id = "SpeciesCount", Species = SpeciesSelected())
observeEvent(input$toggle, {
updateF7Navbar()
})
}
shinyApp(ui, server)
But the results of the SpeciesSelect module are not generating any UI in the SpeciesCount module
Adding the LocalStorage issue
This app is going to be used in the field, that means, that at time we might get connectivity issues, I have issues at storing the values of the Species Select Module, then for sure I will have issues with the next module this is the shiny app I am using
library(shiny)
library(shinyMobile)
library(shinyStore)
source("R/SpeciesCount.R")
source("R/SpeciesSelect.R")
SpeciesList <- c("Species1", "Species2", "Species3", "Species4", "Species5")
ui = f7Page(
title = "Show navbar",
f7SingleLayout(
navbar = f7Navbar("Hide/Show navbar"),
f7Button(inputId = "toggle", "Toggle navbar", color = "red"),
SpeciesSelect_UI(id = "SpeciesList", SpeciesList = SpeciesList),
lapply(seq_along(SpeciesList), function(i) {
SpeciesCount_UI(id = i, Species = SpeciesList[i])
})
)
)
server = function(input, output, session) {
lapply(seq_along(SpeciesList), function(i) {
SpeciesCount_Server(id = i, Species = SpeciesList[i])
})
observeEvent(input$toggle, {
updateF7Navbar()
})
}
shinyApp(ui, server)
And I modified the species select for that also
SpeciesSelect_UI <- function(id, SpeciesList){
ns <- NS(id)
tagList(
shiny::selectizeInput(inputId = ns("SpeciesNames"), label = "SpeciesName",
choices = SpeciesList,
multiple = T)
)
}
SpeciesSelect_Server <- function(id){
moduleServer(id, function(input, output, session) {
ns <- session$ns
# return the reactive here
observeEvent(input$save, {
updateStore(session, name = ns("SpeciesNames"), input$SpeciesNames)
}, ignoreInit = TRUE)
observeEvent(input$clear, {
# clear current user inputs:
updateTextInput(session, inputId = ns("SpeciesNames"), value = "")
# clear shinyStore:
updateStore(session, name = ns("SpeciesNames"), value = "")
}, ignoreInit = TRUE)
return(reactive({ns(input$SpeciesNames)}))
})
}
But nothing gets stored. Maybe creating a module for shiny store is needed?
Export as a dataframe
This one is tied two point 2:
So lets say I am in the following input set:
The idea would be to generate a reactive that has the following that frame, that I can then export as a CSV file. I think I can handle the export, but I am unsure on how to generate the data.frame from the dynamic UI:
data.frame(Species = c("Species1", "Species2", "Species3"), Method = c("Pin-point","5m circle", "15m circle"), abundance = c(5, 1, 1))
Your first module is probably already silently returning the reactive but for clarity you can make it explicit. In you first module, return a reactive:
SpeciesSelect_Server <- function(id){
moduleServer(id, function(input, output, session) {
# return the reactive here
return(reactive({input$SpeciesNames}))
})
}
Now call the module AND assign its output a name where you'd like to use it (in another module or in your app server), like this:
selected_species <- SpeciesSelect_Server(id = "SpeciesList")
Now selected_species can be called, observed, etc with:
selected_species()
I'm modularizing a Shiny app I developed using shinydashboard packages. Despite it traditionally works when I use it without involving modules, I can't make it work when I try to divide it into modules and submodules. Here I would like to combine two UIs (one for the sidebar, one for the body) in order to upload a dataset from the sidebar and show it into the body.
I'd be very glad if anybody could provide me some help with this.
Here is the code of the general Shiny app:
library(shiny)
library(excelR)
library(vroom)
library(readxl)
library(janitor)
library(dplyr)
library(shinydashboard)
library(shinydashboardPlus)
# # load separate module and function scripts
source("modules.R")
# app_ui
app_ui <- function() {
tagList(
shinydashboardPlus::dashboardPagePlus(
header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
enable_rightsidebar = FALSE),
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
import_sidebar_ui("import"))
),
body = shinydashboard::dashboardBody(shinydashboard::tabItems(
import_body_ui("import"))
),
rightsidebar = NULL,
title = "Module App"
)
)
}
# app_server
app_server <- function(input, output, session) {
shiny::moduleServer(id = "import", module = import_server)
}
####################################################################
run_app <- function(...) {
shiny::shinyApp(
ui = app_ui,
server = app_server)
}
#---------------------------------
run_app()
and here is the modules.R file I wrote containing the UIs for sidebar and body, plus the server:
# Import module ####
#
# Import sidebar UI
import_sidebar_ui <- function(id) {
ns <- NS(id)
shinydashboard::menuItem("Module Testing",
tabName = "tab_testing_mod",
icon = icon("th"),
tagList(
selectInput(ns("input_type"),
"Type of file:",
choices = c("Choose one" = "",".csv" = "csv",
".txt" = "txt", ".xls/.xlsx" = "xlsx"),
selected = NULL),
uiOutput(ns("inputControls")),
fileInput(ns("file"), "Data", buttonLabel = "Upload..."),
checkboxInput(ns("rownames"), "Check if 1st column contains rownames"),
checkboxInput(ns("constant"), "Remove constant columns?"),
checkboxInput(ns("empty"), "Remove empty cols?"),
actionButton(ns("bttn_import"), "Import data")
)
)
}
# Import body UI
import_body_ui <- function(id) {
ns <- NS(id)
shinydashboard::tabItem(tabName = "tab_testing_mod",
fluidRow(
h3("Imported Data"),
excelR::excelOutput(ns("preview")))
)
}
# Import server
import_server <- function(input, output, session) {
ns <- session$ns
output$inputControls <- renderUI({
tagList(
switch(input$input_type,
"csv" = textInput("delim", "Delimiter (leave blank to guess)", ""),
"txt" = textInput("delim", "Delimiter (leave blank to guess)", "")
),
switch(input$input_type,
"xlsx" = numericInput("sheet", "Sheet number", value = 1))
)
})
raw <- reactive({
req(input$file)
if (input$input_type == "csv" || input$input_type == "txt") {
delim <- if (input$delim == "") NULL else input$delim
data <- vroom::vroom(input$file$datapath, delim = delim)
} else if (input$input_type == "xlsx") {
data <- tibble::as.tibble(readxl::read_excel(input$file$datapath, sheet = input$sheet, col_names = TRUE))
} else {
return(NULL)
}
raw <- data
raw
})
tidied <- eventReactive(input$bttn_import,{
out <- raw()
if (input$empty) {
out <- janitor::remove_empty(out, "cols")
}
if (input$constant) {
out <- janitor::remove_constant(out)
}
if (input$rownames) {
out <- tibble::column_to_rownames(out, var = colnames(out[1]))
}
out <- out %>% dplyr::mutate_if(is.character,as.factor)
out
})
output$preview <- excelR::renderExcel({
excelR::excelTable(data = raw(),
colHeaders = toupper(colnames(raw())),
fullscreen = FALSE,
columnDrag = TRUE,
rowDrag = TRUE,
wordWrap = FALSE,
search =TRUE,
showToolbar = TRUE,
minDimensions = c(ncol(raw()),10)
)
})
}
It seems to me I can upload the dataset (.csv, .txt or .xlsx) files but I can't show it into the body.
I'd be very glad if you can help me, thank you very much in advance for your assistance.
I am developing a shiny app to be used locally. I am trying to develop a system for the user to be able to restore a former session.
For that, I took the code from this entrance: Saving state of Shiny app to be restored later , and it did work, however I wanted to be able to restore the inputs within a different session, so that I added a fileInput (Restore Session) and a downloadButton (Save Session) to the code, but unfortunately I could not make it work.
My code is as follows:
library(shiny)
ui <- fluidPage(
textInput("control_label",
"This controls some of the labels:",
"LABEL TEXT"),
numericInput("inNumber", "Number input:", min = 1, max = 20, value = 5, step = 0.5),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1",
"label 2" = "option2",
"label 3" = "option3")),
fileInput("load_inputs", "Restore Session", multiple = FALSE),
downloadButton("save_inputs", 'Save Session')
)
server <- function(input, output,session) {
# SAVE SESSION
output$save_inputs <- downloadHandler(
filename = function() {
paste("session", ".RDS", sep = "")
},
content = function(file) {
saveRDS( reactiveValuesToList(input), file)
})
# LOAD SESSION
load_sesion <- reactive({
req(input$load_inputs)
load_session <- readRDS( input$load_inputs$datapath )
})
observeEvent(input$load_inputs,{
if(is.null(input$load_inputs)) {return(NULL)}
savedInputs <- load_sesion()
inputIDs <- names(savedInputs)
inputvalues <- unlist(savedInputs)
for (i in 1:length(inputvalues)) {
session$sendInputMessage(inputIDs[i], list(value=inputvalues[[i]]) )
}
})}
shinyApp(ui, server)
With this code I can save the inputs of the session and I can read them in the following session, however I am not able to use those values stored on the RDS as inputs in another session.
Thanks a lot,
Rachael
As suggested in my above comments the following app uses shiny's built-in capabilities to create bookmarks instead of using a custom function to save the current state of the inputs.
After the download button is clicked a bookmark is stored on the server side, renamed and copied to the downloadHandler.
If the user uploads a bookmark file, the needed path is created based on the filename and the user gets redirected to the earlier session. (Also see the commented out alternative, which requires the user to actively switch sessions).
Of course you could implement a modal to have the user input a name for the session to avoid using the rather cryptic bookmark hash as the filename.
Edit:
Implemented a modal to let the user provide a custom session name (limited to alphanumeric characters)
library(shiny)
library(shinyjs)
library(utils)
library(tools)
library(stringi)
ui <- function(request) {
fluidPage(
useShinyjs(),
textInput("control_label", "This controls some of the labels:", "LABEL TEXT"),
numericInput("inNumber", "Number input:", min = 1, max = 20, value = 5, step = 0.5 ),
radioButtons("inRadio", "Radio buttons:", c("label 1" = "option1", "label 2" = "option2", "label 3" = "option3")),
fileInput("restore_bookmark", "Restore Session", multiple = FALSE, accept = ".rds"),
actionButton("save_inputs", 'Save Session', icon = icon("download"))
)
}
server <- function(input, output, session) {
latestBookmarkURL <- reactiveVal()
onBookmarked(
fun = function(url) {
latestBookmarkURL(parseQueryString(url))
}
)
onRestored(function(state) {
showNotification(paste("Restored session:", basename(state$dir)), duration = 10, type = "message")
})
observeEvent(input$save_inputs, {
showModal(modalDialog(
title = "Session Name",
textInput("session_name", "Please enter a session name (optional):"),
footer = tagList(
modalButton("Cancel"),
downloadButton("download_inputs", "OK")
)
))
}, ignoreInit = TRUE)
# SAVE SESSION
output$download_inputs <- downloadHandler(
filename = function() {
removeModal()
session$doBookmark()
if (input$session_name != "") {
tmp_session_name <- sub("\\.rds$", "", input$session_name)
# "Error: Invalid state id" when using special characters - removing them:
tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
# TODO: check if a valid filename is provided (e.g. via library(shinyvalidate)) for better user feedback
tmp_session_name <- paste0(tmp_session_name, ".rds")
} else {
paste(req(latestBookmarkURL()), "rds", sep = ".")
}
},
content = function(file) {
file.copy(from = file.path(
".",
"shiny_bookmarks",
req(latestBookmarkURL()),
"input.rds"
),
to = file)
}
)
# LOAD SESSION
observeEvent(input$restore_bookmark, {
sessionName <- file_path_sans_ext(input$restore_bookmark$name)
targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
if (!dir.exists(dirname(targetPath))) {
dir.create(dirname(targetPath), recursive = TRUE)
}
file.copy(
from = input$restore_bookmark$datapath,
to = targetPath,
overwrite = TRUE
)
restoreURL <- paste0(session$clientData$url_protocol, "//", session$clientData$url_hostname, ":", session$clientData$url_port, session$clientData$url_pathname, "?_state_id_=", sessionName)
# redirect user to restoreURL
runjs(sprintf("window.location = '%s';", restoreURL))
# showModal instead of redirecting the user
# showModal(modalDialog(
# title = "Restore Session",
# "The session data was uploaded to the server. Please visit:",
# tags$a(restoreURL),
# "to restore the session"
# ))
})
}
shinyApp(ui, server, enableBookmarking = "server")
Just wanted to add a note here because I spent awhile figuring out how to make this work with saved values. My version is very much derived from #ismirsehregal. I also created bookmarking modules that might be helpful to others. This was needed because shinyFiles inputs caused an error and needed to be excluded from bookmarks so I saved the value in a reactive and then saved it in onBookmark. This was the error when they were not excluded:
Error in writeImpl: Text to be written must be a length-one character vector
library(shiny)
library(shinyFiles)
# source these functions
#Saving #=======================================================================
save_bookmark_ui <- function(id){
actionButton(NS(id, "start_save"), "Save")
}
save_bookmark_server <- function(id, latestBookmarkURL, volumes){
moduleServer(id, function(input, output, session) {
shinyDirChoose(input, "save_dir", root = volumes)
save_dir_pth <- reactive(parseDirPath(volumes, input$save_dir))
onRestored(function(state) {
showNotification(paste("Restored session:", basename(state$dir)),
duration = 10, type = "message")
})
setBookmarkExclude(c("save_dir", "start_save", "save_action", "new_dir_name"))
observeEvent(input$start_save, {
showModal(
modalDialog(
p("The app session is saved using two files, input.rds and values.rds",
"You will provide a location and name for a new folder that will",
" be created to store these files. Make sure you choose a name",
"and location that will be easy to find when you want to load the ",
"saved inputs."),
strong("Choose location to save progess"),
br(),
shinyDirButton(NS(id, "save_dir"), "Location to create folder",
"Location to create folder"),
br(),
textInput(NS(id, "new_dir_name"),
"Choose a name for the new folder that will be created"),
br(),
footer = tagList(
actionButton(NS(id, "save_action"), "Save"),
modalButton("Cancel")
),
title = "Save assessment progress"
)
)
})
iv <- shinyvalidate::InputValidator$new()
iv$add_rule("new_dir_name", shinyvalidate::sv_optional())
iv$add_rule("new_dir_name",
shinyvalidate::sv_regex("[^[:alnum:]]",
paste0("Please choose a name with only",
" letters or numbers and no spaces"),
invert = TRUE))
observeEvent(input$save_action, {
if (!iv$is_valid()) {
iv$enable()
} else {
removeModal()
session$doBookmark()
if (input$new_dir_name != "") {
# "Error: Invalid state id" when using special characters - removing them:
tmp_session_name <- stringr::str_replace_all(input$new_dir_name,
"[^[:alnum:]]", "")
} else {
tmp_session_name <- paste(req(latestBookmarkURL))
}
# create the new directory in the chosen location
new_dir <- fs::dir_create(fs::path(save_dir_pth(), tmp_session_name))
message("Saving session")
# move the files from where shiny saves them to where the user can find them
fs::dir_copy(path = fs::path(".", "shiny_bookmarks", req(latestBookmarkURL)),
new_path = new_dir,
overwrite = TRUE)
}
}, ignoreInit = TRUE)
})
}
# Load #=======================================================================
load_bookmark_ui <- function(id){
actionButton(NS(id, "start_load"), "Load")
}
load_bookmark_server <- function(id, volumes){
moduleServer(id, function(input, output, session){
shinyDirChoose(input, "load_dir", root = volumes)
load_dir_pth <- reactive(parseDirPath(volumes, input$load_dir))
setBookmarkExclude(c("load_dir", "load_action", "start_load"))
observeEvent(input$start_load, {
showModal(
modalDialog(
strong("Select the folder where the app was saved"),
br(),
shinyDirButton(NS(id, "load_dir"), "Select Folder",
"Location of folder with previous state"),
footer = tagList(
actionButton(NS(id, "load_action"), "Load"),
modalButton("Cancel")
),
title = "Load existing assessment"
)
)
})
# LOAD SESSION
observeEvent(input$load_action, {
sessionName <- fs::path_file(load_dir_pth())
targetPath <- file.path(".", "shiny_bookmarks", sessionName)
if (!dir.exists(dirname(targetPath))) {
dir.create(dirname(targetPath), recursive = TRUE)
}
# copy the bookmark to where shiny expects it to be
fs::dir_copy(path = load_dir_pth(),
new_path = targetPath,
overwrite = TRUE)
restoreURL <- paste0(session$clientData$url_protocol, "//",
session$clientData$url_hostname, ":",
session$clientData$url_port, "/?_state_id_=",
sessionName)
removeModal()
# redirect user to restoreURL
shinyjs::runjs(sprintf("window.location = '%s';", restoreURL))
# showModal instead of redirecting the user
# showModal(modalDialog(
# title = "Restore Session",
# "The session data was uploaded to the server. Please visit:",
# tags$a(restoreURL, href = restoreURL),
# "to restore the session"
# ))
})
})
}
# Input options
valueNms <- c("Greatly increase", "Increase", "Somewhat increase", "Neutral")
valueOpts <- c(3, 2, 1, 0)
ui <- function(request) {
fluidPage(
shinyjs::useShinyjs(),
textInput("control_label", "This controls some of the labels:", "LABEL TEXT"),
numericInput("inNumber", "Number input:", min = 1, max = 20, value = 5, step = 0.5 ),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1", "label 2" = "option2", "label 3" = "option3")),
checkboxGroupInput("inChk","Checkbox:", choiceNames = valueNms,
choiceValues = valueOpts),
shinyFilesButton("range_poly_pth", "Choose file",
"Range polygon shapefile", multiple = FALSE),
verbatimTextOutput("range_poly_pth_out", placeholder = TRUE),
save_bookmark_ui("save"),
load_bookmark_ui("load"),
tableOutput("table")
)
}
server <- function(input, output, session) {
shinyFileChoose("range_poly_pth", root = volumes, input = input)
file_pth <- reactive({
if(is.integer(input$range_poly_pth)){
if(!is.null(restored$yes)){
return(file_pth_restore())
}
return(NULL)
} else{
return(parseFilePaths(volumes, input$range_poly_pth)$datapath)
}
})
output$table <- renderTable({
req(file_pth())
read.csv(file_pth())
})
output$range_poly_pth_out <- renderText({
file_pth()
})
setBookmarkExclude(c("range_poly_pth",
"range_poly_pth_out"))
# this part is not allowed to be inside the module
latestBookmarkURL <- reactiveVal()
onBookmarked(
fun = function(url) {
latestBookmarkURL(parseQueryString(url))
showNotification("Session saved",
duration = 10, type = "message")
}
)
R.utils::withTimeout({
volumes <- c(wd = getShinyOption("file_dir"),
Home = fs::path_home(),
getVolumes()())
}, timeout = 10, onTimeout = "error")
save_bookmark_server("save", latestBookmarkURL(), volumes)
load_bookmark_server("load", volumes)
# Need to explicitly save and restore reactive values.
onBookmark(function(state) {
val2 <- Sys.Date()
state$values$date <- val2
state$values$file <- file_pth()
})
restored <- reactiveValues()
file_pth_restore <- reactiveVal()
onRestore(fun = function(state){
file_pth_restore(state$values$file)
print(file_pth_restore())
restored$yes <- TRUE
})
}
shinyApp(ui, server, enableBookmarking = "server")
I have created an R shiny application to download dynamic reports using R Markdown. Previously I was downloading one report at a time by selecting the row in the data table in r shiny and clicking on download button, the selected row's column values would get filled in the report, this was working perfectly fine.
But now i am trying to download multiple reports, so that if I select multiple rows in a datatable in r shiny and click on download, the number of reports downloaded should be equal to number of rows selected.
For this I am trying to create a zip file which contains all my individual report but I am getting this
error: pandoc document conversion failed with error 1
I had researched for this error but couldn't find anything. Please help!
ui <- {
tagList(
div(id = "downloadBtn",
downloadButton("downloadData", "Download")),
DT::dataTableOutput('myTable1')
)
}
dataJ <- read.csv(file = "iris.csv", header = TRUE, stringsAsFactors =
FALSE)
server <- function(input, output)
{
output$myTable1 <- DT::renderDataTable({
DT::datatable(dataJ, options = list(orderClasses = TRUE), filter = 'top')})
output$downloadData <- downloadHandler(
filename = function()
{
paste("output", "zip", sep = ".")
},
content = function(file)
{
k = list(input$myTable1_rows_selected)
fs <- c()
for ( i in k)
{
params <- list(j=i)
path <- paste(i,".docx")
rmarkdown::render("R_markdown_script.Rmd", rmarkdown::word_document(),
output_file = path , params = params,
envir = new.env(parent = globalenv()))
fs <- c(fs,path)
}
zip(zipfile = file, files = fs)
if (file.exists(paste0(file, ".zip")))
file.rename(paste0(file, ".zip"), file)
},
contentType = "application/zip" )
}
runApp(list(ui = ui, server = server))
Here is a reproducible example (to make it work, create an rmarkdown file with the default content using RStudio, and save it as "test.rmd" in the same folder as your Shiny app).
Important:
You need to run the app externally inside your web browser. Somehow it does not work in the viewer pane or RStudio window (you get the download window but then no file is saved).
If you are on Windows, you need to make sure that you install RTools first, and also put the rtools/bin folder in your system path.
app.R
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
downloadButton("downloadData", "Download")
),
mainPanel(
DT::dataTableOutput('myTable1')
)
)
))
server <- shinyServer(function(input, output) {
output$myTable1 <- DT::renderDataTable(iris)
output$downloadData <- downloadHandler(
filename = function() {
paste0("output", ".zip")
},
content = function(file) {
k <- input$myTable1_rows_selected
fs <- c()
for (i in k) {
path <- paste0(i, ".docx")
rmarkdown::render("test.rmd", rmarkdown::word_document(), output_file = path)
fs <- c(fs, path)
}
zip(file, fs)
},
contentType = "application/zip"
)
})
shinyApp(ui = ui, server = server)
Hello I also installed Rtools/bin and was running the code on the web browser, but when I click on download button, download window doesn't comes up and shows '404 Not Found', but when I check the directory, the doc files report are saving directly to directory, no zip file is produced. Please see below code.
ui <- {
tagList(
div(id = "downloadBtn",
downloadButton("downloadData", "Download")),
DT::dataTableOutput('myTable1')
)
}
dataJ <- read.csv(file = "iris.csv", header = TRUE, stringsAsFactors =
FALSE)
server <- function(input, output)
{
output$myTable1 <- DT::renderDataTable({
DT::datatable(dataJ, options = list(orderClasses = TRUE), filter = 'top')})
output$downloadData <- downloadHandler(
filename = ("output.zip"),
content = function(file)
{
k <- (input$myTable1_rows_selected)
fs <- c()
for ( i in k)
{
path <- paste0(i,".docx")
rmarkdown::render("R_markdown_script.Rmd", output_file = path ,
params = list(j=i), envir = new.env(parent = globalenv()))
fs <- c(fs,file)
}
zip(zipfile = file, files = fs)
},
contentType = "application/zip" )
}
runApp(list(ui = ui, server = server))`