summary.lm 输出自定义
summary.lm output customization
我希望我的 lm 摘要输出比平时更紧凑。我想删除一些换行符，"Residuals" 部分，带有单词 "Coefficients" 的行。从积极的方面来说，summary.lm 是作为原生 R 函数编写的，所以大概我可以将它复制到一个文件中，更改它，然后通过我的 .Rprofile 获取它。不利的一面是，当我尝试第一步（复制到 emacs 并获取它）时，它抱怨找不到 qr.lm。有魔法吗，还是我遗漏了什么？
如何重新定义它？
summary.lm <- function(object, correlation = FALSE, symbolic.cor = FALSE,
print.residstable = TRUE, succinct = FALSE, ...)
无论我得到什么都不理想。如果上游有人在 summary.lm 中进行了更改，我将不得不重做我的代码。仍然，在没有参数来控制打印冗长的情况下，我不知道该怎么做。
确实，重新定义 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 组件。您可以直接粘贴代码而不调用函数。
这更像是旁白，而不是对你的问题的回答
一种不常用的（我认为）在包中编辑函数的方法是 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
edit 它并基本上用 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"
需要更改的是print.summary.lm函数，而不是summary.lm。这是一个添加了 'concise' 选项的版本，当 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 功能。
我希望我的 lm 摘要输出比平时更紧凑。我想删除一些换行符，"Residuals" 部分，带有单词 "Coefficients" 的行。从积极的方面来说，summary.lm 是作为原生 R 函数编写的，所以大概我可以将它复制到一个文件中，更改它，然后通过我的 .Rprofile 获取它。不利的一面是，当我尝试第一步（复制到 emacs 并获取它）时，它抱怨找不到 qr.lm。有魔法吗，还是我遗漏了什么？
如何重新定义它？
summary.lm <- function(object, correlation = FALSE, symbolic.cor = FALSE,
print.residstable = TRUE, succinct = FALSE, ...)
无论我得到什么都不理想。如果上游有人在 summary.lm 中进行了更改，我将不得不重做我的代码。仍然，在没有参数来控制打印冗长的情况下，我不知道该怎么做。
确实，重新定义 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 组件。您可以直接粘贴代码而不调用函数。
这更像是旁白，而不是对你的问题的回答
一种不常用的（我认为）在包中编辑函数的方法是 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
edit 它并基本上用 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"
需要更改的是print.summary.lm函数，而不是summary.lm。这是一个添加了 'concise' 选项的版本，当 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 功能。