在 R 中使用 jqui_resizable 下载 plot shiny

Question

对不起，我的英语很差，我不是母语人士。

我想制作可以下载由 jqui_resizable package 调整大小的 plot 的下载按钮。

我读了这些 URLs 来做这个。 下载 plot 而无需在 R shiny Z3E751ABE1B5D023220C68CF279ZA 上重新绘制。

但我有一个问题。 与上面的第二个 URL 一样，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 环境中似乎不会出现此问题。
这是我的会话信息。

R 版本 4.0.2 (2020-06-22) 平台：x86_64-pc-linux-gnu (64-bit) 运行于：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.ZAE3B3DF9970B49B6523E608
[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] 生命周期_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 fani_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 蜡笔_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 编译器_4.0.2

Answer 1

我自己解决了这个问题。 我做了两个虚拟下载按钮。
这种方法可能看起来很麻烦，但模块化会消除麻烦。

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

ui <- fluidPage(
  useShinyjs(),
  actionButton("save_myPlot","download", icon = icon("download")),
  actionButton("save_myPlot2","download", icon = icon("download"), style = "visibility: hidden;"),
  downloadButton("save_myPlot_hidden",style = "visibility: hidden;"),
  # plot
  jqui_resizable(plotOutput("myPlot")),
)

server <- function(input, output, session) {
  # I could not get plot_src with Javascript in Linux environment. However, I found that I could get it by running it twice.
  # Therefore, I was able to solve the problem by inserting two dummy buttons: DL button -> DL button 2 -> real DL button.
  observeEvent(input$save_myPlot,{
    shinyjs::runjs("Shiny.setInputValue('plot_src', document.getElementById('myPlot').childNodes[0].src);
                   document.getElementById('save_myPlot2').click();
                   ")
  })
  observeEvent(input$save_myPlot2,{
    shinyjs::runjs("Shiny.setInputValue('plot_src',document.getElementById('myPlot').childNodes[0].src);
                   document.getElementById('save_myPlot_hidden').click();
                   ")
  })
  # downaload handler - save the image
  output$save_myPlot_hidden <- downloadHandler(
    filename = function() { 
      paste0("plot_", Sys.Date(), ".png") },
    content = function(file) {
      # get image code from URI
      plot_src <- gsub("^data.*base64,", "", input$plot_src)
      # decode the image code into the image
      plot_image <- image_read(base64_decode(plot_src))
      # save the image
      image_write(plot_image, file)
    })
  
  # plot
  output$myPlot <- renderPlot(
    plot(rnorm(5), rnorm(5))
  )
}

shinyApp(ui = ui, server = server)