R语言绘制多幅椭圆图时模型系数点全部叠加到单图的问题

开发自定义R函数，目标是基于线性模型批量生成椭圆置信图，同时将每个模型对应的系数点绘制到所属椭圆子图中。实际运行时所有系数点都被绘制到同一张图上，无法实现单幅子图对应一个系数点的效果。

some_plot_func <- function(data, predictors, type=NULL){
  models <- 
    data %>% 
    keep( ~ all(length(names(.$model)) > 2))

    models <- 
      models %>%
      keep(~all(predictors %in% names(.$model))) 
    
    row_predictor_data <- 
      lapply(models, function(x)
        names(x$model) %>%
          seq_along() %>% as.factor() %>%
          data.frame(id = ., name = as.factor(names(x$model))))
    
    row_predictor_value <-
      lapply(row_predictor_data, function(x)
        which(x == predictors, arr.ind = TRUE)) %>% 
      lapply(., function(x)
        data.frame(x) %>% 
          mutate(pred_num = c('first', 'second')) %>% 
          pivot_wider(names_from = pred_num, values_from = row))
    
    # 分开执行椭圆绘制和点绘制操作
    lapply(models, function(x)
      plot(ellipse(x, predictors), type = type))
    
    mapply(function(x, y)points(coef(x)[y$first], coef(x)[y$second]), models, row_predictor_value)
}

# 构造测试模型
lm1 <- lm(lifespan ~ brain, mammalsleep)
lm2 <- lm(lifespan ~ brain+dream+nondream, mammalsleep)
lm3 <- lm(lifespan ~ brain+sleep, mammalsleep)
lm4 <- lm(lifespan ~ brain+predation+danger+sleep, mammalsleep)
lm5 <- lm(lifespan ~ sleep, mammalsleep)

list_models <- list(lm1, lm2, lm3, lm4, lm5)

# 运行函数
par(mfrow=c(1, 2))
some_plot_func(list_models, c('brain', 'sleep'), type='l')

R基础绘图系统中，plot()调用完成后会自动将当前活动绘图设备切换到下一个子图位置，后续所有独立调用的points()都会默认绘制在最后一个处于活动状态的子图上，不会自动回溯匹配之前绘制的椭圆子图。原代码将「绘制椭圆」和「添加系数点」拆成两个独立循环，导致所有点都叠加到最后一张图上。

将绘制椭圆和添加对应系数点的操作合并到同一个循环中，保证绘制完单个椭圆后，立刻在当前活动子图上添加对应的系数点，再进入下一个子图的绘制流程。

修复后的可运行代码：

library(ellipse)
library(tidyverse)

some_plot_func <- function(data, predictors, type=NULL){
  models <- 
    data %>% 
    keep( ~ all(length(names(.$model)) > 2))

    models <- 
      models %>%
      keep(~all(predictors %in% names(.$model))) 
    
    row_predictor_data <- 
      lapply(models, function(x)
        names(x$model) %>%
          seq_along() %>% as.factor() %>%
          data.frame(id = ., name = as.factor(names(x$model))))
    
    row_predictor_value <-
      lapply(row_predictor_data, function(x)
        which(x == predictors, arr.ind = TRUE)) %>% 
      lapply(., function(x)
        data.frame(x) %>% 
          mutate(pred_num = c('first', 'second')) %>% 
          pivot_wider(names_from = pred_num, values_from = row))
    
    # 合并椭圆绘制和点绘制到同一个循环
    Map(function(x, y){
      # 绘制当前模型的椭圆
      plot(ellipse(x, predictors), type = type)
      # 在当前活动子图上添加对应系数点
      points(coef(x)[y$first], coef(x)[y$second], pch = 19, col = "red")
    }, models, row_predictor_value)
}

# 构造测试模型
lm1 <- lm(lifespan ~ brain, mammalsleep)
lm2 <- lm(lifespan ~ brain+dream+nondream, mammalsleep)
lm3 <- lm(lifespan ~ brain+sleep, mammalsleep)
lm4 <- lm(lifespan ~ brain+predation+danger+sleep, mammalsleep)
lm5 <- lm(lifespan ~ sleep, mammalsleep)

list_models <- list(lm1, lm2, lm3, lm4, lm5)

# 运行函数
par(mfrow=c(1, 2))
some_plot_func(list_models, c('brain', 'sleep'), type='l')

• 用Map（等价于mapply默认SIMPLIFY = FALSE的版本）替代分开执行的lapply和mapply，把单张子图的所有绘制操作封装在同一个迭代块内
• 每轮迭代先绘制当前模型的椭圆，此时当前绘图设备定位在刚生成的子图上，立刻调用points()就会把系数点绘制在对应子图中，不会出现错位
• 示例中传入的预测变量为c('brain', 'sleep')，过滤后同时包含两个预测变量的模型共2个（lm3、lm4，其余模型不同时包含两个目标预测变量，或模型变量数不足），可根据实际剩余模型数量调整par(mfrow)的子图布局参数

内容的提问来源于stack exchange，提问作者Dollar Tune-bill