Package optimization: improved code efficiency, grammar fixes, tidyverse style compliance, and CLI message consistency

DESCRIPTION

@@ -9,7 +9,7 @@ Authors@R: c(
     person("Chenyang", "Shu", , "402221506@qq.com", role = "aut")
   )
 Maintainer: Shixiang Wang <w_shixiang@163.com>
-Description: Easily process batches of univariate or multivariate
+Description: Easily processes batches of univariate or multivariate
     regression models. Returns results in a tidy format and generates
     visualization plots for straightforward interpretation (Wang,
     Shixiang, et al. (2021) <DOI:10.48550/arXiv.2110.14232>).

R/01-class.R

@@ -82,7 +82,7 @@ method(print, breg) <- function(x, ..., raw = FALSE) {
   if (raw) {
     print(utils::str(x))
   } else {
-    cli_text("A object of {.cls breg} class with slots:\n")
+    cli_text("an object of {.cls breg} class with slots:\n")
 
     qty_x <- qty(x@n_x)
     qty_x2 <- qty(x@n_x2)

R/02-pipeline.R

@@ -17,8 +17,8 @@
 #' **bregr** supported global options can be set with `options()`.
 #' Currently they are used in `br_run()`.
 #'
-#' - `bregr.save_model`: If `TRUE`, save model to local disk.
-#' - `bregr.path`: A path for save model, default uses a
+#' - `bregr.save_model`: If `TRUE`, saves models to local disk.
+#' - `bregr.path`: A path for saving models, defaults to using a
 #' temporary directory.
 #'
 #' @returns
@@ -35,7 +35,7 @@
 #' For GLM models, this is typically a single character (e.g., `"outcome"`).
 #' For Cox-PH models, it should be a length-2 vector in the format `c("time", "status")`.
 #' @param x Character vector specifying focal independent terms (predictors).
-#' @param x2 Character vector specifying control independent terms (predictor, optional).
+#' @param x2 Character vector specifying control independent terms (predictors, optional).
 #' @param method Method for model construction.
 #' A name or a list specifying custom model setting.
 #' A string representing a complex method setting is acceptable,
@@ -224,12 +224,12 @@ br_set_x <- function(obj, ...,
         "Pre-filtering removed {filter_result$filter_summary$filtered} out of {filter_result$filter_summary$total} focal variables ({round(filter_result$filter_summary$prop_filtered * 100, 1)}%)"
       )
       if (length(filter_result$filtered_out) <= 10) {
-        cli::cli_inform("Filtered variables: {.val {filter_result$filtered_out}}")
+        cli::cli_inform("filtered variables: {.val {filter_result$filtered_out}}")
       } else {
-        cli::cli_inform("Filtered variables (showing first 10): {.val {filter_result$filtered_out[1:10]}} ...")
+        cli::cli_inform("filtered variables (showing first 10): {.val {filter_result$filtered_out[1:10]}} ...")
       }
     } else {
-      cli::cli_inform("Pre-filtering: no variables were filtered out")
+      cli::cli_inform("pre-filtering: no variables were filtered out")
     }
   }
 
@@ -250,7 +250,7 @@ br_set_x2 <- function(obj, ...) {
   data <- br_get_data(obj)
   col_names <- colnames(data)
   if (nrow(data) == 0) {
-    cli_abort("cannot set {.arg x} for {.arg obj} with void data")
+    cli_abort("cannot set {.arg x2} for {.arg obj} with void data")
   }
 
   x <- br_get_x(obj)
@@ -264,7 +264,9 @@ br_set_x2 <- function(obj, ...) {
   assert_character(x2, allow_na = FALSE, allow_null = TRUE)
   assert_not_overlap(x, x2)
 
-  if (length(x2) > 0) x2 <- repair_names(x2, col_names)
+  if (length(x2) > 0) {
+    x2 <- repair_names(x2, col_names)
+  }
   x2_ <- get_vars(x2)
 
   .in <- x2_ %in% col_names
@@ -358,7 +360,7 @@ br_run <- function(obj, ...,
 
   if (n_workers > 1) {
     if (obj@n_x < 100) {
-      cli::cli_warn("running in parallel is typically not recommended for small number (<100) of focal terms")
+      cli::cli_warn("running in parallel is typically not recommended for a small number (<100) of focal terms")
     }
   }
 

R/03-accessors.R

@@ -259,13 +259,13 @@ br_predict <- function(obj, newdata = NULL, idx = NULL, type = NULL) {
 
       # Handle missing values
       if (any(is.na(predictions))) {
-        cli::cli_warn("Some predictions are NA, consider checking your data for missing values")
+        cli::cli_warn("some predictions are NA, consider checking your data for missing values")
       }
 
       predictions
     },
     error = function(e) {
-      cli::cli_abort("Failed to generate predictions: {e$message}")
+      cli::cli_abort("failed to generate predictions: {e$message}")
     }
   )
 }

R/04-show.R

@@ -21,7 +21,7 @@
 #' @param breg A regression object with results (must pass `assert_breg_obj_with_results()`).
 #' @param clean Logical indicating whether to clean/condense redundant group/focal variable labels.
 #' If `TRUE`, remove "Group" or "Focal" variable column when the values in the result table
-#' are same (before performing `subset` and `drop`),
+#' are the same (before performing `subset` and `drop`),
 #' and reduce repeat values in column "Group", "Focal", and "Variable".
 #' @param rm_controls If `TRUE`, remove control terms.
 #' @param ... Additional arguments passed to [forestploter::forest()], run `vignette("forestploter-post", "forestploter")`
@@ -594,7 +594,7 @@ br_show_survival_curves <- function(breg,
   # Get survival variables
   y_vars <- br_get_y(breg)
   if (length(y_vars) != 2) {
-    cli::cli_abort("Expected 2 survival variables (time, status), got {length(y_vars)}")
+    cli::cli_abort("expected 2 survival variables (time, status), got {length(y_vars)}")
   }
 
   time_var <- y_vars[1]
@@ -605,7 +605,7 @@ br_show_survival_curves <- function(breg,
 
   # Handle case where scores have little variation
   if (length(unique(score_quantiles)) <= 2) {
-    cli::cli_warn("Score values have limited variation, grouping may not be meaningful")
+    cli::cli_warn("score values have limited variation, grouping may not be meaningful")
   }
 
   score_groups <- cut(scores,
@@ -624,7 +624,7 @@ br_show_survival_curves <- function(breg,
       group_labels <- paste0("Q", 1:n_groups)
     }
   } else if (length(group_labels) != n_groups) {
-    cli::cli_abort("Length of group_labels ({length(group_labels)}) must match n_groups ({n_groups})")
+    cli::cli_abort("length of group_labels ({length(group_labels)}) must match n_groups ({n_groups})")
   }
 
   # Prepare data for survival analysis

R/05-polar.R

@@ -77,21 +77,21 @@ br_show_risk_network <- function(breg, ...) {
 
   vars_comb <- combn(x |> get_vars(), 2, simplify = FALSE)
   cor_value <- rlang::try_fetch(
-    sapply(vars_comb, function(x) {
+    purrr::map_dbl(vars_comb, function(x) {
       cor(data[[x[1]]], data[[x[2]]], use = "pairwise")
     }),
     error = function(e) {
       cli_abort("failed due to error: {e$message}, please check your data format")
     }
   )
 
-  data_cor <- cbind(
-    as.data.frame(t(sapply(vars_comb, function(x) x))),
-    cor_value
+  data_cor <- tibble::tibble(
+    var1 = purrr::map_chr(vars_comb, ~ .x[1]),
+    var2 = purrr::map_chr(vars_comb, ~ .x[2]),
+    correlation = cor_value
   )
-  colnames(data_cor) <- c("var1", "var2", "correlation")
   data_cor$linewidth <- abs(data_cor$correlation)
-  data_cor$way <- ifelse(data_cor$correlation > 0, "positive", "negative")
+  data_cor$way <- if_else(data_cor$correlation > 0, "positive", "negative")
   data_cor$way <- factor(
     data_cor$way,
     levels = c("negative", "positive"),

R/98-utils.R

@@ -36,17 +36,19 @@ get_necessary_columns <- function(y, x, x2, group_by, available_cols) {
     necessary_cols <- union(necessary_cols, ".row_names")
   }
 
-  return(necessary_cols)
+  necessary_cols
 }
 
 merge_vars <- function(...) {
   vars_list <- list(...) |> unlist()
-  rv <- NULL
-  for (i in vars_list) {
-    v <- unique(sapply(i, get_vars))
-    if (length(v) > 0) rv <- union(rv, v)
-  }
-  rv
+  if (length(vars_list) == 0) return(NULL)
+
+  all_vars <- vars_list |>
+    purrr::map(get_vars) |>
+    purrr::list_c() |>
+    unique()
+
+  if (length(all_vars) == 0) NULL else all_vars
 }
 
 # x: terms to repair
@@ -195,14 +197,15 @@ filter_variables_x <- function(data, x, filter_na_prop = 0.8, filter_sd_min = 1e
   }
 
   # Get variable names from terms (handle complex terms like I(x^2))
-  x_vars <- sapply(x, get_vars)
-  x_simple <- x_vars[sapply(x_vars, function(v) length(v) == 1)]
-
+  x_vars <- purrr::map(x, get_vars)
+  var_lengths <- purrr::map_int(x_vars, length)
+  
   # For complex terms with multiple variables, we keep them for now
   # Only filter simple single-variable terms
-  complex_terms <- x[sapply(x_vars, function(v) length(v) != 1)]
-  simple_terms <- x[sapply(x_vars, function(v) length(v) == 1)]
-  simple_vars <- x_simple
+  is_simple <- var_lengths == 1
+  complex_terms <- x[!is_simple]
+  simple_terms <- x[is_simple]
+  simple_vars <- x_vars[is_simple] |> unlist()
 
   if (length(simple_vars) == 0) {
     return(list(

README.md

@@ -137,7 +137,7 @@ mds_p <- br_pipeline(
   n_workers = 3
 )
 #> exponentiate estimates of model(s) constructed from coxph method at default
-#> ■■■■■■■                           20% | ETA: 46s
+#> ■■■■■■■                           20% | ETA: 47s
 #>                                                  
 ```
 
@@ -338,7 +338,7 @@ create survival curves grouped by these scores:
 # Generate model predictions
 scores <- br_predict(mds2, idx = "ph.ecog")
 #> `type` is not specified, use lp for the model
-#> Warning: Some predictions are NA, consider checking your data for missing
+#> Warning: some predictions are NA, consider checking your data for missing
 #> values
 head(scores)
 #>          1          2          3          4          5          6 
@@ -353,7 +353,7 @@ br_show_survival_curves(
   n_groups = 3,
   title = "Survival Curves by 'ph.ecog' Model Risk Score"
 )
-#> Warning: Some predictions are NA, consider checking your data for missing
+#> Warning: some predictions are NA, consider checking your data for missing
 #> values
 ```
 
@@ -425,15 +425,15 @@ site](https://wanglabcsu.github.io/bregr/).
 
 ``` r
 covr::package_coverage()
-#> bregr Coverage: 76.48%
-#> R/98-utils.R: 51.14%
+#> bregr Coverage: 75.70%
+#> R/98-utils.R: 57.89%
+#> R/06-avail.R: 66.07%
 #> R/03-accessors.R: 72.50%
 #> R/04-show.R: 75.87%
-#> R/02-pipeline.R: 76.32%
-#> R/06-avail.R: 78.57%
+#> R/02-pipeline.R: 77.36%
 #> R/01-class.R: 90.70%
 #> R/99-zzz.R: 90.91%
-#> R/05-polar.R: 95.19%
+#> R/05-polar.R: 92.37%
 ```
 
 ## Related Project(s)