Skip to content

Add optional thousand separator parameter for formatting large numbers #1137

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 13 commits into
base: main
Choose a base branch
from
Open

Add optional thousand separator parameter for formatting large numbers #1137

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
4c2e480
Initial plan
Copilot Sep 30, 2025
f71a7bb
Add big_mark parameter for thousand separators in format_value and ex…
Copilot Sep 30, 2025
71366f9
Refine big_mark to exclude percentages and add test
Copilot Sep 30, 2025
93ecac2
document [skip ci]
rempsyc Sep 30, 2025
428cbd6
document, styler, version [skip ci]
rempsyc Sep 30, 2025
20fd78d
Fix big_mark to suppress scientific notation for large numbers and up…
Copilot Sep 30, 2025
9b5eebe
air styler [skip ci]
rempsyc Sep 30, 2025
d07d5f6
Fix big_mark to work with protect_integers and percentages
Copilot Sep 30, 2025
df3f44b
Fix export_table tests to use any(grepl()) for vector outputs
Copilot Oct 1, 2025
bd8f9c0
fix test, air style
rempsyc Oct 1, 2025
734e6f4
linter [skip ci]
rempsyc Oct 1, 2025
c8ad686
Fix linting issues: avoid nested ifelse and use fixed=TRUE in strsplit
Copilot Oct 1, 2025
94e5ef6
Revert "Fix linting issues: avoid nested ifelse and use fixed=TRUE in…
Copilot Oct 1, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
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: 1.4.2.4
Version: 1.4.2.5
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down
6 changes: 6 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,12 @@
* Better formatting for p-values-columns from equivalence tests from other
packages.

* `format_value()`, `format_number()`, and `export_table()` gain a `big_mark`
argument to format numbers with thousands separators (e.g., `1,234,567.89` or
`1 234 567.89`). This makes large numbers more readable in tables and formatted
output. When `big_mark` is provided, scientific notation is suppressed for
large numbers to show the full value with separators.

## Bug fixes

