Shiny R Zip multiple PDFS for download - r

I am sorry if this too simple... I need to zip a number of generated pdfs for uses to download. I tried to use Zip function, but failed with error:
Warning: running command '"zip" -r9X "pdfs.zip" "plot_1.pdf" "plot_2.pdf" "plot_3.pdf" "plot_4.pdf" "plot_5.pdf" ' had status 127
Error opening file: 2
Error reading: 6
Below is my code and any suggestions are welcomed (based on shiny app : disable downloadbutton) :
UI.R
library(shiny)
shinyUI(fluidPage(
singleton(tags$head(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
// disable download at startup. data_file is the id of the downloadButton
$("#data_file").attr("disabled", "true").attr("onclick", "return false;");
Shiny.addCustomMessageHandler("download_ready", function(message) {
$("#data_file").removeAttr("disabled").removeAttr("onclick").html(
"<i class=\\"fa fa-download\\"></i>Download " + message.fileSize + " ");
});
})
</script>
'
))),
tabsetPanel(
tabPanel('Data download example',
actionButton("start_proc", h5("Click to start processing data")),
hr(),
downloadButton("data_file"),
helpText("Download will be available once the processing is completed.")
)
)
))
Server UI.R
library(shiny)
get_a_pdf_plot <- function(my_i){
pdf(paste("plot_", my_i, sep=""))
plot(1:my_i*5, 1:my_i*5,
xlim = c(1, my_i*5),
ylim = c(1, my_i*5),
main = paste("1:", my_i, sep = ""))
dev.off()
}
shinyServer(function(input, output, session) {
observe({
if (input$start_proc > 0) {
Sys.sleep(2)
session$sendCustomMessage("download_ready", list(fileSize= "Ready"))
}
})
output$data_file <- downloadHandler(
filename = 'pdfs.zip',
content = function(fname) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
print (tempdir())
for (i in c(1,2,3,4,5)) {
path <- paste("plot_", i, ".pdf", sep="")
fs <- c(fs, path)
get_a_pdf_plot(i)
}
print (fs)
zip(zipfile="pdfs.zip", files=fs)
}
)
})

In get_a_pdf_plot you have ommitted the .pdf
get_a_pdf_plot <- function(my_i){
pdf(paste("plot_", my_i,".pdf", sep=""))
plot(1:my_i*5, 1:my_i*5,
xlim = c(1, my_i*5),
ylim = c(1, my_i*5),
main = paste("1:", my_i, sep = ""))
dev.off()
}
In your downloadHandler your need to prompt shiny on the download type:
output$data_file <- downloadHandler(
filename = 'pdfs.zip',
content = function(fname) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
print (tempdir())
for (i in c(1,2,3,4,5)) {
path <- paste("plot_", i, ".pdf", sep="")
fs <- c(fs, path)
get_a_pdf_plot(i)
}
print (fs)
zip(zipfile="pdfs.zip", files=fs)
},
contentType = "application/zip"
)

