Question

我必须在不同的测量方法之间进行多次比较，并且必须使用 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)), data, 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, 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))
  }
}

用法示例：

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)

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

添加 Passing-Bablok 回归线

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

0 个答案: