Code tweaks

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)

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)
 }

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
 }

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))
   )
 }
 

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 = "_")
 }

R/plume-handler.R

@@ -185,7 +185,7 @@ PlumeHandler <- R6Class(
       )
     },
 
-    get = function(col) {
+    pull = function(col) {
       private$plume[[private$pick(col)]]
     },
 

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

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,57 +137,51 @@ PlumeQuarto <- R6Class(
     },
 
     author_ids = function() {
-      ids <- private$get("id")
+      ids <- private$pull("id")
       if (length(ids) == 1L) {
         return()
       }
       paste0("aut", ids)
     },
 
     author_orcids = function() {
-      out <- private$get("orcid")
+      out <- private$pull("orcid")
       if (!is.null(out)) {
         check_orcid(out)
       }
       out
     },
 
     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()
       }

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 {

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)

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())