Question

我一直在为我的生存数据cph模型生成校准图。但是，默认设置将“理想”行置于灰色，这使得难以区分。我试图在plot（）中指定颜色参数，但这显然只会更改“ observed”的行。我可以在plot（）中传递什么以更改以rms为单位生成的校准图中的“理想”线？

Answer 1

这里是一种选择：

假设您有代码创建生存数据的cph模型并使用calibrate包中的rms：

library(rms)

set.seed(1)
n <- 200
d.time <- rexp(n)
x1 <- runif(n)
x2 <- factor(sample(c('a', 'b', 'c'), n, TRUE))
f <- cph(Surv(d.time) ~ pol(x1,2) * x2, x=TRUE, y=TRUE, surv=TRUE,time.inc=1.5)
cal <- calibrate(f, u=1.5, cmethod='KM', m=50, B=20)

这将生成一个calibrate对象：

R> class(cal)
[1] "calibrate"

如果在此对象上使用plot，则可以发现在rms中被调用的函数：

R> getAnywhere("plot.calibrate.default")
A single object matching ‘plot.calibrate.default’ was found
It was found in the following places
  registered S3 method for plot from namespace rms
  namespace:rms
with value

function (x, xlab, ylab, xlim, ylim, legend = TRUE, subtitles = TRUE, 
    cex.subtitles = 0.75, riskdist = TRUE, scat1d.opts = list(nhistSpike = 200), 
    ...)

您可以基于此功能创建自己的功能，并更改理想线条的颜色。在这种情况下，我们将理想的行设置为绿色（并修改文本标签以使其匹配）：

myplot <- function (x, xlab, ylab, subtitles = TRUE, conf.int = TRUE, cex.subtitles = 0.75, 
          riskdist = TRUE, add = FALSE, scat1d.opts = list(nhistSpike = 200), 
          par.corrected = NULL, ...) 
{
  at <- attributes(x)
  u <- at$u
  units <- at$units
  if (length(par.corrected) && !is.list(par.corrected)) 
    stop("par.corrected must be a list")
  z <- list(col = "blue", lty = 1, lwd = 1, pch = 4)
  if (!length(par.corrected)) 
    par.corrected <- z
  else for (n in setdiff(names(z), names(par.corrected))) par.corrected[[n]] <- z[[n]]
  predicted <- at$predicted
  if ("KM" %in% colnames(x)) {
    type <- "stratified"
    pred <- x[, "mean.predicted"]
    cal <- x[, "KM"]
    cal.corrected <- x[, "KM.corrected"]
    se <- x[, "std.err"]
  }
  else {
    type <- "smooth"
    pred <- x[, "pred"]
    cal <- x[, "calibrated"]
    cal.corrected <- x[, "calibrated.corrected"]
    se <- NULL
  }
  un <- if (u == 1) 
    paste(units, "s", sep = "")
  else units
  if (missing(xlab)) 
    xlab <- paste("Predicted ", format(u), units, "Survival")
  if (missing(ylab)) 
    ylab <- paste("Fraction Surviving ", format(u), " ", 
                  un, sep = "")
  if (length(se) && conf.int) {
    ciupper <- function(surv, d) ifelse(surv == 0, 0, pmin(1, 
                                                           surv * exp(d)))
    cilower <- function(surv, d) ifelse(surv == 0, 0, surv * 
                                          exp(-d))
    errbar(pred, cal, cilower(cal, 1.959964 * se), ciupper(cal, 
                                                           1.959964 * se), xlab = xlab, ylab = ylab, type = "b", 
           add = add, ...)
  }
  else if (add) 
    lines(pred, cal, type = if (type == "smooth") 
      "l"
      else "b")
  else plot(pred, cal, xlab = xlab, ylab = ylab, type = if (type == 
                                                            "smooth") 
    "l"
    else "b", ...)
  err <- NULL
  if (riskdist && length(predicted)) {
    do.call("scat1d", c(list(x = predicted), scat1d.opts))
    if (type == "smooth") {
      s <- !is.na(pred + cal.corrected)
      err <- predicted - approxExtrap(pred[s], cal.corrected[s], 
                                      xout = predicted, ties = mean)$y
    }
  }
  if (subtitles && !add) {
    if (type == "smooth") {
      Col <- par.corrected$col
      substring(Col, 1, 1) <- toupper(substring(Col, 1, 
                                                1))
      title(sub = sprintf("Black: observed  Green: ideal\n%s : optimism corrected", 
                          Col), adj = 0, cex.sub = cex.subtitles)
      w <- if (length(err)) 
        paste("B=", at$B, " based on ", at$what, "\nMean |error|=", 
              round(mean(abs(err)), 3), "  0.9 Quantile=", 
              round(quantile(abs(err), 0.9, na.rm = TRUE), 
                    3), sep = "")
      else paste("B=", at$B, "\nBased on ", at$what, sep = "")
      title(sub = w, adj = 1, cex.sub = cex.subtitles)
    }
    else {
      title(sub = paste("n=", at$n, " d=", at$d, " p=", 
                        at$p, ", ", at$m, " subjects per group\nGreen: ideal", 
                        sep = ""), adj = 0, cex.sub = cex.subtitles)
      title(sub = paste("X - resampling optimism added, B=", 
                        at$B, "\nBased on ", at$what, sep = ""), adj = 1, 
            cex.sub = cex.subtitles)
    }
  }
  abline(0, 1, col = "green")
  if (type == "stratified") 
    points(pred, cal.corrected, pch = par.corrected$pch, 
           col = par.corrected$col)
  else lines(pred, cal.corrected, col = par.corrected$col, 
             lty = par.corrected$lty, lwd = par.corrected$lwd)
  invisible()
}

然后，您可以将自定义函数与calibrate对象一起使用：

myplot(cal)

更改校准图的颜色

1 个答案: