如何在R中为散点图的因变量绘制基于分位数的二维密度图？

明确需求：不是捕捉双变量平滑密度的热图散点图，而是要在散点图上叠加因变量分布的“切片”（按因变量分位数截取分组，展示每组自变量的分布）。

初始尝试（未达预期） #

最初使用tidyverse的代码尝试，但未将分布切片与预测变量关联，无法实现需求：

#### Load Library ####
library(tidyverse)

#### Get IQR ####
q <- quantile(iris$Sepal.Length, 
              probs = c(.25,.5,.75))
q

#### Label Quantile Regions ####
qiris <- iris %>% 
  mutate(qs = ifelse(Sepal.Length >= q[3],
                     "Q75",
                     ifelse(Sepal.Length >= q[2],
                            "Q50","Q25")))

#### Plot Density and Scatter ####
ggplot()+
  geom_point(aes(x=Sepal.Width,
                 y=Sepal.Length),
             data=iris)+
  geom_density(aes(y=Sepal.Length,
                   fill=qs),
               data=qiris)

第二次尝试（ggridges方案） #

改用ggridges实现了分布切片的定位，但存在三个问题：

• 无法拟合回归线
• 数据点按分位数空间分离距离过远
• 未纳入另一个关键变量

代码如下：

library(ggridges)

ggplot(qiris, 
       aes(x = Sepal.Length,
           y = qs)) + 
  stat_density_ridges(quantiles = c(0.25,0.5,0.75),
                      geom="density_ridges_gradient",
                      jittered_points = TRUE,
                      position = "raincloud", 
                      alpha = 0.6, 
                      scale = 0.6)+
  coord_flip()

测试Allen方案时的问题 #

尝试Allen的方案时，用mtcars数据集测试得到贯穿图的平线，测试代码如下：

#### Load Library ####
library(tidyverse)

#### Save Objects ####
dfy <- mtcars$mpg # y var
dfx <- mtcars$hp # x var
data <- mtcars # dataset

#### QDATA ####
qdata <- data %>% 
  mutate(cut_group = cut(dfy, 
                         quantile(dfy, c(0.125, 0.375, 0.625, 0.875)),
                         labels = c('Q25', 'Q50', 'Q75')),
         baseline = quantile(dfy, 
                             c(0.25, 0.5, 0.75))[as.numeric(cut_group)]) %>%
  filter(complete.cases(.)) %>%
  group_by(cut_group) %>%
  reframe(dfxx = density(dfx)$x,
          dfy = first(baseline) - density(dfx, bw = 0.5)$y/3) %>%
  rename(dfx = dfxx) 

ggplot(data,
       aes(dfy,
           dfx)) +
  geom_smooth(method = 'lm', 
              color = 'gray',
              se = FALSE) +
  geom_point(color = 'navy',
             shape = 21,
             fill = NA) +
  geom_path(data = qdata,
            aes(group = cut_group), 
            color = 'darkgreen',
            linewidth = 1.5) +
  theme_classic() +
  theme(panel.border = element_rect(fill = NA, 
                                    linewidth = 1))

解决方案 #

针对mtcars数据集的问题，修正代码如下，解决平线问题并满足需求：

library(tidyverse)

dfy <- mtcars$mpg # 因变量
dfx <- mtcars$hp # 自变量
data <- mtcars # 数据集

# 修正分位数分组与密度计算逻辑
qdata <- data %>% 
  # 修正分位数区间，确保覆盖所有数据
  mutate(cut_group = cut(dfy, 
                         quantile(dfy, c(0, 0.25, 0.5, 0.75, 1)),
                         labels = c('Q1-Q25', 'Q25-Q50', 'Q50-Q75', 'Q75-Q100')),
         # 为每个分组设置对应的y轴基线（分位数数值）
         baseline = quantile(dfy, c(0.25, 0.5, 0.75, 1))[as.numeric(cut_group)]) %>%
  filter(complete.cases(.)) %>%
  group_by(cut_group) %>%
  reframe(
    # 调整带宽适配hp的数值范围，避免密度曲线异常
    dfx = density(dfx, bw = 15)$x,
    # 调整缩放因子，让密度曲线在y轴方向更清晰可见
    dfy = first(baseline) - density(dfx, bw = 15)$y * 2
  )

# 绘制图形：自变量x，因变量y，符合常规可视化逻辑
ggplot(data, aes(x = dfx, y = dfy)) +
  # 添加回归线
  geom_smooth(method = 'lm', color = 'gray', se = FALSE) +
  # 散点层
  geom_point(color = 'navy', shape = 21, fill = NA) +
  # 叠加分组密度切片
  geom_path(data = qdata, aes(group = cut_group), color = 'darkgreen', linewidth = 1.5) +
  # 主题调整
  theme_classic() +
  theme(panel.border = element_rect(fill = NA, linewidth = 1))

关键修正点： #

• 分位数区间修正：将原有的分位数区间c(0.125, 0.375, 0.625, 0.875)改为c(0, 0.25, 0.5, 0.75, 1)，确保所有数据都能被分到对应分组，避免数据丢失。
• 密度带宽调整：针对mtcars$hp的数值范围（52-335），将带宽bw=0.5调整为bw=15，适配数据分布，避免密度曲线异常变成平线。
• 缩放因子调整：将密度曲线的y轴缩放从/3改为*2，让曲线在y轴方向更明显，便于观察分布形态。
• 轴映射修正：将自变量hp放在x轴、因变量mpg放在y轴，符合常规散点图的阅读习惯。

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