From 4a1c12f25b4fa2101d9ea85e65c79e2e6436b28d Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 7 Jan 2025 14:49:43 -0500 Subject: [PATCH 1/4] Minor refactoring of code. Conditions, vctrs --- R/gt_group.R | 2 +- R/render_as_i_html.R | 2 +- R/tab_options.R | 2 +- R/utils_render_grid.R | 12 ++++++------ R/utils_render_html.R | 21 +++++++++++---------- R/z_utils_render_footnotes.R | 2 +- 6 files changed, 21 insertions(+), 20 deletions(-) diff --git a/R/gt_group.R b/R/gt_group.R index 6882ba931d..df645f4c7c 100644 --- a/R/gt_group.R +++ b/R/gt_group.R @@ -796,7 +796,7 @@ grp_options <- function( dplyr::bind_rows( dplyr::inner_join( new_df, - dplyr::select(opts_df, -value), + dplyr::select(opts_df, -"value"), by = "parameter" ), dplyr::anti_join(opts_df, new_df, by = "parameter") diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index ba9a1337aa..3f1cafbaa6 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -397,7 +397,7 @@ render_as_ihtml <- function(data, id) { # for defaultExpanded = TRUE expand_groupname_col <- TRUE # modify data_tbl to include - data_tbl <- dplyr::bind_cols( + data_tbl <- vctrs::vec_cbind( data_tbl, data_tbl0[ , groupname_col, drop = FALSE] ) diff --git a/R/tab_options.R b/R/tab_options.R index 8b72a512e5..99cc07e6c6 100644 --- a/R/tab_options.R +++ b/R/tab_options.R @@ -906,7 +906,7 @@ tab_options <- function( dplyr::bind_rows( dplyr::inner_join( new_df, - dplyr::select(opts_df, -value), + dplyr::select(opts_df, -"value"), by = "parameter" ), dplyr::anti_join(opts_df, new_df, by = "parameter") diff --git a/R/utils_render_grid.R b/R/utils_render_grid.R index b033268668..f95c0af916 100644 --- a/R/utils_render_grid.R +++ b/R/utils_render_grid.R @@ -104,17 +104,17 @@ create_heading_component_g <- function(data) { title_styles <- NA_character_ if ("title" %in% styles_tbl$locname) { - title_style_rows <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "title") - if (nrow(title_style_rows) > 0) { - title_styles <- title_style_rows$html_style + title_styles <- vctrs::vec_slice(styles_tbl$html_style, styles_tbl$locname == "title") + if (length(title_styles) == 0) { + title_styles <- NA_character_ } } subtitle_styles <- NA_character_ if (subtitle_defined && "subtitle" %in% styles_tbl$locname) { - subtitle_style_rows <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "subtitle") - if (nrow(subtitle_style_rows) > 0) { - subtitle_styles <- subtitle_style_rows$html_style + subtitle_styles <- vctrs::vec_slice(styles_tbl$html_style, styles_tbl$locname == "subtitle") + if (length(subtitle_styles) == 0) { + subtitle_styles <- NA_character_ } } diff --git a/R/utils_render_html.R b/R/utils_render_html.R index a5ddc57907..5c6f976fe1 100644 --- a/R/utils_render_html.R +++ b/R/utils_render_html.R @@ -190,7 +190,7 @@ styles_to_html <- function(styles) { style <- as.character(x) } else if (all(names(x) != "")) { x <- cell_style_to_html(x) - style <- gsub(";;", ";", paste0(names(x), ": ", x, ";", collapse = " ")) + style <- gsub(";;", ";", paste0(names(x), ": ", x, ";", collapse = " "), fixed = TRUE) } else { style <- as.character(x) } @@ -417,11 +417,11 @@ create_heading_component_h <- function(data) { # Get the style attrs for the title if ("title" %in% styles_tbl$locname) { - title_style_rows <- styles_tbl[styles_tbl$locname == "title", ] - - if (nrow(title_style_rows) > 0) { - title_styles <- title_style_rows$html_style - } else { + title_styles <- vctrs::vec_slice( + styles_tbl$html_style, + styles_tbl$locname == "title" + ) + if (length(title_styles) == 0) { title_styles <- NULL } @@ -450,11 +450,12 @@ create_heading_component_h <- function(data) { # Get the style attrs for the subtitle if (subtitle_defined && "subtitle" %in% styles_tbl$locname) { - subtitle_style_rows <- styles_tbl[styles_tbl$locname == "subtitle", ] + subtitle_styles <- vctrs::vec_slice( + styles_tbl$html_style, + styles_tbl$locname == "subtitle" + ) - if (nrow(subtitle_style_rows) > 0) { - subtitle_styles <- subtitle_style_rows$html_style - } else { + if (length(subtitle_styles) == 0) { subtitle_styles <- NULL } diff --git a/R/z_utils_render_footnotes.R b/R/z_utils_render_footnotes.R index 4f63aa4b29..d982e1ea2e 100644 --- a/R/z_utils_render_footnotes.R +++ b/R/z_utils_render_footnotes.R @@ -236,7 +236,7 @@ resolve_footnotes_styles <- function(data, tbl_type) { # Re-combine `tbl_not_column_cells` # with `tbl_column_cells` tbl <- - dplyr::bind_rows( + vctrs::vec_rbind( tbl_not_column_cells, tbl_column_cells ) From a10206799ae33392b0922274cb2496a07cce3f2d Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 7 Jan 2025 15:05:08 -0500 Subject: [PATCH 2/4] Improve coverage action speed --- .github/workflows/test-coverage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 988226098e..b59df5f0ab 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -25,7 +25,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr, any::xml2 + extra-packages: r-lib/covr, any::xml2 needs: coverage - name: Test coverage From b387f34086f79cede2ef096d40d68c363b79c563 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 7 Jan 2025 16:13:52 -0500 Subject: [PATCH 3/4] conditions updates --- R/compile_scss.R | 2 +- R/dt_heading.R | 2 +- R/dt_stub_df.R | 1 - R/dt_summary.R | 9 ++------- R/fmt.R | 10 +++++----- R/resolver.R | 22 +++++++++++----------- R/summary_rows.R | 7 +------ R/tab_options.R | 11 ++--------- R/utils_render_latex.R | 19 ++++++++----------- R/zzz.R | 4 ++-- tests/testthat/test-as_latex.R | 2 +- tests/testthat/test-color_handling.R | 16 ++++++---------- 12 files changed, 40 insertions(+), 65 deletions(-) diff --git a/R/compile_scss.R b/R/compile_scss.R index 28db93b947..c1824480fc 100644 --- a/R/compile_scss.R +++ b/R/compile_scss.R @@ -51,7 +51,7 @@ compile_scss <- function(data, id = NULL) { additional_css <- dt_options_get_value(data = data, option = "table_additional_css") # Determine if there are any additional CSS statements - has_additional_css <- any(nchar(additional_css) > 0) + has_additional_css <- any(nzchar(additional_css)) # Combine any additional CSS statements and separate with `\n` if (has_additional_css) { diff --git a/R/dt_heading.R b/R/dt_heading.R index 1f7395a143..6aaf45d662 100644 --- a/R/dt_heading.R +++ b/R/dt_heading.R @@ -67,7 +67,7 @@ dt_heading_has_title <- function(data) { heading <- dt_heading_get(data = data) - length(heading) > 0 && !is.null(heading$title) && length(heading$title) > 0 + length(heading) > 0 && length(heading$title) > 0 } dt_heading_has_subtitle <- function(data) { diff --git a/R/dt_stub_df.R b/R/dt_stub_df.R index 9ae15900f2..866aa78425 100644 --- a/R/dt_stub_df.R +++ b/R/dt_stub_df.R @@ -79,7 +79,6 @@ dt_stub_df_init <- function( # Handle column of data specified as the `groupname_col` # if ( - !is.null(groupname_col) && length(groupname_col) > 0L && all(groupname_col %in% colnames(data_tbl)) ) { diff --git a/R/dt_summary.R b/R/dt_summary.R index a9434dae9f..cac9ae3330 100644 --- a/R/dt_summary.R +++ b/R/dt_summary.R @@ -131,18 +131,13 @@ dt_summary_build <- function(data, context) { groups <- unique(stub_df$group_id) - } else if ( - !is.null(groups) && - is.character(groups) && - length(groups) == 1 && - groups == ":GRAND_SUMMARY:" - ) { + } else if (is_string(groups, ":GRAND_SUMMARY:")) { # If groups is given as ":GRAND_SUMMARY:" then use a # special group (`::GRAND_SUMMARY`) groups <- grand_summary_col - } else if (!is.null(groups) && is.character(groups)) { + } else if (is.character(groups)) { assert_rowgroups() diff --git a/R/fmt.R b/R/fmt.R index fd85ee2ff8..2c9c6e6ad9 100644 --- a/R/fmt.R +++ b/R/fmt.R @@ -184,7 +184,7 @@ validate_locale <- function(locale, call = rlang::caller_env()) { 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.", @@ -252,7 +252,7 @@ get_locale_sep_mark <- function( # Get the correct `group_sep` value from the `gt:::locales` lookup table sep_mark <- locales$group[locales$locale == locale] - validate_length_one(sep_mark) + validate_length_one(sep_mark, "sep_mark") # Replace any `""` or "\u00a0" with `" "` since an empty string actually # signifies a space character, and, we want to normalize to a simple space if (sep_mark == "" || sep_mark == "\u00a0") sep_mark <- " " @@ -291,7 +291,7 @@ get_locale_range_pattern <- function(locale = NULL) { # Get the correct `range_pattern` value from the `gt:::locales` lookup table range_pattern <- locales$range_pattern[locales$locale == locale] - validate_length_one(range_pattern) + validate_length_one(range_pattern, "range_pattern") range_pattern <- gsub("1", "2", range_pattern, fixed = TRUE) range_pattern <- gsub("0", "1", range_pattern, fixed = TRUE) @@ -332,7 +332,7 @@ get_locale_idx_set <- function(locale = NULL) { } val <- locales$chr_index[locales$locale == locale] - validate_length_one(val) + validate_length_one(val, "locale") val } @@ -388,7 +388,7 @@ get_locale_no_table_data_text <- function(locale = NULL) { # Get the correct `no_table_data_text` value from the # `gt:::locales` lookup table val <- locales$no_table_data_text[locales$locale == locale] - validate_length_one(val) + validate_length_one(val, "locale") val } diff --git a/R/resolver.R b/R/resolver.R index 3f9905ba9e..ef8b485362 100644 --- a/R/resolver.R +++ b/R/resolver.R @@ -153,13 +153,13 @@ resolve_cells_column_spanners <- function( spanners <- dt_spanners_get(data = data) - levels <- attr(object,"spanner_levels") + levels <- attr(object, "spanner_levels") - if(!is.null(levels)){ + if (!is.null(levels)) { # check if there are wrong level expectations in the argument # must be numeric - if(!all(suppressWarnings(!is.na(as.numeric(levels))))){ + if (!all(suppressWarnings(!is.na(as.numeric(levels))))) { cli::cli_warn(c( "All values of vector `levels` must be numeric.", "!" = "Please check wrong element{?/s}: [{levels[suppressWarnings(is.na(as.numeric(levels)))]}]." @@ -170,7 +170,7 @@ resolve_cells_column_spanners <- function( # must actually exist wrong_levels <- setdiff(levels, unique(spanners$spanner_level)) - if(length(wrong_levels) > 0){ + if (length(wrong_levels) > 0) { cli::cli_warn(c( "All values of vector `levels` must exist in spanner definition.", "i" = "currently only the following level{?s} {?is/are} available: [{as.character(unique(spanners$spanner_level))}].", @@ -261,9 +261,9 @@ resolve_cols_c <- function( ret <- names(dt_data_get(data)) return(ret) } - + null_means <- rlang::arg_match0(null_means, c("everything", "nothing")) - + names( resolve_cols_i( expr = {{ expr }}, @@ -520,11 +520,11 @@ resolve_rows_i <- function( call = call ) - if (!is.null(resolved_rows)) { - return(which(resolved_rows)) - } else { + if (is.null(resolved_rows)) { return(NULL) } + + which(resolved_rows) } resolve_vector_l <- function( @@ -601,7 +601,7 @@ resolve_groups <- function(expr, vector) { resolved <- NULL } - if (length(resolved) < 1) { + if (length(resolved) == 0) { # Error if groups = everything() and no row groups. Return NULL otherwise. input <- tryCatch(rlang::as_label(quo), error = NULL) if (identical(input, "everything()")) { @@ -624,7 +624,7 @@ resolve_groups <- function(expr, vector) { resolved <- base::intersect(resolved, vector) - if (length(resolved) < 1) { + if (length(resolved) == 0) { return(NULL) } diff --git a/R/summary_rows.R b/R/summary_rows.R index 28ec420666..505c7e0c01 100644 --- a/R/summary_rows.R +++ b/R/summary_rows.R @@ -443,12 +443,7 @@ summary_rows <- function( data$`_data` <- dplyr::mutate( data$`_data`, - !!rowname_col_private := rep("", nrow(data$`_data`)) - ) - data$`_data` <- - dplyr::relocate( - data$`_data`, - dplyr::all_of(rowname_col_private), + !!rowname_col_private := rep("", nrow(data$`_data`)), .after = dplyr::last_col() ) diff --git a/R/tab_options.R b/R/tab_options.R index 99cc07e6c6..5f7be74265 100644 --- a/R/tab_options.R +++ b/R/tab_options.R @@ -946,9 +946,7 @@ tab_options <- function( dt_options_get_default_value <- function(option) { # Validate the provided `option` value - if (length(option) != 1) { - cli::cli_abort("A character vector of length one must be provided.") - } + check_string(option) if (!(option %in% dt_options_tbl$parameter)) { cli::cli_abort("The `option` provided is invalid.") } @@ -1046,12 +1044,7 @@ set_super_options <- function(arg_vals) { if ("ihtml.selection_mode" %in% names(arg_vals)) { ihtml_selection_mode_val <- arg_vals$ihtml.selection_mode - if ( - !( - rlang::is_scalar_character(ihtml_selection_mode_val) && - ihtml_selection_mode_val %in% c("single", "multiple") - ) - ) { + if (!rlang::is_string(ihtml_selection_mode_val, c("single", "multiple"))) { cli::cli_abort(c( "The chosen option for `ihtml.selection_mode` (`{ihtml_selection_mode_val}`) is invalid.", "*" = "We can use either \"single\" or \"multiple\"." diff --git a/R/utils_render_latex.R b/R/utils_render_latex.R index 932c5f356d..514f0075e7 100644 --- a/R/utils_render_latex.R +++ b/R/utils_render_latex.R @@ -46,10 +46,7 @@ footnote_mark_to_latex <- function( } spec <- get_footnote_spec_by_location(data = data, location = location) - - if (is.null(spec)) { - spec <- "^i" - } + spec <- spec %||% "^i" if (grepl(".", spec, fixed = TRUE)) mark <- sprintf_unless_na("%s.", mark) if (grepl("b", spec, fixed = TRUE)) mark <- sprintf_unless_na("\\textbf{%s}", mark) @@ -156,10 +153,10 @@ create_table_start_l <- function(data, colwidth_df) { if ("group_label" %in% stub_layout) { types <- c(types, "row_group") } - + colwidth_df_visible <- colwidth_df[colwidth_df$type %in% types, ] - - # Ensure that the `colwidth_df_visible` df rows are sorted such that the + + # Ensure that the `colwidth_df_visible` df rows are sorted such that the # `"row_group"` row is first (only if it's located in the stub), then `"stub"`, # and then everything else if ("stub" %in% colwidth_df_visible[["type"]]) { @@ -167,7 +164,7 @@ create_table_start_l <- function(data, colwidth_df) { othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), stub_idx) colwidth_df_visible <- vctrs::vec_slice(colwidth_df_visible, c(stub_idx, othr_idx)) } - + if ("row_group" %in% colwidth_df_visible[["type"]]) { row_group_idx <- which(colwidth_df_visible$type == "row_group") othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), row_group_idx) @@ -200,7 +197,7 @@ create_table_start_l <- function(data, colwidth_df) { col_defs <- NULL for (i in seq_len(nrow(colwidth_df_visible))) { - + if (colwidth_df_visible$unspec[i] == 1L) { col_defs_i <- substr(colwidth_df_visible$column_align[i], 1, 1) } else { @@ -228,7 +225,7 @@ create_table_start_l <- function(data, colwidth_df) { } } else { - + col_defs <- substr(colwidth_df_visible$column_align, 1, 1) } @@ -1710,7 +1707,7 @@ create_colwidth_df_l <- function(data) { pt = rep.int(0L, n), column_align = boxhead$column_align ) - + width_df$column_align[width_df$type %in% c("stub", "row_group")] <- "left" for (i in 1:n) { diff --git a/R/zzz.R b/R/zzz.R index b37a0fce8d..70b48bb93f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -138,7 +138,7 @@ utils::globalVariables( #' #' **gt** uses the following [options()] to configure behavior: #' -#' - `gt.locale`: A [locale][info_locales()] to yse by default in +#' - `gt.locale`: A [locale][info_locales()] to use by default in #' the [gt()] function. #' - `gt.row_group.sep`: A separator between groups for the row group label. By #' default this is `" - "`. @@ -151,7 +151,7 @@ utils::globalVariables( #' - `gt.latex_packages`: A vector of LaTeX package names to use when generating #' tables in the LaTeX output context. The set of packages loaded is controlled #' by this default vector: -#' `c("booktabs", "caption", "longtable", "colortbl", "array")`. +#' `c("booktabs", "caption", "longtable", "colortbl", "array", "anyfontsize", "multirow")`. #' #' @keywords internal #' @name gt-options diff --git a/tests/testthat/test-as_latex.R b/tests/testthat/test-as_latex.R index c417019b6e..eedd6601ac 100644 --- a/tests/testthat/test-as_latex.R +++ b/tests/testthat/test-as_latex.R @@ -179,7 +179,7 @@ test_that("Table styles correctly applied for tabular*", { tab_style(style = cell_text(transform = "uppercase"), locations = cells_column_labels(columns = c("num", "fctr", "datetime"))) %>% tab_style(style = gt::cell_text(style = "italic"), - locations = cells_column_spanners(spanner = "a1")) %>% + locations = cells_column_spanners(spanners = "a1")) %>% # Body styles tab_style(style = cell_text(size = 20, diff --git a/tests/testthat/test-color_handling.R b/tests/testthat/test-color_handling.R index f6cff83e41..170869fae6 100644 --- a/tests/testthat/test-color_handling.R +++ b/tests/testthat/test-color_handling.R @@ -663,37 +663,33 @@ test_that("cell_fill() accepts colors of various types", { # Expect that using shorthand hexadecimal color values will result in the # same table output as with using standard hexadecimal colors - expect_equal( + expect_equal_gt( test_tbl %>% gt() %>% tab_style( style = cell_text(color = "#888"), locations = cells_body(columns = "month") - ) %>% - render_as_html(), + ), test_tbl %>% gt() %>% tab_style( style = cell_text(color = "#888888"), locations = cells_body(columns = "month") - ) %>% - render_as_html() + ) ) - expect_equal( + expect_equal_gt( test_tbl %>% gt() %>% tab_style( style = cell_text(color = "#888A"), locations = cells_body(columns = "month") - ) %>% - render_as_html(), + ), test_tbl %>% gt() %>% tab_style( style = cell_text(color = "#888888AA"), locations = cells_body(columns = "month") - ) %>% - render_as_html() + ) ) }) From df7519839bcacc2133df320ec73274e33d4cef4a Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 7 Jan 2025 16:26:04 -0500 Subject: [PATCH 4/4] Redoc --- man/gt-options.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/gt-options.Rd b/man/gt-options.Rd index 6aeb6d7f21..818b02c19c 100644 --- a/man/gt-options.Rd +++ b/man/gt-options.Rd @@ -11,7 +11,7 @@ \strong{gt} uses the following \code{\link[=options]{options()}} to configure behavior: \itemize{ -\item \code{gt.locale}: A \link[=info_locales]{locale} to yse by default in +\item \code{gt.locale}: A \link[=info_locales]{locale} to use by default in the \code{\link[=gt]{gt()}} function. \item \code{gt.row_group.sep}: A separator between groups for the row group label. By default this is \code{" - "}. @@ -24,7 +24,7 @@ incompatible with the function. This is \code{FALSE} by default. \item \code{gt.latex_packages}: A vector of LaTeX package names to use when generating tables in the LaTeX output context. The set of packages loaded is controlled by this default vector: -\code{c("booktabs", "caption", "longtable", "colortbl", "array")}. +\code{c("booktabs", "caption", "longtable", "colortbl", "array", "anyfontsize", "multirow")}. } }