Search code examples
rimagedeploymentshinypng

R Shiny: Exported PNG Resolution is Different when Running App Local vs. Deployed


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:

enter image description here

However, when I deploy exactly the same app to shinyapps.io and run it online, the following PNG image is created:

enter image description here

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?


Solution

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