getCaption <- function(k) if (length(caption) < k) NA_character_ else { if(include.modeltype){ grDevices::as.graphicsAnnot(paste0(caption[[k]], " - ", x$modeltype, " Regression")) } else { grDevices::as.graphicsAnnot(caption[[k]]) }
时间: 2024-04-21 19:28:10 浏览: 88
这段代码看起来像是 R 语言中的一个函数,名为 getCaption。该函数接受一个参数 k,如果 caption 列表的长度小于 k,则返回 NA_character_。如果 caption 列表的长度大于等于 k,则根据 include.modeltype 的值选择不同的字符串格式。如果 include.modeltype 为真,则返回一个字符串,该字符串包含 caption[[k]] 和 x$modeltype 的值,中间用 " - " 连接。如果 include.modeltype 为假,则返回 caption[[k]] 的值。最后,函数通过调用 as.graphicsAnnot 将返回的字符串转换为一个图形注释对象。
相关问题
if (is.null(sub.caption)) { cal <- x$call if (!is.na(m.f <- match("formula", names(cal)))) { cal <- cal[c(1, m.f)] names(cal)[2L] <- "" } cc <- deparse(cal, 80) nc <- nchar(cc[1L], "c") abbr <- length(cc) > 1 || nc > 75 sub.caption <- if (abbr) paste(substr(cc[1L], 1L, min(75L, nc)), "...") else cc[1L] } place_ids <- function(x_coord, y_coord, offset, dif_pos_neg){ extreme_points <- as.vector(Rfast::nth(abs(y_coord), k = id.n, num.of.nths = id.n, index.return = TRUE, descending = TRUE)) if(dif_pos_neg){ idx_x_pos <- extreme_points[which(y_coord[extreme_points] >= 0)] idx_x_neg <- setdiff(extreme_points, idx_x_pos) idx_y_pos <- y_coord[idx_x_pos] idx_y_neg <- y_coord[idx_x_neg] idx_x_pos_id <- x_coord[idx_x_pos] idx_x_neg_id <- x_coord[idx_x_neg] if(length(idx_x_pos)>0){ graphics::text(idx_x_pos_id, idx_y_pos, labels = labels.id[idx_x_pos], col = col.id, cex = cex.id, xpd = TRUE, pos = 3, offset = offset) } if(length(idx_x_neg)>0){ graphics::text(idx_x_neg_id, idx_y_neg, labels = labels.id[idx_x_neg], col = col.id, cex = cex.id, xpd = TRUE, pos = 1, offset = offset) } } else{ idx_x <- extreme_points idx_y <- y_coord[idx_x] idx_x_id <- x_coord[idx_x] labpos <- label.pos[1 + as.numeric(idx_x_id > mean(range(x_coord)))] graphics::text(idx_x_id, idx_y, labels = labels.id[idx_x], col = col.id, cex = cex.id, pos = labpos, xpd = TRUE, offset = offset) } } one.fig <- prod(graphics::par("mfcol")) == 1 if (ask) { oask <- grDevices::devAskNewPage(TRUE) on.exit(grDevices::devAskNewPage(oask)) }
这段代码看起来也是 R 语言中的函数,但是和之前的代码段不是同一个函数。这个函数开始首先判断 sub.caption 是否为 NULL,如果是,则生成一个子标题 sub.caption。生成子标题的过程中,函数会获取对象 x 的调用 cal,并根据其是否包含 formula 来生成简略或详细的调用字符串 cc。如果 cc 的长度大于 1 或者第一个字符串长度大于 75,则将其缩写成不超过 75 个字符的字符串并加上省略号,否则直接使用 cc。接下来,函数调用了另一个函数 place_ids,将标签和标识符的位置绘制在图形中。最后,在设置 ask 为 TRUE 的情况下,函数使用 devAskNewPage 函数设置交互模式,以便在绘制每个图之前提示用户进行交互。
if (1 %in% which) { # First plot (residuals vs index) res <- stats::residuals(x, type = x$residualname) ylim <- range(res, na.rm = TRUE) if (id.n > 0) ylim <- grDevices::extendrange(r = ylim, f = 0.08) grDevices::dev.hold() residualname <- paste0(toupper(substring(x$residualname, 1, 1)), substring(x$residualname, 2)) if(include.residualtype){ caption[[1]] = paste(residualname, caption[[1]]) } ylab <- paste0(residualname, " residuals") graphics::plot(res, ylab = ylab, xlab = "Obs. number", main = main, ylim = ylim, cex = cex.points, col = col.points, ...) graphics::abline(0, 0, lty = 3) if (one.fig) graphics::title(sub = sub.caption, ...) graphics::mtext(getCaption(1), side = 3, cex = cex.caption, col = col.caption) if(id.n > 0) place_ids(1:length(res), res, 0.5, TRUE) grDevices::dev.flush() }
这段代码在之前的代码段中的函数中,实现了第一个图的绘制。首先,如果 which 中包含 1,则绘制第一个图(残差 vs 观测值序号)。函数通过调用 residuals 函数获取对象 x 的残差 res,并根据 id.n 的值对 y 轴范围进行调整。接下来,函数创建 y 轴标签 ylab,并根据 include.residualtype 的值选择不同的字符串格式。如果 include.residualtype 为真,则将残差类型加入到 caption[[1]] 中。否则,caption[[1]] 不变。接着,函数使用 plot 函数绘制残差图,其中 y 轴标签为 ylab,x 轴标签为 "Obs. number",标题为 main,y 轴范围为 ylim,点大小为 cex.points,点颜色为 col.points,其他参数使用 ...。函数还通过 abline 函数在图中添加了一条虚线,用于表示理论上的残差为 0。接下来,函数通过调用 title 函数将子标题 sub.caption 添加到图中。然后,函数通过调用 mtext 函数将 caption[[1]] 添加到图的上方。最后,如果 id.n 大于 0,则函数调用了之前提到的 place_ids 函数,将标识符和标签的位置绘制在图形中。