Reload fileInput when actionButton is clicked - r

I wrote a Shiny app that loads several user-defined csv files as fileInput. The app is designed to plot data from a running measurement and new datapoints are written to the input files about every five minutes. I want to be able to reload all inputs by clicking on an actionButton.
I tried to define the function reading the .csv as eventReactive:
library(shiny)
ui <- fluidPage(
actionButton(inputId = "update", label = "Reload input files"),
fileInput(inputId = "file", label = "Choose file"),
textOutput("test")
)
server <- function(input, output) {
data <- eventReactive(input$update, {
mydata <- read.delim(input$file$datapath)
return(nrow(mydata))
})
output$test <- renderText(print(data()))
}
shinyApp(ui = ui, server = server)
When I choose an input file and click the action button, the output is correctly rendered. If I now open the csv file, add additional rows and click the action button again, the output is not updated.

Based on this answer I was able to create a workaround for you problem.
As I pointed out in my comment above, the reason why it is not possible to update fileInput with an action button is that, apparently, fileInput creates a temporary file in a temporary directory and the Input$file$datapth links to this temporary file. So you can reload the file with using the action button as often as you like, changes to the orignial file will not be reflected, since the link is pointing to the temporary file. I really don't know why inputFile works with temp files, but using the shinyFiles packages, you can build a workaround. You have one button which gets the real link to your file and load the data in and another button to reload the data. Pressing the load button will reload the original data and all changes to it will be reflected.
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
actionButton(inputId = "reload", label = "Reload data"),
tableOutput("test")
)
server <- function(input,output,session){
volumes <- getVolumes()
v = reactiveValues(path = NULL)
observe({
shinyFileChoose(input, "GetFile", roots = volumes, session = session)
if (!is.null(input$GetFile)) {
file_selected <- parseFilePaths(volumes, input$GetFile)
v$path <- as.character(file_selected$datapath)
req(v$path)
v$data <- read.csv(v$path)
}
})
observeEvent(input$reload, {
req(v$path)
v$data <- read.csv(v$path)
})
output$test <- renderTable({
print(v$path)
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
Update
It is also possible to combine this approach with reactiveFileReader, see example below:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
tableOutput("test")
)
server <- function(input,output,session){
volumes <- getVolumes()
v = reactiveValues(path = NULL)
observe({
shinyFileChoose(input, "GetFile", roots = volumes, session = session)
req(input$GetFile)
file_selected <- parseFilePaths(volumes, input$GetFile)
v$path <- as.character(file_selected$datapath)
req(v$path)
v$data <- reactiveFileReader(1000, session, filePath = v$path, readFun = read.csv, sep = ";")
})
output$test <- renderTable({
print(v$path)
req(v$data)
v$data()
})
}
shinyApp(ui = ui, server = server)

Related

Adding an action (reset) button to the R shiny DT table

I modified the example here to include a save button as well. I want the user to be able to reset to the initial table after uploading a new file by adding a reset button (similar to the save button), but I wonder if it's possible to do so.
EDIT:
I want the button to be a part of the DT table and be placed next to the save.
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
DTOutput("head")
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = data.frame(
x = seq(1:12),
y = LETTERS[1:12])
)
observe({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
NULL)
})
output$head <- renderDT({
validate(need(!is.null(rv$dataframe)," Please upload a .csv file"))
datatable(rv$dataframe, extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(list( extend = 'csv',
filename = '//public/comments/comments.csv',
text = 'Save'))))
})
}
shinyApp(ui, server)
Here is a snapshot of the current version:
There could be multiple ways to handle this. Here is one of it -
Used a fixed dataframe mtcars[1:6, 1:6] as the default dataframe instead of one which generates random numbers which is difficult to compare imo.
Added an actionButton for Reset feature.
Created another reactive variable called dataframe_copy which always holds the default dataframe.
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
DTOutput("head"),
actionButton('reset', 'Reset')
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = mtcars[1:6, 1:6],
dataframe_copy = mtcars[1:6, 1:6]
)
observe({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
NULL)
})
observeEvent(input$reset, {
rv$dataframe <- rv$dataframe_copy
})
output$head <- renderDT({
validate(need(!is.null(rv$dataframe)," Please upload a .csv file"))
datatable(rv$dataframe, extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(list( extend = 'csv',
filename = '//public/comments/comments.csv',
text = 'Save'))))
})
}
shinyApp(ui, server)

How to get a folder path (not file path) in Shiny

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)

Saving user defined variables and running R scipt in Shiny

I have a shiny app that saves a few variables globally. I would like for the user to be able to click a button 'Run' That would 1) save the variables globally and 2) run an R script that uses those variables.
Below is where I am at, but I am not able to save the variables before hitting the button.
library(shiny)
ui <- fluidPage(
column(4, wellPanel(dateInput('date', label = 'Date input: yyyy-mm-dd', value = Sys.Date()))),
column(4, wellPanel(numericInput('STD', 'STD', 1.2))),
actionButton("Run", "Run the tool")
)
server <- function(input, output) {
observeEvent(input$STD, {
STDShiny <<- input$STD1
})
observeEvent(input$date, {
dateShiny <<- input$date
})
observeEvent(input$Run, {
source("someScript.R")
})
}
Example script: someScript.R
dir.create(paste(date,STD, sep = ''))
Any assistance is appreciated.
Somescript.R code:
dir.create(paste(.GlobalEnv$dateShiny, .GlobalEnv$STDShiny, sep = ''))
Shinyapp:
library(shiny)
library(tidyverse)
ui <- fluidPage(
column(4, wellPanel(dateInput('date', label = 'Date input: yyyy-mm-dd', value = Sys.Date()))),
column(4, wellPanel(numericInput('STD', 'STD', 1.2))),
actionButton("Run", "Run the tool") #The button to trigger script
)
server <- function(input, output) {
#Upon clicking in the button the following code gets executed
observeEvent(input$Run,{
#declare as variables in the global env with the values of the inputs
walk2(c('STDShiny', 'dateShiny'), c(input$STD, input$date), ~{
assign(..1, ..2, envir = .GlobalEnv)
})
#Run the script
exec(source, file = 'someScript.R')
})}
shinyApp(ui, server)

