rshinyshinyscreenshot

Shinyscreenshot captures only a part of selected svg file in a shiny app


I have the shiny app below from which I ant to take a screenshot of the svg file but it captures only the upper corner of it.

library(shiny)
library(DiagrammeR)
library(tidyverse)
# probably don't need all of these:
library(DiagrammeRsvg)
library(svglite)
library(svgPanZoom)
library(rsvg)
library(V8)# only for svg export but also does not work
library(xml2)
library(magrittr)
library(shinyscreenshot)
ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js")
  ),
  grVizOutput("grr",width = "100%",height = "90vh"),
  actionButton("go", "Take a screenshot"),
  tags$script(
    HTML('panzoom($("#grr")[0])')
  )
)

server <- function(input, output) {
  
  observeEvent(input$go, {
    screenshot(selector="#grr")
  })
  
  reactives <- reactiveValues()
  observe({
    reactives$graph <- render_graph(create_graph() %>%
                                      add_n_nodes(n = 2) %>%
                                      add_edge(
                                        from = 1,
                                        to = 2,
                                        edge_data = edge_data(
                                          value = 4.3)))
  })
  output$grr <-
    renderGrViz(reactives$graph
    )
  
}

# Run the application
shinyApp(ui = ui, server = server)

Solution

  • You can use the capture package instead. Works well, but you won't get an SVG image.

    library(shiny)
    library(DiagrammeR)
    library(magrittr)
    library(capture)
    
    ui <- fluidPage(
      tags$head(
        tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js")
      ),
    
      grVizOutput("grr", width = "100%", height = "90vh"),
    
      capture(
        selector = "#grr",
        filename = "myimage.png",
        icon("camera"), "Take screenshot"
      ),
    
      tags$script(
        HTML('panzoom($("#grr")[0])')
      )
    )
    
    server <- function(input, output) {
    
      reactives <- reactiveValues()
      observe({
        reactives$graph <- render_graph(create_graph() %>%
                                          add_n_nodes(n = 2) %>%
                                          add_edge(
                                            from = 1,
                                            to = 2,
                                            edge_data = edge_data(
                                              value = 4.3)))
      })
      output$grr <- renderGrViz(reactives$graph)
    
    }
    
    # Run the application
    shinyApp(ui = ui, server = server)