摘要生成模型的输出自定义

4
我希望我的lm摘要输出比通常更紧凑。我想删除一些换行符,"残差"部分和带有"系数"一词的行。积极的一面是,summary.lm是作为本地R函数编写的,因此我可以将其复制到文件中,进行更改,然后通过我的.Rprofile进行源代码。消极的一面是,当我尝试第一步(将其复制到emacs并进行源代码),它会抱怨找不到qr.lm。是否存在魔法或者我遗漏了什么?
如何重新定义它?
summary.lm <- function(object, correlation = FALSE, symbolic.cor = FALSE,
      print.residstable = TRUE, succinct = FALSE, ...)

无论我得到的是什么,都不是理想的。如果上游的某个人更改了summary.lm,我将不得不重新编写我的代码。但是,在缺少控制打印详细程度的参数的情况下,我不知道还有其他方法可以做到这一点。


对于更大的视角,我认为你实际上需要编辑stats:::print.summary.lm,但是从列表中删除摘要对象的lm类并选择你想要的内容并打印可能更容易。 - rawr
3个回答

3

确实,重新定义summary.lm是您想要做的事情的方法。

您缺少的是R中命名空间的概念。summary.lm是来自stats包的函数,因此可以访问此包的内部函数。仅当加载了包时,才会导出并可用一些功能。

qr.lm正是这样的内部函数。它可以使用三重:::运算符访问(请参见?/:::``):

> qr.lm
Error: object 'qr.lm' not found

> stats::qr.lm
Error: 'qr.lm' is not an exported object from 'namespace:stats'

> stats:::qr.lm
function (x, ...) 
{
    if (is.null(r <- x$qr)) 
        stop("lm object does not have a proper 'qr' component.\n Rank zero or should not have used lm(.., qr=FALSE).")
    r
}
<bytecode: 0x0000000017983b68>
<environment: namespace:stats>

正如您所看到的,它只是提取lm对象的qr组件。您可以直接粘贴代码而不是调用函数。


有趣。我首先执行了?qr.lm,然后根据建议执行了??qr.lm,但这并没有解决问题。(我还尝试了stats$qr.lm,而不是stats:::qr.lm。)了解getAnywhere非常有用。 - ivo Welch
1
实际上,我应该在我的问题中补充说明,我不明白为什么R中最常用的函数之一不能给用户更多控制其输出。每次发布新版本时,我都在寻找这个功能... - ivo Welch

3

需要更改的是print.summary.lm函数,而不是summary.lm。这里有一个版本添加了一个“简洁”选项,当concise为false时,注意不要更改任何内容:

print.summary.lm <- 
function (x, digits = max(3L, getOption("digits") - 3L), symbolic.cor = x$symbolic.cor,
          signif.stars = getOption("show.signif.stars"), concise = FALSE, ...)
    {
        cat("\nCall:", if(!concise) "\n" else " ", paste(deparse(x$call), sep = "\n", collapse = "\n"),
            if (!concise) "\n\n", sep = "")
        resid <- x$residuals
        df <- x$df
        rdf <- df[2L]
        if (!concise) {
            cat(if (!is.null(x$weights) && diff(range(x$weights)))
                    "Weighted ", "Residuals:\n", sep = "")
        }
        if (rdf > 5L) {
            nam <- c("Min", "1Q", "Median", "3Q", "Max")
            rq <- if (length(dim(resid)) == 2L)
                      structure(apply(t(resid), 1L, quantile), dimnames = list(nam,
                                                                   dimnames(resid)[[2L]]))
                  else {
                      zz <- zapsmall(quantile(resid), digits + 1L)
                      structure(zz, names = nam)
                  }
            if (!concise) print(rq, digits = digits, ...)
        }
        else if (rdf > 0L) {
            print(resid, digits = digits, ...)
        }
        else {
            cat("ALL", df[1L], "residuals are 0: no residual degrees of freedom!")
            cat("\n")
        }
        if (length(x$aliased) == 0L) {
            cat("\nNo Coefficients\n")
        }
        else {
            if (nsingular <- df[3L] - df[1L])
                cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n",
                    sep = "")
            else { cat("\n"); if (!concise) cat("Coefficients:\n")  }
            coefs <- x$coefficients
            if (!is.null(aliased <- x$aliased) && any(aliased)) {
                cn <- names(aliased)
                coefs <- matrix(NA, length(aliased), 4, dimnames = list(cn,
                                                            colnames(coefs)))
                coefs[!aliased, ] <- x$coefficients
            }
            printCoefmat(coefs, digits = digits, signif.stars = signif.stars, signif.legend = (!concise),
                         na.print = "NA", eps.Pvalue = if (!concise) .Machine$double.eps else 1e-4, ...)
        }
        cat("\nResidual standard error:", format(signif(x$sigma,
                                                        digits)), "on", rdf, "degrees of freedom")
        cat("\n")
        if (nzchar(mess <- naprint(x$na.action)))
            cat("  (", mess, ")\n", sep = "")
        if (!is.null(x$fstatistic)) {
            cat("Multiple R-squared: ", formatC(x$r.squared, digits = digits))
            cat(",\tAdjusted R-squared: ", formatC(x$adj.r.squared,
                                                   digits = digits), "\nF-statistic:", formatC(x$fstatistic[1L],
                                                       digits = digits), "on", x$fstatistic[2L], "and",
                x$fstatistic[3L], "DF,  p-value:", format.pval(pf(x$fstatistic[1L],
                                                                  x$fstatistic[2L], x$fstatistic[3L], lower.tail = FALSE),
                                                               digits = digits, if (!concise) .Machine$double.eps else 1e-4))
            cat("\n")
        }
        correl <- x$correlation
        if (!is.null(correl)) {
            p <- NCOL(correl)
            if (p > 1L) {
                cat("\nCorrelation of Coefficients:\n")
                if (is.logical(symbolic.cor) && symbolic.cor) {
                    print(symnum(correl, abbr.colnames = NULL))
                }
                else {
                    correl <- format(round(correl, 2), nsmall = 2,
                                     digits = digits)
                    correl[!lower.tri(correl)] <- ""
                    print(correl[-1, -p, drop = FALSE], quote = FALSE)
                }
            }
        }
        cat("\n")
        invisible(x)
    }

