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:
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)
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
))
})
}