如何在ggplot2中识别geom_abline上下点并用data.table拆分数据

你拥有包含150个唯一ID的面板数据集，已经通过plm()函数拟合了固定效应模型，数据集示例如下：

data <- data.frame(ID = c(1,1,1,1,2,2,3,3,3),
                   year = c(1,2,3,4,1,2,1,2,3),
                   progenyMean = c(90,78,92,69,86,73,82,85,91),
                   damMean = c(89,89,72,98,95,92,94,87,89))

你拟合固定效应模型的代码如下：

# plm固定效应模型拟合
fixed <- plm(progenyMean ~ damMean, data, model= "within", index = c("ID","year"))

你已经通过如下代码绘制了响应变量progenyMean与damMean的散点图，叠加了斜率为fixed模型系数、截距为fixef(fixed)均值71.09的geom_abline：

plotFunction <- function(aggData, year){
  
  ggplot(aggData, aes(x=damMeanCentered, y=progenyMean3Y)) + 
    geom_point() + 
    geom_abline(slope=fixed$coefficients, intercept=71.09, colour='dodgerblue1', size=1)
# 截距71.09由fixef(fixed)取均值计算得到
  
}

plotFunction(data, '(2005 - 2012)')

生成的可视化结果如下：

是否可以识别出ggplot中位于geom_abline上下方的对应数据点，并且使用data.table将这两类数据拆分，生成新的数据表？

可以实现，核心逻辑是先根据拟合线的斜率、截距计算每个x对应的拟合y值，再对比实际y值和拟合y值的大小即可区分点位，data.table处理这类运算效率很高，具体实现代码如下：

# 加载所需包
library(data.table)
library(plm)

# 1. 将数据集转为data.table格式
dt <- as.data.table(data)

# 2. 提取模型参数
slope <- fixed$coefficients[[1]]
intercept <- 71.09

# 3. 计算拟合值、给点位打标签，注意x、y变量要和你绘图时用的变量名一致
dt[, `:=`(
  fitted_y = intercept + slope * damMeanCentered,
  point_pos = fifelse(progenyMean3Y > fitted_y, "线上方", "线下方")
)]

# 4. 拆分生成两个新表
## 方法1：生成独立的两个数据表
dt_above <- dt[point_pos == "线上方"]
dt_below <- dt[point_pos == "线下方"]

## 方法2：直接生成包含两个子表的列表，调用更方便
split_dt <- split(dt, by = "point_pos")
# 后续可以通过split_dt$线上方、split_dt$线下方调用对应数据表

如果需要验证拆分结果是否正确，可以用标签给散点上色后和拟合线对比：

ggplot(dt, aes(x=damMeanCentered, y=progenyMean3Y, color = point_pos)) +
  geom_point() +
  geom_abline(slope = slope, intercept = intercept, colour='dodgerblue1', size=1) +
  scale_color_manual(values = c("线上方" = "red", "线下方" = "green"))

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