This gist helped me setup the export. It runs out of the box on a Mac. Windows required downloading Rtools and pointing to the zip in Rtools (from this question). I've not had problems yet.
Sys.setenv(R_CMDZIP = 'C:/Rtools/bin/zip')
The ?zip documentation mentions "On Windows, the default relies on a zip program (for example that from Rtools". If you point to a zip executable for your favorite zip program I'm sure it'll work similarly (if you don't want to download Rtools).

Related

Downloadhandler not working on published server

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.

R shiny - having trouble with file download

So I want to have a Shiny page which:
A) Allows the user to upload a .xls file;
B) Offers that file back to the user for download as a .csv file;
C) Prints the head of the file in the Shiny app to ensure that it was properly read.
Here is the code I am using:
# Want to read xls files with readxl package
library(readxl)
library(shiny)
## Only run examples in interactive R sessions
if (interactive()) {
ui <- fluidPage(
fileInput("file1", "Choose File", accept = ".xls"),
tags$hr(),
uiOutput("downloader"),
htmlOutput("confirmText", container = tags$h3),
tableOutput("listContents")
)
server <- function(input, output) {
theOutput <- reactiveValues(temp = NULL, df = NULL, msg = NULL, fn = NULL)
observeEvent(input$file1, {
theOutput$fn <- paste('data-', Sys.Date(), '.csv', sep='')
theOutput$temp <- read_xls(input$file1$datapath)
theOutput$msg <- paste("File Contents:")
theOutput$df <- write.csv(theOutput$temp,
file = theOutput$fn,
row.names = FALSE)
})
output$confirmText <- renderText({
theOutput$msg
})
output$listContents <- renderTable({
head(theOutput$temp)
})
output$downloader <- renderUI({
if(!is.null(input$file1)) {
downloadButton("theDownload", label = "Download")
}
})
output$theDownload <- downloadHandler(
filename = theOutput$fn,
content = theOutput$df
)
}
shinyApp(ui, server)
}
The Shiny page renders correctly, it accepts the upload with no problems, it prints out the head of the .csv with no problems, and it creates a properly formatted "data-{today's date}.csv" file in the same directory as the app.R file.
Problem is, when I hit the download button I get the error message:
Warning: Error in download$func: attempt to apply non-function
[No stack trace available]
Can someone tell me what I am doing wrong?
Thanks to the comments above, this is the solution I found (with my comments added, to show where the code changed):
library(readxl)
library(shiny)
if (interactive()) {
ui <- fluidPage(
fileInput("file1", "Choose File", accept = ".xls"),
tags$hr(),
uiOutput("downloader"),
htmlOutput("confirmText", container = tags$h3),
tableOutput("listContents")
)
server <- function(input, output) {
theOutput <- reactiveValues(temp = NULL, msg = NULL)
observeEvent(input$file1, {
# Do not try to automate filename and the write.csv output here!
theOutput$temp <- read_xls(input$file1$datapath)
theOutput$msg <- paste("File Contents:")
})
output$confirmText <- renderText({
theOutput$msg
})
output$listContents <- renderTable({
head(theOutput$temp)
})
output$downloader <- renderUI({
if(!is.null(input$file1)) {
downloadButton("theDownload", label = "Download")
}
})
output$theDownload <- downloadHandler(
# Filename and content need to be defined as functions
# (even if, as with filename here, there are no inputs to those functions)
filename = function() {paste('data-', Sys.Date(), '.csv', sep='')},
content = function(theFile) {write.csv(theOutput$temp, theFile, row.names = FALSE)}
) }
shinyApp(ui, server) }
The fact that content takes an argument (named here "theFile"), which is not called anywhere else, is what was throwing me off.

Download Handler with reactive datatable (R Shiny)

