Skip to content

Commit

Permalink
options for format_value() : drop leading 0, minus and plus signs (#…
Browse files Browse the repository at this point in the history 
…724)

* options for `format_value()` : drop leading 0, minus and plus signs
Fixes #711

* test, news, version bump

* add stlye for signs

* news

* deal with factors

* test

* Apply automatic changes

---------

Co-authored-by: strengejacke <strengejacke@users.noreply.github.com>
  • Loading branch information
@strengejacke
strengejacke and strengejacke authored Feb 22, 2023
1 parent baead01 commit 8d64ef8
Show file tree
Hide file tree
Showing 6 changed files with 136 additions and 50 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: insight
Title: Easy Access to Model Information for Various Model Objects
Version: 0.19.0.1
Version: 0.19.0.2
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down
6 changes: 5 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,13 @@
# insight 0.19.1

## General
## Changes to functions

* Minor improvements to `get_data()` for `t.test()`.

* `format_value()` gets a `lead_zero` argument, to keep or drop the leading
zero of a formatted value, as well as arguments `style_positive` and
`style_negative` to style positive or negative numbers.

# insight 0.19.0

## New supported models
Expand Down
6 changes: 3 additions & 3 deletions R/format_number.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ format_number <- function(x, textual = TRUE, ...) {

suffixes <- c("thousand", "million", "billion", "trillion")

digits <- rev(strsplit(as.character(x), "")[[1]])
digits <- rev(strsplit(as.character(x), "", fixed = TRUE)[[1]])
nDigits <- length(digits)

if (nDigits == 1) {
Expand All @@ -79,7 +79,7 @@ format_number <- function(x, textual = TRUE, ...) {
} else {
nSuffix <- ((nDigits + 2) %/% 3) - 1
if (nSuffix > length(suffixes)) {
stop(paste(x, "is too large!"), call. = FALSE)
format_error(paste(x, "is too large!"))
}
.trim_ws_and(paste(
Recall(.make_number(digits[nDigits:(3 * nSuffix + 1)])),
Expand All @@ -99,7 +99,7 @@ format_number <- function(x, textual = TRUE, ...) {

.trim_ws_and <- function(text) {
# Tidy leading/trailing whitespace, space before comma
text <- gsub("^\ ", "", gsub("\ *$", "", gsub("\ ,", ",", text)))
text <- gsub("^ ", "", gsub(" *$", "", gsub(" ,", ",", text, fixed = TRUE)))
# Clear any trailing " and"
text <- gsub(" and$", "", text)
# Clear any trailing comma
Expand Down
54 changes: 50 additions & 4 deletions R/format_value.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#' @name format_value
#'
#' @description
#' `format_value()` converts numeric values into formatted string values2, where
#' `format_value()` converts numeric values into formatted string values, where
#' formatting can be something like rounding digits, scientific notation etc.
#' `format_percent()` is a short-cut for `format_value(as_percent = TRUE)`.
#'
Expand All @@ -25,6 +25,15 @@
#' @param zap_small Logical, if `TRUE`, small values are rounded after
#' `digits` decimal places. If `FALSE`, values with more decimal
#' places than `digits` are printed in scientific notation.
#' @param lead_zero Logical, if `TRUE` (default), includes leading zeros, else
#' leading zeros are dropped.
#' @param style_positive A string that determines the style of positive numbers.
#' May be `"none"` (default), `"plus"` to add a plus-sign or `"space"` to
#' precede the string by a Unicode "figure space", i.e., a space equally as
#' wide as a number or `+`.
#' @param style_negative A string that determines the style of negative numbers.
#' May be `"hyphen"` (default), `"minus"` for a proper Unicode minus symbol or
#' `"parens"` to wrap the number in parentheses.
#' @param ... Arguments passed to or from other methods.
#'
#'
Expand All @@ -39,6 +48,7 @@
#' format_value(c(0.0045, .12, .34), as_percent = TRUE)
#' format_value(c(0.0045, .12, .34), digits = "scientific")
#' format_value(c(0.0045, .12, .34), digits = "scientific2")
#' format_value(c(0.045, .12, .34), lead_zero = FALSE)
#'
#' # default
#' format_value(c(0.0045, .123, .345))
Expand Down Expand Up @@ -67,6 +77,9 @@ format_value.data.frame <- function(x,
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
...) {
as.data.frame(sapply(
x,
Expand All @@ -77,6 +90,9 @@ format_value.data.frame <- function(x,
width = width,
as_percent = as_percent,
zap_small = zap_small,
lead_zero = lead_zero,
style_positive = style_positive,
style_negative = style_negative,
simplify = FALSE
))
}
Expand All @@ -91,7 +107,14 @@ format_value.numeric <- function(x,
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
...) {
# check input
style_positive <- match.arg(style_positive, choices = c("none", "plus", "space"))
style_negative <- match.arg(style_negative, choices = c("hyphen", "minus", "parens"))

if (protect_integers) {
out <- .format_value_unless_integer(
x,
Expand All @@ -114,15 +137,38 @@ format_value.numeric <- function(x,
)
}

# Deal with negative zeros
# following changes do not apply to factors

if (!is.factor(x)) {
# Deal with negative zeros
whitespace <- ifelse(is.null(width), "", " ")
out[out == "-0"] <- paste0(whitespace, "0")
out[out == "-0.0"] <- paste0(whitespace, "0.0")
out[out == "-0.00"] <- paste0(whitespace, "0.00")
out[out == "-0.000"] <- paste0(whitespace, "0.000")
out[out == "-0.0000"] <- paste0(whitespace, "0.0000")

# drop leading zero?
if (!lead_zero) {
out <- gsub("(.*)(0\\.)(.*)", "\\1\\.\\3", out)
}

# find negative values, to deal with sign
negatives <- startsWith(out, "-")

if (style_positive == "plus") {
out[!negatives] <- paste0("+", out[!negatives])
} else if (style_positive == "space") {
out[!negatives] <- paste0("\u2007", out[!negatives])
}

if (style_negative == "minus") {
out[negatives] <- gsub("-", "\u2212", out[negatives], fixed = TRUE)
} else if (style_negative == "parens") {
out[negatives] <- gsub("-(.*)", "\\(\\1\\)", out[negatives])
}
}

out
}

Expand Down Expand Up @@ -189,7 +235,7 @@ format_percent <- function(x, ...) {
x <- ifelse(is.na(x), .missing, sprintf("%.*f%%", digits, 100 * x))
} else {
x <- ifelse(is.na(x), .missing,
ifelse(need_sci,
ifelse(need_sci, # nolint
sprintf("%.*e%%", digits, 100 * x),
sprintf("%.*f%%", digits, 100 * x)
)
Expand Down Expand Up @@ -224,7 +270,7 @@ format_percent <- function(x, ...) {
x <- ifelse(is.na(x), .missing, sprintf("%.*f", digits, x))
} else {
x <- ifelse(is.na(x), .missing,
ifelse(need_sci,
ifelse(need_sci, # nolint
sprintf("%.*e", digits, x),
sprintf("%.*f", digits, x)
)
Expand Down
21 changes: 20 additions & 1 deletion man/format_value.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

97 changes: 57 additions & 40 deletions tests/testthat/test-format.R
View file
Original file line number Diff line number Diff line change
@@ -1,71 +1,88 @@
test_that("format_value", {
expect_equal(nchar(format_value(1.2012313)), 4)
expect_equal(format_value(4.2, protect_integers = TRUE), "4.20")
expect_equal(format_value(4.0, protect_integers = TRUE), "4")
expect_equal(format_value(0, protect_integers = TRUE), "0")
expect_equal(format_value(0), "0.00")
expect_equal(format_value(1234565789101112), "1.23e+15")
expect_equal(format_value(1234565789101112, protect_integers = TRUE), "1234565789101112")
expect_equal(format_value(0.0000000123), "1.23e-08")
expect_equal(format_value(0.0000000123, zap_small = TRUE), "0.00")
expect_equal(format_value(0.0000000123, digits = 8), "0.00000001")
expect_equal(format_value(0.95, as_percent = TRUE), "95.00%")
expect_equal(format_value(0.000001, as_percent = TRUE), "1.00e-04%")
expect_equal(format_value(0.000001, as_percent = TRUE, zap_small = TRUE), "0.00%")
expect_identical(nchar(format_value(1.2012313)), 4L)
expect_identical(format_value(4.2, protect_integers = TRUE), "4.20")
expect_identical(format_value(4.0, protect_integers = TRUE), "4")
expect_identical(format_value(0, protect_integers = TRUE), "0")
expect_identical(format_value(0), "0.00")
expect_identical(format_value(1234565789101112), "1.23e+15")
expect_identical(format_value(1234565789101112, protect_integers = TRUE), "1234565789101112")
expect_identical(format_value(0.0000000123), "1.23e-08")
expect_identical(format_value(0.0000000123, zap_small = TRUE), "0.00")
expect_identical(format_value(0.0000000123, digits = 8), "0.00000001")
expect_identical(format_value(c(0.012, 0.45, -0.03), lead_zero = FALSE), c(".01", ".45", "-.03"))
expect_identical(format_value(c(1.012, 0.45, -0.03), lead_zero = FALSE), c("1.01", ".45", "-.03"))
expect_identical(format_value(c(0.45, -0.03), style_positive = "plus"), c("+0.45", "-0.03"))
expect_identical(format_value(c(0.45, -0.03), style_positive = "plus", lead_zero = FALSE), c("+.45", "-.03"))
expect_equal(
format_value(as.factor(c("A", "B", "A"))),
structure(c(1L, 2L, 1L), levels = c("A", "B"), class = "factor"),
ignore_attr = TRUE
)
expect_identical(
format_value(c(0.45, -0.03), style_positive = "plus", style_negative = "parens", lead_zero = FALSE),
c("+.45", "(.03)")
)
expect_identical(
format_value(c(0.45, -0.03), style_positive = "plus", style_negative = "parens"),
c("+0.45", "(0.03)")
)
expect_identical(format_value(0.95, as_percent = TRUE), "95.00%")
expect_identical(format_value(0.000001, as_percent = TRUE), "1.00e-04%")
expect_identical(format_value(0.000001, as_percent = TRUE, zap_small = TRUE), "0.00%")
})

test_that("format_value", {
expect_equal(format_value(0.0045, zap_small = TRUE), "0.00")
expect_equal(format_value(0.0045), "4.50e-03")
expect_equal(format_value(0.00045), "4.50e-04")
expect_equal(format_value(0.00045, digits = 3), "4.500e-04")
expect_equal(format_value(0.00045, digits = 4), "0.0004")
expect_identical(format_value(0.0045, zap_small = TRUE), "0.00")
expect_identical(format_value(0.0045), "4.50e-03")
expect_identical(format_value(0.00045), "4.50e-04")
expect_identical(format_value(0.00045, digits = 3), "4.500e-04")
expect_identical(format_value(0.00045, digits = 4), "0.0004")
})

test_that("format_ci", {
expect_equal(
expect_identical(
format_ci(c(123, 123, 123, 123), c(123, 12345, 123456, 123456789012), width = "auto"),
c("95% CI [123.00, 123.00]", "95% CI [123.00, 12345.00]", "95% CI [123.00, 1.23e+05]", "95% CI [123.00, 1.23e+11]")
)
expect_equal(
expect_identical(
format_ci(c(123, 123, 123, 123), c(123, 12345, 123456, 123456789012), width = "auto", digits = 5),
c(
"95% CI [123.00000, 123.00000]", "95% CI [123.00000, 12345.00000]",
"95% CI [123.00000, 1.23456e+05]", "95% CI [123.00000, 1.23457e+11]"
)
)
expect_equal(
expect_identical(
format_ci(c(123, 123, 123, 123), c(123, 12345, 123456, 123456789012), width = "auto", digits = 0),
c("95% CI [123, 123]", "95% CI [123, 12345]", "95% CI [123, 1e+05]", "95% CI [123, 1e+11]")
)
expect_equal(format_ci(1.24, 0.0000054), "95% CI [1.24, 5.40e-06]")
expect_equal(format_ci(1.24, 0.0000054, digits = 0), "95% CI [1, 5e-06]")
expect_equal(format_ci(1.24, 0.0000054, zap_small = TRUE), "95% CI [1.24, 0.00]")
expect_equal(format_ci(1.24, 0.0000054, zap_small = TRUE, digits = 0), "95% CI [1, 0]")
expect_identical(format_ci(1.24, 0.0000054), "95% CI [1.24, 5.40e-06]")
expect_identical(format_ci(1.24, 0.0000054, digits = 0), "95% CI [1, 5e-06]")
expect_identical(format_ci(1.24, 0.0000054, zap_small = TRUE), "95% CI [1.24, 0.00]")
expect_identical(format_ci(1.24, 0.0000054, zap_small = TRUE, digits = 0), "95% CI [1, 0]")
})

test_that("format others", {
expect_true(is.character(insight::format_pd(0.02)))
expect_equal(nchar(format_bf(4)), 9)
expect_true(is.character(format_rope(0.02)))
expect_type(insight::format_pd(0.02), "character")
expect_identical(nchar(format_bf(4)), 9L)
expect_type(format_rope(0.02), "character")
})

test_that("format_number", {
expect_equal(format_number(2), "two")
expect_equal(format_number(45), "forty five")
expect_equal(format_number(2), "two")
expect_identical(format_number(2), "two")
expect_identical(format_number(45), "forty five")
expect_identical(format_number(2), "two")
})

test_that("format_p", {
expect_equal(nchar(format_p(0.02)), 9)
expect_equal(nchar(format_p(0.02, stars = TRUE)), 10)
expect_equal(nchar(format_p(0.02, stars_only = TRUE)), 1)
expect_identical(nchar(format_p(0.02)), 9L)
expect_identical(nchar(format_p(0.02, stars = TRUE)), 10L)
expect_identical(nchar(format_p(0.02, stars_only = TRUE)), 1L)
})

test_that("format_table, other CI columns", {
x <- data.frame(test_CI = 0.9, test_CI_low = 0.1, test_CI_high = 1.3)
test <- utils::capture.output(format_table(x))
expect_equal(test, c(" test 90% CI", "1 [0.10, 1.30]"))
expect_identical(test, c(" test 90% CI", "1 [0.10, 1.30]"))

x <- data.frame(
CI = 0.8,
Expand All @@ -76,13 +93,13 @@ test_that("format_table, other CI columns", {
test_CI_high = 1.3
)
test <- utils::capture.output(format_table(x))
expect_equal(test, c(" 80% CI test 90% CI", "1 [2.43, 5.45] [0.10, 1.30]"))
expect_identical(test, c(" 80% CI test 90% CI", "1 [2.43, 5.45] [0.10, 1.30]"))

x <- data.frame(CI_low = 2.43, CI_high = 5.453, test_CI_low = 0.1, test_CI_high = 1.3)
attr(x, "ci") <- 0.8
attr(x, "ci_test") <- 0.9
test <- utils::capture.output(format_table(x))
expect_equal(test, c(" 80% CI test 90% CI", "1 [2.43, 5.45] [0.10, 1.30]"))
expect_identical(test, c(" 80% CI test 90% CI", "1 [2.43, 5.45] [0.10, 1.30]"))

x <- data.frame(
CI_low = 2.43,
Expand All @@ -95,7 +112,7 @@ test_that("format_table, other CI columns", {
attr(x, "ci") <- 0.8
attr(x, "ci_test") <- 0.9
test <- utils::capture.output(format_table(x))
expect_equal(test, c(" 80% CI test 80% CI other 80% CI", "1 [2.43, 5.45] [0.10, 1.30] [0.12, 1.40]"))
expect_identical(test, c(" 80% CI test 80% CI other 80% CI", "1 [2.43, 5.45] [0.10, 1.30] [0.12, 1.40]"))
})


Expand Down Expand Up @@ -161,6 +178,6 @@ test_that("format_table, preserve attributes", {
attr(d, "table_footer") <- "This is a footer"
attr(d, "table_caption") <- "And the caption"
d2 <- insight::format_table(d, digits = 3, preserve_attributes = TRUE)
expect_equal(names(attributes(d2)), c("names", "row.names", "class", "table_footer", "table_caption"))
expect_equal(attributes(d2)$table_caption, "And the caption")
expect_named(attributes(d2), c("names", "row.names", "class", "table_footer", "table_caption"))
expect_identical(attributes(d2)$table_caption, "And the caption")
})

0 comments on commit 8d64ef8

Please sign in to comment.