R/Rshiny adding item to list of factors - r

Question

Why is this so difficult?! I have (what I believe is a factor vector) and I want to add an item to the list so I can use it farther down the road.
I want to add "memo.txt" to the factor vector filenames.
I have figured out how to add a factor level to the list, but not the item itself.
levels(filenames) <- c(levels(filenames), "memo.txt")
The specific section I am working in is here:
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
#I need to add items to "filenames" here. I then display "test" to make sure those items exist in "filenames" - ie, i want to add "memo.txt" to filenames.
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
The entire code:
library(shiny)
library(timevis)
library(lubridate)
library(dplyr)
library(jsonlite)
library(base64enc)
starthour <- 8
today <- as.character(Sys.Date())
todayzero <- paste(today, "00:00:00")
todayAM <- paste(today, "07:00:00")
todayPM <- paste(today, "18:00:00")
items <- data.frame(
category = c("Room", "IceBreaker", "Activity", "Break"),
group = c(1, 2, 3, 4),
className = c ("red_point", "blue_point", "green_point", "purple_point"),
content = c("Big Room", "Introductions", "Red Rover", "Lunch"),
length = c(480, 60, 120, 90),
file_name = c("Toolkit_placeholder.pdf", NA, "Placeholder.txt", "Toolkit_placeholder.pdf")
)
groups <- data.frame(id = items$group, content = items$category)
data <- items %>% mutate(
id = 1:4,
start = as.POSIXct(todayzero) + hours(starthour),
end = as.POSIXct(todayzero) + hours(starthour) + minutes(items$length)
)
js <- "
function downloadZIP(x){
var csv = Papa.unparse(x.table);
var URIs = x.URIs;
domtoimage.toPng(document.getElementById('appts'), {bgcolor: 'white'})
.then(function (dataUrl) {
var zip = new JSZip();
var idx = dataUrl.indexOf('base64,') + 'base64,'.length;
var content = dataUrl.substring(idx);
zip.file('timeline.png', content, {base64: true})
.file('timeline.csv', btoa(csv), {base64: true});
for(let i=0; i < URIs.length; ++i){
zip.file(URIs[i].filename, URIs[i].uri, {base64: true});
}
zip.generateAsync({type:'base64'}).then(function (b64) {
var link = document.createElement('a');
link.download = 'mytimeline.zip';
link.href = 'data:application/zip;base64,' + b64;
link.click();
});
});
}
$(document).on('shiny:connected', function(){
Shiny.addCustomMessageHandler('download', downloadZIP);
});"
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jszip/3.5.0/jszip.min.js"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/PapaParse/5.2.0/papaparse.min.js"),
tags$script(HTML(js)),
tags$style(
HTML(
"
.red_point { border-color: red; border-width: 2px; }
.blue_point { border-color: blue; border-width: 2px; }
.green_point { border-color: green; border-width: 2px; }
.purple_point { border-color: purple; border-width: 2px; }
"
)
)
),
DT::dataTableOutput("tbl1"),
conditionalPanel(
condition = "typeof input.tbl1_rows_selected !== 'undefined' && input.tbl1_rows_selected.length > 1",
actionButton(class = "btn-success",
"button2",
"GENERATE TIMELINE")
),
conditionalPanel(
condition = "input.button2 > 0",
timevisOutput("appts"),
actionButton("download", "Download timeline", class = "btn-success"),
conditionalPanel(
condition = "input.download > 0",
tableOutput("test")
)
)
)
server <- function(input, output, session) {
output$tbl1 <- DT::renderDataTable({
data
},
caption = 'Select desired options and scroll down to continue.',
selection = 'multiple',
class = "display nowrap compact",
extensions = 'Scroller',
options = list(
dom = 'Bfrtip',
paging = FALSE,
columnDefs = list(list(visible = FALSE))
))
observeEvent(input$button2, {
row_data <- data[input$tbl1_rows_selected, ]
output$appts <- renderTimevis(timevis(
data = row_data,
groups = groups,
fit = TRUE,
options = list(
editable = TRUE,
multiselect = TRUE,
align = "center",
stack = TRUE,
start = todayAM,
end = todayPM,
showCurrentTime = FALSE,
showMajorLabels = FALSE
)
))
file_list <- as.data.frame(row_data$file_name)
})
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
#levels(filenames) <- c(levels(filenames), "memo.txt")
#test <- "memo.txt"
#browser()
#filenames <- append(filenames,test)
# levels(filenames) <- c(levels(filenames), "memo.txt")
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
}
shinyApp(ui, server)
EDIT w/answer(ish)
After trying (and failing) like so many others to deal with the factors, I wisened up and set my original "items" dataframe to stringAsFactors = FALSE
this is by far the easiest solution. From there the following works:
items <- data.frame(
category = c("Room", "IceBreaker", "Activity", "Break"),
group = c(1, 2, 3, 4),
className = c ("red_point", "blue_point", "green_point",
"purple_point"),
content = c("Big Room", "Introductions", "Red Rover", "Lunch"),
length = c(480, 60, 120, 90),
file_name = c("Toolkit_placeholder.pdf", NA, "Placeholder.txt",
"Toolkit_placeholder.pdf"), stringsAsFactors = FALSE
)
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
static_files <- "memo.txt"
filenames <- append(filenames,static_files)
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})

Answer 1

Instead of trying to manipulate the factors, the simplest answer was to set stringsToFactors as FALSE. I am using R version 3.6, in R 4.0 that is now the default behavior.
I have updated the original question to include the answer.

Answer 2

Try this code:
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
## added the next seven lines; no other modifications to your code.
filez <- file.path(".", "www", filenames)
fnamez <- lapply(seq_along(filez), function(i){
list(filename = filenames[i])
})
f2namez <- list(fnamez,"memo.txt")
filenamez <- unlist(f2namez)
filenamez2 <- data.frame(filenamez)
output$test <- renderTable(filenamez2)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
No other modification to the remaining part of your code. This gives the following output: