From cc3d36bf89d4adae9b41bd8169a0ce16fbc42135 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 29 Nov 2024 09:35:47 -0500 Subject: [PATCH 1/6] Several code refactor and take advantage of dplyr 1.1 --- DESCRIPTION | 2 +- R/get_agent_report.R | 10 +- R/get_informant_report.R | 2 +- R/incorporate.R | 4 +- R/interrogate.R | 17 +-- R/remove_deactivate.R | 2 +- R/scan_data.R | 8 +- R/steps_and_briefs.R | 1 + R/utils-profiling.R | 8 +- R/utils-specifications.R | 134 +++++++++--------- .../test-incorporate_with_informant.R | 2 +- 11 files changed, 93 insertions(+), 97 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f8c99062f..5f2c097a7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,7 @@ Imports: cli (>= 3.6.0), DBI (>= 1.1.0), digest (>= 0.6.27), - dplyr (>= 1.0.10), + dplyr (>= 1.1.0), dbplyr (>= 2.3.0), fs (>= 1.6.0), glue (>= 1.6.2), diff --git a/R/get_agent_report.R b/R/get_agent_report.R index 984342da0..5306484c7 100644 --- a/R/get_agent_report.R +++ b/R/get_agent_report.R @@ -1612,7 +1612,7 @@ get_agent_report <- function( n_pass, f_pass, n_fail, f_fail, W, S, N, extract, W_val, S_val, N_val, eval, active ) %>% - gt::gt(id = "pb_agent") %>% + gt::gt(id = "pb_agent", locale = locale) %>% gt::tab_header( title = title_text, subtitle = gt::md(combined_subtitle) @@ -1666,15 +1666,13 @@ get_agent_report <- function( align = "right", columns = "i" ) %>% - gt::fmt_number( + gt::fmt_integer( columns = c("units", "n_pass", "n_fail", "f_pass", "f_fail"), - decimals = 0, drop_trailing_zeros = TRUE, suffixing = TRUE, - locale = locale + drop_trailing_zeros = TRUE, suffixing = TRUE ) %>% gt::fmt_number( columns = c("f_pass", "f_fail"), - decimals = 2, - locale = locale + decimals = 2 ) %>% gt::fmt_markdown( columns = c( diff --git a/R/get_informant_report.R b/R/get_informant_report.R index e46273fdf..f787e65f5 100644 --- a/R/get_informant_report.R +++ b/R/get_informant_report.R @@ -359,7 +359,7 @@ get_informant_report <- function( gsub("(\\(|\\)|\\[|\\]|\\||\\.|\\^|\\?|\\+|\\$|\\*)", "\\\\\\1", .) row_idx <- - which(grepl(paste0("^", column_escaped, "<.*?"), tbl$item)) + grep(paste0("^", column_escaped, "<.*?"), tbl$item) if (length(miniheader_vec) > 0) { tbl$item[[row_idx]] <- diff --git a/R/incorporate.R b/R/incorporate.R index 78fc5d16a..e2e4f12a2 100644 --- a/R/incorporate.R +++ b/R/incorporate.R @@ -283,10 +283,10 @@ incorporate <- function(informant) { # of the `lang` value (from `NULL` to the informant `lang`) select_call_idx <- - which(grepl("select", snippet_f_rhs_str)) + grep("select", snippet_f_rhs_str) pb_str_catalog_call_idx <- - which(grepl("pb_str_catalog", snippet_f_rhs_str)) + grep("pb_str_catalog", snippet_f_rhs_str) snippet_f_rhs_str[pb_str_catalog_call_idx] <- gsub( diff --git a/R/interrogate.R b/R/interrogate.R index 71dc71b3d..181a1adc4 100644 --- a/R/interrogate.R +++ b/R/interrogate.R @@ -339,8 +339,8 @@ interrogate <- function( if (any_1_unit && any_n_unit) { - col_is_idx <- which(grepl("col_is|col_exists", validation_fns)) - col_vals_idx <- which(grepl("col_vals", validation_fns)) + col_is_idx <- grep("col_is|col_exists", validation_fns) + col_vals_idx <- grep("col_vals", validation_fns) validation_formulas <- c( @@ -427,10 +427,7 @@ interrogate <- function( tbl_checked %>% dplyr::mutate(pb_is_good_ = !!rlang::parse_expr(columns_str_add)) %>% dplyr::select(-dplyr::all_of(columns_str_vec)) %>% - dplyr::mutate(pb_is_good_ = dplyr::case_when( - pb_is_good_ == validation_n ~ TRUE, - TRUE ~ FALSE - )) + dplyr::mutate(pb_is_good_ = pb_is_good_ == validation_n) } # Perform rowwise validations for the column @@ -1158,7 +1155,7 @@ tbl_val_comparison <- function( table %>% dplyr::mutate(pb_is_good_ = dplyr::case_when( !!expression ~ 1, - TRUE ~ 0 + .default = 0 )) } else { @@ -1167,7 +1164,7 @@ tbl_val_comparison <- function( dplyr::mutate(pb_is_good_ = !!expression) %>% dplyr::mutate(pb_is_good_ = dplyr::case_when( is.na(pb_is_good_) ~ na_pass, - TRUE ~ pb_is_good_ + .default = pb_is_good_ )) } } @@ -1363,7 +1360,7 @@ tbl_vals_between <- function( table %>% dplyr::mutate(pb_is_good_ = dplyr::case_when( is.na({{ column }}) ~ na_pass_bool, - TRUE ~ pb_is_good_ + .default = pb_is_good_ )) } @@ -2031,7 +2028,7 @@ interrogate_within_spec <- function( check_vin_db(table, column = {{ column }}) %>% dplyr::mutate(pb_is_good_ = dplyr::case_when( is.na(pb_is_good_) ~ na_pass, - TRUE ~ pb_is_good_ + .default = pb_is_good_ )) } diff --git a/R/remove_deactivate.R b/R/remove_deactivate.R index 39a62f140..a4be7f995 100644 --- a/R/remove_deactivate.R +++ b/R/remove_deactivate.R @@ -269,7 +269,7 @@ remove_steps <- function( # Renumber steps agent$validation_set$i <- - as.integer(seq(from = 1, to = nrow(agent$validation_set), by = 1)) + seq.int(from = 1L, to = nrow(agent$validation_set), by = 1L) # Remove any data extracts agent$extracts <- NULL diff --git a/R/scan_data.R b/R/scan_data.R index 8e05e3346..2411e20b1 100644 --- a/R/scan_data.R +++ b/R/scan_data.R @@ -1421,9 +1421,11 @@ get_corr_plot <- function( corr_df <- as.data.frame(as.table(mat)) %>% - dplyr::mutate(Freq = ifelse(Var1 == Var2, NA_real_, Freq)) %>% - dplyr::mutate(Var1 = factor(Var1, levels = names(labels_vec))) %>% - dplyr::mutate(Var2 = factor(Var2, levels = rev(names(labels_vec)))) + dplyr::mutate( + Freq = ifelse(Var1 == Var2, NA_real_, Freq), + Var1 = factor(Var1, levels = names(labels_vec)), + Var2 = factor(Var2, levels = rev(names(labels_vec))) + ) plot_missing <- corr_df %>% diff --git a/R/steps_and_briefs.R b/R/steps_and_briefs.R index fd8cbb6a3..a0dfe5387 100644 --- a/R/steps_and_briefs.R +++ b/R/steps_and_briefs.R @@ -159,6 +159,7 @@ hash_validation_step <- function(assertion_type, seg_val = as.character(seg_val %||% NA_character_) ) + # Maybe consider replacing with rlang::hash? step_hash <- digest::sha1(step_chr) paste(step_hash, hash_version, sep = "-") diff --git a/R/utils-profiling.R b/R/utils-profiling.R index c805b363f..7a49b560b 100644 --- a/R/utils-profiling.R +++ b/R/utils-profiling.R @@ -423,8 +423,10 @@ get_tbl_dbi_missing_tbl <- function(data) { frequency_list %>% dplyr::bind_rows() %>% - dplyr::mutate(value = ifelse(value == 0, NA_real_, value)) %>% - dplyr::mutate(col_name = factor(col_name, levels = colnames(data))) + dplyr::mutate( + value = ifelse(value == 0, NA_real_, value), + col_name = factor(col_name, levels = colnames(data)) + ) } # nocov start @@ -484,7 +486,7 @@ get_tbl_df_missing_tbl <- function(data) { rowid < cuts_[18] ~ 18L, rowid < cuts_[19] ~ 19L, rowid < cuts_[20] ~ 20L, - TRUE ~ 20L + .default = 20L )) data <- dplyr::select(data, -rowid) data <- dplyr::group_by(data, `::cut_group::`) diff --git a/R/utils-specifications.R b/R/utils-specifications.R index 354a6d7a3..27f070b31 100644 --- a/R/utils-specifications.R +++ b/R/utils-specifications.R @@ -276,88 +276,84 @@ check_vin_db <- function(table, table <- table %>% - dplyr::mutate(pb_vin_all_ = {{ column }}) %>% - dplyr::mutate(pb_vin_all_ = tolower(as.character((pb_vin_all_)))) %>% - dplyr::mutate(pb_vin_nch_ = ifelse(nchar(pb_vin_all_) == 17, TRUE, FALSE)) %>% - dplyr::mutate(pb_vin_001_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 1, 1), "8")) %>% - dplyr::mutate(pb_vin_002_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 2, 2), "8")) %>% - dplyr::mutate(pb_vin_003_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 3, 3), "8")) %>% - dplyr::mutate(pb_vin_004_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 4, 4), "8")) %>% - dplyr::mutate(pb_vin_005_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 5, 5), "8")) %>% - dplyr::mutate(pb_vin_006_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 6, 6), "8")) %>% - dplyr::mutate(pb_vin_007_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 7, 7), "8")) %>% - dplyr::mutate(pb_vin_008_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 8, 8), "8")) %>% - dplyr::mutate(pb_vin_009_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 9, 9), "8")) %>% - dplyr::mutate(pb_vin_010_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 10, 10), "8")) %>% - dplyr::mutate(pb_vin_011_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 11, 11), "8")) %>% - dplyr::mutate(pb_vin_012_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 12, 12), "8")) %>% - dplyr::mutate(pb_vin_013_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 13, 13), "8")) %>% - dplyr::mutate(pb_vin_014_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 14, 14), "8")) %>% - dplyr::mutate(pb_vin_015_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 15, 15), "8")) %>% - dplyr::mutate(pb_vin_016_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 16, 16), "8")) %>% - dplyr::mutate(pb_vin_017_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 17, 17), "8")) %>% - dplyr::mutate_at( - dplyr::vars(dplyr::matches("pb_vin_[0-9]{3}_")), - .funs = list(~ case_when( - . %in% c("a", "j") ~ "1", - . %in% c("b", "k", "s") ~ "2", - . %in% c("c", "l", "t") ~ "3", - . %in% c("d", "m", "u") ~ "4", - . %in% c("e", "n", "v") ~ "5", - . %in% c("f", "w") ~ "6", - . %in% c("g", "p", "x") ~ "7", - . %in% c("h", "y") ~ "8", - . %in% c("r", "z") ~ "9", - !(. %in% c("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")) ~ "100000", - TRUE ~ . - ) - )) %>% - dplyr::mutate(pb_vin_chk_ = pb_vin_009_) %>% - dplyr::mutate_at( - dplyr::vars(dplyr::matches("pb_vin_[0-9]{3}_")), - .funs = as.integer - ) %>% - dplyr::mutate(pb_vin_001_w = pb_vin_001_ * 8L) %>% - dplyr::mutate(pb_vin_002_w = pb_vin_002_ * 7L) %>% - dplyr::mutate(pb_vin_003_w = pb_vin_003_ * 6L) %>% - dplyr::mutate(pb_vin_004_w = pb_vin_004_ * 5L) %>% - dplyr::mutate(pb_vin_005_w = pb_vin_005_ * 4L) %>% - dplyr::mutate(pb_vin_006_w = pb_vin_006_ * 3L) %>% - dplyr::mutate(pb_vin_007_w = pb_vin_007_ * 2L) %>% - dplyr::mutate(pb_vin_008_w = pb_vin_008_ * 10L) %>% - dplyr::mutate(pb_vin_009_w = pb_vin_009_ * 0L) %>% - dplyr::mutate(pb_vin_010_w = pb_vin_010_ * 9L) %>% - dplyr::mutate(pb_vin_011_w = pb_vin_011_ * 8L) %>% - dplyr::mutate(pb_vin_012_w = pb_vin_012_ * 7L) %>% - dplyr::mutate(pb_vin_013_w = pb_vin_013_ * 6L) %>% - dplyr::mutate(pb_vin_014_w = pb_vin_014_ * 5L) %>% - dplyr::mutate(pb_vin_015_w = pb_vin_015_ * 4L) %>% - dplyr::mutate(pb_vin_016_w = pb_vin_016_ * 3L) %>% - dplyr::mutate(pb_vin_017_w = pb_vin_017_ * 2L) %>% dplyr::mutate( + pb_vin_all_ = {{ column }}, + pb_vin_all_ = tolower(as.character((pb_vin_all_))), + pb_vin_nch_ = nchar(pb_vin_all_) == 17, + pb_vin_001_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 1, 1), "8"), + pb_vin_002_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 2, 2), "8"), + pb_vin_003_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 3, 3), "8"), + pb_vin_004_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 4, 4), "8"), + pb_vin_005_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 5, 5), "8"), + pb_vin_006_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 6, 6), "8"), + pb_vin_007_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 7, 7), "8"), + pb_vin_008_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 8, 8), "8"), + pb_vin_009_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 9, 9), "8"), + pb_vin_010_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 10, 10), "8"), + pb_vin_011_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 11, 11), "8"), + pb_vin_012_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 12, 12), "8"), + pb_vin_013_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 13, 13), "8"), + pb_vin_014_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 14, 14), "8"), + pb_vin_015_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 15, 15), "8"), + pb_vin_016_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 16, 16), "8"), + pb_vin_017_ = ifelse(pb_vin_nch_, substr(pb_vin_all_, 17, 17), "8"), + dplyr::across( + .cols = dplyr::matches("pb_vin_[0-9]{3}_"), + function(x) { + dplyr::case_match(x, + c("a", "j") ~ "1", + c("b", "k", "s") ~ "2", + c("c", "l", "t") ~ "3", + c("d", "m", "u") ~ "4", + c("e", "n", "v") ~ "5", + c("f", "w") ~ "6", + c("g", "p", "x") ~ "7", + c("h", "y") ~ "8", + c("r", "z") ~ "9", + c("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") ~ "100000", + .default = x + ) + }), + pb_vin_chk_ = pb_vin_009_, + dplyr::across(dplyr::matches("pb_vin_[0-9]{3}_"), as.integer), + pb_vin_001_w = pb_vin_001_ * 8L, + pb_vin_002_w = pb_vin_002_ * 7L, + pb_vin_003_w = pb_vin_003_ * 6L, + pb_vin_004_w = pb_vin_004_ * 5L, + pb_vin_005_w = pb_vin_005_ * 4L, + pb_vin_006_w = pb_vin_006_ * 3L, + pb_vin_007_w = pb_vin_007_ * 2L, + pb_vin_008_w = pb_vin_008_ * 10L, + pb_vin_009_w = pb_vin_009_ * 0L, + pb_vin_010_w = pb_vin_010_ * 9L, + pb_vin_011_w = pb_vin_011_ * 8L, + pb_vin_012_w = pb_vin_012_ * 7L, + pb_vin_013_w = pb_vin_013_ * 6L, + pb_vin_014_w = pb_vin_014_ * 5L, + pb_vin_015_w = pb_vin_015_ * 4L, + pb_vin_016_w = pb_vin_016_ * 3L, + pb_vin_017_w = pb_vin_017_ * 2L, pb_vin_sum_uw = pb_vin_001_ + pb_vin_002_ + pb_vin_003_ + pb_vin_004_ + pb_vin_005_ + pb_vin_006_ + pb_vin_007_ + pb_vin_008_ + pb_vin_009_ + pb_vin_010_ + pb_vin_011_ + pb_vin_012_ + pb_vin_013_ + pb_vin_014_ + pb_vin_015_ + pb_vin_016_ + - pb_vin_017_ - ) %>% - dplyr::mutate( + pb_vin_017_, pb_vin_sum_ = pb_vin_001_w + pb_vin_002_w + pb_vin_003_w + pb_vin_004_w + pb_vin_005_w + pb_vin_006_w + pb_vin_007_w + pb_vin_008_w + pb_vin_009_w + pb_vin_010_w + pb_vin_011_w + pb_vin_012_w + pb_vin_013_w + pb_vin_014_w + pb_vin_015_w + pb_vin_016_w + - pb_vin_017_w - ) %>% - dplyr::mutate(pb_vin_mod_ = as.character(pb_vin_sum_ %% 11L)) %>% - dplyr::mutate(pb_vin_mod_ = ifelse(pb_vin_mod_ == "10", "x", pb_vin_mod_)) %>% - dplyr::mutate(pb_is_good_ = pb_vin_mod_ == pb_vin_chk_) %>% - dplyr::mutate(pb_is_good_ = ifelse(!pb_vin_nch_, FALSE, pb_vin_nch_)) %>% - dplyr::mutate(pb_is_good_ = ifelse(pb_vin_sum_uw >= 100000, FALSE, pb_is_good_)) + pb_vin_017_w, + pb_vin_mod_ = as.character(pb_vin_sum_ %% 11L), + pb_vin_mod_ = ifelse(pb_vin_mod_ == "10", "x", pb_vin_mod_), + pb_is_good_ = pb_vin_mod_ == pb_vin_chk_, + pb_is_good_ = ifelse(!pb_vin_nch_, FALSE, pb_vin_nch_), + pb_is_good_ = ifelse(pb_vin_sum_uw >= 100000, FALSE, pb_is_good_) + ) table <- - table %>% dplyr::select(c(tbl_colnames, "pb_is_good_")) + table %>% dplyr::select(dplyr::all_of(c(tbl_colnames, "pb_is_good_"))) table } diff --git a/tests/testthat/test-incorporate_with_informant.R b/tests/testthat/test-incorporate_with_informant.R index ca1485728..7cbf2638f 100644 --- a/tests/testthat/test-incorporate_with_informant.R +++ b/tests/testthat/test-incorporate_with_informant.R @@ -191,7 +191,7 @@ test_that("Incorporating an informant from YAML yields the correct results", { # Modify the `read_fn` in the YAML file to read in a slightly altered table yaml_file_lines <- readLines("informant-test_table.yml") - read_fn_line <- which(grepl("tbl:", yaml_file_lines)) + read_fn_line <- grep("tbl:", yaml_file_lines) yaml_file_lines[read_fn_line] <- yaml_file_lines[read_fn_line] %>% From 3976b6fd4f7d583c82fc64bbbd884385060f99d2 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 29 Nov 2024 09:36:04 -0500 Subject: [PATCH 2/6] Strip trailing WS --- scripts/translation-utils.R | 122 ++++++++++++++++++------------------ 1 file changed, 61 insertions(+), 61 deletions(-) diff --git a/scripts/translation-utils.R b/scripts/translation-utils.R index 01b5bcda6..e3ecf4e53 100644 --- a/scripts/translation-utils.R +++ b/scripts/translation-utils.R @@ -2,32 +2,32 @@ get_r_files_with_exports <- function(pkg_root = ".") { path_resolved <- fs::as_fs_path(path.expand(paste0(pkg_root, "/R"))) - + # Get a list of paths for all .R files in the R dir - r_files <- + r_files <- list.files( path = path_resolved, pattern = ".R$", full.names = TRUE ) - + has_exports <- rep(FALSE, length(r_files)) - + # Subset this to only those files that contain roxygen2 @export tags for (i in seq_along(r_files)) { - + lines <- readLines(r_files[i]) - + has_exports[i] <- any(grepl("^#' @export", lines)) } - + r_files[has_exports] } get_documentation_tbl <- function(pkg_root = ".") { - + r_files <- get_r_files_with_exports(pkg_root = pkg_root) - + docs_tbl <- dplyr::tibble( file = character(0), @@ -39,32 +39,32 @@ get_documentation_tbl <- function(pkg_root = ".") { has_export = logical(0), has_no_rd = logical(0) ) - + for (i in seq_along(r_files)) { - + lines <- readLines(r_files[i]) - + are_roxygen_lines <- grepl("^#'", lines) - + rle_lines <- rle(are_roxygen_lines) - + rle_lengths <- rle_lines$lengths rle_values <- rle_lines$values cumsum_lengths <- cumsum(rle_lines$lengths) - + change_idx <- c(1, (cumsum_lengths + 1)) change_idx <- change_idx[-length(change_idx)] roxygen_start_idx <- change_idx[rle_values] roxygen_end_idx <- roxygen_start_idx + rle_lengths[rle_values] - 1 - + rd_name <- rep(NA_character_, length(roxygen_start_idx)) has_name <- has_export <- has_no_rd <- rep(NA, length(roxygen_start_idx)) - + for (j in seq_along(roxygen_start_idx)) { - + roxygen_part <- lines[roxygen_start_idx[j]:roxygen_end_idx[j]] line_n <- length(roxygen_part) - + # Check for @name directive if (any(grepl("^#' @name", roxygen_part))) { has_name[j] <- TRUE @@ -72,28 +72,28 @@ get_documentation_tbl <- function(pkg_root = ".") { } else { has_name[j] <- FALSE } - + # Check for @export directive if (any(grepl("^#' @export", roxygen_part))) { has_export[j] <- TRUE rd_name[j] <- gsub(" <-.*$", "", lines[roxygen_end_idx[j] + 1]) } else { - + has_export[j] <- FALSE - + # Handle `datasets.R` specially if (grepl("datasets.R", r_files[i])) { rd_name[j] <- gsub("\"", "", lines[roxygen_end_idx[j] + 1]) } } - + # Check for @noRd directive if (any(grepl("^#' @noRd", roxygen_part))) { has_no_rd[j] <- TRUE } else { has_no_rd[j] <- FALSE } - + docs_tbl_row <- dplyr::tibble( file = r_files[i], @@ -105,7 +105,7 @@ get_documentation_tbl <- function(pkg_root = ".") { has_export = has_export[j], has_no_rd = has_no_rd[j] ) - + docs_tbl <- dplyr::bind_rows(docs_tbl, docs_tbl_row) } } @@ -117,27 +117,27 @@ get_documentation_tbl <- function(pkg_root = ".") { } write_r_file <- function(lines, file_path) { - - # Create a file connection + + # Create a file connection file_connection <- file(file_path, open = "wb", encoding = "utf-8") on.exit(close(file_connection)) - + # Obtain the appropriate line ending based on the platform if (.Platform$OS.type == "windows") { line_ending <- "\r\n" } else { line_ending <- "\n" } - + lines <- gsub("\r?\n", line_ending, lines) - + writeLines( text = enc2utf8(lines), con = file_connection, - sep = line_ending, + sep = line_ending, useBytes = TRUE ) - + invisible(TRUE) } @@ -147,10 +147,10 @@ make_man_translation_file <- function(pkg_root = ".", name = paste0("man-", toupper(lang_code), ".R"), path = "inst/translations", overwrite = FALSE) { - + # Create path that contains the testthat test file name file_path <- as.character(fs::path_norm(fs::path(pkg_root, path, name))) - + # Check if the file to write already exists; if it does, don't # write the new file if `overwrite` is FALSE if (fs::file_exists(file_path) && !overwrite) { @@ -162,25 +162,25 @@ make_man_translation_file <- function(pkg_root = ".", call. = FALSE ) } - + # Get the roxygen documentation tbl docs_tbl <- get_documentation_tbl(pkg_root = pkg_root) - + docs_tbl <- docs_tbl %>% dplyr::arrange(rd_name) - - lines <- + + lines <- c( "# Generated file", paste0("# ", toupper(lang_code), " translations for man pages"), "" ) - + for (i in seq_len(nrow(docs_tbl))) { - + docs_list <- as.list(docs_tbl[i, ]) - + lines_file <- readLines(con = docs_list$file) lines_doc <- c( @@ -192,10 +192,10 @@ make_man_translation_file <- function(pkg_root = ".", ), lines_file[(docs_list$line_start):(docs_list$line_end)] ) - + lines <- c(lines, lines_doc) } - + write_r_file(lines = lines, file_path = file_path) } @@ -204,63 +204,63 @@ translate_with_file <- function(pkg_root = ".", name = paste0("man-", toupper(lang_code), ".R"), subdir = "inst/translations", article_names = NULL) { - + # Create file path file_path <- as.character(fs::path_norm(fs::path(pkg_root, subdir, name))) - + # Check if the file to use exists if (!fs::file_exists(file_path)) { stop("The translation file doesn't exist", call. = FALSE) } - + translation_lines <- readLines(con = file_path) translation_lines <- translation_lines[5:length(translation_lines)] - - article_headers <- which(grepl("^# [a-zA-Z0-9_\\.]*-*?$", translation_lines)) + + article_headers <- grep("^# [a-zA-Z0-9_\\.]*-*?$", translation_lines) article_footers <- c(article_headers[(2:length(article_headers))] - 1, length(translation_lines)) article_names_all <- gsub("(^# |-*|\\s+)", "", translation_lines[article_headers]) - + if (!is.null(article_names)) { article_names <- base::intersect(article_names_all, article_names) } else { article_names <- article_names_all } - + if (length(article_names) < 1) { return(NULL) } - + for (i in seq_along(article_names)) { - + # Get the roxygen documentation tbl docs_tbl <- get_documentation_tbl(pkg_root = pkg_root) - + if (!(article_names[i] %in% docs_tbl$rd_name)) { next } - + # Get information about the existing article doc in '/R' docs_list <- as.list(dplyr::filter(docs_tbl, rd_name == article_names[i])) - + # Get the index for the translated article doc idx <- which(article_names_all == docs_list$rd_name) - + roxygen_lines <- translation_lines[article_headers[idx]:article_footers[idx]] roxygen_lines <- roxygen_lines[grepl("^#'", roxygen_lines)] - + r_file_lines <- readLines(con = docs_list$file) - + r_file_lines_top <- r_file_lines[0:(docs_list$line_start - 1)] r_file_lines_bottom <- r_file_lines[(docs_list$line_end + 1):length(r_file_lines)] - + r_file_lines_replaced <- c( r_file_lines_top, roxygen_lines, r_file_lines_bottom ) - + # Write the file anew write_r_file(lines = r_file_lines_replaced, file_path = docs_list$file) - + # Write message to console cat( paste0( From cbdecc10ccccd711f2737f81bbb8e16aeecd2e81 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 29 Nov 2024 09:36:40 -0500 Subject: [PATCH 3/6] Take advantage of `vec_fmt_number()` for `pb_fmt_number()` --- R/utils.R | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/R/utils.R b/R/utils.R index 18be13e8b..2c87a1dbf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1073,23 +1073,20 @@ pb_fmt_number <- function( (!inherits(x, "numeric") && !inherits(x, "integer"))) { return(x) } - - ((dplyr::tibble(a = x) %>% - gt::gt() %>% - gt::fmt_number( - columns = "a", - decimals = decimals, - n_sigfig = n_sigfig, - drop_trailing_zeros = drop_trailing_zeros, - drop_trailing_dec_mark = drop_trailing_dec_mark, - use_seps = use_seps, - scale_by = scale_by, - suffixing = suffixing, - pattern = pattern, - sep_mark = sep_mark, - dec_mark = dec_mark, - locale = locale - ))$`_formats`[[1]][[1]][[1]])(x) + gt::vec_fmt_number( + x, + decimals = decimals, + n_sigfig = n_sigfig, + drop_trailing_zeros = drop_trailing_zeros, + drop_trailing_dec_mark = drop_trailing_dec_mark, + use_seps = use_seps, + scale_by = scale_by, + suffixing = suffixing, + pattern = pattern, + sep_mark = sep_mark, + dec_mark = dec_mark, + locale = locale + ) } add_icon_img <- function( From 0a410a59586a47367bec01c17686733a7ef2fad3 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 29 Nov 2024 09:37:12 -0500 Subject: [PATCH 4/6] Avoid ggplot2 3.5 deprecation warnings --- DESCRIPTION | 2 +- R/scan_data.R | 3 ++- R/utils-profiling.R | 5 +++-- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5f2c097a7..b26cfe845 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -54,7 +54,7 @@ Suggests: data.table, duckdb, ggforce, - ggplot2, + ggplot2 (>= 3.5.0), jsonlite, log4r, lubridate, diff --git a/R/scan_data.R b/R/scan_data.R index 2411e20b1..f7ace0f04 100644 --- a/R/scan_data.R +++ b/R/scan_data.R @@ -1446,7 +1446,8 @@ get_corr_plot <- function( panel.grid = ggplot2::element_blank(), legend.direction = "horizontal", legend.title = ggplot2::element_blank(), - legend.position = c(0.5, 1.03), + legend.position = "inside", + legend.position.inside = c(0.5, 1.03), plot.margin = ggplot2::unit(c(1, 0.5, 0, 0), "cm"), legend.key.width = ggplot2::unit(2.0, "cm"), legend.key.height = ggplot2::unit(3.0, "mm") diff --git a/R/utils-profiling.R b/R/utils-profiling.R index 7a49b560b..3e1ce28df 100644 --- a/R/utils-profiling.R +++ b/R/utils-profiling.R @@ -339,7 +339,7 @@ get_table_column_histogram <- function(data_column, lang, locale) { ggplot2::geom_col(fill = "steelblue", width = 0.5) + ggplot2::geom_hline(yintercept = 0, color = "#B2B2B2") + ggplot2::labs(x = x_label, y = y_label) + - ggplot2::scale_y_continuous(labels = scales::comma_format()) + + ggplot2::scale_y_continuous(labels = scales::label_comma()) + ggplot2::theme_minimal() ) } @@ -606,7 +606,8 @@ get_missing_value_plot <- function(data, frequency_tbl, missing_by_column_tbl) { panel.grid = ggplot2::element_blank(), legend.direction = "horizontal", legend.title = ggplot2::element_blank(), - legend.position = c(0.5, 1.0), + legend.position = "inside", + legend.position.inside = c(0.5, 1.0), plot.margin = ggplot2::unit(c(1, 0.5, 0, 0), "cm"), legend.key.width = ggplot2::unit(2.0, "cm"), legend.key.height = ggplot2::unit(3.0, "mm") From 95d3a8ab89fb0977d978310fb153db4a5824863b Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 29 Nov 2024 09:45:08 -0500 Subject: [PATCH 5/6] unused arg --- R/get_agent_report.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_agent_report.R b/R/get_agent_report.R index 5306484c7..3744c6f04 100644 --- a/R/get_agent_report.R +++ b/R/get_agent_report.R @@ -1668,7 +1668,7 @@ get_agent_report <- function( ) %>% gt::fmt_integer( columns = c("units", "n_pass", "n_fail", "f_pass", "f_fail"), - drop_trailing_zeros = TRUE, suffixing = TRUE + suffixing = TRUE ) %>% gt::fmt_number( columns = c("f_pass", "f_fail"), From cfbfd4b7a297267722dc4255ab72d6675e6c32f4 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Mon, 2 Dec 2024 12:27:40 -0500 Subject: [PATCH 6/6] Require ggplot 3.5.0 in check --- R/scan_data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scan_data.R b/R/scan_data.R index f7ace0f04..b55edc9b8 100644 --- a/R/scan_data.R +++ b/R/scan_data.R @@ -222,7 +222,7 @@ scan_data <- function( if (any(c("interactions", "correlations") %in% sections)) { rlang::check_installed( - c("ggforce", "ggplot2"), + c("ggforce", "ggplot2 (>= 3.5.0)"), "to use the `interactions` and `correlations` sections." ) }