Shiny: dynamic UI - a loop around downloadHandler? - r

I have a simple example Siny code that works fine (below). It generates a list of several tiny data frames (reactive object 'myout' in server.R). The number of the data frames is based on user's input.('NumRuns').
My current code allows the user to download the first of these data frames - via downloadButton in ui.R and downloadHandler in server.r.
I am wondering if it's possible to create a loop around both downloadButton and downloadHandler so that - after the analysis is run (actionButton) - the user gets as many buttons to download as there were data frames generated in 'myout'. Is it even possible?
Or maybe it's possible to create one downloadButton that allows the user to 'pick' which data frame s/he wants to download?
Thanks a lot for any hints - because I am not sure how to approach it!
My code (I run it using: runApp(launch.browser = T)
### My ui.R code:
shinyUI(pageWithSidebar(
headerPanel("My App"),
sidebarPanel(
numericInput('NumRuns','Number of runs',value=3,min=3,max=10,step=1),
br(),
actionButton(inputId="goButton","Run!"),
br(),
br(),
textInput("downloadData","Save My Data Frame:",value="Data Frame 1"),
downloadButton('downloadData','Save my file!')
),
mainPanel(
tabsetPanel(
tabPanel("Shows the 1st data frame",tableOutput("mydf"))
)
)
))
### My 'server.R' code:
shinyServer(function(input,output){
### Creating files for displaying and downloading
myout = reactive({
if(input$goButton==0) return(NULL)
nrruns=input$NumRuns
mylist=NULL
for(i in 1:nrruns){
mylist[[i]]<-data.frame(a=rnorm(10),b=runif(10))
names(mylist)[i]<-paste("dataframe",i,sep="")
}
return(mylist)
})
# Grabbing only the 1st data frame:
output$mydf <- renderTable({
if(input$goButton==0) return(NULL)
myout()$dataframe1
})
# Allowing to download only the 1st data frame:
output$downloadData <- downloadHandler(
filename = function() { paste(input$downloadData, " ",Sys.Date(),".csv",sep="") },
content = function(file) {
write.csv(myout()$dataframe1,file,row.names=F)
}
)
})

This post might gives you the answer.
https://groups.google.com/forum/#!msg/shiny-discuss/qGN3jeCbFRY/xOW5qoVrr94J
Yes, this is possible. You'll need to use uiOutput/renderUI to render the buttons, each with a different ID (e.g. downloadData1 through downloadDataN). For defining the download handlers dynamically, use a pattern like:
observe({
lapply(1:N, function(i) {
output[[paste0("downloadData", i)]] <- downloadHandler(...)
})
})
the important thing there being that you can assign to output[[id]] if your output names are dynamic.

Related

R Shiny: Switching datasets based on user input

I am working on a shiny app where users can upload their own data and get some plots and statistics back. However, I also want to include an example dataset that gets used instead if the user presses a specific button. Importantly, the plots should be reactive so that users get updated plots whenever they click on the "use example data instead" button or upload a new file. I tried to recreate my current approach of overwriting the data object as best as I could here, but simply defining the data object twice doesn't overwrite the data in the way I hoped it would. Any suggestions are appreciated.
library(shiny)
# UI
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("Upload", "Upload your own Data"),
actionButton("Example", "Use Example Data instead")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("hist")
)
)
)
# Server Logic
server <- function(input, output) {
data <- eventReactive(input$Upload,{input$Upload})
data <- eventReactive(input$Example, {faithful$eruptions})
output$hist <- renderPlot({hist(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use a reactiveVal like this:
server <- function(input, output) {
my_data <- reactiveVal()
observeEvent(input$Upload, {
tmp <- read.csv(input$Upload$datapath)
## do whatever is needed to parse the data
my_data(tmp)
})
observeEvent(input$Example, {
my_data(faithful)
})
output$hist <- renderPlot({
dat <- as.data.frame(req(my_data()))
dat <- dat[, sapply(dat, is.numeric), drop = FALSE]
validate(need(NCOL(dat) > 1, "No numeric columns found in provided data"))
hist(dat[,1])
})
}
Depending on upload or button click, you store your data in my_data which is a reactive value. Whenever this value changes, the renderPlot function fires and uses the correct data.
You can use a reactive value to access whether the user has chosen to use an example dataset or use their own dataset. The user can choose to switch between the active dataset using an input from your UI.
Here's the official explanation on reactive values from RStudio: link
This would go in your ui.R:
radioButtons("sample_or_real",
label = h4("User data or sample data?"),
choices = list(
"Sample Data" = "sample",
"Upload from user data" = "user",
),
selected = "user"
)
This would go in your server.R:
data_active <- reactive({
# if user switches to internal data, switch in-app data
observeEvent(input$sample_or_real_button, {
if(input$sample_or_real == "sample"){
data_internal <- sample_data_object
} else {
data_internal <- uploaded_data_object
}
})
Note, that when using a reactive value in your server.R file, it must have parentheses () at the end of the object name. So, you call the data_internal object as data_internal().

Subsetting a reactive object in Shiny

I am in the process of learning Shiny and developing a simple app. The start of the program will allow a user to import a CSV file and then apply a filter variable(s) if needed. They will only be able to use factors as filter variables at this stage. I apply the filters on an iterative basis. So, one can apply a filter based on a factor level and then apply another factor level and so on until completed.
The best application I could find of being able to subset a reactive data frame was to apply the data frame as a reactive value. This seems to work, but I am having a couple issues that I can't figure out how to resolve.
1) Given the filtering is an iterative process, I would like to keep track and print out each variable and level applied during the filtering process. The best way I could figure out was creating a global variable (<<-) and using renderText to print out the contents after hitting the apply filter button. The issue is renderText just flashes on the screen and quickly disappears. I included a print to console statement that verifies the text is being saved correctly. I believe this is happening from the filter being applied to the reactive data frame and the updating process, but I can't figure out how to stop the text from disappearing on the screen?
2) When I try to save out the reactive data frame at the end of the shiny code, I get the following error "Warning: Error in $: $ operator is invalid for atomic vectors". I tried a couple things, but don't really understand what is going on here because the object "file$dfSource" is not like a normal reactive data frame dfSource()?
The shiny app below uses iris data so its easier to use/test. I don't know if applying the data frame to a reactive value is the best way to program this or if there is an easier way to do all this - just trying to learn best approach here.
library(shiny)
allfilters <- c()
ui <- (fluidPage(
# Application title
titlePanel("Filter Data"),
# Input Forms
sidebarLayout(
sidebarPanel(
h3("Data"),
checkboxInput("selectFilter", label = "Apply Filter Variable", value = FALSE),
uiOutput("selectFilterVar"),
uiOutput("selectFilterGroup"),
helpText("Apply filter to data"),
uiOutput("selectFilterButton"),
helpText("Reset data to total"),
uiOutput("selectResetButton"),
h3("Download Data"),
helpText("Download Data"),
downloadButton("downloadData", "Download File")
),
# Output Forms
mainPanel(
tabsetPanel(
tabPanel("Summary",
h2("Output Summary"),
textOutput("ncases"),
textOutput("selectedfilters")))
)
)
))
server <- (function(input, output, session) {
data <- iris
file <- reactiveValues(dfSource = data)
## Select Filter Variable
output$selectFilterVar <- renderUI({
req(file$dfSource)
if (input$selectFilter){
selectInput("filterVar", "Select Filter Variable", multiple = FALSE, choices = sort(names(file$dfSource[, sapply(file$dfSource, is.factor), drop = FALSE])))
}
})
# Select Filter Group(s)
output$selectFilterGroup <- renderUI({
req(file$dfSource)
req(input$filterVar)
if (input$selectFilter){
selectInput("filterGroup", "Select Filter Group", multiple = TRUE, choices = sort(unique(file$dfSource[,input$filterVar])))
}
})
# Apply Filter Button
output$selectFilterButton <- renderUI({
req(file$dfSource)
if (input$selectFilter) {
actionButton("filterButton", "Apply Filter")
}
})
# Apply filter group to data
observeEvent(input$filterButton, {
temp <- file$dfSource[(file$dfSource[,input$filterVar] %in% c(input$filterGroup)),]
file$dfSource <- temp
})
# Reset Total Sample Button
output$selectResetButton <- renderUI({
req(file$dfSource)
if (input$selectFilter) {
actionButton("resetButton", "Reset Total")
}
})
# Reset data to total sample
observeEvent(input$resetButton, {
file$dfSource <- data
updateCheckboxInput(session, "selectFilter", value = FALSE)
allfilters <- NULL
})
## Summary number of cases
output$ncases <- renderText({
req(file$dfSource)
mainTitle <- paste("Number of cases =" , nrow(file$dfSource))
return(mainTitle)
})
## Capture selected filter variables in global object
testfilter <- eventReactive(input$filterButton, {
appliedfilter <- paste0(input$filterVar, "(", input$filterGroup,")")
if (is.null(allfilters)) {
allfilters <<- paste("Selected Filters:", appliedfilter)
} else {
allfilters <<- paste(allfilters, "&", appliedfilter)
}
return(allfilters)
})
# Print out filter variables in global object
output$selectedfilters <- renderText({
filteroutput <- testfilter()
print(filteroutput)
return(filteroutput)
})
## Save out case data file
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(file$dfSource, file)
}
)
})
shinyApp(ui, server)
1) Storing it a global variable is probably not a good idea (scope in shiny is already complicated enough!). You already have a reactiveValues object, why not use that?
This alone, however, is not enough; the problem seems to be the eventReactive - I'm not quite sure why.
This works:
# this replaces the testfilter eventReactive
observeEvent(input$filterButton, {
appliedfilter <- paste0(input$filterVar, "(", input$filterGroup,")")
if (is.null(file$allfilters)) {
file$allfilters <- paste("Selected Filters:", appliedfilter)
} else {
file$allfilters <- paste(file$allfilters, "&", appliedfilter)
}
})
# Print out filter variables in global object
output$selectedfilters <- renderText({
filteroutput <- file$allfilters
print(filteroutput)
return(filteroutput)
})
2) The error is in the content function you pass to downloadHandler. The parameter is called file, which shadows the file reactiveValues. This works:
## Save out case data file
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(filetarget) {
write.csv(file$dfSource, filetarget)
}
)
PS ad 1: It might be better to store the filters, instead of storing the filtered data frame and a string listing the filters. If your users change their mind, they have to start over from the beginning, but if you store the filters you can have a table or similar that allows deleting/editing individual filters. You could just store a list of two-element vectors, then iterate though the list to filter the data.

