ggplot2：如何 plot 正交回归线？

Question

我已经在两种不同的视觉感知测试中测试了大量参与者样本——现在，我想看看这两种测试的表现在多大程度上相关。

为了可视化相关性，我使用ggplot() plot R 中的散点图，并拟合回归线（使用stat_smooth() ）。 但是，由于我的x和y变量都是性能度量，因此在拟合回归线时我需要将它们都考虑在内 - 因此，我不能使用简单的线性回归（使用stat_smooth(method="lm") ），但是而是需要拟合正交回归（或总最小二乘法）。 我将如何 go 这样做？

我知道我可以在stat_smooth()中指定formula ，但我不知道要使用什么公式。 据我了解，预设方法（ lm, glm, gam, loess, rlm ）均不适用。

Answer 1

事实证明，可以提取从主成分分析的斜率和截距上（X，Y），如图所示在这里。 这只是简单一点，在基本 R 中运行，并给出与在MethComp使用Deming(...)相同的结果。

# same `x and `y` as @user20650's answer
df  <- data.frame(y, x)
pca <- prcomp(~x+y, df)
slp <- with(pca, rotation[2,1] / rotation[1,1])
int <- with(pca, center[2] - slp*center[1])

ggplot(df, aes(x,y)) + 
  geom_point() + 
  stat_smooth(method=lm, color="green", se=FALSE) +
  geom_abline(slope=slp, intercept=int, color="blue")

Answer 2

警告：不熟悉这种方法

我认为您应该能够通过slope并intercept到geom_abline以生成拟合线。 或者，您可以定义自己的方法以传递给stat_smooth （如stat_smooth的链接smooth.Pspline 包装器所示（在 ggplot2 中）。 我使用了MethComp包中的Deming函数，如链接如何计算 R 中的总最小二乘法中所建议的那样？ （正交回归） 。

library(MethComp)
library(ggplot2)

# Sample data and model (from ?Deming example) 
set.seed(1)
M <- runif(100,0,5)
# Measurements:
x <-         M + rnorm(100)
y <- 2 + 3 * M + rnorm(100,sd=2)

# Deming regression
mod <- Deming(x,y)

# Define functions to pass to stat_smooth - see mnel's answer at link for details
# Defined the Deming model output as class Deming to define the predict method
# I only used the intercept and slope for predictions - is this correct?
f <- function(formula,data,SDR=2,...){
        M <- model.frame(formula, data)
        d <- Deming(x =M[,2],y =M[,1], sdr=SDR)[1:2]
        class(d) <- "Deming"
        d  
        }

# an s3 method for predictdf (called within stat_smooth)
predictdf.Deming <- function(model, xseq, se, level) {
                         pred <- model %*% t(cbind(1, xseq) )
                         data.frame(x = xseq, y = c(pred))
                         }

ggplot(data.frame(x,y), aes(x, y)) + geom_point() + 
          stat_smooth(method = f, se= FALSE, colour='red', formula=y~x, SDR=1) +  
          geom_abline(intercept=mod[1], slope=mod[2], colour='blue') +
          stat_smooth(method = "lm", se= FALSE, colour='green', formula = y~x)

因此，将截距和斜率传递给geom_abline会产生相同的拟合线（如预期）。 因此，如果这是正确的方法，那么 imo 更容易使用它。

Answer 3

MethComp包似乎不再维护（已从 CRAN 中删除）。 Russel88/COEF允许使用stat_ / geom_summary with method="tls"添加正交回归线。

基于此和wikipedia:Deming_regression，我创建了以下函数，这些函数允许使用 1 以外的噪声比：

deming.fit <- function(x, y, noise_ratio = sd(y)/sd(x)) {
  if(missing(noise_ratio) || is.null(noise_ratio)) noise_ratio <- eval(formals(sys.function(0))$noise_ratio) # this is just a complicated way to write `sd(y)/sd(x)`
  delta <-  noise_ratio^2
  x_name <- deparse(substitute(x))

  s_yy <- var(y)
  s_xx <- var(x)
  s_xy <- cov(x, y)
  beta1 <- (s_yy - delta*s_xx + sqrt((s_yy - delta*s_xx)^2 + 4*delta*s_xy^2)) / (2*s_xy)
  beta0 <- mean(y) - beta1 * mean(x) 

  res <- c(beta0 = beta0, beta1 = beta1)
  names(res) <- c("(Intercept)", x_name)
  class(res) <- "Deming"
  res
}

