Search code examples
rshinyreactiverhandsontable

Exporting reactive ggplot and rhandsontable as Excel workbook via Download Button in R Shiny


I'm trying to create a small application where you paste some x-y data into a table that are then displayed and fitted (the actual app will do further calculations but that's working so I cut it off for this question). The resulting plot as well as the table shall then be exported into a compact file, for which I used the xlsl package. I am encountering two problems:

  1. Although the plot can be written into the xlsl workbook, it only exports the initial dummy plot and not the reactive plot resulting from the values pasted into the rhandsontable.
  2. If I try to append the data from the rhandsontable into the workbook, I encounter errors and the app won't run.

How can I realize a data export that exports the dataframe and the plot AFTER the actual data were inserted to the table?

I created a minimal example (sorry for the ugly code, I'm still pretty unfamiliar with R Shiny / programming in general) that reproduces the issues:

UI:

library(shiny)
library(rhandsontable)
library(tidyverse)
library(rhandsontable)
library(ggplot2)
library(xlsx)


ui <- fluidPage(sidebarLayout(
  sidebarPanel (
    titlePanel("Data Calculation"),
    selectInput(
      "select",
      label = h3("Tool"),
      choices = list(
        "Select Tool" = "Select Tool",
        "Tool-0200" = "Tool-0200",
        "Tool-0300" = "Tool-0300",
        "Tool-0500" = "Tool-0500",
        "Tool-0600" = "Tool-0600",
        "Tool-0700" = "Tool-0700",
        "Tool-0800" = "Tool-0800",
        "Tool-0900" = "Tool-0900",
        "Tool-1000" = "Tool-1000"
      ),
      selected = 1,
      width = "150"
    ),
  
    rHandsontableOutput('table'),
    downloadButton("downloadData", "Download"),
    width = 3
  ),
      mainPanel(br(),
            h2("Data Visualization"),
            plotOutput("testplot"))
))

Server:

server <- function(input, output, session)
  ({
    df <-
      reactiveValues(data = data.frame(
        Wafer = c(
          "Sample-01",
          "Sample-02",
          "Sample-03",
          "Sample-04",
          "Sample-05"
        ),
        Angle = seq(-1, 1, 0.5),
        RS = c(8, 2, 0, 2, 8)
      ))
      output$table <- renderRHandsontable({
      rhandsontable(df$data)
    })
    
    output$testplot <- renderPlot({
      ggplot(df$data, aes(x = Angle, y = RS)) +
        geom_line() +
        
        geom_point(
          shape = 21,
          color = "black",
          fill = "black",
          size = 3
        ) +
        geom_smooth(
          formula = y ~ poly(x, 2, raw = TRUE),
          method = lm,
          se = TRUE
        ) +
        xlab("Tilt Angle /°") + ylab(expression(paste("RS /" , Omega, "/squ"))) +
        theme_bw() +
        theme(
          axis.title.x = element_text(size = 16),
          axis.text.x = element_text(size = 14),
          axis.title.y = element_text(size = 16),
          axis.text.y = element_text(size = 14)
        )

    }, height = 600, width = 800)
    
    #Save Plot for Export
    ggsave("test.png")
    
    #Create Excel WorkBook for Export
    wb <- createWorkbook(type = "xlsx")
    sheet <- createSheet(wb, sheetName = "Test")
    addPicture(
      "test.png",
      sheet,
      scale = 1,
      startRow = 10,
      startColumn = 1
    )
   # addDataFrame(df()$data, sheet, startRow=3, startColumn=1) #excluded to make app executable
    
    # Downloadbutton
    output$downloadData <- downloadHandler(
      filename = function() {
        paste(input$select, "_Angle-Test_", Sys.Date(), ".xlsx", sep = "")
      },
        content = function(file) {
        saveWorkbook(wb, file = file)
      }
    )
   
    
    
    observeEvent(input$table$changes$changes, {
      df$data <- hot_to_r(input$table)
    })
    #Reactive Fit 
    data_fit <-
      reactive({
        coeff <- lm(RS ~ poly(Angle, 2, raw = TRUE),  data = df$data)
        
        a <-
          coeff[["coefficients"]][["poly(Angle, 2, raw = TRUE)2"]]
        b <-
          coeff[["coefficients"]][["poly(Angle, 2, raw = TRUE)1"]]
        c <- -(b / 2 / a)
        d <- coeff[["coefficients"]][["(Intercept)"]]

        return(list(
          a = a,
          b = b,
          c = c,
          d = d
        ))
      })
    
  })

shinyApp(ui = ui, server = server)

Solution

  • Here is a working approach to achieve your desired results where I switched to openxlsx which however is not that important and you should be able easily adapt the code if you prefer the xlsx. Basically I moved the plotting code in a separate reactive and the code to create the workbook inside the downloadHandler as we can't access reactive values outside of a reactive context. Also note that I export the plot to a temporary file.

    server <- function(input, output, session) {
      df <- reactiveValues(data = data.frame(
        Wafer = c(
          "Sample-01",
          "Sample-02",
          "Sample-03",
          "Sample-04",
          "Sample-05"
        ),
        Angle = seq(-1, 1, 0.5),
        RS = c(8, 2, 0, 2, 8)
      ))
    
      output$table <- renderRHandsontable({
        rhandsontable(df$data)
      })
    
      plot <- reactive({
        ggplot(df$data, aes(x = Angle, y = RS)) +
          geom_line() +
          geom_point(
            shape = 21,
            color = "black",
            fill = "black",
            size = 3
          ) +
          geom_smooth(
            formula = y ~ poly(x, 2, raw = TRUE),
            method = lm,
            se = TRUE
          ) +
          xlab("Tilt Angle /°") +
          ylab(expression(paste("RS /", Omega, "/squ"))) +
          theme_bw() +
          theme(
            axis.title.x = element_text(size = 16),
            axis.text.x = element_text(size = 14),
            axis.title.y = element_text(size = 16),
            axis.text.y = element_text(size = 14)
          )
      })
    
      output$testplot <- renderPlot(
        plot(),
        height = 600,
        width = 800
      )
    
      output$downloadData <- downloadHandler(
        filename = function() {
          paste(input$select, "_Angle-Test_", Sys.Date(), ".xlsx", sep = "")
        },
        content = function(file) {
          tmp <- tempfile(fileext = ".png")
          ggsave(tmp, plot())
    
          wb <- openxlsx::createWorkbook()
          sheet <- openxlsx::addWorksheet(wb, sheetName = "Test")
          openxlsx::writeData(wb, sheet, df$data, startRow = 3, startCol = 1)
          openxlsx::insertImage(wb,
            sheet,
            tmp,
            startRow = 10,
            startCol = 1
          )
    
          openxlsx::saveWorkbook(wb, file = file)
        }
      )
    
      observeEvent(input$table$changes$changes, {
        df$data <- hot_to_r(input$table)
      })
    
      data_fit <-
        reactive({
          coeff <- lm(RS ~ poly(Angle, 2, raw = TRUE), data = df$data)
    
          a <-
            coeff[["coefficients"]][["poly(Angle, 2, raw = TRUE)2"]]
          b <-
            coeff[["coefficients"]][["poly(Angle, 2, raw = TRUE)1"]]
          c <- -(b / 2 / a)
          d <- coeff[["coefficients"]][["(Intercept)"]]
    
          return(list(
            a = a,
            b = b,
            c = c,
            d = d
          ))
        })
    }
    

    enter image description here