Specifying data range from excel in Shiny

I would like to know if its possible to create a shiny app which allows you to upload an excel file and which allows you to select a data range based on sheet name and cell range.
I would like to build upon it in order to showcase some regression analysis but haven't been able to find a starting point.
John, it is always a good idea to take a look at the Shiny gallery and take a look at past answers on Stack Overflow for code examples when faced with issues like these.
Here is a example tutorial for data upload. This can be CSV and not just xls.
https://shiny.rstudio.com/gallery/file-upload.html. But code layout may be useful for you to set up your inputs.
Keep it simple? You might be able to save the data range you want out as a csv file so your users do not have specify data range and sheet. I do this so users just simply need to look at what data sets they want in a select box and not go hunt for the data. See example below. (This may save you lots of error trapping code).
Do not forget to transform your data. Note this example where you might need to factor some of your variables.
As outlined above by Parth see https://www.r-bloggers.com/read-excel-files-from-r/ for more detail on packages Xl_Connect and xlsx. You can specify sheets.
WORKING WITH FILES
Some code snippets that may help you. I have the data blocks already available as csv files. Setting up an selectInput with a list of these files
# in ui.R
selectInput(("d1"), "Data:", choices = data.choices)
I fill data.choices in global.R with this code.
# filter on .csv
data.files <- list.files(path = "data", pattern = ".csv")
# dataset choices (later perhaps break by date)
# sort by date most recent so selectInput takes first one
data.choices <- sort(data.files, decreasing = TRUE)
I have a reactive around the selectInput that then loads the data. (I use data.tables package fread so you will need to install this package and use library(data.tables) if you use this code).
dataset1 <- reactive({
validate(
need(input$d1 != "", "Please select a data set")
)
if (!is.null(input$d1)) {
k.filename <- input$d1 # e.g. 'screendata20160405.csv'
isolate({
## part of code this reactive should NOT take dependency on
# LOAD CSV
s.dt <- fread(file.path("data", k.filename),
na.strings = c("NA", "#N/A")) %>%
rename(ticker = Ticker)
# You might choose to rather dot.the.column.names to save DT issues
#setnames(DT, make.names(colnames(DT)))
# SET KEYS IF RELEVANT
k.id.cols <- c("ticker")
if ("date" %in% names(s.dt)) {
k.id.cols <- c(k.id.cols, "date")
}
setkeyv(s.dt, k.id.cols)
# NAME CHANGES rename columns if necessary
setnames(s.dt, "Short Name", "name")
})
} else {
s.dt <- NULL #input$d1 is null
}
s.dt
})
Note the validates as my data is plotted and I want to avoid error messages. Please appreciate the key setting and renaming columns code above is not necessary but specific to my example, but shows you what you can do to get your data "ready" for user.
GET SHEET NAMES OUT
John this is very useful. Take a look at this long thread on google groups https://groups.google.com/forum/#!topic/shiny-discuss/Mj2KFfECBhU
Huidong Tian had this very useful code at 3/17/14 (but also see Stephane Laurent's code about closing XLConnect too to manage memory):
library(XLConnect)
shinyServer(function(input, output) {
Dat <- reactiveValues()
observe({
if (!is.null(input$iFile)) {
inFile <- input$iFile
wb <- loadWorkbook(inFile$datapath)
sheets <- getSheets(wb)
Dat$wb <- wb
Dat$sheets <- sheets
}
})
output$ui <- renderUI({
if (!is.null(Dat$sheets)) {
selectInput(inputId = "sheet", label = "Select a sheet:", choices = Dat$sheets)
}
})
observe({
if (!is.null(Dat$wb)) {
if (!is.null(input$sheet)){
dat <- readWorksheet(Dat$wb, input$sheet)
print(names(dat))
output$columns <- renderUI({
checkboxGroupInput("columns", "Choose columns",
choices = names(dat))
})
}
}
})
})
shinyUI(pageWithSidebar(
# Include css file;
tagList(
tags$head(
tags$title("Upload Data"),
tags$h1("Test")
)
),
# Control panel;
sidebarPanel(
fileInput(inputId = "iFile", label = "Escolha um arquivo:", accept="application/vnd.ms-excel"),
radioButtons("model", "Escolha do Modelo:",
list("CRS" = "crs",
"VRS" = "vrs")),
br(),
tags$hr(),
uiOutput(outputId = "ui"),
uiOutput(outputId = "columns")
),
# Output panel;
mainPanel()
))
You could include inputs for the file path and cell range, and use a shiny action button to send the input variables to read_excel()
https://shiny.rstudio.com/articles/action-buttons.html
http://readxl.tidyverse.org

accessing reactiveValues in a reactiveValuesToList

Instead of specifying separate fileInput variables, I'd like to use reactiveValues to store uploaded CSV dataframes, manipulate them in some way, and then store them for accession later. My design is to name each dataframe by its filename and append to the reactiveValue rvTL. My questions are,
How can I access individual dataframes under the list I created using reactiveValuesToList(rvTL)?
Next step, how to create a selectInput menu to access the individual dataframes uploaded by fileInput
To learn this concept, I am piggybacking off the answer from Dean Attali and made rvTL the same as his values variable.
R shiny: How to get an reactive data frame updated each time pressing an actionButton without creating a new reactive data frame?
I've gone over many example codes on reactiveValues, yet still at an incomplete understanding. Most examples are using some sort variation on reactiveValuesToList(input) R Shiny: Keep/retain values of reactive inputs after modifying selection, I'm really not seeing the logic here. Any help/suggestions would be appreciated!
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("tab1",
numericInput("Delete", "Delete row:", 1, step = 1),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL"),
tableOutput("rvTL_out")
),
tabPanel("tab2",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(rvTL = NULL)
observeEvent(input$file, {
values$df_data <- read.csv(input$file$datapath)
rvTL[[input$file$name]] <- c(isolate(rvTL), read.csv(input$file$datapath))
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL <- renderPrint(names(reactiveValuesToList(rvTL))[1] )
output$rvTL_out <- renderTable(reactiveValuesToList(rvTL)[[1]])
output$df_data_out <- renderTable(values$df_data)
})
))
It really is as straightforward as you thought. You were close too, just fell into some syntax traps. I made the following changes:
that c(isolate(.. call was messing things up, I got rid of it. It was leading to those "Warning: Error in as.data.frame.default: cannot coerce class "c("ReactiveValues", "R6")" to a data.frame" errors.
Also you were reusing the rvTL name too often which is confusing and can lead to conflicts, so I renamed a couple of them.
I also added a loaded file name list (lfnamelist) to keep track of what was loaded. I could have used names(rvTL$dflist) for this but it didn't occur to me at the time - and I also this is a useful example of how to organize related reactive values into one declaration.
And then I added rendered selectInput so you can inspect what is saved in the reactiveValue list.
So here is the adjusted code:
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("rvTL tab",
numericInput("Delete", "Delete row:", 1, step = 1),
uiOutput("filesloaded"),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL_names"),
tableOutput("rvTL_out")
),
tabPanel("values tab",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(dflist=NULL,lfnamelist=NULL)
observeEvent(input$file, {
req(input$file)
values$df_data <- read.csv(input$file$datapath)
rvTL$dflist[[input$file$name]] <-read.csv(input$file$datapath)
rvTL$lfnamelist <- c( rvTL$lfnamelist, input$file$name )
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL_names <- renderPrint(names(rvTL$dflist))
output$rvTL_out <- renderTable(rvTL$dflist[[input$lftoshow]])
output$df_data_out <- renderTable(values$df_data)
output$filesloaded <- renderUI(selectInput("lftoshow","File to show",choices=rvTL$lfnamelist))
})
))
And here is a screen shot:

Save input in file to continue in an other session the data analysis in R Shiny App

I work on a long Shiny App where I want to give te possibility for the user to save the input in a Rdata file in order to load it later.
I manage to do that with downloadhandler, fileInput and renderUI,
But I have more than 200 input, I am sure there is a simple way.
All idea are welcome, Thanks in advance
Dimitri
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Save Input"),
sidebarPanel(
downloadButton("download.input","Download Input"),
## Bolean to read or not the old input of the file load bellow
checkboxInput("use.list.input","Use Rdata for input",F),
fileInput('file.Rdata','Reload the input of a last session')
),
mainPanel(
## All the input will become uiOUtput
uiOutput("num1"),
uiOutput("num2")
)
),
server = function(input,output){
## The downloadHandler to write the current input
output$download.input <- downloadHandler(
filename = function() { paste0("input", '.csv') },
content = function(name) {
write.table(save.input(), file=name)
}
)
### Two object, one for write the current input, one for read the old input
save.input<-reactive({
data<-cbind(c("number1","number2"),c(input$number1,input$number2))
return(data)
})
table.input<-reactive({
inFile<-input$file.Rdata
table.input<-read.table(inFile$datapath)
return(table.input)
})
### RenderUI ###
output$num1<-renderUI({
if(input$use.list.input==T){
default<-table.input()[1,2]
}else{default<-1}
numericInput("number1","number1",default)
})
output$num2<-renderUI({
if(input$use.list.input==T){
default<-table.input()[2,2]
}else{default<-2}
numericInput("number2","number2",default)
})
}
))
Perhaps this entry on GitHub from "aagarw30/R-Shinyapp-Tutorial" would be useful. Storing a Visitor Counter in a separate file is similar to your dilemma.
https://github.com/aagarw30/R-Shinyapp-Tutorial/tree/master/ShinyAppVisitorHitCounter
The server.R code loads number updates to a separate counter.Rdata file using this code:
output$counter <-
renderText({
if (!file.exists("counter.Rdata"))
counter <- 0
else
load(file="counter.Rdata")
counter <- counter + 1
save(counter, file="counter.Rdata")
paste("Hits: ", counter)
})

Resources