From 991b1754744e50c6cef2896f4e1796e20f5cfbfa Mon Sep 17 00:00:00 2001 From: arnaudgallou Date: Wed, 28 Aug 2024 09:31:34 +0200 Subject: [PATCH] Code tweaks --- NAMESPACE | 2 -- R/checkers.R | 6 ++--- R/credit-roles.R | 9 ++++--- R/icon.R | 2 +- R/plm-template.R | 6 ++--- R/plume-handler.R | 2 +- R/plume-package.R | 2 -- R/plume-quarto.R | 64 +++++++++++++++++++++-------------------------- R/plume.R | 2 +- R/sequential.R | 4 +-- R/yaml.R | 13 +++------- 11 files changed, 49 insertions(+), 63 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c9ec8a2..3f2851d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -80,5 +80,3 @@ importFrom(vctrs,vec_duplicate_any) importFrom(vctrs,vec_group_id) importFrom(vctrs,vec_rank) importFrom(vctrs,vec_restore) -importFrom(yaml,as.yaml) -importFrom(yaml,yaml.load) diff --git a/R/checkers.R b/R/checkers.R index 3768dea..197bf0f 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -115,7 +115,7 @@ abort_check <- function( msg = NULL, bullets = NULL, ..., - msg_body = 1, + msg_body = 1L, param, call = caller_user() ) { @@ -264,11 +264,11 @@ check_suffix_format <- function(x, param = caller_arg(x)) { } if (has_dup_keys) { what <- "unique keys" - msg_body <- 2 + msg_body <- 2L } else { allowed <- wrap(allowed, "`") what <- paste("any of", enumerate(allowed, last = " or ")) - msg_body <- 3 + msg_body <- 3L } abort_check(what, msg_body = msg_body, param = param) } diff --git a/R/credit-roles.R b/R/credit-roles.R index d6028a2..dee36bd 100644 --- a/R/credit-roles.R +++ b/R/credit-roles.R @@ -14,11 +14,12 @@ credit_roles <- function(oxford_spelling = TRUE) { if (oxford_spelling) { return(out) } - full_replace(out, "ization", "isation") + ise(out) } -full_replace <- function(x, pattern, replacement) { - names(x) <- str_replace(names(x), pattern, replacement) - x[] <- str_replace(x, pattern, replacement) +ise <- function(x) { + pattern <- "(?<=[iy])z(?=(?:e|ation)$)" + names(x) <- str_replace(names(x), pattern, "s") + x[] <- str_replace(x, pattern, "s") x } diff --git a/R/icon.R b/R/icon.R index 7db714d..5ebfdaf 100644 --- a/R/icon.R +++ b/R/icon.R @@ -81,7 +81,7 @@ icn_get_attrs <- function(x, size, bw, ...) { x <- icn_format(x) c( list(size = round(size), filename = icn_filename(x, bw), ...), - icn_buffer(x, margin = round(size / 4)) + icn_buffer(x, margin = round(size / 4L)) ) } diff --git a/R/plm-template.R b/R/plm-template.R index bada132..58aa076 100644 --- a/R/plm-template.R +++ b/R/plm-template.R @@ -26,7 +26,7 @@ plm_template <- function(minimal = TRUE, role_cols = credit_roles(), credit_role role_cols <- credit_roles() } vars <- get_template_vars(minimal, role_cols) - tibble(!!!vars, .rows = 0) + tibble(!!!vars, .rows = 0L) } get_template_vars <- function(minimal, role_cols) { @@ -47,10 +47,10 @@ get_secondaries <- function(minimal) { } get_nestables <- function() { - vars <- c(seq_names("affiliation", n = 2), "note") + vars <- c(seq_names("affiliation", n = 2L), "note") as.list(set_names(vars)) } seq_names <- function(..., n) { - paste(rep(c(...), each = n), seq(n), sep = "_") + paste(rep(c(...), each = n), seq_len(n), sep = "_") } diff --git a/R/plume-handler.R b/R/plume-handler.R index 217cffd..bfc1475 100644 --- a/R/plume-handler.R +++ b/R/plume-handler.R @@ -185,7 +185,7 @@ PlumeHandler <- R6Class( ) }, - get = function(col) { + pull = function(col) { private$plume[[private$pick(col)]] }, diff --git a/R/plume-package.R b/R/plume-package.R index 42dea45..1529bce 100644 --- a/R/plume-package.R +++ b/R/plume-package.R @@ -70,7 +70,5 @@ #' @importFrom vctrs vec_group_id #' @importFrom vctrs vec_rank #' @importFrom vctrs vec_restore -#' @importFrom yaml as.yaml -#' @importFrom yaml yaml.load ## usethis namespace: end NULL diff --git a/R/plume-quarto.R b/R/plume-quarto.R index ae5bb44..b0dbaf8 100644 --- a/R/plume-quarto.R +++ b/R/plume-quarto.R @@ -98,11 +98,11 @@ PlumeQuarto <- R6Class( private = list( file = NULL, plume_names = .names_quarto, - meta_prefix = "meta-", + meta_key = "meta-", id = NULL, mold = function(...) { - super$mold(starts_with(private$meta_prefix), ...) + super$mold(starts_with(private$meta_key), ...) }, get_template = function() { @@ -116,19 +116,19 @@ PlumeQuarto <- R6Class( author_tbl = function() { tibble( id = private$author_ids(), - number = private$get("number"), + number = private$pull("number"), name = tibble( - given = private$get("given_name"), - family = private$get("family_name"), - `dropping-particle` = private$get("dropping_particle") + given = private$pull("given_name"), + family = private$pull("family_name"), + `dropping-particle` = private$pull("dropping_particle") ), - url = private$get("url"), - email = private$get("email"), - phone = private$get("phone"), - fax = private$get("fax"), + url = private$pull("url"), + email = private$pull("email"), + phone = private$pull("phone"), + fax = private$pull("fax"), orcid = private$author_orcids(), note = private$author_notes(), - acknowledgements = private$get("acknowledgements"), + acknowledgements = private$pull("acknowledgements"), attributes = private$author_attributes(), roles = private$author_roles(), metadata = private$author_metadata(), @@ -137,7 +137,7 @@ PlumeQuarto <- R6Class( }, author_ids = function() { - ids <- private$get("id") + ids <- private$pull("id") if (length(ids) == 1L) { return() } @@ -145,7 +145,7 @@ PlumeQuarto <- R6Class( }, author_orcids = function() { - out <- private$get("orcid") + out <- private$pull("orcid") if (!is.null(out)) { check_orcid(out) } @@ -153,41 +153,35 @@ PlumeQuarto <- R6Class( }, author_roles = function() { - col <- private$pick("role") - if (!private$has_col(col)) { - return() - } - out <- unnest(private$plume, cols = all_of(col)) - out <- summarise(out, `_` = if_not_na( - .data[[col]], - as_role_list(.data[[col]]), - all = TRUE - ), .by = all_of(private$id)) - out[["_"]] + private$pull_nestable("role", as_role_list) }, author_notes = function() { - col <- private$pick("note") + private$pull_nestable("note", \(x) bind(x, sep = ", ", arrange = FALSE)) + }, + + pull_nestable = function(var, callback) { + col <- private$pick(var) if (!private$has_col(col)) { return() } if (!is_nested(private$plume, col)) { - return(private$get("note")) + return(private$pull(var)) } out <- unnest(private$plume, cols = all_of(col)) out <- summarise(out, `_` = if_not_na( .data[[col]], - bind(.data[[col]], sep = ", ", arrange = FALSE), + callback(.data[[col]]), all = TRUE - ), .by = all_of(private$id)) + ), .by = private$id) out[["_"]] }, author_attributes = function() { out <- tibble( - corresponding = private$get("corresponding"), - deceased = private$get("deceased"), - `equal-contributor` = private$get("equal_contributor") + corresponding = private$pull("corresponding"), + deceased = private$pull("deceased"), + `equal-contributor` = private$pull("equal_contributor") ) if (is_empty(out)) { return() @@ -209,19 +203,19 @@ PlumeQuarto <- R6Class( )) out <- summarise(out, `_` = list( tibble(ref = sort(!!sym(.col))) - ), .by = all_of(private$id)) + ), .by = private$id) out[["_"]] }, author_metadata = function() { - if (!private$has_col(begins_with(private$meta_prefix))) { + if (!private$has_col(begins_with(private$meta_key))) { return() } - select(private$plume, starts_with(private$meta_prefix)) + select(private$plume, starts_with(private$meta_key)) }, affiliation_tbl = function() { - affiliations <- private$get("affiliation") + affiliations <- private$pull("affiliation") if (is.null(affiliations)) { return() } diff --git a/R/plume.R b/R/plume.R index 5a8af88..163e661 100644 --- a/R/plume.R +++ b/R/plume.R @@ -135,7 +135,7 @@ Plume <- R6Class( lifecycle::deprecate_warn("0.2.0", "get_author_list(format)", "get_author_list(suffix)") suffix <- format } - authors <- private$get("literal_name") + authors <- private$pull("literal_name") if (is_empty(suffix)) { out <- authors } else { diff --git a/R/sequential.R b/R/sequential.R index 391075f..b209b39 100644 --- a/R/sequential.R +++ b/R/sequential.R @@ -44,12 +44,12 @@ seq_vector <- function(x, n) { } seq_vector.default <- function(x, n) { - out <- map(seq(n), \(i) strrep(x, i)) + out <- map(seq_len(n), \(i) strrep(x, i)) unlist(out) } seq_vector.sequential <- function(x, n) { - out <- map(seq(n - 1), \(i) c("", x)) + out <- map(seq_len(n - 1L), \(i) c("", x)) out <- c(out, list(x)) out <- set_names(out, seq_along(out)) out <- vctrs::vec_expand_grid(!!!out) diff --git a/R/yaml.R b/R/yaml.R index 41b04e0..2e96bc9 100644 --- a/R/yaml.R +++ b/R/yaml.R @@ -2,15 +2,10 @@ eol <- function() { if (.Platform$OS.type == "unix") "\n" else "\r\n" # nocov } -as_verbatim_lgl <- function(x) { - x <- if_else(x, "true", "false") - structure(x, class = "verbatim") -} - .yaml_args <- list( line.sep = eol(), indent.mapping.sequence = TRUE, - handlers = list(logical = as_verbatim_lgl) + handlers = list(logical = yaml::verbatim_logical) ) schemas_are_up_to_date <- function(old, new) { @@ -37,8 +32,8 @@ separate_yaml_header <- function(x) { } yaml_inject <- function(x, lines) { - yaml <- do.call(as.yaml, c(list(x), .yaml_args)) - out <- replace(lines, 2, yaml) + yaml <- do.call(yaml::as.yaml, c(list(x), .yaml_args)) + out <- replace(lines, 2L, yaml) collapse(out, paste0("---", eol())) } @@ -95,7 +90,7 @@ yaml_push.qmd <- function(x, file) { if (yaml_has_strippable(items[[2]])) { items <- add_yaml_header(items) } - old <- yaml.load(items[[2]]) + old <- yaml::yaml.load(items[[2]]) json <- json_update(old, x) if (is.null(json)) { return(invisible())