I am building a Shiny application and I am trying to add a download button to download csv files (tables taken from a database). Basically I have a checkboxgroupInput with 4 values, every value corresponds to a different table and the button should download the tables that are "ticked" is a single zip file
I have tried different versions of my code, even if it does not throw any errors, when I run the application, when the download button is clicked it tries to download an inexistent files. I think that the for is never executed, but I don't understand why. So my idea was to populate selectedCountry with the ifelse and then write everyelement as csv and the create the ziip with the csv. I have tried to download the single table, so ITALY_DB etc are not empty or null, they work properly.
server.R
Italy_tbl <- data.frame(ITALY_DB())
ne_tbl <- data.frame(NE_DB())
turkey_tbl <- data.frame(TURKEY_DB())
usa_tbl <- data.frame(USA_DB())
selectedCountry<- vector()
observeEvent(input$country,{
ifelse (input$country == "Italy",selectedCountry <-
C(selectedCountry,Italy_tbl), selectedCountry<-selectedCountry)
ifelse (input$country == "Turkey",selectedCountry <-
C(selectedCountry,turkey_tbl),selectedCountry<-selectedCountry)
ifelse (input$country == "Netherlands",selectedCountry <-
C(selectedCountry,ne_tbl ),selectedCountry<-selectedCountry)
ifelse (input$country == "USA",selectedCountry <-
C(selectedCountry,usa_tbl),selectedCountry<-selectedCountry)
})
output$download <- downloadHandler(
filename = function() {
paste0(input$country,".zip")
#paste(input$country, ".csv", sep = "")
},
content = function(file) {
#go to a temp dir to avoid permission issues
owd <- setwd(tempdir())
print(tempdir())
on.exit(setwd(owd))
files <- NULL;
for(i in selectedCountry){
fileName <- paste(input$country,"_0",".csv",sep = "")
write.csv(selectedCountry[i],fileName,sep = ';', row.names = F,
col.names = T)
files <- c(fileName,files)
}
zip(file,files)
}
)
ui.R
column(3,inputPanel(
sliderInput('yearSlider', 'Select Years', sep="",
min=2009, max=2018, step=1, value =c(2009,2018)),
(checkboxGroupInput("country",h4('Select Countries'),
choices = list("Italy" = 1,
"Netherlands" = 2,
"Turkey" = 3,
"USA" = 4),
selected = 1)),
radioButtons(
inputId = 'plotCount'
, label = 'Plot Count'
, choices = as.character(1:2)
, inline=T
),
downloadButton("download", "Download Data")
))
I am sure there is something I am missing, but I just don't understand what
Related
I'm building an app that takes excel files as an input. To protect against errors, I first check if the file is an .xls or .xslx, and then I check if it contains the right content based on the sheet names.
I'm encountering that the first time I upload the right file, the app works as expected:
But when I hit 'browse' and try to upload again, I get this:
It only shows the right label on the first time.
This doesn't happen if I upload an excel file with the wrong info multiple times
If I then try to upload a different type of file, I get this:
Here's the simple code
library(shiny)
library(readxl)
library(tools)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(),
fileInput("file", "upload file", multiple = FALSE),
tableOutput("data")
)
server <- function(input, output, session) {
data <- reactive({
req(input$file)
path <- input$file$datapath
good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
feedbackDanger(inputId = "file",
show=!good_file,
color = "orange",
text = "Upload only .xls or .xlsx files")
req(good_file)
good_sheet <- "Special Sheet" %in% excel_sheets(path)
feedbackDanger(inputId = "file",
show=!good_sheet,
color = "#E6007E",
text = "File must contain the special sheet'")
req(good_sheet)
read_excel(path)
})
output$data = renderTable(data())
}
shinyApp(ui, server)
Not sure, but perhaps this is due to the fact that the two feedbacks are the same.
Here is a solution:
server <- function(input, output, session) {
data <- reactive({
req(input$file)
hideFeedback("file") # hide feedback, if any
path <- input$file$datapath
good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
if(!good_file){
showFeedbackDanger(inputId = "file",
color = "orange",
text = "Upload only .xls or .xlsx files")
}
req(good_file)
good_sheet <- "Special Sheet" %in% excel_sheets(path)
if(!good_sheet){
showFeedbackDanger(inputId = "file",
color = "#E6007E",
text = "File must contain the special sheet'")
}
req(good_sheet)
read_excel(path)
})
output$data = renderTable(data())
}
I am creating an app to allow user to upload two excel files and carry over the comments one to the other one, then to download the merged file. The downloadhandler is not working when I tried to run it on the published server, however it running properly locally in rstudio. Any thoughts/suggestions?
library(plyr)
library(dplyr)
library(tidyr)
library(readxl)
library(xlsx)
library(openxlsx)
ui <- fluidPage(
br(),
titlePanel("Excel File Merging Tool"),
br(),
br(),
sidebarLayout(
sidebarPanel(
fileInput("file1", label = h3("Upload New File"), multiple = FALSE, buttonLabel = "Browse", placeholder = "No file selected"),
fileInput("file2", label = h3("Upload Old File"), multiple = FALSE, buttonLabel = "Browse", placeholder = "No file selected"),
actionButton("actionMerge", label = "Merge Uploaded Files"),
hr(),
downloadButton('downloadData', 'Download Merged File')
),
mainPanel(
)
)
)
#Defined Funtions
read_excel_allsheets <- function(filename, tibble = FALSE) {
sheets <- readxl::excel_sheets(filename)
x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X))
if(!tibble) x <- lapply(x, as.data.frame)
names(x) <- sheets
x
}
server <- function(input, output) {
getData <- eventReactive(input$actionMerge, {
inFile1 <- input$file1
if (is.null(inFile1)){
return(NULL)
} else {
mydata1= read_excel_allsheets(inFile1$datapath)}
inFile2 <- input$file2
if (is.null(inFile2)){
return(NULL)
} else {
mydata2= read_excel_allsheets(inFile2$datapath)}
wb <- createWorkbook()
#find tabs not in old file
newSheets <- (names(mydata1))[which(!(names(mydata1)) %in% (names(mydata2)))]
if (length(newSheets) > 0){
for (n in newSheets)
{
mydata6 <- bind_rows(mydata1[n])
addWorksheet(wb, sheetName = names(mydata1[n]))
writeData(wb, names(mydata1[n]), mydata6)
}}
for (i in names(mydata1)){
for (j in names(mydata2)){
if (i == j ){
if ((nrow(as.data.frame(mydata1[i]))) == 0 | (nrow(as.data.frame(mydata2[j]))) == 0 )
{
mydata6 <- bind_rows(mydata1[i])
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}
else {
if (ncol(bind_rows(mydata1[i])) == ncol(bind_rows(mydata2[j])) )
{
mydata6 <- bind_rows(mydata1[i])
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}
else {
# validate(
# column_mismatch(mydata1[i], mydata2[j])
# )
drop_in_key <- c("Earliest data creation time", "Latest data update time", "Timestamp of last save in clinical views", "Date time value from the source file name",
"Lowest Date of Rec, Pg, Inst or Subj", "Record Minimum Created Datetime Stamp", "Record Maximum Updated Datetime Stamp", "Accessible to Jreview Timestamp")
mydatax0 = bind_rows(mydata1[i])
mydatax = bind_rows(mydata1[i])[,!(names(bind_rows(mydata1[i])) %in% drop_in_key)]
mydatanew <- mydatax %>% unite(col="Key", 1:(ncol(mydatax)-1), sep=";", remove=FALSE)
mydatanew$Newflag <- "New"
mydatanew0 = mydatanew %>% select(Key, Newflag)
mydatanew1 = bind_cols(mydatanew0,mydatax0)
mydatay0 = bind_rows(mydata2[j])
mydatay = bind_rows(mydata2[j])[,!(names(bind_rows(mydata2[j])) %in% drop_in_key)]
mydataold <- mydatay %>% unite(col="Key", 1:(ncol(mydatay)-1), sep=";", remove=FALSE)
mydataold$Oldflag <- "Old"
mydataold0 <- mydataold %>% select(Oldflag, Key)
mydataold1 <- bind_cols(mydataold0,mydatay0)
mydataold2 = select(mydataold1, Key, Oldflag, (ncol(bind_rows(mydata1[i]))+3):((ncol(mydataold1))))
mydata3 <- merge(x=mydatanew0, y=mydataold2, by="Key", all=TRUE)
mydata4 <- subset(mydata3, Newflag == "New")
mydata5 <- merge(x=mydatanew1, y=mydata4, by="Key", all.y=TRUE)
drop <- c("Key", "Newflag.x", "Oldflag", "Newflag.y")
mydata6 = mydata5[,!(names(mydata5) %in% drop)]
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}}}
else
NULL
}
}
saveWorkbook(wb, file = "aaa.xlsx" , overwrite = TRUE)
})
output$downloadData <- downloadHandler(
filename = function() {
paste0(input$file2, ".xlsx")
},
content = function(file) {
file.copy("aaa.xlsx", file)
})
}
shinyApp(ui = ui, server = server)```
Here's a toy shiny app that provides a solution that is safe for concurrent users. All operations are done on either (a) temporary files that shiny controls, or (b) in the directory of one of these temp files, using tempfile to create the new filename. Both of those assure new-file uniqueness, so no filename collisions. (I believe shiny's method is temporary directories under a temp-directory, at least that's what I'm seeing in my dev env here. So ... seemingly robust.)
The some_magic_function function is mostly because I didn't want to generate an example with openxlsx and sample datas and such, mostly my laziness. For your code, remove all of the if (runif... within the tryCatch and replace with whatever you need, ensuring your code ends by returning the filename with the new data (or updated) data.
... but keep the tryCatch! It will ensure that the function always returns "something". If all code succeeds, then the function will return the filename with new/updated data. If something goes wrong, it returns a class "error" string that can be used to communicate to the user (or otherwise react/recover).
Last thing, though it's just icing on my cupcake here: I use the shinyjs package to disable the 'merge' and 'download' buttons until there is valid data. Frankly, once the two file-selection inputs have something set, the "merge" button will likely never be disabled. However, if there's ever a problem during the merge/update, then the download button will be disabled (until a merge/update happens without error).
library(shiny)
library(shinyjs)
# a naive function that just concatenates the files, first removing
# the header row from the second file
some_magic_function <- function(f1, f2) {
# put the output file in the same directory as 'f2'
d <- dirname(f2)
if (!length(d)) d <- "."
output_file <- tempfile(tmpdir = d, fileext = paste0(".", tools::file_ext(f2)))
tryCatch({
if (runif(1) < 0.2) {
# purely for StackOverflow demonstration
stop("Something went wrong")
} else {
# add your stuff here (and remove the runif if/else)
writeLines(c(readLines(f1), readLines(f2)[-1]), output_file)
output_file # you must return this filename
}
}, error = function(e) e)
# implicitly returning the output_file or an error (text with class 'error')
}
shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
fileInput("file1", label = "File #1", multiple = FALSE, placeholder = "No file selected"),
fileInput("file2", label = "File #2", multiple = FALSE, placeholder = "No file selected"),
actionButton("btn", label = "Merge uploaded files"),
hr(),
downloadButton("dnld", "Download merged file")
),
mainPanel(
tableOutput("tbl"),
hr(),
verbatimTextOutput("bigtext")
)
)
),
server = function(input, output, session) {
# start with neither button enabled
for (el in c("btn", "dnld")) shinyjs::disable(el)
# disable the 'merge' button until both files are set
observeEvent({
input$file1
input$file2
}, {
req(input$file1, input$file2)
shinyjs::toggleState("btn", isTRUE(file.exists(input$file1$datapath) && file.exists(input$file2$datapath)))
})
# this is the "workhorse" of the shiny app
newfilename <- eventReactive(input$btn, {
req(input$file1, input$file2)
some_magic_function(input$file1$datapath, input$file2$datapath)
})
# prevent the download handler from being used if the new file does not exist
observeEvent(newfilename(), {
cond <- !is.null(newfilename()) &&
!inherits(newfilename(), "error") &&
file.exists(newfilename())
shinyjs::toggleState("dnld", cond)
})
output$dnld <- downloadHandler(
filename = function() paste0("merged_", input$file2),
content = function(f) {
file.copy(newfilename(), f)
}
)
# some sample output, for fun
output$tbl <- renderTable({
req(newfilename(),
!inherits(newfilename(), "error"),
file.exists(newfilename()))
read.csv(newfilename(), nrows = 10, stringsAsFactors = FALSE)
})
output$bigtext <- renderText({
if (inherits(newfilename(), "error")) {
# if we get here then there was a problem
as.character(newfilename())
} else "(No problem)"
})
}
)
Notes:
shiny::req is supposed to ensure the data has something useful and "truthy" in it (see shiny::isTruthy). Normally it is good with detecting nulls, NA, empty variables, etc ... but it "passes" something that has class "error", perhaps counter-intuitive. That's why I had to be a little more explicit with conditions in some of the reactive blocks.
One impetus for having the merge/update functionality within an external not-shiny-requiring function (some_magic_function here) is that it facilitates testing of the merge functionality before adding the shiny scaffolding. It's difficult to test basic functionality when one is required to interact with a browser for every debugging step of basic functionality.
I would like to be able to upload a dataset, select a set of columns, transform the selected columns (i.e. apply a function), then download the modified file. I have been trying to do so with the following code:
library(shiny)
library(DT)
library(shinyWidgets)
library(plyr)
library(dplyr)
library(RecordLinkage)
library(readxl)
cleanup <- function(x){
x <- as.character(x) # convert to character
x <- tolower(x) # make all lowercase
x <- trimws(x, "both") # trim white space
return(x)
}
ui <- fluidPage(
h2("Record Linkage Data"),
fileInput("file1", "Upload file for cleaning", accept = c("xls", "csv"), multiple = F),
actionButton(inputId = "clean", label = "Clean Data"),
downloadButton("download1", "Download file1"),
pickerInput(width = "75%",
inputId = "pick_col1",
label = "Select columns to display",
choices = colnames(file1),
selected = colnames(file1),
options = list(
`actions-box` = T,
`selected-text-format` = paste("count > ", length(colnames(file1)) - 1),
`count-selected-text` = "Alle",
liveSearch = T,
liveSearchPlaceholder = T
),
multiple = T),
DT::dataTableOutput("mytable")
)
load_path <- function(path) {
req(input$file)
ext <- tools::file_ext(path)
if (ext == "csv"){
read.csv(path, header = T)
} else if (ext == "xls" || ext == "xlsx"){
read_excel(path)
} else{
stop("Unknown extension: '.", ext, "'")
}
}
server <- function(input, output, session){
file1 <- reactive(load_path(input$selection$datapath[[1]]))
#file2 <- reactive(load_path(input$selection$datapath[[2]]))
eventReactive(input$clean, {
output$mytable <- DT::renderDataTable({
data.frame(lapply(select(file1, input$pick_col1), cleanup))
})
})
output$download <- downloadhandler(
filename = function(){
paste0(tools::file_path_sans_ext(input$filename), ".csv")
},
content = function(file){
write.csv(data(), file)
}
)
}
shinyApp(ui, server)
When I run the above code, I get the error : Error in is.data.frame(x) : object 'file1' not found. I am unsure why this is but I have been struggling to understand naming things in shiny. For example: I want to upload file1, then transform it. Do I continue to refer to file1 when I want to download it? These may seem like silly questions but I am asking because I don't know and I'm trying to learn. There seem to be lots of different approaches.
I would like to:
1. Load a file
2. Select columns (pickerInput is what I have been trying, but selectInput would suffice I suppose)
3. via action button, apply a pre-specified function to the selected columns
4. download the transformed dataset as a .csv
I've encountered some problems
It is a very silly one (it happens to all of us). You should write downloadHandler instead of downloadhandler.
The main problem: Your pickerInput is trying to select the column names of the data frame file1 when it does not exists. When you run the application the code is trying to find a file1 data frame and look its column names, but since at that time you haven't uploaded anything yet, it throws an error.
On how you read files: I am not familiar with how you read files, I suggest you do something similar than what is done in this example. https://shiny.rstudio.com/gallery/file-upload.html. Note you need to use a read.* function and point the result to another name, df in the example.
How would I solve it:
1. Set choices and selected options to NULL by default. Something like the following should work:
pickerInput(width = "75%",
inputId = "pick_col1",
label = "Select columns to display",
choices = NULL,
selected = NULL,
options = list(
`actions-box` = T,
# `selected-text-format` = paste("count > ", length(colnames(file1)) - 1),
`count-selected-text` = "Alle",
liveSearch = T,
liveSearchPlaceholder = T
),
multiple = T)
Add an updatePickerInput in the server side within an observeEvent. Something like this should work.
observeEvent(input$file1, {
req(input$file1) # ensure the value is available before proceeding
df <- read.csv(input$file1$datapath)
updatePickerInput(session = session,
inputId = "pick_col1",
choices = colnames(df),
# ... other options)
})
I haven't looked much if there are other problems with the code.
I suggest you start from the example in the link shared and start modifying it until you get what you want.
If that does not work, let me know and I can try to figure it out
Good luck!
*Hi, I'm trying to download multiple csv file from a unique excel file. I want to download (using only one downloadbutton) the differents sheets from the excel file.
I don't understand why a for() loop doesn't work, and I can't see how can I do?
If anyone knows..
The point is to download differents csv files, which are in the "wb" list (wb[1],wb[2]...)
Thanks.
Here is my code who works with the third sheet for instance (and sorry for my bad english) :
ui :
library(readxl)
library(shiny)
library(XLConnect)
fluidPage(
titlePanel("Export onglets en CSV"),
sidebarLayout(
sidebarPanel(
fileInput('fichier1','Choisissez votre fichier excel :',
accept = ".xlsx"),
fluidPage(
fluidRow(
column(width = 12,
numericInput("sheet","Indiquez l'onglet à afficher :",min = 1, value = 1),
tags$hr(),
textInput('text',"Indiquez le nom des fichiers :"),
tags$hr(),
h4("Pour télécharger les fichiers .csv :"),
downloadButton("download","Télécharger")
)
)
)),
mainPanel(
tabsetPanel(
tabPanel('Importation',
h4("Fichier de base:"),
dataTableOutput("contents"))
)
)
)
)
Server :
function(input,output){
#Création data :
data <- reactive({
inFile<- input$fichier1
if (is.null(inFile)){
return(NULL)
}else{
file.rename(inFile$datapath,
paste(inFile$datapath,".xlsx", sep =""))
wb = loadWorkbook(paste(inFile$datapath,".xlsx",sep=""))
lst = readWorksheet(wb,sheet = getSheets(wb))
list(wb = wb, lst = lst)
}
})
#Sortie de la table :
output$contents <- renderDataTable({
data()$wb[input$sheet]
},options = list(pageLength = 10))
#Téléchargement :
output$download <- downloadHandler(
#for (i in 1:input$sheet){
filename = function(){
paste(input$text,"_0",3,".csv",sep = "")
},
content = function(file){
write.table(data()$wb[3],file,
sep = ';', row.names = F, col.names = T)
}
#}
)
}
As #BigDataScientist pointed out, you could zip all of your csv file and download the zipped file. Your downloadHandler could look like:
output$download <- downloadHandler(
filename = function(){
paste0(input$text,".zip")
},
content = function(file){
#go to a temp dir to avoid permission issues
owd <- setwd(tempdir())
on.exit(setwd(owd))
files <- NULL;
#loop through the sheets
for (i in 1:input$sheet){
#write each sheet to a csv file, save the name
fileName <- paste(input$text,"_0",i,".csv",sep = "")
write.table(data()$wb[i],fileName,sep = ';', row.names = F, col.names = T)
files <- c(fileName,files)
}
#create the zip file
zip(file,files)
}
)
This does not download all the sheets from the excel file but the sheets ranging from 1 to whatever the user has as input in input$sheet.
You could also disable the download button if the user has not added an excel file/name.
Hope you've solved this MBnn, but in case anyone else is having similar problems, this case is down to RTools not being installed correctly on windows.
Currently you need to play close attention while running through the install process, and make sure to hit the checkbox to edit the system path.
Based on your code, this is likely to be the same issue preventing you from saving XLSX workbooks too.
I know this is an old thread but I had the same issue and the top answer did not work for me. However a simple tweak and using the archive package worked.
Reproductible example below:
library(shiny)
library(archive)
shinyApp(
# ui
ui = fluidPage(downloadButton("dl")),
# server
server = function(input, output, session) {
# download handler
output$dl <- downloadHandler(
filename = function() {"myzipfile.zip"},
# content: iris and mtcars
content = function(file) {
# definition of content to download
to_dl <- list(
# names to use in file names
names = list(a = "iris",
b = "mtcars"),
# data
data = list(a = iris,
b = mtcars)
)
# temp dir for the csv's as we can only create
# an archive from existent files and not data from R
twd <- setwd(tempdir())
on.exit(setwd(twd))
files <- NULL
# loop on data to download and write individual csv's
for (i in c("a", "b")) {
fileName <- paste0(to_dl[["names"]][[i]], ".csv") # csv file name
write.csv(to_dl[["data"]][[i]], fileName) # write csv in temp dir
files <- c(files, fileName) # store written file name
}
# create archive from written files
archive_write_files(file, files)
}
)
}
)
This will create the zip file myzipfile.zip which will contain iris.csv and mtcars.csv.
Goal: I'm working on a bioinformatics project. I'm currently trying to implement R code that dynamically creates tabPanels (they are essentially carbon copies except for the data output).
Implementation: After doing some research I implemented this solution. It works in a way (the panels that I'm "carbon copying" are created), but the data that I need cannot be displayed.
Problem: I'm sure that the way I'm displaying my data is fine. The problem is that I can't use the same output function to display the data as seen here. So let me get to the code...
ui.R
library(shiny)
library(shinythemes)
library(dict)
library(DT)
...# Irrelevant functions removed #...
geneinfo <- read.table(file = "~/App/final_gene_info.csv",
header = TRUE,
sep = ",",
na.strings = "N/A",
as.is = c(1,2,3,4,5,6,7))
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Home",
#shinythemes::themeSelector(),
fluidPage(
includeHTML("home.html")
)),
tabPanel("Gene Info",
h2('Detailed Gene Information'),
DT::dataTableOutput('table')),
tabPanel("File Viewer",
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "gene", label = "Choose a Gene", choice = genes, multiple = TRUE),
selectInput(inputId = "organism", label = "Choose an Organism", choice = orgs),
selectInput(inputId = "attribute", label = "Choose an Other", choice = attributes),
width = 2),
mainPanel(
uiOutput('change_tabs'),
width = 10))),
tabPanel("Alignment")
)
I'm using uiOutput to generate tabs dynamically on the server side....
server.R
server <- function (input, output, session) {
# Generate proper files from user input
fetch_files <- function(){
python <- p('LIB', 'shinylookup.py', python=TRUE)
system(sprintf('%s %s %s', python, toString(genie), input$organism), wait = TRUE)
print('Done with Python file generation.')
# Fetch a temporary file for data output
fetch_temp <- function(){
if(input$attribute != 'Features'){
if(input$attribute != 'Annotations'){
chosen <- toString(attribute_dict[[input$attribute]])
}
else{
chosen <- toString(input$sel)
extension <<- '.anno'
}
}
else{
chosen <- toString(input$sel)
extension <<- '.feat'
}
count = 0
oneline = ''
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, extension, sep = '')
# Writes a temporary file to display output to the UI
target <- p('_DATA', f)
d <- dict_fetch(target)
temp_file <- tempfile("temp_file", p('_DATA', ''), fileext = '.txt')
write('', file=temp_file)
vectorofchar <- strsplit(toString(d[[chosen]]), '')[[1]]
for (item in vectorofchar){
count = count + 1
oneline = paste(oneline, item, sep = '')
# Only 60 characters per line (Find a better solution)
if (count == 60){
write(toString(oneline), file=temp_file, append=TRUE)
oneline = ''
count = 0
}
}
write(toString(oneline), file=temp_file, append=TRUE)
return(temp_file)
}
# Get the tabs based on the number of genes selected in the UI
fetch_tabs <- function(Tabs, OId, s = NULL){
count = 0
# Add a select input or nothing at all based on user input
if(is.null(s)==FALSE){
selection <- select(s)
x <- selectInput(inputId = 'sel', label = "Choose an Annotation:", choices = selection$keys())
}
else
x <- ''
for(gene in input$gene){
if(count==0){myTabs = character()}
count = count + 1
genie <<- gene
fetch_files()
file_tab <- lapply(sprintf('File for %s', gene), tabPanel
fluidRow(
titlePanel(sprintf("File for %s:", gene)),
column(5,
pre(textOutput(outputId = "file")),offset = 0))
)
addTabs <- c(file_tab, lapply(sprintf('%s for %s',paste('Specific', Tabs), gene), tabPanel,
fluidRow(
x,
titlePanel(sprintf("Attribute for %s:", gene)),
column(5,
pre(textOutput(outputId = OId), offset = 0)))
))
# Append additional tabs every iteration
myTabs <- c(myTabs, addTabs)
}
return(myTabs)
}
# Select the proper file and return a dictionary for selectInput
select <- function(ext, fil=FALSE){
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, ext, sep = '')
f <- p('_DATA', f)
if(fil==FALSE){
return(dict_fetch(f))
}
else if(fil==TRUE){
return(toString(f))
}
}
# Output gene info table
output$table <- DT::renderDataTable(
geneinfo,
filter = 'top',
escape = FALSE,
options = list(autoWidth = TRUE,
options = list(pageLength = 10),
columnDefs = list(list(width = '600px', targets = c(6))))
)
observe({
x <- geneinfo[input$table_rows_all, 2]
if (is.null(x))
x <- genes
updateSelectizeInput(session, 'gene', choices = x)
})
# Output for the File tab
output$file <- renderText({
extension <<- '.gbk'
f <- select(extension, f=TRUE)
includeText(f)
})
# Output for attributes with ony one property
output$attributes <- renderText({
extension <<- '.kv'
f <- fetch_temp()
includeText(f)
})
# Output for attributes with multiple properties (features, annotations)
output$sub <- renderText({
f <- fetch_temp()
includeText(f)
})
# Input that creates tabs and selectors for more input
output$change_tabs <- renderUI({
# Fetch all the appropriate files for output
Tabs = input$attribute
if(input$attribute == 'Annotations'){
extension <<- '.anno'
OId = 'sub'
s <- extension
}
else if(input$attribute == 'Features'){
extension <<- '.feat'
OId = 'sub'
s <- extension
}
else{
OId = 'attributes'
s <- NULL
}
myTabs <- fetch_tabs(Tabs, OId, s = s)
do.call(tabsetPanel, myTabs)
})
}
)
Explanation: Now I'm aware that there's a lot to look at here.. But my problem exists within output$change_tabs (it's the last function), which calls fetch_tabs(). Fetch tabs uses the input$gene (a list of genes via selectizeInput(multiple=TRUE)) to dynamically create a set of 2 tabs per gene selected by the user.
What's Happening: So if the user selects 2 genes then 4 tabs are created. With 5 genes 10 tabs are created... And so on and so forth... Each tab is EXACTLY THE SAME, except for the data.
Roadblocks: BUT... for each tab I'm trying to use the same output Id (since they are EXACTLY THE SAME) for the data that I want to display (textOutput(outputId = "file")). As explained above in the second link, this simply does not work because HTML.
Questions: I've tried researching several solutions, but I would rather not have to implement this solution. I don't want to have to rewrite so much code. Is there any way I can add a reactive or observer function that can wrap or fix my output$file function? Or is there a way for me to add information to my tabs after the do.call(tabsetPanel, myTabs)? Am I thinking about this the right way?
I'm aware that my code isn't commented very well so I apologize in advance. Please feel free to critique my coding style in the comments, even if you don't have a solution. Please and thank you!
I've come up with a very VERY crude answer that will work for now...
Here is the answer from #BigDataScientist
My Issue with BigDataScientist's Answer:
I can't dynamically pass data to the outputs. The output functions are not interpreted until they are needed... So if I wanted to pass the for loop iterator that you created (iter) into the dynamically created outputs, then I wouldn't be able to do that. It can only take static data
My Solution:
I end up taking advantage of sys.calls() solution I found here in order to get the name of the function as a string. The name of the function has the info I need (in this case a number).
library(shiny)
library(shinythemes)
myTabs <<- list()
conv <- function(v1) {
deparse(substitute(v1))
}
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Gene Info",
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 5,
value = 3)
),
# Show a plot of the generated distribution
mainPanel(
uiOutput('changeTab')
)
)
)
)
server <- function(input, output) {
observe({
b <<- input$bins
myTabs <<- list()
# Dynamically Create output functions
# Dynamically Create formatted tabs
# Dynamically Render the tabs with renderUI
for(iter in 1:b){
x <<- iter
output[[sprintf("tab%s", iter)]] <- renderText({
temp <- deparse(sys.calls()[[sys.nframe()-3]])
x <- gsub('\\D','',temp)
x <- as.numeric(x)
f <- sprintf('file%s.txt', x)
includeText(f)
})
addTabs <<- lapply(sprintf('Tab %s', iter), tabPanel,
fluidRow(
titlePanel(sprintf("Tabble %s:", iter)),
column(5,
pre(textOutput(outputId = sprintf('%s%s','tab', iter))))))
myTabs <<- c(myTabs, addTabs)
}
myTabs <<- c(myTabs, selected = sprintf('Tab %s', x))
output$changeTab <- renderUI({
do.call(tabsetPanel, myTabs)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I think your being a victim of this behavior. Try:
for (el in whatever) {
local({
thisEl <- el
...
})
}
like Joe suggests in the first reply to the Github issue I linked to. This is only necessary if you're using a for loop. lapply already takes el as an argument, so you get this "dynamic evaluation" benefit (for lack of a better name) for free.
For readability, I'm going to quote most of Joe's answer here:
You're the second person at useR that I talked to that was bitten by this behavior in R. It's because all the iterations of the for loop share the same reference to el. So when any of the created reactive expressions execute, they're using whatever the final value of el was.
You can fix this either by 1) using lapply instead of a for loop; since each iteration executes as its own function call, it gets its own reference to el; or 2) using a for loop but introducing a local({...}) inside of there, and creating a local variable in there whose value is assigned to el outside of the reactive.