I'm building an Rshiny app that takes user input and generates an Rmd powerpoint slide with graphs. I'm basing this off of the example I found at https://mattherman.info/blog/ppt-patchwork/ . When I try running the example off of Matt Herman's blog it generates the ppt as expected. Yesterday, when I ran my code, I kept getting the error message "Error in +: non-numeric argument to binary operator". I slowly subbed out my graphs/charts/code into the example code, and was able to generate a ppt slide without the error. I thought I was in the clear.
This morning, I tried to run the program again after opening and closing R, and now I'm getting the same error as yesterday, although the Matt Herman example code still runs perfectly. I'm thinking it has to do with the patchwork package loading incorrectly, but I'm such a newbie at R that I'm not 100% sure. If anyone could help, it'd be much appreciated! The inconsistency of this is driving me bananas.
(PS I know the code is a little sloppy right now - I have libraries added on there from past attempts that I probably don't need anymore, I'm just in the middle of writing this and trying to figure out this patchwork issues, so apologies for the clutter.)
Code for the Shiny App:
library(config)
library(shiny)
library(dplyr)
library(DBI)
library(odbc)
library(ggplot2)
library(ggthemes)
library(convertr)
library(forcats)
library(gt)
library(gridExtra)
library(tidyr)
library(ggpubr)
library(plotly)
library(DT)
library(knitr)
library(rmarkdown)
library(tidyverse)
library(gapminder)
library(scales)
library(gridExtra)
library(patchwork)
conn_args <- config::get("dataconnection")
con <- dbConnect(odbc::odbc(),
Driver = conn_args$driver,
Server = conn_args$server,
UID = conn_args$uid,
PWD = conn_args$pwd,
Port = conn_args$port,
Database = conn_args$database
)
project_list <- dbGetQuery(con, "select projectname as project, report
from projectlist join project on project.id = projectlist.project
order by projectname")
map_data <- dbGetQuery(con, "select * from sitesubjectprojecttotal")
site_enrollment <- dbGetQuery(con, "select * from dashboard.all_enrollment_site_unlimited")
ui <- fluidPage(
selectInput(inputId = "projectname", "Select Project", project_list$project, selected = TRUE, multiple = FALSE, width=220),
dateRangeInput(inputId = "projectdate", "Select Date Range for Shipping and Enrollment Report", Sys.Date()-365, Sys.Date()),
downloadButton("mybutton","Download Data")
)
server <- function(input, output) {map_data_filtered <- reactive({filter(map_data, projectname == input$projectname)})
map_table <- reactive({map_data_filtered() %>% select(location, sites, subjects)})
map_plot <- reactive({map_data_filtered() %>% select(-projectname)})
site_enroll_plot <- reactive({filter(site_enrollment, projectname == input$projectname) %>%
pivot_longer(totalenroll:currentenroll, names_to = "enrolltype", values_to = "quantity")})
kit_status_qry <- reactive({dbGetQuery(con, paste0("select kitssent::integer-kitsavailable::integer as kitsused, kitsavailable::integer
from projectkitstatus where projectname ='", input$projectname, "'"))})
kit_status <- reactive({pivot_longer(kit_status_qry(), kitsused:kitsavailable, names_to = "kitstatus", values_to = "quantity")})
patch_status_qry <- reactive({dbGetQuery(con, paste0("select available::integer as qtyavailable, activated::integer as qtyactive, returned::integer as qtyreturned, expunused::integer as qtyexpunused
from projectpatchstatus where projectname ='", input$projectname, "'"))})
patch_status <- reactive({pivot_longer(patch_status_qry(), qtyavailable:qtyexpunused, names_to = "patchstatus", values_to = "quantity")})
output$mybutton = downloadHandler(
filename = 'PMProjectDashboard.pptx',
content = function(file) {
out = render('PMProjectDashboard.Rmd')
file.rename(out, file) # move pdf to file for downloading
},
contentType = NA
)
}
shinyApp(ui, server)
Code for the Markdown File
---
title: "`r input$projectname` Project Metrics"
date: "`r Sys.Date()`"
output:
powerpoint_presentation:
reference_doc: "template.pptx"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(
echo = FALSE,
message = FALSE,
warning = FALSE,
fig.width = 12,
fig.height = 7
)
```{r}
library(tidyverse)
library(gapminder)
library(glue)
library(scales)
library(gridExtra)
library(patchwork)
library(config)
library(shiny)
library(odbc)
conn_args <- config::get("dataconnection")
con <- dbConnect(odbc::odbc(),
Driver = conn_args$driver,
Server = conn_args$server,
UID = conn_args$uid,
PWD = conn_args$pwd,
Port = conn_args$port,
Database = conn_args$database
)
map_data <- dbGetQuery(con, "select * from sitesubjectprojecttotal")
bar2 <- site_enroll_plot() %>%
ggplot(aes(x=sitename, y=quantity, fill = enrolltype)) + geom_col()
tab <- map_table() %>%
transmute(
`Location` = location,
`Sites` = sites,
`Subjects` = subjects,
) %>%
tableGrob(theme = ttheme_minimal(), rows = NULL)
pie1 <- ggplot(kit_status(), aes(x="", y=quantity, fill = kitstatus)) +
geom_bar(width=1, color = "white", stat = "identity") + coord_polar("y", start =0) +
theme_minimal() + ggtitle("Kit Status") + theme(legend.position = "bottom",
legend.box = "horizontal",
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(hjust = 0.5, family="sans")) +
labs(fill = NULL) + guides(fill=guide_legend(ncol=1)) +
geom_text(aes(label = quantity), position = position_stack(vjust = 0.5)) +
scale_fill_manual(NULL, labels = c("kitsavailable" = "Available",
"kitsused" = "Used"),
values = c("kitsavailable" = "gold1",
"kitsused" = "darkgoldenrod3"))
pie2 <- patchstatuspie <- ggplot(patch_status(), aes(x="", y=quantity, fill = patchstatus)) +
geom_bar(width=1, color = "white", stat = "identity") + coord_polar("y", start =0) +
theme_minimal() + ggtitle("Patch Status") + theme(legend.position = "bottom",
legend.box = "horizontal",
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(family="sans", hjust = 0.5)) +
labs(fill = NULL) + guides(fill=guide_legend(ncol=1)) +
geom_text(aes(label = quantity), position = position_stack(vjust = 0.5)) +
scale_fill_manual(NULL,
limits = c("qtyavailable", "qtyactive", "qtyreturned", "qtyexpunused"),
labels = c("qtyavailable" = "Available", "qtyactive" = "Used",
"qtyexpunused" = "Unused and Expired", "qtyreturned" = "Returned"),
values = c("qtyactive" = "darkgoldenrod3",
"qtyreturned" = "orange1", "qtyexpunused" = "orange2", "qtyavailable" = "gold1"))
pies <- ggarrange(pie1, pie2, nrow = 1, common.legend = TRUE, legend = "right")
layout <- (tab) / (pies + bar2)
layout +
plot_annotation(
title = paste0(input$projectname, " Metrics"),
caption = "*Accuracy of enrollment information dependent
on accurate marker entry in Portal.",
theme = theme(plot.title = element_text(size = 20, hjust = 0.5, face = "bold"))
)
The solution (using wrap_elements) has already been provided in the comments, which deserves to be the accepted answer. But I'd like to add a little on why this can produce slightly confusing results, which is not immediately obvious.
Interestingly, the need to wrap_elements seems to depend on the order in which the element are added to the patchwork layout.
This from the linked example code works (last step)
layout <- (bar + tab) / line
class(bar)
[1] "gg" "ggplot"
while starting with the non-gg object (tab as in the question) produces an error.
layout <- (tab + bar) / line
Error in e1 + e2 + plot_layout(ncol = 1) :
non-numeric argument to binary operator
class(tab)
[1] "gtable" "gTree" "grob" "gDesc"
With wrap_elements everything works again, as suggested and verified in the comments.
layout <- (wrap_elements(tab) + bar) / line