在R中使用jqui_resizable下载绘图

Question

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

我想让下载按钮，可以下载绘图大小调整的jqui_resizable包。

​

我读这些网址是为了制作这个。下载一个没有在R中重新标绘的情节 Shiny.setInputValue只在第二次尝试中工作

但我有个问题。与上面的第二个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环境中。

这是我的sessionInfo。

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 _TIME=ja_JP.UTF-8 LC_COLLATE=ja_JP.UTF-8

5 LC_MONETARY=ja_JP.UTF-8 LC_MESSAGES=C LC_PAPER=ja_ja.JP.UTF 8 LC_NAME=C

9 LC_ADDRESS=C LC_TELEPHONE=C LC_测=ja_JP.UTF-8 LC_IDENTIFICATION=C

附加的基本包：1统计、图形、grDevices实用程序、数据集、方法库

其他附加包裹：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 _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开罗_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质量_7.3-57

49 ellipsis_0.3.2矩阵_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

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)