使用 Patchwork 时出现不一致错误（二元运算符的非数字参数）

Question

我正在构建一个 Rshiny 应用程序，它接受用户输入并生成带有图表的 Rmd powerpoint 幻灯片。我基于我在 https://mattherman.info/blog/ppt 找到的示例-拼凑/。当我尝试运行 Matt Herman 博客上的示例时，它会按预期生成 ppt。昨天，当我运行代码时，我不断收到错误消息“+ 中的错误：二元运算符的非数字参数”。我慢慢地将我的图形/图表/代码替换到示例代码中，并且能够生成没有错误的 ppt 幻灯片。我以为我是清白的。

今天早上，我尝试在打开和关闭 R 后再次运行该程序，现在我得到了与昨天相同的错误，尽管 Matt Herman 示例代码仍然运行完美。我认为这与拼凑包加载不正确有关，但我是 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"))
      )

Answer 1

解决方案（使用wrap_elements）已经在评论中提供，值得被接受的答案。但我想补充一点为什么这会产生稍微令人困惑的结果，这并不是立即显而易见的。

有趣的是，对 wrap_elements 的需求似乎取决于将元素添加到拼凑布局的顺序。

这来自 链接示例代码，

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