deming <- function(formula, data, R = 100, noise_ratio = NULL, ...){
  ret <- boot::boot(
    data = model.frame(formula, data), 
    statistic = function(data, ind) {
      data <- data[ind, ]
      args <- rlang::parse_exprs(colnames(data))
      names(args) <- c("y", "x")
      rlang::eval_tidy(rlang::expr(deming.fit(!!!args, noise_ratio = noise_ratio)), data, env = rlang::current_env())
    },
    R=R
  )
  class(ret) <- c("Deming", class(ret))
  ret  
}

predictdf.Deming <- function(model, xseq, se, level) {
  pred <- as.vector(tcrossprod(model$t0, cbind(1, xseq)))
  if(se) {
    preds <- tcrossprod(model$t, cbind(1, xseq))
    data.frame(
      x = xseq,
      y = pred,
      ymin = apply(preds, 2, function(x) quantile(x, probs = (1-level)/2)),
      ymax = apply(preds, 2, function(x) quantile(x, probs = 1-((1-level)/2)))
    )
  } else {
    return(data.frame(x = xseq, y = pred))
  }
}

# unrelated hlper function to create a nicer plot:
fix_plot_limits <- function(p) p + coord_cartesian(xlim=ggplot_build(p)$layout$panel_params[[1]]$x.range, ylim=ggplot_build(p)$layout$panel_params[[1]]$y.range)

示范：

library(ggplot2)

#devtools::install_github("Russel88/COEF")
library(COEF)

fix_plot_limits(
    ggplot(data.frame(x = (1:5) + rnorm(100), y = (1:5) + rnorm(100)*2), mapping = aes(x=x, y=y)) +
      geom_point()
    ) +
  geom_smooth(method=deming, aes(color="deming"), method.args = list(noise_ratio=2)) +
  geom_smooth(method=lm, aes(color="lm")) +
  geom_smooth(method = COEF::tls, aes(color="tls"))

^{由reprex 包(v0.3.0) 于 2019 年 12 月 4 日创建}

Answer 4

对于任何感兴趣的人，我针对 deming::deming() function 验证了 jhoward 的解决方案，因为我不熟悉 jhoward 使用 PCA 提取斜率和截距的方法。 它们确实产生了相同的结果。 代表是：

# Sample data and model (from ?Deming example) 
set.seed(1)
M <- runif(100,0,5)
# Measurements:
x <-         M + rnorm(100)
y <- 2 + 3 * M + rnorm(100,sd=2)

# Make data.frame()
df <- data.frame(x,y)

# Get intercept and slope using deming::deming()
library(deming)
mod_Dem <- deming::deming(y~x,df)
slp_Dem <- mod_Dem$coefficients[2]
int_Dem <- mod_Dem$coefficients[1]

# Get intercept and slope using jhoward's method
pca <- prcomp(~x+y, df)
slp_jhoward <- with(pca, rotation[2,1] / rotation[1,1])
int_jhoward <- with(pca, center[2] - slp_jhoward*center[1])

# Plot both orthogonal regression lines and simple linear regression line
library(ggplot2)
ggplot(df, aes(x,y)) + 
  geom_point() + 
  stat_smooth(method=lm, color="green", se=FALSE) +
  geom_abline(slope=slp_jhoward, intercept=int_jhoward, color="blue", lwd = 3) +
  geom_abline(slope=slp_Dem, intercept=int_Dem, color = "white", lwd = 2, linetype = 3)

有趣的是，如果你在模型中切换 x 和 y 的顺序（即，到mod_Dem <- deming::deming(x~y,df)和pca <- prcomp(~y+x, df) ），你会得到完全不同的坡度：

我对正交回归的（非常肤浅的）理解是它不会将变量视为独立的或依赖的，因此回归线应该不受 model 的指定方式的影响，例如y~x vs x~y 。 显然我错了，我很想听听任何人对我为什么错了的想法。