如何用R的ggplot分别填充相交曲线的上下区域？

核心问题分析 #

你的代码在无中间交点的简单数据集能正常工作，但遇到原始数据点间隔内存在曲线交叉的场景时，会触发两个问题：

1. geom_ribbon直接连接原始端点，导致交叉区域的填充出现溢出；
2. 面积计算未考虑中间交点，将跨交叉的区间当作单一区域计算，结果不准确。

解决的核心思路是：先找出两条曲线在所有原始数据点间隔内的交点，把这些交点插入数据集，让每个相邻数据点之间的曲线不再交叉，再进行后续的面积计算和绘图。

完整解决方案代码 #

1. 工具函数：查找区间内的曲线交点 #

# 查找两条曲线在[x1, x2]区间内的交点（存在则返回交点坐标）
find_intersection <- function(x1, x2, y1_1, y1_2, y2_1, y2_2) {
  # 生成两条曲线的线性插值函数
  f1 <- approxfun(c(x1, x2), c(y1_1, y1_2), method = "linear")
  f2 <- approxfun(c(x1, x2), c(y2_1, y2_2), method = "linear")
  
  # 定义差值函数：基线值 - curve2值
  diff_f <- function(x) f1(x) - f2(x)
  
  # 检查区间两端差值是否异号（判断是否存在交点）
  if (sign(diff_f(x1)) == sign(diff_f(x2))) {
    return(NULL)
  }
  
  # 用uniroot求解交点的x值
  root <- uniroot(diff_f, interval = c(x1, x2))$root
  # 计算交点的y值（两条曲线在该x处的y值相等）
  y_val <- f1(root)
  
  return(data.frame(time = root, baseline = y_val, curve2 = y_val))
}

2. 补全数据集（插入所有交点） #

library(dplyr)
library(ggplot2)

# 输入复杂数据集
df <- data.frame(time = c(0, 120, 300, 600, 900),
                 baseline = c(100, 62.3, 56.7, 47.9, 44.7),
                 curve2 = c(92.2, 58.7, 58.2, 52.4, 51.1))

# 按time排序（确保数据沿x轴递增）
df <- df %>% arrange(time)

# 初始化包含交点的完整数据集
full_df <- df

# 遍历每个相邻数据点对，查找并插入交点
for (i in 1:(nrow(df)-1)) {
  x1 <- df$time[i]
  x2 <- df$time[i+1]
  y1_1 <- df$baseline[i]
  y1_2 <- df$baseline[i+1]
  y2_1 <- df$curve2[i]
  y2_2 <- df$curve2[i+1]
  
  intersection <- find_intersection(x1, x2, y1_1, y1_2, y2_1, y2_2)
  if (!is.null(intersection)) {
    # 将交点插入到数据集对应位置
    full_df <- full_df %>%
      add_row(intersection, .before = i+1)
    # 更新df为补全后的数据集，避免索引混乱
    df <- full_df
  }
}

3. 准确计算面积（基于补全后的数据集） #

calculate_area_between_curves <- function(df, x_col, y1_col, y2_col) {
  df <- df %>% arrange(!!sym(x_col))
  
  x <- df[[x_col]]
  y1 <- df[[y1_col]]
  y2 <- df[[y2_col]]
  
  dx <- diff(x)
  # 计算每个区间的梯形平均差值
  avg_diff <- (y1[-1] + y1[-length(y1)])/2 - (y2[-1] + y2[-length(y2)])/2
  
  total_area <- sum(abs(avg_diff) * dx)
  # curve2在基线之下的区域面积（基线值更大）
  blue_area <- sum(pmax(avg_diff, 0) * dx)
  # curve2在基线之上的区域面积（curve2值更大）
  red_area <- sum(pmax(-avg_diff, 0) * dx)
  
  return(list(total = total_area, blue = blue_area, red = red_area))
}

# 计算面积
areas <- calculate_area_between_curves(full_df, "time", "baseline", "curve2")
areas

4. 正确绘制填充曲线（无溢出） #

ggplot(full_df, aes(time)) +
  # 填充curve2在基线之下的区域（蓝色）
  geom_ribbon(aes(ymin = curve2, ymax = baseline), 
              fill = "blue", alpha = 0.3, 
              data = filter(full_df, baseline >= curve2)) +
  # 填充curve2在基线之上的区域（红色）
  geom_ribbon(aes(ymin = baseline, ymax = curve2), 
              fill = "red", alpha = 0.3, 
              data = filter(full_df, curve2 > baseline)) +
  geom_line(aes(y = baseline), col = 'red', linewidth = 1) +
  geom_line(aes(y = curve2), col = 'blue', linewidth = 1) + 
  theme_bw()

关键说明 #

1. 交点插入：通过线性插值找到每个区间内的交点，确保相邻数据点之间的曲线无交叉，从根源解决填充溢出问题；
2. 面积计算：补全数据后，每个区间内两条曲线的上下关系唯一，梯形法计算的面积完全准确；
3. 分层填充：绘图时按区间内的上下关系过滤数据，分别填充对应区域，避免交叉区域的错误填充。

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