R Shiny：当 运行 App Local 与 Deployed 时，导出的 PNG 分辨率不同

Question

我想在已部署的 Shiny 应用程序中创建具有手动指定分辨率的 PNG 图像。此 PNG 图像应保存在我的 Dropbox 中。出于某种原因，我的 Shiny 应用程序的部署版本没有考虑 png 函数中的 res 参数。

考虑以下示例：

##### 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)

如果我在本地 运行 此应用程序，则会创建以下 PNG 图像：

但是，当我将完全相同的应用程序部署到 shinyapps.io 并在线 运行 时，会创建以下 PNG 图像：

如您所见，第二张图片的分辨率要大得多，即我在 png 函数中指定的 res = 10 参数在部署版本中没有被考虑在内应用程序。

我是 Shiny 的新手，所以我认为我缺少一些非常基本的东西。但是，经过2天的研究，我仍然没有找到解决方案。

问题：如何在已部署的 Shiny 应用程序中指定 PNG 分辨率？

Answer 1

请使用以下方法检查系统上的 ragg 输出是否与 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)

可以找到相关的post。