Download uploaded PDFs from Shiny App and delete files on close

I have a shiny app that uploads pdfs to do some checks on them and write a report to a table for the user to see. One of the requirements is to create a link to the document that downloads the initial uploaded pdf. Is there a way to access the temp directory files for download and put that download link in a DT datatable? I've tried coping files to www and they can be accessed that way but when the session ends the files are not deleted.
library(shiny)
library(DT)
ui <- fluidPage(
fileInput('pdfFile',
'Upload PDF',
multiple = TRUE,
accept = c('.pdf')),
DTOutput('Table')
)
server <- function(input, output) {
output$Table <- renderDT({
pdfTable <- cbind(input$pdfFile,
pdflink = sprintf('%s',
input$pdfFile$datapath,
input$pdfFile$name,
input$pdfFile$name),
stringsAsFactors = FALSE)
datatable(pdfTable,escape = FALSE)
})
}
shinyApp(ui = ui, server = server)
You can use session$onSessionEnded to execute some code after the client has disconnected (I confess I never tried):
server <- function(input, output, session) {
session$onSessionEnded(function(){
file.remove(......)
})
output$Table <- renderDT({
pdfTable <- cbind(input$pdfFile,
pdflink = sprintf('%s',
input$pdfFile$datapath,
input$pdfFile$name,
input$pdfFile$name),
stringsAsFactors = FALSE)
datatable(pdfTable, escape = FALSE)
})
}
I wasn't able to get the downloadButton to appear in the table, but the otherwise I believe the following meets your requirements. The basic idea is to copy the uploaded file to a new tempfile whose location gets saved in a reactiveVal until needed.
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
fileInput('pdfFile',
'Upload PDF',
multiple = TRUE,
accept = c('.pdf')),
downloadButton("download_button", "Download Selected File"),
DTOutput('Table')
)
server <- function(input, output) {
output$Table <- renderDT({
uploaded_df() %>%
select(-temp) %>%
datatable(selection = "single")
})
uploaded_df <- reactiveVal(tibble(name = character(), temp = character()))
observeEvent(input$pdfFile,{
temp_file_location <- tempfile(fileext = ".pdf")
file.copy(input$pdfFile$datapath, temp_file_location)
tibble(name = input$pdfFile$name,
temp = temp_file_location) %>%
bind_rows(uploaded_df(), .) %>%
uploaded_df()
})
output$download_button <- downloadHandler(
filename <- function() {
req(input$Table_rows_selected)
uploaded_df()$name[[input$Table_rows_selected]]
},
content <- function(file) {
file.copy(uploaded_df()$temp[[input$Table_rows_selected]], file)
}
)
}
shinyApp(ui = ui, server = server)

R SHINY: Clear/ update mainPanel depending on selectInput/numericInput choice

I'm pretty new to shiny (being playing around for about a week). And I'm trying to create an app that takes and input tab-separated text file and perform several exploratory functions. In this case I'm presenting a very simplified version of that app just to highlight what I want to do in a specific case:
Problem:
If you try the app with the sample data (or any data in the same format) you can notice that the app effectively performs the default summary table (if selectInput="summarize", then output$sumfile), but when you try to select "explore", the previous table gets removed from the mainPanel, and outputs the full file (selectInput="explore",then output$gridfile) in the place where it would be as if selectInput="summarize" was still selected.
If you re-select "summarize", excelOutput("sumfile") gets duplicated on the mainPanel.
My goal is simple:
excelOutput("sumfile") when selectInput="summarize" ONLY and
excelOutput("gridfile") when selectInput="explore" ONLY
without placement issues or duplications on the mainPanel
So far I've tried:
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="summarize")
return(NULL)
or
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="explore")
return(NULL)
To control what shows up on the mainPanel, but with placement and duplication issues.
sample data:
#Build test data
testdat<-data.frame(W=c(rep("A",3),
rep("B",3),
rep("C",3)),
X=c(letters[1:9]),
Y=c(11:19),
Z=c(letters[1:7],"",NA),
stringsAsFactors = FALSE)
#Export test data
write.table(testdat,
"your/path/file.txt",
row.names = FALSE,
sep = "\t",
quote = FALSE,
na="")
shiny app (app.R):
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
#get summary
output$sumfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") #if selectInput = "explore" return nothing
return(NULL)
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
#get full file
output$gridfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="summarize") #if selectInput = "summarize" return nothing
return(NULL)
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
shinyApp(ui = ui, server = server)
One way to do what you want is to use observeEvent for your inputs input$show and input$df and renderExcel based on your selection of `input$show. Here is an updated version for your code:
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
observeEvent({
input$show
input$df
}, {
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") {
output$gridfile<-renderExcel({
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
if(input$show=="summarize") {
output$sumfile<-renderExcel({
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
}
})
}
shinyApp(ui = ui, server = server)
Hope it helps!

Resources