当 scipen 和 digits 不起作用时，如何在 R 中打印一定数量的小数/数字？

Question

I cannot get summary(lm(model) to print numbers that are not either 1) in scientific notation or b) have too many decimals.

Before this question gets closed as a duplicate, I have already tried the scripen() and option(digits = x) from similar questions answered here:

• How to disable scientific notation?
• How to make decimal digits of chisq.test four numbers?
• Force R not to use exponential notation (eg e+10)?

My code

library(haven)
auto <- haven::read_dta(file = "http://www.stata-press.com/data/r16/auto.dta", .name_repair = "unique")
# Use scale() to create standardised variables
model1_s <- lm(data = auto,
           formula = scale(price) ~ scale(mpg))

I'd like to see the output display with just 3 decimals and not in scientific notation, like this:

summary(model1_s)
# Output truncated.    
>Coefficients:
>            Estimate Std. Error t value Pr(>|t|)    
>(Intercept)  0.000   0.103      0.0        1    
>scale(mpg)  -0.469   0.104     -4.5      0.000 ***

Instead I can only manage:

# Default
summary(model1_s)
>              Estimate Std. Error t value Pr(>|t|)    
>(Intercept) -8.613e-17  1.034e-01   0.000        1    
>scale(mpg)  -4.686e-01  1.041e-01  -4.501 2.55e-05 ***

# Changing options
options(digits = 3)
summary(model1_s)
>             Estimate Std. Error t value Pr(>|t|)    
>(Intercept) -8.61e-17   1.03e-01     0.0        1    
>scale(mpg)  -4.69e-01   1.04e-01    -4.5  2.5e-05 ***

# Using print and digits = x 
print(summary(model1_s), digits = 1)
summary(model1_s)
>            Estimate Std. Error t value Pr(>|t|)    
>(Intercept)   -9e-17      1e-01       0        1    
>scale(mpg)    -5e-01      1e-01      -4    3e-05 ***

# Using scipen
options(scipen = 100, digits = 3)
summary(model1_s)
>                          Estimate             Std. Error t value Pr(>|t|)    
>(Intercept) -0.0000000000000000861  0.1034052818198464840     0.0        1    
>scale(mpg)  -0.4685966881951871832  0.1041111281150861323    -4.5 0.000025 ***

Any tips on what I can do?

Answer 1

A demonstration of @RaphaelS's suggestion (that I was working on simultaneously:-),

mdl <- lm(mpg~disp+gear,data=mtcars)

summary(mdl)$coefficients
#               Estimate Std. Error   t value    Pr(>|t|)
# (Intercept) 29.1049423 4.48591900  6.488067 4.21414e-07
# disp        -0.0408473 0.00576243 -7.088556 8.46528e-08
# gear         0.1112022 0.96799225  0.114879 9.09333e-01

round(summary(mdl)$coefficients, 3)
#             Estimate Std. Error t value Pr(>|t|)
# (Intercept)   29.105      4.486   6.488    0.000
# disp          -0.041      0.006  -7.089    0.000
# gear           0.111      0.968   0.115    0.909

---

Alternatively, I think there is nothing baked-in to R that will print it that way. One option you have is to rewrite (plagiarize!) printCoefmat (used in print.summary.lm , among others) to account for your preferences. One such attempt at that:

printCoefmat_round <- 
  function (x, digits = max(3L, getOption("digits") - 2L), signif.stars = getOption("show.signif.stars"), 
            signif.legend = signif.stars, dig.tst = max(1L, min(5L, digits - 1L)),
            cs.ind = 1:k, tst.ind = k + 1, zap.ind = integer(), P.values = NULL,
            has.Pvalue = nc >= 4L && length(cn <- colnames(x)) && substr(cn[nc], 1L, 3L) %in% c("Pr(", "p-v"),
            eps.Pvalue = .Machine$double.eps, na.print = "NA", quote = FALSE, right = TRUE, ...,
            n = NA) {
    if (is.null(d <- dim(x)) || length(d) != 2L) 
      stop("'x' must be coefficient matrix/data frame")
    nc <- d[2L]
    if (is.null(P.values)) {
      scp <- getOption("show.coef.Pvalues")
      if (!is.logical(scp) || is.na(scp)) {
        warning("option \"show.coef.Pvalues\" is invalid: assuming TRUE")
        scp <- TRUE
      }
      P.values <- has.Pvalue && scp
    }
    else if (P.values && !has.Pvalue) 
      stop("'P.values' is TRUE, but 'has.Pvalue' is not")
    if (has.Pvalue && !P.values) {
      d <- dim(xm <- data.matrix(x[, -nc, drop = FALSE]))
      nc <- nc - 1
      has.Pvalue <- FALSE
    }
    else xm <- data.matrix(x)
    k <- nc - has.Pvalue - (if (missing(tst.ind)) 
      1
      else length(tst.ind))
    if (!missing(cs.ind) && length(cs.ind) > k) 
      stop("wrong k / cs.ind")
    Cf <- array("", dim = d, dimnames = dimnames(xm))
    ok <- !(ina <- is.na(xm))
    for (i in zap.ind) xm[, i] <- zapsmall(xm[, i], digits)
    if (length(cs.ind)) {
      acs <- abs(coef.se <- xm[, cs.ind, drop = FALSE])
      if (any(ia <- is.finite(acs))) {
        digmin <- 1 + if (length(acs <- acs[ia & acs != 0])) 
                        floor(log10(range(acs[acs != 0], finite = TRUE))) else 0
        Cf[, cs.ind] <- format(round(coef.se, if (is.na(n)) max(1L, digits - digmin) else n), digits = digits)
      }
    }
    if (length(tst.ind)) 
      Cf[, tst.ind] <- format(round(xm[, tst.ind], digits = if (is.na(n)) dig.tst else min(dig.tst, n)), 
                              digits = digits)
    if (any(r.ind <- !((1L:nc) %in% c(cs.ind, tst.ind, if (has.Pvalue) nc)))) 
      for (i in which(r.ind)) Cf[, i] <- format(xm[, i], digits = digits)
    ok[, tst.ind] <- FALSE
    okP <- if (has.Pvalue) ok[, -nc] else ok
    x1 <- Cf[okP]
    dec <- getOption("OutDec")
    if (dec != ".") x1 <- chartr(dec, ".", x1)
    x0 <- (xm[okP] == 0) != (as.numeric(x1) == 0)
    if (length(not.both.0 <- which(x0 & !is.na(x0)))) {
      Cf[okP][not.both.0] <- format(xm[okP][not.both.0], digits = if (is.na(n)) max(1L, digits - 1L) else n)
    }
    if (any(ina)) Cf[ina] <- na.print
    if (P.values) {
      if (!is.logical(signif.stars) || is.na(signif.stars)) {
        warning("option \"show.signif.stars\" is invalid: assuming TRUE")
        signif.stars <- TRUE
      }
      if (any(okP <- ok[, nc])) {
        pv <- as.vector(xm[, nc])
        Cf[okP, nc] <-
          if (is.na(n)) {
            format.pval(pv[okP], digits = dig.tst, eps = eps.Pvalue)
          } else format(round(pv[okP], digits = n), digits = n)
        signif.stars <- signif.stars && any(pv[okP] < 0.1)
        if (signif.stars) {
          Signif <- symnum(pv, corr = FALSE, na = FALSE, 
                           cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), 
                           symbols = c("***", "**", "*", ".", " "))
          Cf <- cbind(Cf, format(Signif))
        }
      } else signif.stars <- FALSE
    } else signif.stars <- FALSE
    print.default(Cf, quote = quote, right = right, na.print = na.print, ...)
    if (signif.stars && signif.legend) {
      if ((w <- getOption("width")) < nchar(sleg <- attr(Signif, 
                                                         "legend"))) 
        sleg <- strwrap(sleg, width = w - 2, prefix = "  ")
      cat("---\nSignif. codes:  ", sleg, sep = "", fill = w + 
                                                     4 + max(nchar(sleg, "bytes") - nchar(sleg)))
    }
    invisible(x)
  }

Demo, using mdl from above:

printCoefmat_round(summary(mdl)$coefficients, n=3)
#             Estimate Std. Error t value Pr(>|t|)    
# (Intercept)   29.105      4.486   6.488    0.000 ***
# disp          -0.041      0.006  -7.089    0.000 ***
# gear           0.111      0.968   0.115    0.909    
# ---
# Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1