Skip to content
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

Performance of vec_fmt_*() by avoiding checking of compatibility + coercion to tibble #1893

Merged
merged 7 commits into from
Sep 27, 2024
Merged

Performance of vec_fmt_*() by avoiding checking of compatibility + coercion to tibble #1893

Show file tree
Hide file tree
Changes from 5 commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
5157a27
Add argument to avoid compatibility check (for render_as_vector()
olivroy Sep 26, 2024
a65415d
Some misc performance improvements
olivroy Sep 26, 2024
fadcbfc
Correction to tf_formats() (avoids NA) + refactor locale normalization
olivroy Sep 26, 2024
5873f80
Fix edge case cols_add()
olivroy Sep 26, 2024
21a3791
fixup cols_add() in corner cases
olivroy Sep 26, 2024
4d1a09f
add minimal tests for cols_nanoplot + remove tidyselect deprecation w…
olivroy Sep 26, 2024
53b1e44
simplify cols_add + improve test coverage
olivroy Sep 26, 2024
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: 2 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,8 @@

* `vec_fmt_*()` (and incidentally `cols_nanoplot()`) should be faster now (@olivroy, #1888, #1891).

* `cols_add()` works in more cases (#1893).

# gt 0.11.0

## New features
Expand Down
4 changes: 2 additions & 2 deletions R/build_data.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ build_data <- function(data, context) {
# Reassemble the rows and columns of `body` in
# the correct order
data <- dt_body_build(data = data)
data <- render_formats(data = data, context = context)
data <- render_formats(data = data, skip_compat_check = FALSE, context = context)
data <- render_substitutions(data = data, context = context)
data <- migrate_unformatted_to_output(data = data, context = context)
data <- perform_col_merge(data = data, context = context)
Expand Down Expand Up @@ -96,7 +96,7 @@ build_data <- function(data, context) {
build_data_body <- function(data, context) {

data <- dt_body_build(data = data)
data <- render_formats(data = data, context = context)
data <- render_formats(data = data, skip_compat_check = TRUE, context = context)
data <- migrate_unformatted_to_output(data = data, context = context)

data
Expand Down
88 changes: 47 additions & 41 deletions R/cols_add.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -242,7 +242,7 @@ cols_add <- function(
# columns
#

if (nrow(data_tbl) < 1 && ncol(data_tbl) < 1) {
if (nrow(data_tbl) == 0L && ncol(data_tbl) == 0L) {

# Generate boxhead rows that correspond to the new columns
updated_boxh_df <-
Expand Down Expand Up @@ -279,7 +279,7 @@ cols_add <- function(
# however, the number of rows should be consistent across the supplied columns
#

if (nrow(data_tbl) < 1 && ncol(data_tbl) > 0) {
if (nrow(data_tbl) == 0L && ncol(data_tbl) > 0) {

# Generate boxhead rows that correspond to the new columns
updated_boxh_df <-
Expand Down Expand Up @@ -380,18 +380,9 @@ cols_add <- function(
null_means = "nothing"
)

if (length(resolved_column_before) < 1) {
if (length(resolved_column_before) == 0) {
resolved_column_before <- NULL
}

if (
!is.null(resolved_column_before) &&
length(resolved_column_before) != 1
) {

if (length(resolved_column_before) < 1) {
cli::cli_abort("The expression used for `.before` did not resolve a column.")
}
} else if (length(resolved_column_before) != 1) {

if (length(resolved_column_before) > 1) {
cli::cli_abort("The expression used for `.before` resolved multiple columns.")
Expand All @@ -405,23 +396,19 @@ cols_add <- function(
null_means = "nothing"
)

if (length(resolved_column_after) < 1) {
if (length(resolved_column_after) == 0L) {
resolved_column_after <- NULL
}

if (
!is.null(resolved_column_after) &&
length(resolved_column_after) != 1
) {

if (length(resolved_column_after) < 1) {
cli::cli_abort("The expression used for `.after` did not resolve a column.")
}
} else if (length(resolved_column_after) != 1) {

if (length(resolved_column_after) > 1) {
cli::cli_abort("The expression used for `.after` resolved multiple columns.")
}
}

if (length(resolved_column_after) == 1 && resolved_column_after == colnames(data_tbl)[NCOL(data_tbl)]) {
# if requesting the last column to add after, use NULL instead.
resolved_column_after <- NULL
}

# Stop function if expressions are given to both `.before` and `.after`
if (!is.null(resolved_column_before) && !is.null(resolved_column_after)) {
Expand Down Expand Up @@ -454,35 +441,45 @@ cols_add <- function(
} else if (!is.null(resolved_column_before) && is.null(resolved_column_after)) {

before_colnum <- which(colnames(data_tbl) == resolved_column_before)

if (before_colnum <= 1) {
# put new column first
updated_data_tbl <-
dplyr::bind_cols(
data_tbl_new_cols,
data_tbl
)
} else {
updated_data_tbl <-
dplyr::bind_cols(
dplyr::select(data_tbl, 1:(dplyr::all_of(before_colnum) - 1)),
data_tbl_new_cols,
dplyr::select(data_tbl, dplyr::all_of(before_colnum):ncol(data_tbl))
)
}

updated_data_tbl <-
dplyr::bind_cols(
dplyr::select(data_tbl, 1:(before_colnum - 1)),
data_tbl_new_cols,
dplyr::select(data_tbl, before_colnum:ncol(data_tbl))
)

before_colnum <- which(boxh_df[["var"]] == resolved_column_before)

updated_boxh_df <-
dplyr::bind_rows(
vctrs::vec_rbind(
boxh_df[(1:before_colnum) - 1, ],
boxh_df_new_cols,
boxh_df[before_colnum:nrow(boxh_df), ]
)

} else if (is.null(resolved_column_before) && !is.null(resolved_column_after)) {

if (resolved_column_after == nrow(data_tbl)) {
if (resolved_column_after == ncol(data_tbl)) {

updated_data_tbl <-
dplyr::bind_cols(
vctrs::vec_cbind(
data_tbl,
data_tbl_new_cols
)

updated_boxh_df <-
dplyr::bind_rows(
vctrs::vec_rbind(
boxh_df,
boxh_df_new_cols
)
Expand All @@ -491,15 +488,24 @@ cols_add <- function(

after_colnum <- which(colnames(data_tbl) == resolved_column_after)

updated_data_tbl <-
dplyr::bind_cols(
dplyr::select(data_tbl, 1:after_colnum),
data_tbl_new_cols,
dplyr::select(data_tbl, (after_colnum + 1):ncol(data_tbl))
)
if (after_colnum >= ncol(data_tbl)) {
updated_data_tbl <-
vctrs::vec_cbind(
data_tbl,
data_tbl_new_cols
)
} else {
updated_data_tbl <-
dplyr::bind_cols(
dplyr::select(data_tbl, 1:dplyr::all_of(after_colnum)),
data_tbl_new_cols,
dplyr::select(data_tbl, (after_colnum + 1):ncol(data_tbl))
)
}

after_colnum <- which(boxh_df[["var"]] == resolved_column_after)

after_colnum <- which(boxh_df[["var"]] == resolved_column_after)

updated_boxh_df <-
dplyr::bind_rows(
boxh_df[1:after_colnum, ],
Expand Down
2 changes: 1 addition & 1 deletion R/cols_align_decimal.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,7 @@ cols_align_decimal <- function(

# If the subsetting of columns finally results in no columns, return
# the data unchanged
if (length(columns) < 1) {
if (length(columns) == 0L) {
return(data)
}

Expand Down
4 changes: 2 additions & 2 deletions R/dt_body.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,12 +36,12 @@ dt_body_get <- function(data) {
}

dt_body_set <- function(data, body) {
dt__set(data, .dt_body_key, dplyr::as_tibble(body))
dt__set(data, .dt_body_key, body)
}

dt_body_build_init <- function(data) {

body <- dt_data_get(data = data)[, dt_boxhead_get_vars(data = data)]
body <- dt_data_get(data = data)[dt_boxhead_get_vars(data = data)]

if (NROW(body) > 0) {
body[] <- NA_character_
Expand Down
34 changes: 17 additions & 17 deletions R/fmt.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -176,22 +176,22 @@ normalize_locale <- function(locale = NULL) {
#' functions. This is expected as `NULL` if not supplied by the user.
#' @noRd
validate_locale <- function(locale, call = rlang::caller_env()) {
if (is.null(locale)) {
return(NULL)
}

# Stop function if the `locale` provided
# isn't a valid one
if (
!is.null(locale) &&
!(gsub("_", "-", locale, fixed = TRUE) %in% locales[["locale"]]) &&
!(gsub("_", "-", locale, fixed = TRUE) %in% default_locales[["default_locale"]])
) {

cli::cli_abort(c(
"The supplied `locale` is not available in the list of supported locales.",
"i" = "Use {.run [info_locales()](gt::info_locales())} to see which locales can be used."
locale <- gsub("_", "-", locale, fixed = TRUE)
if (locale %in% c(locales[["locale"]], default_locales[["default_locale"]])) {
return(locale)
}

# Stop function if the `locale` provided is invalid
cli::cli_abort(c(
"The supplied `locale` is not available in the list of supported locales.",
"i" = "Use {.run [info_locales()](gt::info_locales())} to see which locales can be used."
),
call = call
)
}
)
}

#' Validate the user-supplied `currency` value
Expand Down Expand Up @@ -293,8 +293,8 @@ get_locale_range_pattern <- function(locale = NULL) {
range_pattern <- locales$range_pattern[locales$locale == locale]
validate_length_one(range_pattern)

range_pattern <- gsub("1", "2", range_pattern)
range_pattern <- gsub("0", "1", range_pattern)
range_pattern <- gsub("1", "2", range_pattern, fixed = TRUE)
range_pattern <- gsub("0", "1", range_pattern, fixed = TRUE)
range_pattern
}

Expand Down Expand Up @@ -1284,7 +1284,7 @@ create_suffix_df <- function(

suffix_fn <- if (system == "intl") num_suffix else num_suffix_ind

# Create a tibble with scaled values for `x` and the
# Create a data frame with scaled values for `x` and the
# suffix labels to use for character formatting
suffix_fn(
round(x, decimals),
Expand Down Expand Up @@ -1344,7 +1344,7 @@ num_fmt_factory <- function(
function(x) {

# Create `x_str` with the same length as `x`
x_str <- rep(NA_character_, length(x))
x_str <- rep_len(NA_character_, length(x))

# Determine which of `x` are not NA
non_na_x <- !is.na(x)
Expand Down
4 changes: 2 additions & 2 deletions R/nanoplot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1387,7 +1387,7 @@ generate_data_vals_list <- function(

} else {

data_vals_i <- dplyr::select(data_tbl, dplyr::all_of(resolved_columns))
data_vals_i <- data_tbl[resolved_columns]

data_vals_i <- as.vector(data_vals_i[i, ])

Expand Down Expand Up @@ -1419,7 +1419,7 @@ generate_data_vals_list <- function(


} else {
data_vals_j <- c(data_vals_j, unname(unlist(data_vals_i[j][[1]])))
data_vals_j <- c(data_vals_j, unlist(data_vals_i[j][[1]], use.names = FALSE))
}
}

Expand Down
3 changes: 2 additions & 1 deletion R/tab_create_modify.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1736,7 +1736,8 @@ tab_row_group <- function(

# Set the `_row_groups` vector here with the group id; new groups will
# be placed at the front, pushing down `NA` (the 'Others' group)
arrange_groups_vars <- c(id, stats::na.omit(arrange_groups_vars))
arrange_groups_vars <- arrange_groups_vars[!is.na(arrange_groups_vars)]
arrange_groups_vars <- c(id, arrange_groups_vars)
arrange_groups_vars <- unique(arrange_groups_vars)
arrange_groups_vars <- arrange_groups_vars[arrange_groups_vars %in% stub_df$group_id]

Expand Down
30 changes: 18 additions & 12 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -226,9 +226,9 @@ tf_formats <- function() {

dplyr::tribble(
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

Before, it seemed that tf_formats_icons() included NAs, not sure what the impact of all this is tbh.

Now, it is:

tf_formats_icons()
[1] "c(\"✔\", \"✘\")" "c(\"●\", \"⭘\")" "c(\"■\", \"□\")" "c(\"◆\", \"◇\")" "c(\"↑\", \"↓\")" "c(\"▲\", \"▼\")"
[7] "c(\"▶\", \"◀\")"

which seems to make sense?

Copy link
Member

Choose a reason for hiding this comment

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

Thanks for adding omit_na()! Yeah, this return value is correct now but AFAICT nothing in the package uses tf_formats_icons() (so I guess no impact).

~format_number, ~format_name, ~characters, ~idx,
"1", "true-false", NA, 1:2,
"2", "yes-no", NA, 3:4,
"3", "up-down", NA, 5:6,
"1", "true-false", NA_character_, 1:2,
"2", "yes-no", NA_character_, 3:4,
"3", "up-down", NA_character_, 5:6,
"4", "check-mark", c("\U02714", "\U02718"), NA,
"5", "circles", c("\U025CF", "\U02B58"), NA,
"6", "squares", c("\U025A0", "\U025A1"), NA,
Expand All @@ -240,7 +240,7 @@ tf_formats <- function() {
}

tf_formats_icons <- function() {
as.character(stats::na.omit(tf_formats()[, "characters"][[1]]))
as.character(omit_na(tf_formats()[, "characters"][[1]]))
}

tf_formats_text <- function() {
Expand Down Expand Up @@ -1866,9 +1866,10 @@ num_suffix <- function(
}

return(
dplyr::tibble(
scale_by = rep_len(scale_by, length(x)),
suffix = rep_len("", length(x))
vctrs::data_frame(
scale_by = scale_by,
suffix = "",
.size = length(x)
)
)
}
Expand Down Expand Up @@ -1919,7 +1920,7 @@ num_suffix <- function(

# Create and return a tibble with `scale_by`
# and `suffix` values
dplyr::tibble(
vctrs::data_frame(
scale_by = 1 / base^suffix_index,
suffix = suffix_labels
)
Expand Down Expand Up @@ -1947,9 +1948,10 @@ num_suffix_ind <- function(
}

return(
dplyr::tibble(
scale_by = rep_len(scale_by, length(x)),
suffix = rep_len("", length(x))
vctrs::data_frame(
scale_by = scale_by,
suffix = "",
.size = length(x)
)
)
}
Expand Down Expand Up @@ -2003,7 +2005,7 @@ num_suffix_ind <- function(

# Create and return a tibble with `scale_by`
# and `suffix` values
dplyr::tibble(
vctrs::data_frame(
scale_by = 10^(-ifelse(suffix_index == 0, 0, (suffix_index * 2) + 1)),
suffix = suffix_labels
)
Expand Down Expand Up @@ -2322,6 +2324,10 @@ flatten_list <- function(x) {
unlist(x, recursive = FALSE)
}

omit_na <- function(x) {
x[!is.na(x)]
}

#' Prepend a vector
#'
#' @inheritParams append
Expand Down
Loading
Loading