I would like my lm summary output to be a little more compact than usual. I want to remove some newlines, the "Residuals" section, the line with the word "Coefficients". on the positive side, summary.lm is written as a native R function, so presumably I can just copy it to a file, change it, and then source it through my .Rprofile. on the negative side, when I try the first step (copy into emacs and source it), it complains that qr.lm is not found. is there magic, or am I missing something?
how do I redefine it?
summary.lm <- function(object, correlation = FALSE, symbolic.cor = FALSE,
print.residstable = TRUE, succinct = FALSE, ...)
whatever I will get is not ideal. if someone upstream makes a change in summary.lm, I will have to redo my code. still, in the absence of parameters to control the printing verbosity, I don't know how else to do this.
答案 0 :(得分：3)
Indeed, redefining summary.lm is the way to go for what you want to do.
What you are missing is the concept of namespace in R. summary.lmis a function from the stats package and so has access to internal functions of this package. Only some functions from a package are exported and available once the package is loaded.
qr.lm is precisely such an internal function. It is accessible with the triple ::: operator (see ?/:::``):
> 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>
As you can see, it simply extracts the qr component of the lm object. You can just paste the code instead of calling the function.
答案 1 :(得分：2)
需要更改print.summary.lm函数，而不是summary.lm。这是一个添加简洁的版本。选项，当简洁是假的时，注意不要改变任何东西：
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功能。
答案 2 :(得分：1)
这不仅仅是对你的q
在包中编辑函数的一种不经常使用的（我认为）方法是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"