使用 Patchwork 时出现不一致错误（二元运算符的非数字参数）
Inconsistent Error (Non-Numeric Argument to Binary Operator) When Using Patchwork
我正在构建一个 Rshiny 应用程序，它接受用户输入并生成带有图表的 Rmd powerpoint 幻灯片。我基于我在 https://mattherman.info/blog/ppt-patchwork/ 找到的例子。当我尝试 运行 关闭 Matt Herman 博客的示例时，它会按预期生成 ppt。昨天，当我 运行 我的代码时，我不断收到错误消息“+ 中的错误：二元运算符的非数字参数”。我慢慢地将我的 graphs/charts/code 替换到示例代码中，并且能够生成没有错误的 ppt 幻灯片。我以为我没事了。
今天早上，我在打开和关闭 R 后再次尝试 运行 程序，现在我得到了与昨天相同的错误，尽管 Matt Herman 示例代码仍然 运行s完美。我认为这与拼凑包加载不正确有关，但我是 R 的新手，我不是 100% 确定。如果有人可以提供帮助，将不胜感激！这种不一致让我发疯。
(PS 我知道现在的代码有点草率——我在过去的尝试中添加了一些我可能不再需要的库，我正在写这篇文章并试图弄清楚这个拼凑的问题，所以对混乱表示歉意。）
闪亮应用代码：
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)
Markdown 文件的代码
---
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"))
)
解决方案（使用wrap_elements）已经在评论中给出了，不愧为采纳答案。但我想补充一点，为什么这会产生稍微令人困惑的结果，这不是很明显。
有趣的是，是否需要 wrap_elements 似乎取决于元素添加到拼凑布局的顺序。
这来自 linked example code 作品（最后一步）
layout <- (bar + tab) / line
class(bar)
[1] "gg" "ggplot"
从非 gg 对象（如问题中的 tab 开始）会产生错误。
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"
有了 wrap_elements，一切又恢复正常了，正如评论中所建议和验证的那样。
layout <- (wrap_elements(tab) + bar) / line
我正在构建一个 Rshiny 应用程序，它接受用户输入并生成带有图表的 Rmd powerpoint 幻灯片。我基于我在 https://mattherman.info/blog/ppt-patchwork/ 找到的例子。当我尝试 运行 关闭 Matt Herman 博客的示例时，它会按预期生成 ppt。昨天，当我 运行 我的代码时，我不断收到错误消息“+ 中的错误：二元运算符的非数字参数”。我慢慢地将我的 graphs/charts/code 替换到示例代码中，并且能够生成没有错误的 ppt 幻灯片。我以为我没事了。
今天早上，我在打开和关闭 R 后再次尝试 运行 程序，现在我得到了与昨天相同的错误，尽管 Matt Herman 示例代码仍然 运行s完美。我认为这与拼凑包加载不正确有关，但我是 R 的新手，我不是 100% 确定。如果有人可以提供帮助，将不胜感激！这种不一致让我发疯。
(PS 我知道现在的代码有点草率——我在过去的尝试中添加了一些我可能不再需要的库，我正在写这篇文章并试图弄清楚这个拼凑的问题，所以对混乱表示歉意。）
闪亮应用代码：
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)
Markdown 文件的代码
---
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"))
)
解决方案（使用wrap_elements）已经在评论中给出了，不愧为采纳答案。但我想补充一点，为什么这会产生稍微令人困惑的结果，这不是很明显。
有趣的是，是否需要 wrap_elements 似乎取决于元素添加到拼凑布局的顺序。
这来自 linked example code 作品（最后一步）
layout <- (bar + tab) / line
class(bar)
[1] "gg" "ggplot"
从非 gg 对象（如问题中的 tab 开始）会产生错误。
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"
有了 wrap_elements，一切又恢复正常了，正如评论中所建议和验证的那样。
layout <- (wrap_elements(tab) + bar) / line