现在,

开始


x <- rnorm(100); y <- rnorm(100)+x
print(summary(lm(y ~ x)))
print(summary(lm(y ~ x)), concise=TRUE)

第一次打印提供标准的 R 打印结果,而后者提供了更好的打印效果。

Call: lm(formula = y ~ x)
            Estimate Std. Error t value Pr(>|t|)
(Intercept)   -0.010      0.102   -0.10     0.92
x              1.009      0.112    9.02  <0.0001 ***

Residual standard error: 1.02 on 98 degrees of freedom
Multiple R-squared:  0.454, Adjusted R-squared:  0.448
F-statistic: 81.4 on 1 and 98 DF,  p-value: <0.0001

PS: 这个更准确地对真实数据进行统计:单个系数的p值现在被限制为0.0001,而不是机器精度。

PPS: 如果R团队在听,请注意,我认为这应该成为标准的R功能。


我不太清楚如何使用被接受的答案来实现任何操作。使用这个答案中的函数,我可以创建一个简略的摘要。我同意,令人惊讶的是没有直接的方法来自定义 summary.lm。 - Michael

1

这更像是对你问题的一个旁注而不是回答

编辑包中函数的一种很少用到(我想是很少用到)的方法是使用edit,它不仅可以很好地格式化源代码,还会使用命名空间,使得你无需去查找qr.lm并将其重新定义为全局变量或者你需要为函数找到它所需的任何内容。

我拟合了这个lm并做了总结,输出非常冗长

(tmp <- summary(fit <- lm(mpg ~ disp, data = mtcars)))

# Call:
#   lm(formula = mpg ~ disp, data = mtcars)
# 
# Residuals:
#   Min      1Q  Median      3Q     Max 
# -4.8922 -2.2022 -0.9631  1.6272  7.2305 
# 
# Coefficients:
#   Estimate Std. Error t value Pr(>|t|)    
# (Intercept) 29.599855   1.229720  24.070  < 2e-16 ***
#   disp        -0.041215   0.004712  -8.747 9.38e-10 ***
#   ---
#   Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
# 
# Residual standard error: 3.251 on 30 degrees of freedom
# Multiple R-squared:  0.7183,  Adjusted R-squared:  0.709 
# F-statistic: 76.51 on 1 and 30 DF,  p-value: 9.38e-10

编辑它并将所有代码基本替换为 function (x) qr.lm(x),请注意 qr.lm 没有被导出,这意味着您需要明确告诉 R 去哪里查找,否则在 my_summ2 中会出现问题。

这是新定义的函数,请注意我不必使用 stats:::qr.lm 以及新函数所在的环境。

(my_summ <- edit(stats:::print.summary.lm))
# function (x) qr.lm(x)
# <environment: namespace:stats>

这是您可能尝试执行相同操作的方式,但现在环境是全局环境。
(my_summ2 <- function (x) qr.lm(x))
# function (x) qr.lm(x)

所以我可以尝试使用两者,但只有第一个有效

my_summ(fit)
# $qr
# (Intercept)          disp
# Mazda RX4            -5.6568542 -1.305160e+03
# Mazda RX4 Wag         0.1767767  6.900614e+02
# Datsun 710            0.1767767  1.624463e-01
# Hornet 4 Drive        0.1767767 -5.492561e-02
# Hornet Sportabout     0.1767767 -2.027385e-01
# Valiant               0.1767767 -7.103778e-03
# ...

my_summ2(fit)
# Error in my_summ2(fit) : could not find function "qr.lm"

但两者都在全局范围内。
ls()
# [1] "fit"      "my_summ"  "my_summ2" "tmp" 

1
这太棒了,我来到这里是为了一个答案,现在我却带着一个我从未听说过的超级有用的函数回去了! - asachet

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接