R语言多子图绘制时首张子图图例缺失问题及解决方案

我尝试基于grouping分组字段对数据做颜色编码、批量绘制多张子图，希望将每个子图的图例放置在box绘图区域范围外。需求基本可实现，但运行代码后首张子图无图例，其余子图的图例均可正常显示。

测试用val数据定义如下：

list(pop15 = 35, pop75 = 2.5, dpi = 2000, ddpi = 7)

复现示例代码：

library(faraway)
library(tidyverse)
library(glue)
data(savings)

group_data <- mapply(function(x, y) {
  savings %>% mutate(test = ifelse(.[, y] > x, "Group 1 (GT)", "Group 2 (LT)"))
}, val, names(val), SIMPLIFY = FALSE) %>%
  mapply(function(a,z) {
    a %>% `colnames<-`(c(names(.)[-length(.)], glue("{z}_group")))
  }, ., names(.), SIMPLIFY = FALSE) %>% 
  Reduce(cbind, .) %>% 
  .[, !duplicated(names(.))] 

nn <- length(val)
ng <- names(group_data)[(length(group_data)-nn+1):length(group_data)]
n2 <- n2mfrow(nn, 2)
par(mfrow=n2, xpd=TRUE)

mapply(function(q, w){
  form <- reformulate(q, response='sr')
plot(form, data=group_data, col=c('red', 'blue')[as.factor(group_data[,w])], pch=c(19, 19))

legend( x=0, 26,
        legend=c("Group 1 (GT)","Group 2 (LT)"),
        col=c("red","blue"), lwd=1, lty=c(0,0), 
        pch=c(19,19), bty='n' )
  
},names(val),ng, SIMPLIFY=FALSE)

运行代码得到的初始异常效果：

针对调整首图图例x坐标的建议，我增加了判断逻辑单独给第一个子图设置图例位置：

if(q == 'pop15'){
legend( x=21, 26,
        legend=c("Group 1 (GT)","Group 2 (GT)"),
        col=c("red","blue"), lwd=1, lty=c(0,0), 
        pch=c(19,19), bty='n' )} else{
          legend( x=0, 26,
                  legend=c("Group 1 (GT)","Group 2 (LT)"),
                  col=c("red","blue"), lwd=1, lty=c(0,0), 
                  pch=c(19,19), bty='n' )
        }

调整后初始4张子图均可正常显示图例，但该方案不具备通用性。当新增如下数据列时：

savings$status <- savings$pop15+1
val <- c(val, status=list(37))

重复运行代码会再次出现图例显示异常：

放弃base绘图手动调图例坐标的思路，改用ggplot2分面逻辑实现，代码如下：

group_data <- mapply(function(x, y) {
  savings %>% mutate(group = ifelse(.[, y] > x, "Group 1 (GT)", "Group 2 (LT)"))
}, val, names(val), SIMPLIFY = FALSE) %>%
  mapply(function(a,z) {
    a %>% `colnames<-`(c(names(.)[-length(.)], glue("{z}_group")))
  }, ., names(.), SIMPLIFY = FALSE) %>% 
  Reduce(cbind, .) %>% 
  .[, !duplicated(names(.))] %>% pivot_longer(-c(1:(length(.)-nn))) %>% dplyr::select(group=value) %>% cbind.data.frame(savings %>% pivot_longer(-c(1)), .)

val_hline <- val %>% unlist() %>% data.frame(hline=.) %>% rownames_to_column() %>% `colnames<-`(c('name', 'hline'))

kop <- inner_join(group_data, val_hline, by='name')

kop %>% ggplot(aes(x = value, y = sr, color = group)) +
  geom_point() +
  facet_wrap(name ~ ., scales = "free") + theme_bw() +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        panel.border = element_rect(colour = "black", fill = NA),
        legend.position = "bottom") + 
  stat_smooth(method='lm') +
  geom_vline(aes(xintercept=hline))

最终实现效果：

内容的提问来源于stack exchange，提问作者Emil11