fixed handling of trailing zeros in prettify (closes #40)

hofnerb · Jan 3, 2019 · d472cf0 · d472cf0
1 parent 193c385
commit d472cf0
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 6 deletions.
diff --git a/R/prettify.R b/R/prettify.R
@@ -469,7 +469,7 @@ prettify.data.frame <- function(object, labels = NULL, sep = ": ", extra.column
 }
 
 
-### helper for pretty p-values
+### helper for pretty p-values and other numerical values
 prettifyPValue <- function(object,
                            smallest.pval = 0.001, digits = NULL, scientific = FALSE,
                            signif.stars = getOption("show.signif.stars"), ...) {
@@ -492,11 +492,8 @@ prettifyPValue <- function(object,
     }
 
     if (!is.null(digits)) {
-        for (i in names(object)[-wchPval]) {
-            if (is.numeric(object[, i]))
-                object[, i] <- format(zapsmall(object[, i]), digits = digits,
-                                      scientific = scientific, ...)
-        }
+        object[-wchPval] <- sapply(object[-wchPval], function(col) 
+            formatC(col, digits = digits, flag = "#", ...))
     }
 
     object

diff --git a/tests/testthat/test-prettify.R b/tests/testthat/test-prettify.R
@@ -375,3 +375,16 @@ if (require("nlme", quietly = TRUE) && require("survival", quietly = TRUE) && re
         }
     })
 }
+
+################################################################################
+## Test that trailing zeros are not dropped
+################################################################################
+
+if (require("survival", quietly = TRUE)) {
+    test_that("trailing zeros are not dropped", {
+        data(ovarian, package = "survival")
+        mod <- coxph(Surv(futime, fustat) ~ age, data = ovarian)
+        x <- prettify(summary(mod), digit = 3, env = .GlobalEnv)
+        expect_match(x[1,5], "1.30")
+    })
+}