diff --git a/DESCRIPTION b/DESCRIPTION index 8d26c74..c1ea0d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,7 @@ Authors@R: c( person("Chenyang", "Shu", , "402221506@qq.com", role = "aut") ) Maintainer: Shixiang Wang -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) ). diff --git a/R/01-class.R b/R/01-class.R index c4026dc..f8adcae 100644 --- a/R/01-class.R +++ b/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) diff --git a/R/02-pipeline.R b/R/02-pipeline.R index 66c58fc..051b792 100644 --- a/R/02-pipeline.R +++ b/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") } } diff --git a/R/03-accessors.R b/R/03-accessors.R index 6187fe3..d8c1551 100644 --- a/R/03-accessors.R +++ b/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}") } ) } diff --git a/R/04-show.R b/R/04-show.R index 2c533f4..db6e9de 100644 --- a/R/04-show.R +++ b/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 diff --git a/R/05-polar.R b/R/05-polar.R index 8db904d..1509886 100644 --- a/R/05-polar.R +++ b/R/05-polar.R @@ -77,7 +77,7 @@ 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) { @@ -85,13 +85,13 @@ br_show_risk_network <- function(breg, ...) { } ) - 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"), diff --git a/R/98-utils.R b/R/98-utils.R index c4df912..2e092a8 100644 --- a/R/98-utils.R +++ b/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( diff --git a/README.md b/README.md index 601f28c..47e612b 100644 --- a/README.md +++ b/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) diff --git a/man/br_show_forest.Rd b/man/br_show_forest.Rd index e50a184..15aa8fa 100644 --- a/man/br_show_forest.Rd +++ b/man/br_show_forest.Rd @@ -20,7 +20,7 @@ br_show_forest( \item{clean}{Logical indicating whether to clean/condense redundant group/focal variable labels. If \code{TRUE}, remove "Group" or "Focal" variable column when the values in the result table -are same (before performing \code{subset} and \code{drop}), +are the same (before performing \code{subset} and \code{drop}), and reduce repeat values in column "Group", "Focal", and "Variable".} \item{rm_controls}{If \code{TRUE}, remove control terms.} diff --git a/man/bregr-package.Rd b/man/bregr-package.Rd index 70177d6..e16730b 100644 --- a/man/bregr-package.Rd +++ b/man/bregr-package.Rd @@ -8,7 +8,7 @@ \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} -Easily process 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}). +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}). } \seealso{ Useful links: diff --git a/man/figures/README-unnamed-chunk-10-1.png b/man/figures/README-unnamed-chunk-10-1.png index c1bc22c..8012cc9 100644 Binary files a/man/figures/README-unnamed-chunk-10-1.png and b/man/figures/README-unnamed-chunk-10-1.png differ diff --git a/man/pipeline.Rd b/man/pipeline.Rd index 99af04a..ec0073d 100644 --- a/man/pipeline.Rd +++ b/man/pipeline.Rd @@ -69,7 +69,7 @@ e.g., 'quasi(variance = "mu", link = "log")'. Or a list with 4 elements, see \code{\link[=br_avail_method_config]{br_avail_method_config()}} for examples.} -\item{x2}{Character vector specifying control independent terms (predictor, optional).} +\item{x2}{Character vector specifying control independent terms (predictors, optional).} \item{group_by}{A string specifying the group by column.} @@ -125,8 +125,8 @@ e.g., \code{x + poly(x, 2)} has \emph{one} variable \code{x}, but \emph{two} ter \strong{bregr} supported global options can be set with \code{options()}. Currently they are used in \code{br_run()}. \itemize{ -\item \code{bregr.save_model}: If \code{TRUE}, save model to local disk. -\item \code{bregr.path}: A path for save model, default uses a +\item \code{bregr.save_model}: If \code{TRUE}, saves models to local disk. +\item \code{bregr.path}: A path for saving models, defaults to using a temporary directory. } }