在 R 中调整 plotmo::plot_glmnet 的顶轴标题和标签图

Question

我使用 r 包 plotmo 来可视化 LASSO 回归的系数收缩。默认情况下，它会添加一个标题为 'Degrees of Freedom' 的顶轴。我如何才能删除顶部标题或更改其内容？通常，如何调整 plotmo::plot_glmnet 绘制的顶轴（包括标题和轴标签）？

library(glmnet)
library(plotmo) 
fit = glmnet(as.matrix(mtcars[-1]), mtcars[,1])
plot_glmnet(fit,xvar='lambda',label=7)

我试过使用 mtext 和 axis 函数，但没有用：

plot_glmnet(fit,xvar='lambda',label=7)
mtext('new top title', side=3)

Answer 1

您可以在 "Degrees of Freedom" 之上添加标题，方法是提供 main 参数，该参数提供给对 plot 的基础调用：

plot_glmnet(fit,xvar='lambda',label=7, main = "new top title")

回复评论，不能直接删除"Degrees of Freedom"。如果您查看 plot_glmnet 的代码，您会发现它被硬编码为 toplab。您将需要手动调整代码，或者永久地使用 package/function 的分支，或者通过使用 trace(plot_glmnet, edit = T) 和设置 toplab = "new top title" 每个 session。您可以在 plot_glmnet 代码底部附近找到相关代码部分。

Answer 2

plot_glmnet, mtext(toplabel...) 的代码中有一行是这样做的.. 不幸的是，如果你想删除它，你必须创建一个删除此行的新函数，并分配命名空间：

new_plot_glmnet = function (x = stop("no 'x' argument"), xvar = c("rlambda", "lambda", 
    "norm", "dev"), label = 10, nresponse = NA, grid.col = NA, 
    s = NA, ...) 
{
    check.classname(x, "x", c("glmnet", "multnet"))
    obj <- x
    beta <- get.beta(obj$beta, nresponse)
    ibeta <- nonzeroCoef(beta)
    if (length(ibeta) == 0) {
        plot(0:1, 0:1, col = 0)
        legend("topleft", legend = "all glmnet coefficients are zero", 
            bty = "n")
        return(invisible(NULL))
    }
    beta <- as.matrix(beta[ibeta, , drop = FALSE])
    xlim <- dota("xlim", ...)
    xvar <- match.arg1(xvar)
    switch(xvar, norm = {
        if (inherits(obj, "multnet") || inherits(obj, "mrelnet")) {
            stop0("xvar=\"norm\" is not supported by plot_gbm for ", 
                "multiple responses (use plot.glmnet instead)")
        }
        x <- apply(abs(beta), 2, sum)
        if (!is.specified(xlim)) xlim <- c(min(x), max(x))
        xlab <- "L1 Norm"
        approx.f <- 1
    }, lambda = {
        x <- log(obj$lambda)
        if (!is.specified(xlim)) xlim <- c(min(x), max(x))
        xlab <- "Log Lambda"
        approx.f <- 0
    }, rlambda = {
        x <- log(obj$lambda)
        if (!is.specified(xlim)) xlim <- c(max(x), min(x))
        xlab <- "Log Lambda"
        approx.f <- 0
    }, dev = {
        x <- obj$dev.ratio
        if (!is.specified(xlim)) xlim <- c(min(x), max(x))
        xlab <- "Fraction Deviance Explained"
        approx.f <- 1
    })
    xlim <- fix.lim(xlim)
    if (xvar != "rlambda") 
        stopifnot(xlim[1] < xlim[2])
    else if (xlim[2] >= xlim[1]) 
        stop0("xlim[1] must be bigger than xlim[2] for xvar=\"rlambda\"")
    iname <- get.iname(beta, ibeta, label)
    old.par <- par("mar", "mgp", "cex.axis", "cex.lab")
    on.exit(par(mar = old.par$mar, mgp = old.par$mgp, cex.axis = old.par$cex.axis, 
        cex.lab = old.par$cex.lab))
    mar4 <- old.par$mar[4]
    if (length(iname)) {
        cex.names <- min(1, max(0.5, 2.5/sqrt(length(iname))))
        mar4 <- max(old.par$mar[4] + 1, 0.75 * cex.names * par("cex") * 
            max(nchar(names(iname))))
    }
    main <- dota("main", ...)
    nlines.needed.for.main <- if (is.specified(main)) 
        nlines(main) + 0.5
    else 0
    par(mar = c(old.par$mar[1], old.par$mar[2], max(old.par$mar[3], 
        nlines.needed.for.main + 2.6), mar4))
    par(mgp = c(1.5, 0.4, 0))
    par(cex.axis = 0.8)
    ylab <- "Coefficients"
    if (is.list(obj$beta)) 
        ylab <- paste0(ylab, ": Response ", rownames(obj$dfmat)[nresponse])
    coef.col <- get.coef.col(..., beta = beta)
    keep <- which((coef.col != "NA") & (coef.col != "0"))
    iname <- iname[iname %in% keep]
    beta[-keep, ] <- NA
    call.plot(graphics::matplot, force.x = x, force.y = t(beta), 
        force.main = "", force.col = coef.col, def.xlim = xlim, 
        def.xlab = xlab, def.ylab = ylab, def.lty = 1, def.lwd = 1, 
        def.type = "l", ...)
    abline(h = 0, col = "gray", lty = 3)
    maybe.grid(x = x, beta = beta, grid.col = grid.col, coef.col = coef.col, 
        ...)
    if (xvar == "rlambda") {
        annotate.rlambda(lambda = obj$lambda, x = x, beta = beta, 
            s = s, grid.col = grid.col, coef.col = coef.col, 
            ...)
        toplab <- "Lambda"
    }
    else {
        top.axis(obj, x, nresponse, approx.f)
        toplab <- "Degrees of Freedom"
    }
    #mtext(toplab, side = 3, line = 1.5, cex = par("cex") * par("cex.lab"))
    if (is.specified(main)) 
        mtext(main, side = 3, line = 3, , cex = par("cex"))
    if (length(iname)) 
        right.labs(beta, iname, cex.names, coef.col)
    invisible(NULL)
}

environment(new_plot_glmnet) <- asNamespace('plotmo')

然后你绘制：

new_plot_glmnet(fit,xvar='lambda',label=7)
mtext('new top title', side=3,padj=-2)

在 R 中调整 plotmo::plot_glmnet 的顶轴标题和标签图

Adjusting top axis title and labels plots of plotmo::plot_glmnet in R

r

plot

glmnet