* Fix CRAN check failures.
Expand Down
25 changes: 15 additions & 10 deletions R/export_table.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -189,7 +189,7 @@
#' export_table(mp, format = "tt", row_groups = groups)
#' }
#' @export
export_table <- function(x,

Check warning on line 192 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=192,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this expression from 73 to at most 40.
sep = " | ",
header = "-",
cross = NULL,
Expand All @@ -207,6 +207,7 @@
align = NULL,
by = NULL,
zap_small = FALSE,
big_mark = NULL,
table_width = "auto",
remove_duplicates = FALSE,
row_groups = NULL,
Expand Down Expand Up @@ -267,6 +268,7 @@
align = align,
group_by = by,
zap_small = zap_small,
big_mark = big_mark,
empty_line = empty_line,
indent_groups = indent_groups,
row_groups = row_groups,
Expand Down Expand Up @@ -511,6 +513,7 @@
align = NULL,
group_by = NULL,
zap_small = FALSE,
big_mark = NULL,
empty_line = NULL,
indent_groups = NULL,
row_groups = NULL,
Expand Down Expand Up @@ -549,7 +552,8 @@
if (is.numeric(i)) {
out <- format_value(i,
digits = digits, protect_integers = protect_integers,
missing = missing, width = col_width, zap_small = zap_small
missing = missing, width = col_width, zap_small = zap_small,
big_mark = big_mark
)
} else {
out <- i
Expand Down Expand Up @@ -581,7 +585,7 @@
}
return(out)

# text and markdown go here...

Check warning on line 588 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=588,col=5,[unreachable_code_linter] Remove code and comments coming after return() or stop().
} else {
# Add colnames as first row to the data frame
table_data <- rbind(colnames(table_data), table_data)
Expand Down Expand Up @@ -652,7 +656,7 @@
# plain text formatting ----------------------------------
# --------------------------------------------------------

.format_basic_table <- function(final,

Check warning on line 659 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=659,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this expression from 76 to at most 40.
header,
sep,
cross = NULL,
Expand All @@ -677,7 +681,7 @@
if (!is.null(indent_groups) && any(grepl(indent_groups, final[, 1], fixed = TRUE))) {
final <- .indent_groups(final, indent_groups)
skip_first_align <- TRUE
} else if (!is.null(row_groups)) {

Check warning on line 684 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=684,col=14,[if_not_else_linter] Prefer `if (A) x else y` to the less-readable `if (!A) y else x` in a simple if/else statement.
final <- .row_groups(final, row_groups)$final
skip_first_align <- TRUE
} else {
Expand Down Expand Up @@ -1122,11 +1126,11 @@
row_index <- out$row_groups
# insert header rows in final-matrix
grps <- vapply(out$row_groups, function(i) i[1], numeric(1))
for (j in length(grps):1) {

Check warning on line 1129 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1129,col=15,[seq_linter] Use rev(seq_along(...)) instead of length(...):1, which is likely to be wrong in the empty edge case.
if (grps[j] == 1) {
final <- rbind(
c(names(grps)[j], rep_len("", ncol(final) - 1)),
final[1:nrow(final), , drop = FALSE]

Check warning on line 1133 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1133,col=17,[seq_linter] Use seq_len(nrow(...)) instead of 1:nrow(...), which is likely to be wrong in the empty edge case.
)
} else {
final <- rbind(
Expand Down Expand Up @@ -1306,7 +1310,7 @@
# go through all columns of the data frame
for (i in 1:n_columns) {
# create separator line for current column
tablecol <- paste0(rep_len("-", column_width[i]), collapse = "")

Check warning on line 1313 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1313,col=17,[paste_linter] Use paste(), not paste0(), to collapse a character vector when sep= is not used.

# check if user-defined alignment is requested, and if so, extract
# alignment direction and save to "align_char"
Expand Down Expand Up @@ -1350,7 +1354,7 @@
# Transform to character
rows <- NULL
for (row in seq_len(nrow(final))) {
final_row <- paste0("|", paste0(final[row, ], collapse = "|"), "|", collapse = "")

Check warning on line 1357 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1357,col=30,[paste_linter] Use paste(), not paste0(), to collapse a character vector when sep= is not used.
rows <- c(rows, final_row)

# First row separation
Expand Down Expand Up @@ -1386,15 +1390,16 @@
# --------------------------------------------------------

.format_html_table <- function(
final,
caption = NULL,
subtitle = NULL,
footer = NULL,
align = "center",
group_by = NULL,
row_groups = NULL,
column_groups = NULL,
...) {
final,
caption = NULL,
subtitle = NULL,
footer = NULL,
align = "center",
group_by = NULL,
row_groups = NULL,
column_groups = NULL,
...
) {
check_if_installed("gt")

if (is.null(align)) {
Expand All @@ -1418,7 +1423,7 @@
}

# indent groups?
if (!is.null(row_groups)) {

Check warning on line 1426 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1426,col=7,[if_not_else_linter] Prefer `if (A) x else y` to the less-readable `if (!A) y else x` in a simple if/else statement.
out <- .row_groups(final, row_groups, "\U00A0\U00A0", remove_first = FALSE)
final <- out$final
highlight_rows <- out$row_headers
Expand Down Expand Up @@ -1476,7 +1481,7 @@

tab <- gt::gt(final, groupname_col = group_by_columns)
header <- gt::tab_header(tab, title = caption, subtitle = subtitle)
if (!is.null(footer)) {

Check warning on line 1484 in R/export_table.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/export_table.R,line=1484,col=7,[if_not_else_linter] Prefer `if (A) x else y` to the less-readable `if (!A) y else x` in a simple if/else statement.
footer <- gt::tab_source_note(header, source_note = gt::html(footer))
} else {
footer <- gt::tab_source_note(header, source_note = NULL)
Expand Down
3 changes: 1 addition & 2 deletions R/find_parameters_other.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -352,8 +352,7 @@ find_parameters.lcmm <- function(x, component = "all", flatten = FALSE, ...) {
],
extra = params[startsWith(params, type)]
)
names(out)[3] <- switch(
type,
names(out)[3] <- switch(type,
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please revert this change, we follow Air styler rules now.

"Beta" = "beta",
"I-splines" = "splines",
"Linear" = "linear"
Expand Down
180 changes: 132 additions & 48 deletions R/format_value.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,9 @@
#' `"parens"` to wrap the number in parentheses.
#' @param decimal_point Character string containing a single character that
#' is used as decimal point in output conversions.
#' @param big_mark Character used as thousands separator. If `NULL` (default),
#' no thousands separator is used. Use `","` for comma separator or `" "`
#' for space separator.
#' @param ... Arguments passed to or from other methods.
#'
#'
Expand All @@ -52,6 +55,8 @@
#' format_value(c(0.0045, 0.12, 0.34), digits = "scientific2")
#' format_value(c(0.045, 0.12, 0.34), lead_zero = FALSE)
#' format_value(c(0.0045, 0.12, 0.34), decimal_point = ",")
#' format_value(c(1234567.89, 1234.56), big_mark = ",")
#' format_value(c(1234567.89, 1234.56), big_mark = " ")
#'
#' # default
#' format_value(c(0.0045, 0.123, 0.345))
Expand All @@ -73,18 +78,21 @@ format_value <- function(x, ...) {

#' @rdname format_value
#' @export
format_value.data.frame <- function(x,
digits = 2,
protect_integers = FALSE,
missing = "",
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
decimal_point = getOption("OutDec"),
...) {
format_value.data.frame <- function(
x,
digits = 2,
protect_integers = FALSE,
missing = "",
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
decimal_point = getOption("OutDec"),
big_mark = NULL,
...
) {
as.data.frame(sapply(
x,
format_value,
Expand All @@ -98,25 +106,29 @@ format_value.data.frame <- function(x,
style_positive = style_positive,
style_negative = style_negative,
decimal_point = decimal_point,
big_mark = big_mark,
simplify = FALSE
))
}


#' @rdname format_value
#' @export
format_value.numeric <- function(x,
digits = 2,
protect_integers = FALSE,
missing = "",
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
decimal_point = getOption("OutDec"),
...) {
format_value.numeric <- function(
x,
digits = 2,
protect_integers = FALSE,
missing = "",
width = NULL,
as_percent = FALSE,
zap_small = FALSE,
lead_zero = TRUE,
style_positive = "none",
style_negative = "hyphen",
decimal_point = getOption("OutDec"),
big_mark = NULL,
...
) {
# check input
style_positive <- validate_argument(style_positive, c("none", "plus", "space"))
style_negative <- validate_argument(style_negative, c("hyphen", "minus", "parens"))
Expand All @@ -129,6 +141,7 @@ format_value.numeric <- function(x,
.width = width,
.as_percent = as_percent,
.zap_small = zap_small,
.big_mark = big_mark,
...
)
} else {
Expand All @@ -139,6 +152,7 @@ format_value.numeric <- function(x,
.width = width,
.as_percent = as_percent,
.zap_small = zap_small,
.big_mark = big_mark,
...
)
}
Expand Down Expand Up @@ -205,12 +219,16 @@ format_percent <- function(x, ...) {
}


.format_value_unless_integer <- function(x,
digits = 2,
.missing = "",
.width = NULL,
.as_percent = FALSE,
.zap_small = FALSE, ...) {
.format_value_unless_integer <- function(
x,
digits = 2,
.missing = "",
.width = NULL,
.as_percent = FALSE,
.zap_small = FALSE,
.big_mark = NULL,
...
) {
x_nonmiss <- x[!is.na(x)]
if (is.numeric(x) && !all(.is_integer(x_nonmiss))) {
.format_value(
Expand All @@ -219,27 +237,45 @@ format_percent <- function(x, ...) {
.missing = .missing,
.width = .width,
.as_percent = .as_percent,
.zap_small = .zap_small
.zap_small = .zap_small,
.big_mark = .big_mark
)
} else if (anyNA(x)) {
.convert_missing(x, .missing)
} else if (is.numeric(x) && all(.is_integer(x_nonmiss)) && !is.null(.width)) {
format(x, justify = "right", width = .width)
} else {
as.character(x)
# For integers, apply big_mark if requested
out <- as.character(x)
if (!is.null(.big_mark) && !identical(.big_mark, "") && is.character(out)) {
needs_big_mark <- !is.na(out) & out != .missing
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Check for is.character() is not necessary here.

if (any(needs_big_mark)) {
out[needs_big_mark] <- prettyNum(
out[needs_big_mark],
big.mark = .big_mark,
preserve.width = "none"
)
}
}
out
}
}


.format_value <- function(x,
digits = 2,
.missing = "",
.width = NULL,
.as_percent = FALSE,
.zap_small = FALSE,
...) {
.format_value <- function(
x,
digits = 2,
.missing = "",
.width = NULL,
.as_percent = FALSE,
.zap_small = FALSE,
.big_mark = NULL,
...
) {
# proper character NA
if (is.na(.missing)) .missing <- NA_character_
if (is.na(.missing)) {
.missing <- NA_character_
}

# sometimes, digits can be `NULL` - sanity check
if (is.null(digits)) {
Expand All @@ -249,11 +285,16 @@ format_percent <- function(x, ...) {
if (is.numeric(x)) {
if (isTRUE(.as_percent)) {
need_sci <- (abs(100 * x) >= 1e+5 | (log10(abs(100 * x)) < -digits)) & x != 0
if (.zap_small) {
# When big_mark is provided, suppress scientific notation for percentages too
use_big_mark <- !is.null(.big_mark) && !identical(.big_mark, "")
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

medium

The variable use_big_mark is defined twice with the same value (here and on line 328). To avoid code duplication, you could define it once at the beginning of the .format_value function (e.g., after line 284) and reuse it in both places.

if (.zap_small || use_big_mark) {
x <- ifelse(is.na(x), .missing, sprintf("%.*f%%", digits, 100 * x))
} else {
x <- ifelse(is.na(x), .missing,
ifelse(need_sci, # nolint
x <- ifelse(
is.na(x),
.missing,
ifelse(
need_sci, # nolint
sprintf("%.*e%%", digits, 100 * x),
sprintf("%.*f%%", digits, 100 * x)
)
Expand All @@ -266,7 +307,9 @@ format_percent <- function(x, ...) {
5
}
)
if (is.na(digits)) digits <- 5
if (is.na(digits)) {
digits <- 5
}
x <- sprintf("%.*e", digits, x)
} else if (is.character(digits) && grepl("signif", digits, fixed = TRUE)) {
digits <- tryCatch(
Expand All @@ -275,21 +318,62 @@ format_percent <- function(x, ...) {
NA
}
)
if (is.na(digits)) digits <- 3
if (is.na(digits)) {
digits <- 3
}
x <- as.character(signif(x, digits))
} else {
# When big_mark is provided, suppress scientific notation for large numbers
# since the user wants to see the full number with thousands separators
use_big_mark <- !is.null(.big_mark) && !identical(.big_mark, "")
need_sci <- (abs(x) >= 1e+5 | (log10(abs(x)) < -digits)) & x != 0
if (.zap_small) {
if (.zap_small || use_big_mark) {
x <- ifelse(is.na(x), .missing, sprintf("%.*f", digits, x))
} else {
x <- ifelse(is.na(x), .missing,
ifelse(need_sci, # nolint
x <- ifelse(
is.na(x),
.missing,
ifelse(
need_sci, # nolint
sprintf("%.*e", digits, x),
sprintf("%.*f", digits, x)
)
)
}
}

# Apply thousands separator if requested
# Only apply to non-scientific notation values
if (!is.null(.big_mark) && !identical(.big_mark, "") && is.character(x)) {
# Don't apply to scientific notation (contains 'e')
needs_big_mark <- !grepl("e", x, fixed = TRUE) & !is.na(x) & x != .missing
if (any(needs_big_mark)) {
# For percentages, we need to handle them specially
has_percent <- grepl("%", x, fixed = TRUE)

# Apply big_mark to non-percentage values directly
if (any(needs_big_mark & !has_percent)) {
x[needs_big_mark & !has_percent] <- prettyNum(
x[needs_big_mark & !has_percent],
big.mark = .big_mark,
preserve.width = "none"
)
}

# For percentages, extract the number, apply big_mark, then add % back
if (any(needs_big_mark & has_percent)) {
idx <- which(needs_big_mark & has_percent)
for (i in idx) {
# Remove the % sign, apply prettyNum, then add % back
num_part <- gsub("%", "", x[i], fixed = TRUE)
x[i] <- paste0(
prettyNum(num_part, big.mark = .big_mark, preserve.width = "none"),
"%"
)
}
}
Comment on lines +364 to +374
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

medium

The for loop here can be vectorized for better performance and more idiomatic R code. Since prettyNum is vectorized, you can apply it to all relevant percentage strings at once.

if (any(needs_big_mark & has_percent)) {
  selector <- needs_big_mark & has_percent
  num_parts <- gsub("%", "", x[selector], fixed = TRUE)
  x[selector] <- paste0(
    prettyNum(num_parts, big.mark = .big_mark, preserve.width = "none"),
    "%"
  )
}

}
}
} else if (anyNA(x)) {
x <- .convert_missing(x, .missing)
}
Expand Down
Loading
Loading