I want to create a PNG image with a manually specified resolution in a deployed Shiny app. This PNG image should be saved in my Dropbox. For some reason, the deployed version of my Shiny app does not take the res
argument within the png
function into account.
Consider the following example:
##### Load R packages #####
library("rdrop2")
library("shiny")
library("shinythemes")
##### Define UI #####
ui <- fluidPage(theme = shinytheme("cerulean"),
path_now <<- tempdir(),
mainPanel(tags$h1("My Input"),
textInput("some_text", "Insert Some Text", "Some Text"),
textOutput("some_text_txtout"),
actionButton("do", "Run"),
))
##### Define server function #####
server <- function(input, output) {
observeEvent(input$do, {
fun_some_text <- reactive({
input$some_text
})
some_text <<- fun_some_text()
outfile <- tempfile(fileext = "my_identifier.png")
png(outfile,
width = 1500,
height = 1000,
res = 10)
par(mar = c(0, 0, 0, 0))
par(bg = "green")
N <- 5000
x <- runif(N)
y <- runif(N)
plot(x, y, type = "l", xlim = c(0.1, 0.9), ylim = c(0.1, 0.9))
points(0.5, 0.5, col = "green", cex = 1700, pch = 16)
text(0.5, 0.575, some_text, cex = 50)
dev.off()
token <- readRDS("droptoken.rds")
file_path <- file.path(path_now, list.files(path_now, pattern = "my_identifier")[1])
file_path <- gsub("\\\\", "/", file_path)
drop_upload(file_path,
path = "responses",
dtoken = token)
})
}
##### Create Shiny object #####
shinyApp(ui = ui, server = server)
If I run this app locally, the following PNG image is created:
However, when I deploy exactly the same app to shinyapps.io and run it online, the following PNG image is created:
As you can see, the resolution of the second image is much larger, i.e. the res = 10
argument that I have specified within the png
function was not taken into account in the deployed version of the app.
I am new to Shiny, so I assume that I'm missing something very basic. However, after 2 days of research I still didn't find a solution.
Question: How could I specify the PNG resolution in a deployed Shiny app?
Please use the following to check if the ragg output remains identical on your system and shinyapps.io:
##### Load R packages #####
library("shiny")
library("shinythemes")
library("ragg")
createPNG <- function(text_input, res, type){
outfile <- tempfile(fileext = paste0("_", gsub(" ","_", gsub(":",".", Sys.time())), "_", type, ".png"))
if(type == "ragg"){
agg_png(outfile, width = 1500, height = 1000, res = res)
} else {
png(outfile,
width = 1500,
height = 1000,
res = res, type = type)
}
par(mar = c(0, 0, 0, 0))
par(bg = "green")
N <- 5000
x <- runif(N)
y <- runif(N)
plot(x, y, type = "l", xlim = c(0.1, 0.9), ylim = c(0.1, 0.9))
points(0.5, 0.5, col = "green", cex = 1700, pch = 16)
text(0.5, 0.575, text_input, cex = 50)
invisible(dev.off())
outfile
}
##### Define UI #####
ui <- fluidPage(theme = shinytheme("cerulean"),
path_now,
mainPanel(tags$h1("My Input"),
textInput("some_text", "Insert Some Text", "Some Text"),
verbatimTextOutput("pngPaths"),
numericInput("resolution", "resolution", value = 10, min = 1, max = 20),
actionButton("do", "Run")
))
##### Define server function #####
server <- function(input, output, session) {
pngPaths <- reactiveVal(NULL)
observeEvent(input$do, {
cairoPath <- createPNG(input$some_text, input$resolution, "cairo")
windowsPath <- createPNG(input$some_text, input$resolution, "windows")
raggPath <- createPNG(input$some_text, input$resolution, "ragg")
pngPaths(list(cairoPath, windowsPath, raggPath))
if(Sys.info()["sysname"] == "Windows"){
shell.exec(dirname(cairoPath))
}
})
output$pngPaths <- renderPrint(req(pngPaths()))
}
##### Create Shiny object #####
shinyApp(ui = ui, server = server)
Here a related post can be found.