概述：通常，我们需要对两个连续变量进行相关性分析，可采用散点图叠加拟合曲线（有时也可包含95%置信区间）来呈现相关性分析的结果。本文将介绍使用R语言来绘制散点相关图，并自动添加相关系数和显著性水平(P值)及拟合方程。

使用工具： R语言中的ggplot2包、ggpubr包和ggpmisc包

本文大部分内容来自一篇英文博客的翻译内容，博客原文链接：Plot Two Continuous Variables: Scatter Graph and Alternatives，但笔者也对一些参数进行了修改，使得图形更为美观。

加载所需的包并设置主题样式

library(ggplot2)
library(ggpubr)
library(ggpmisc)
theme_set(ggpubr::theme_pubr()+
            theme(legend.position = "top"))

示例数据

示例数据集：mtcars。变量 cyl 作为分组变量。

# Load data
data("mtcars")
df <- mtcars
# Convert cyl as a grouping variable
df$cyl <- as.factor(df$cyl)
# Inspect the data
head(df[, c("wt", "mpg", "cyl", "qsec")], 4)

示例数据如下：

##                  wt  mpg cyl qsec
## Mazda RX4      2.62 21.0   6 16.5
## Mazda RX4 Wag  2.88 21.0   6 17.0
## Datsun 710     2.32 22.8   4 18.6
## Hornet 4 Drive 3.21 21.4   6 19.4

基本的散点相关图

关键函数：

• geom_point()：用于创建散点图。关键参数：color，size和shape，用于设置散点的边缘颜色，大小和形状。

• geom_smooth()：用于添加回归曲线和曲线拟合的置信区间。关键参数：

  • color，size和linetype：指定回归曲线的颜色、粗细和线型。
  • fill：指定置信区间的填充颜色。
  • method：用于指定曲线拟合的方法。

b <- ggplot(df, aes(x = wt, y = mpg))
# Scatter plot with regression line
b + geom_point()+
  geom_smooth(method = "lm", color = "black", fill = "lightgray") 

# Add a loess smoothed fit curve
b + geom_point()+
  geom_smooth(method = "loess", color = "black", fill = "lightgray")

注意：如果不需要显示曲线拟合的置信区间(即上图中的阴影区域)，可以设置 geom_smooth() 参数se = FALSE。

散点图点的形状可由 geom_point() 中参数 shape 指定，例如：

b + geom_point(shape = 17)+
  geom_smooth(method = "lm", color = "black", fill = "lightgray")

键入如下命令，可以查看R中点的形状及对应的索引：

ggpubr::show_point_shapes()

添加相关系数和显著性水平(P值)

使用 ggscatter() 也可以轻松绘制散点图，并可以使用 stat_cor() 自动添加相关系数和显著性水平(P值)。

# Add regression line and confidence interval
# Add correlation coefficient: stat_cor()
ggscatter(df, x = "wt", y = "mpg",
          add = "reg.line", conf.int = TRUE,    
          add.params = list(fill = "lightgray")
          
)+
  stat_cor(method = "pearson", 
           label.x = 3, label.y = 30)

存在多个组别的散点相关图

• 依据组别改变点的颜色和形状

• 使用函数 geom_rug() 在X轴和Y轴上添加轴须线(marginal rug)

# Change color and shape by groups (cyl)
b + geom_point(aes(color = cyl, shape = cyl))+
  geom_smooth(aes(color = cyl, fill = cyl), method = "lm") +
  geom_rug(aes(color =cyl)) +
  scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  scale_fill_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))
# Remove confidence region (se = FALSE)
# Extend the regression lines: fullrange = TRUE
b + geom_point(aes(color = cyl, shape = cyl)) +
  geom_rug(aes(color =cyl)) +
  geom_smooth(aes(color = cyl), method = lm, 
              se = FALSE, fullrange = TRUE)+
  scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  ggpubr::stat_cor(aes(color = cyl), label.x = 3)

使用 facet_wrap() 将各个分组展示于不同面板：