I have simplified a lot the shiny app I'm trying to build, but, in the idea, I have two functions :
choose_input <- function(n1,n2,n3){
x1 <<- n1+n2
x2 <<- n2+n3
x3 <<- (n1*n2)/n3
}
createmydata <- function(n){
c1 <- c(1:n)
c2 <- c1+(x2*x3)
c3 <- c2+x1
df <- data.frame("column1"=c1,"column2"=c2,"column3"=c3)
return(df)
}
You'll tell me that I can do simply one function with these two because they are very simple, but in my app there are a lot of lines and I have to separate the two. Anyway, here is my simulated code :
ui <- fluidPage(
numericInput("n1",label="Choose the first parameter",min=0,max=100,value=3),
numericInput("n2",label="Choose the second parameter",min=0,max=100,value=4),
numericInput("n3",label="Choose the third parameter",min=0,max=100,value=5),
numericInput("n",label="Choose dataframe length",min=1,max=10000,value=100),
radioButtons("filetype", "File type:",
choices = c("csv", "tsv")),
downloadButton('downloadData', 'Download'),
tableOutput("data")
)
server <- function(input,output){
RE <- reactive({
choose_input(input$n1,input$n2,input$n3)
createmydata(input$n)
})
output$data <- renderTable({
RE()
})
output$downloadData <- downloadHandler(
filename = function() {
paste(name, input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
}
shinyApp(ui = ui, server=server)
As you can see, I'd like to download the output table to a csv or excel file... I let you try the code and then try to click on the download button, it does not work...
Debugging
When I run the code up above and attempted to download the data set, I received the following warning and error message in the Console Pane within RStudio.
Warning: Error in paste: object 'name' not found
Stack trace (innermost first):
1: runApp
Error : object 'name' not found
This led me to examine the paste() function used within the filename argument in shiny::downloadHandler(). In your code, you use the object name without ever assigning it a value.
I replaced name with the text "customTable" within the filename argument inside of downloadHandler().
output$downloadData <- downloadHandler(
filename = function() {
paste( "customTable", input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
Downloading Data in Browser
After running the app.R script, I clicked on the Open in Browser button to view the Shiny app in a new tab on Chrome. Once there, I was successfully able to download both a .csv and .tsv file after hitting the download button.
Note: I'm looking for a better reason as to why this action needs to occur, but for now, I came across this relevant SO post Shiny app: downloadHandler does not produce a file.

Download multiple csv files with one button (downloadhandler) with R Shiny

*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.

Download multiple csv files in a zipped folder in Shiny

Can someone please point out how I can make this download zip function work in server.R? When I run this, I get the following error:
[1] "/var/folders/00/1dk1r000h01000cxqpysvccm005p87/T//Rtmps3T6Ua"
Warning in write.csv(datasetInput()$rock, file = "rock.csv", sep = ",") :
attempt to set 'sep' ignored
Warning in write.csv(datasetInput()$pressure, file = "pressure.csv", sep = ",") : attempt to set 'sep' ignored
Warning in write.csv(datasetInput()$cars, file = "cars.csv", sep = ",") :
attempt to set 'sep' ignored
[1] "rock.csv" "pressure.csv" "cars.csv"
adding: rock.csv (deflated 54%)
adding: pressure.csv (deflated 42%)
adding: cars.csv (deflated 57%)
Error opening file: 2
Error reading: 9
library(shiny)
# server.R
server <- function(input, output) {
datasetInput <- reactive({
return(list(rock=rock, pressure=pressure, cars=cars))
})
output$downloadData <- downloadHandler(
filename = 'pdfs.zip',
content = function(fname) {
tmpdir <- tempdir()
setwd(tempdir())
print(tempdir())
fs <- c("rock.csv", "pressure.csv", "cars.csv")
write.csv(datasetInput()$rock, file = "rock.csv", sep =",")
write.csv(datasetInput()$pressure, file = "pressure.csv", sep =",")
write.csv(datasetInput()$cars, file = "cars.csv", sep =",")
print (fs)
zip(zipfile=fname, files=fs)
},
contentType = "application/zip"
)
}
# ui.R
ui <- shinyUI(fluidPage(
titlePanel('Downloading Data'),
sidebarLayout(
sidebarPanel(
downloadButton('downloadData', 'Download')
),
mainPanel()
)
)
)
shinyApp(ui = ui, server = server)
Solution: Include if(file.exists(paste0(fname, ".zip"))) {file.rename(paste0(fname, ".zip"), fname)} after zip() call.
The top solution still wasn't working for me. I was working in RStudio Server on a Linux server. The problem was that RStudio couldn't automatically locate the path to the zip executable. I had to manually specify it. In the command line, which zip revealed to me /usr/bin/zip.
So, I just had to set the R_ZIPCMD environment variable at the top of my code.
Sys.setenv(R_ZIPCMD="/usr/bin/zip")
Source: The help file for zip() mentions R_ZIPCMD.

Resources