添加 Passing-Bablok 回归线

如何解决添加 Passing-Bablok 回归线

我必须在不同的测量方法之间进行多次比较，并且必须使用 Passing-Bablok regression 方法。

我想利用 ggplot2 和 faceting，但我不知道如何基于 Passing-Bablok 回归添加 geom_smooth 层。 我在想这样的事情：https://stackoverflow.com/a/59173260/2096356

此外，我还需要在每个图中显示回归线方程，以及截距和斜率参数的置信区间。

使用部分解决方案进行编辑

我找到了结合 this post 和 in this answer 中提供的代码的部分解决方案。

## Regression algorithm
 passing_bablok.fit <- function(x,y) {
  
    x_name <- deparse(substitute(x))
  
    lx <- length(x)
    l <- lx*(lx - 1)/2
    k <- 0
    S <- rep(NA,lx)
    for (i in 1:(lx - 1)) {
      for (j in (i + 1):lx) {
        k <- k + 1
        S[k] <- (y[i] - y[j])/(x[i] - x[j])
      }
    }
    S.sort <- sort(S)
    N <- length(S.sort)
    neg <- length(subset(S.sort,S.sort < 0))
    K <- floor(neg/2)
    if (N %% 2 == 1) {
      b <- S.sort[(N+1)/2+K]
    } else {
      b <- sqrt(S.sort[N / 2 + K]*S.sort[N / 2 + K + 1])
    }
    a <- median(y - b * x)
    res <- as.vector(c(a,b))

  names(res) <- c("(Intercept)",x_name)
  class(res) <- "Passing_Bablok"
  res
}

## Computing confidence intervals
 passing_bablok <- function(formula,data,R = 100,weights = 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(passing_bablok.fit(!!!args)),env = rlang::current_env())
    },R=R
  )
  class(ret) <- c("Passing_Bablok",class(ret))
  ret  
}

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

用法示例：

z <- data.frame(x = rnorm(100,mean = 100,sd = 5),y = rnorm(100,mean = 110,sd = 8))

ggplot(z,aes(x,y)) + 
 geom_point() + 
 geom_smooth(method = passing_bablok) + 
 geom_abline(slope = 1,intercept = 0)

到目前为止，我还没有能够展示回归线方程，以及截距和斜率参数的置信区间（如 +- 或括号中）。