b + geom_point(aes(color = cyl, shape = cyl))+
  geom_smooth(aes(color = cyl, fill = cyl), 
              method = "lm", fullrange = TRUE) +
  facet_wrap(~cyl) +
  scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  scale_fill_manual(values = c("#00AFBB", "#E7B800", "#FC4E07")) +
  theme_bw()

自动添加回归曲线的拟合方程

使用 stat_poly_eq() 可以将回归曲线的拟合方程添加到图形中。值得注意的是，stat_poly_eq() 还可以用于添加拟合方程的决定系数(R²)、P值、AIC值和BIC值等，可通过设定label 实现。

b <- ggplot(df, aes(x = wt, y = mpg))

formula <- y ~ x

b + geom_point(shape = 17)+
  geom_smooth(method = "lm", color = "black", fill = "lightgray") +
  stat_cor(method = "pearson",label.x = 3, label.y = 30) +
  stat_poly_eq(
    aes(label = ..eq.label..),
formula = formula,parse = TRUE, geom = "text",label.x = 3,label.y = 28, hjust = 0)

注意：
显示相关系数与方程式的两个文本的位置需要根据实际的数据分布作调整，尽量显示在没有点分布的位置处。

为了将显示相关系数与方程式的两个文本对齐，上图为左对齐，需设置 stat_cor() 和 stat_poly_eq() 中label.x的值相同（横轴位置相同）， 设置label.y来控制两文本的间隔。同时，需要设置 stat_poly_eq() 中geom = “text”。此外，在指定的 (label.x, label.y) 位置处显示文本，stat_cor() 默认为左对齐，而 stat_poly_eq() 默认为居中对齐，为了保持一致，需将 stat_poly_eq() 也设置为左对齐，即hjust = 0。(注：hjust=0表示左对齐，hjust=1表示右对齐，hjust=0.5表示居中对齐)

上图是通过指定显示文本的绝对位置来实现，即 label.x 和 label.y 的取值范围与X轴和Y轴的取值对应。

也可以通过以下方式来实现：其中通过 label.x.npc 和 label.y.npc 来指定显示文本的位置，但 label.x.npc 和 label.y.npc的取值范围为0~1，如0.5表示居中。

b <- ggplot(df, aes(x = wt, y = mpg))

formula <- y ~ x

b + geom_point(shape = 17)+
  geom_smooth(method = "lm", color = "black", fill = "lightgray") +
  stat_cor(method = "pearson",label.x.npc = 0.5, label.y.npc = 0.9) +
  stat_poly_eq(
    aes(label = ..eq.label..),
    formula = formula,parse = TRUE,label.x.npc = 0.5,label.y.npc = 0.8, hjust = 0)

拟合多项式方程

创建样本数据

set.seed(4321)
x <- 1:100
y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4)
my.data <- data.frame(x, y, group = c("A", "B"), 
                      y2 = y * c(0.5,2), block = c("a", "a", "b", "b"))

采用多项式回归拟合并添加拟合方程

# Polynomial regression. Sow equation and adjusted R2
formula <- y ~ poly(x, 3, raw = TRUE)
p <- ggplot(my.data, aes(x, y2, color = group)) +
  geom_point() +
  geom_smooth(aes(fill = group), method = "lm", formula = formula) +
  stat_poly_eq(
    aes(label =  paste(..eq.label.., ..adj.rr.label.., sep = "~~~~")),
    formula = formula, parse = TRUE
  )+
  scale_fill_manual(values = c("#00AFBB", "#E7B800"))+
  scale_color_manual(values = c("#00AFBB", "#E7B800"))
p

注意：可以在 label 中添加 ..AIC.label.. 和 ..BIC.label.. ，
将会显示拟合方程的AIC值和BIC值。

stat_poly_eq()中的 label.x 和 label.y 可用于调整标签显示的位置。

想要查看更多的示例，请键入该命令进行查看：
browseVignettes("ggpmisc")
将打开如下网页：http://127.0.0.1:18537/session/Rvig.2970595b7d23.html

References

原文链接：Plot Two Continuous Variables: Scatter Graph and Alternatives