rshinydownloadchart.jsradar-chart

chartJSRadar downloadhandler creating empty png


I would like to create a download button within my shiny app to download a reactive plot created with chartJSRadar. I am not able to solve this problem! As I have been through the documented problem on the internet, I was not able to solve it, receiving all the time an empty png. As suggested (Save plots made in a shiny app), https://groups.google.com/forum/#!msg/shiny-discuss/u7gwXc8_vyY/IZK_o7b7I8gJ
I built a function ... So my code is an example code:

ui.R:

library(radarchart)

shinyUI(pageWithSidebar(
  headerPanel('Radarchart Shiny Example'),
  sidebarPanel(
    checkboxGroupInput('selectedPeople', 'Who to include', 
                       names(radarchart::skills)[-1], selected="Rich")
  ),
  mainPanel(
    chartJSRadarOutput("plot1", width = "450", height = "300"), width = 7,
  radioButtons(inputId = "var3", label = "Select the file type", choices = list("png", "pdf")),
  downloadButton('downloadPlot', 'Download Plot')
  )
))

server.R


library(radarchart)

shinyServer(function(input, output) {
  output$plot1 <- renderChartJSRadar({

    chartJSRadar(skills[, c("Label", input$selectedPeople)], 
                 maxScale = 10, showToolTipLabel=TRUE)
  })

  plot2 <- function(){
    chartJSRadar(skills[, c("Label", input$selectedPeople)], 
                 maxScale = 10, showToolTipLabel=TRUE)
  }

  output$downloadPlot <- downloadHandler(
    filename = "Shinyplot.png",
    content = function(file) {
      png(file)
      plot2()
      print(plot2())
      dev.off()
  })    
})

Solution

  • Here is a JavaScript way which should be faster than webshot, I think.

    library(shiny)
    library(radarchart)
    library(htmlwidgets) # to use the 'onRender' function
    
    js <- c(
      "function(el, x){",
      "  $('#downloadPlot').on('click', function(){",
      "    // Clone the chart to add a background color.",
      "    var cloneCanvas = document.createElement('canvas');",
      "    cloneCanvas.width = el.width;",
      "    cloneCanvas.height = el.height;",
      "    var ctx = cloneCanvas.getContext('2d');",
      "    ctx.fillStyle = '#FFFFFF';",
      "    ctx.fillRect(0, 0, el.width, el.height);",
      "    ctx.drawImage(el, 0, 0);",
      "    // Download.",
      "    const a = document.createElement('a');",
      "    document.body.append(a);",
      "    a.download = 'radarchart.png';",
      "    a.href = cloneCanvas.toDataURL('image/png');",
      "    a.click();",
      "    a.remove();",
      "  });",
      "}"
    )
    
    ui <- pageWithSidebar(
      headerPanel('Radarchart Shiny Example'),
      sidebarPanel(
        checkboxGroupInput('selectedPeople', 'Who to include', 
                           names(radarchart::skills)[-1], selected="Rich"),
        actionButton('downloadPlot', 'Download Plot')
      ),
      mainPanel(
        chartJSRadarOutput("plot1", width = "450", height = "300"), width = 7
      )
    )
    
    server <- function(input, output) {
      output$plot1 <- renderChartJSRadar({
        chartJSRadar(skills[, c("Label", input$selectedPeople)], 
                     maxScale = 10, showToolTipLabel=TRUE) %>% 
          onRender(js)
      })
    }
    
    shinyApp(ui, server)
    

    This exports to png only. Use webshot to export to pdf.


    EDIT

    library(shiny)
    library(radarchart)
    
    js <- paste0(c(
      "$(document).ready(function(){",
      "  $('#downloadPlot').on('click', function(){",
      "    var el = document.getElementById('plot1');",
      "    // Clone the chart to add a background color.",
      "    var cloneCanvas = document.createElement('canvas');",
      "    cloneCanvas.width = el.width;",
      "    cloneCanvas.height = el.height;",
      "    var ctx = cloneCanvas.getContext('2d');",
      "    ctx.fillStyle = '#FFFFFF';",
      "    ctx.fillRect(0, 0, el.width, el.height);",
      "    ctx.drawImage(el, 0, 0);",
      "    // Download.",
      "    const a = document.createElement('a');",
      "    document.body.append(a);",
      "    a.download = 'radarchart.png';",
      "    a.href = cloneCanvas.toDataURL('image/png');",
      "    a.click();",
      "    a.remove();",
      "    cloneCanvas.remove();",
      "  });",
      "});"
    ), collapse = "\n")
    
    ui <- pageWithSidebar(
      headerPanel('Radarchart Shiny Example'),
      sidebarPanel(
        checkboxGroupInput('selectedPeople', 'Who to include', 
                           names(radarchart::skills)[-1], selected="Rich"),
        actionButton('downloadPlot', 'Download Plot')
      ),
      mainPanel(
        tags$head(tags$script(HTML(js))),
        chartJSRadarOutput("plot1", width = "450", height = "300"), width = 7
      )
    )
    
    server <- function(input, output) {
      output$plot1 <- renderChartJSRadar({
        chartJSRadar(skills[, c("Label", input$selectedPeople)], 
                     maxScale = 10, showToolTipLabel=TRUE) 
      })
    }
    
    shinyApp(ui, server)