R Shiny中jqui_resizable调整后图表首次点击无法下载求助

我非英语母语者，英文表达欠佳。我想实现一个下载按钮，能下载经shinyjqui包调整尺寸后的图表。参考相关资料后遇到问题：Shiny.setInputValue仅在第二次点击时才会更新值，导致首次点击下载按钮无法正常获取图表。以下是最小复现代码：

library(shiny)
library(shinyjqui)
library(magick)
library(xfun)

js <- 'function get_img_src(){
    var src = document.getElementById("myPlot").childNodes[0].src;
    Shiny.setInputValue("img_src", src);
    }'

ui <- fluidPage(
  downloadButton("save_myPlot",onclick="get_img_src();"),
  # plot
  jqui_resizable(plotOutput("myPlot")),
  tags$script(HTML(js))
)

server <- function(input, output, session) {
  
  # downaload handler - save the image
  output$save_myPlot <- downloadHandler(
    filename = function() { 
      paste0("plot_", Sys.Date(), ".png") },
    content = function(file) {
      # get image code from URI
      img_src <- gsub("data:.+base64,", "", input$img_src)
      # decode the image code into the image
      img_src <- image_read(base64_decode(img_src))
      # save the image
      image_write(img_src, file)
    })
  
  # plot
  output$myPlot <- renderPlot(
    plot(rnorm(5), rnorm(5))
  )
}

shinyApp(ui = ui, server = server)

补充信息 #

• 该问题在Windows+Chrome环境下未出现，仅在Ubuntu 20.04.3 LTS环境下复现
• Session信息：

R版本4.0.2（2020-06-22）
平台：x86_64-pc-linux-gnu（64位）
运行环境：Ubuntu 20.04.3 LTS

矩阵运算：默认
BLAS/LAPACK：/usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.8.so

区域设置：
1 LC_CTYPE=ja_JP.UTF-8       LC_NUMERIC=C               LC_TIME=ja_JP.UTF-8        LC_COLLATE=ja_JP.UTF-8
[5] LC_MONETARY=ja_JP.UTF-8    LC_MESSAGES=C              LC_PAPER=ja_JP.UTF-8       LC_NAME=C
[9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=ja_JP.UTF-8 LC_IDENTIFICATION=C

已附加的基础包：
1 stats     graphics  grDevices utils     datasets  methods   base

其他已附加包：
1 xfun_0.31        magick_2.7.3     shinyjqui_0.4.1  wordcloud2_0.2.1 shiny_1.7.2

已加载的命名空间（未附加）：
1 tinytex_0.40       tidyselect_1.1.2   bslib_0.4.0        shinyjs_2.1.0      purrr_0.3.4        lattice_0.20-45
[7] vctrs_0.4.1        generics_0.1.2     htmltools_0.5.3    yaml_2.3.5         utf8_1.2.2         rlang_1.0.3
[13] later_1.3.0        pillar_1.7.0       jquerylib_0.1.4    glue_1.6.2         withr_2.5.0        DBI_1.1.3
[19] lifecycle_1.0.1    fontawesome_0.3.0  htmlwidgets_1.5.4  memoise_2.0.1      fastmap_1.1.0      Cairo_1.6-0
[25] httpuv_1.6.6       parallel_4.0.2     fansi_1.0.3        Rcpp_1.0.8.3       xtable_1.8-4       renv_0.15.5
[31] promises_1.2.0.1   DT_0.23            cachem_1.0.6       RcppParallel_5.1.4 OpenMx_2.20.6      jsonlite_1.8.0
[37] mime_0.12          digest_0.6.29      dplyr_1.0.9        grid_4.0.2         cli_3.3.0          tools_4.0.2
[43] magrittr_2.0.3     sass_0.4.2         tibble_3.1.7       crayon_1.5.1       pkgconfig_2.0.3    MASS_7.3-57
[49] ellipsis_0.3.2     Matrix_1.4-1       shinyBS_0.61.1     lubridate_1.8.0    assertthat_0.2.1   rstudioapi_0.13
[55] R6_2.5.1           compiler_4.0.2

问题根源是downloadButton的原生点击事件与自定义onclick事件执行顺序冲突，部分浏览器环境下下载请求会先于Shiny.setInputValue完成，导致首次点击时input$img_src未更新。

修改后的完整代码 #

library(shiny)
library(shinyjqui)
library(magick)
library(xfun)

js <- '
function get_img_src(){
    var src = document.getElementById("myPlot").childNodes[0].src;
    // 增加优先级参数确保输入值立即同步到服务器
    Shiny.setInputValue("img_src", src, {priority: "event"});
    // 延迟触发下载，给输入值同步留足时间
    setTimeout(function(){
        document.getElementById("save_myPlot").click();
    }, 100);
}
// 页面加载完成后移除原生下载按钮的点击事件，避免冲突
document.addEventListener("DOMContentLoaded", function(){
    var downloadBtn = document.getElementById("save_myPlot");
    downloadBtn.removeAttribute("onclick");
});
'

ui <- fluidPage(
  # 用普通按钮触发自定义逻辑
  actionButton("trigger_download", "下载图表", onclick="get_img_src();"),
  jqui_resizable(plotOutput("myPlot")),
  tags$script(HTML(js)),
  # 隐藏原生下载按钮，仅用它触发下载请求
  downloadButton("save_myPlot", style="display: none;")
)

server <- function(input, output, session) {
  
  output$save_myPlot <- downloadHandler(
    filename = function() { 
      paste0("plot_", Sys.Date(), ".png") },
    content = function(file) {
      # 确保输入值存在后再执行下载逻辑
      req(input$img_src)
      img_src <- gsub("data:.+base64,", "", input$img_src)
      img_src <- image_read(base64_decode(img_src))
      image_write(img_src, file)
    })
  
  output$myPlot <- renderPlot(
    plot(rnorm(5), rnorm(5))
  )
}

shinyApp(ui = ui, server = server)

关键修改点 #

1. 拆分触发逻辑：用actionButton作为用户可见的触发按钮，隐藏原生downloadButton避免事件冲突
2. 提升输入值同步优先级：在Shiny.setInputValue中添加{priority: "event"}参数，确保值立即同步到服务器
3. 延迟触发下载：用setTimeout延迟调用原生下载按钮的点击事件，保证输入值已更新
4. 增加输入值校验：在downloadHandler中用req(input$img_src)确保只有值存在时才执行下载

内容的提问来源于stack exchange，提问作者Takuro Ikeda