From d59988c499a1b68110bf99da411c2d8f28fec9d9 Mon Sep 17 00:00:00 2001 From: abichat Date: Sat, 8 Jun 2024 09:37:12 +0200 Subject: [PATCH 1/6] v0.0.2.9000 --- DESCRIPTION | 2 +- NEWS.md | 3 +++ README.md | 2 +- man/scimo-package.Rd | 2 ++ 4 files changed, 7 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 016bb34..e5780cf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: scimo Title: Extra Recipes Steps for Dealing with Omics Data -Version: 0.0.2 +Version: 0.0.2.9000 Authors@R: c( person("Antoine", "BICHAT", , "antoine.bichat@proton.me", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-6599-7081")), diff --git a/NEWS.md b/NEWS.md index 7856e04..10ff83a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# scimo 0.0.2.9000 + + # scimo 0.0.2 * New function `step_taxonomy()`. diff --git a/README.md b/README.md index e7613a6..a2c8a1b 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ -![packageversion](https://img.shields.io/badge/version-0.0.2-orange.svg) +![packageversion](https://img.shields.io/badge/version-0.0.2.9000-orange.svg) [![R-CMD-check](https://github.com/abichat/scimo/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/abichat/scimo/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/scimo)](https://CRAN.R-project.org/package=scimo) diff --git a/man/scimo-package.Rd b/man/scimo-package.Rd index 215a2c4..acc41b3 100644 --- a/man/scimo-package.Rd +++ b/man/scimo-package.Rd @@ -6,6 +6,8 @@ \alias{scimo-package} \title{scimo: Extra Recipes Steps for Dealing with Omics Data} \description{ +\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} + Omics data (e.g. transcriptomics, proteomics, metagenomics...) offer a detailed and multi-dimensional perspective on the molecular components and interactions within complex biological (eco)systems. Analyzing these data requires adapted procedures, which are implemented as steps according to the 'recipes' package. } \seealso{ From d0f7d1903993e9bbad94e1e395a2e7cbbfcb3c33 Mon Sep 17 00:00:00 2001 From: abichat Date: Mon, 29 Jul 2024 18:46:20 +0200 Subject: [PATCH 2/6] remove workarounds and notes about long formulas issue + add recipes >=1.1 dependency (closes #2) --- DESCRIPTION | 2 +- NEWS.md | 3 ++- README.Rmd | 20 -------------------- README.md | 33 --------------------------------- vignettes/pedcan.Rmd | 6 ++---- 5 files changed, 5 insertions(+), 59 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e5780cf..ffc6361 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,7 @@ URL: https://github.com/abichat/scimo BugReports: https://github.com/abichat/scimo/issues Depends: R (>= 2.10), - recipes + recipes (>= 1.1) Imports: dplyr, generics, diff --git a/NEWS.md b/NEWS.md index 10ff83a..083c068 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # scimo 0.0.2.9000 +* Add a dependency on **recipes** >= 1.1 to avoid stack overflow errors with long formulas, as this issue has been resolved in this version (#2). + # scimo 0.0.2 @@ -7,7 +9,6 @@ * Replace superseded `juice()` with `bake(new_data = NULL)` to align with current practices (#1). - # scimo 0.0.1 * First release of **scimo**. diff --git a/README.Rmd b/README.Rmd index ba22201..1caa78e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -91,26 +91,6 @@ tidy(rec, 3) ## Notes -### `protection stack overflow` error - -If you have a very large dataset, you may encounter this error: - -```{r error, error=TRUE} -data("pedcan_expression") -recipe(disease ~ ., data = pedcan_expression) %>% - step_select_cv(all_numeric_predictors(), prop_kept = 0.1) -``` - -It is linked to [how **R** handles many variables in formulas](https://github.com/tidymodels/recipes/issues/467). To solve it, pass only the dataset to `recipe()` and manually update roles with `update_role()`, like in the example below: - -```{r fix} -recipe(pedcan_expression) %>% - update_role(disease, new_role = "outcome") %>% - update_role(-disease, new_role = "predictor") %>% - step_select_cv(all_numeric_predictors(), prop_kept = 0.1) -``` - - ### Steps for variable selection Like [**colino**](https://github.com/stevenpawley/colino), **scimo** proposes 3 arguments for variable selection steps based on a statistic: `n_kept`, `prop_kept` and `cutoff`. diff --git a/README.md b/README.md index a2c8a1b..048ae92 100644 --- a/README.md +++ b/README.md @@ -156,39 +156,6 @@ tidy(rec, 3) ## Notes -### `protection stack overflow` error - -If you have a very large dataset, you may encounter this error: - -``` r -data("pedcan_expression") -recipe(disease ~ ., data = pedcan_expression) %>% - step_select_cv(all_numeric_predictors(), prop_kept = 0.1) -#> Error: protect(): protection stack overflow -``` - -It is linked to [how **R** handles many variables in -formulas](https://github.com/tidymodels/recipes/issues/467). To solve -it, pass only the dataset to `recipe()` and manually update roles with -`update_role()`, like in the example below: - -``` r -recipe(pedcan_expression) %>% - update_role(disease, new_role = "outcome") %>% - update_role(-disease, new_role = "predictor") %>% - step_select_cv(all_numeric_predictors(), prop_kept = 0.1) -#> -#> ── Recipe ────────────────────────────────────────────────────────────────────── -#> -#> ── Inputs -#> Number of variables by role -#> outcome: 1 -#> predictor: 19196 -#> -#> ── Operations -#> • Top CV filtering on: all_numeric_predictors() -``` - ### Steps for variable selection Like [**colino**](https://github.com/stevenpawley/colino), **scimo** diff --git a/vignettes/pedcan.Rmd b/vignettes/pedcan.Rmd index ba568e1..b5d08c2 100644 --- a/vignettes/pedcan.Rmd +++ b/vignettes/pedcan.Rmd @@ -44,8 +44,7 @@ One approach to exploring this dataset is by performing PCA. ```{r} rec_naive_pca <- - recipe(pedcan_expression) %>% - update_role(-cell_line) %>% + recipe(~ ., data = pedcan_expression) %>% step_zv(all_numeric_predictors()) %>% step_normalize(all_numeric_predictors()) %>% step_pca(all_numeric_predictors()) %>% @@ -62,8 +61,7 @@ To improve the appearance of PCA, one can precede it with a feature selection st ```{r} rec_cv_pca <- - recipe(pedcan_expression) %>% - update_role(-cell_line) %>% + recipe(~ ., data = pedcan_expression) %>% step_select_cv(all_numeric_predictors(), prop_kept = 1/4) %>% step_normalize(all_numeric_predictors()) %>% step_pca(all_numeric_predictors()) %>% From de93f25c88b561ab2c5bcd04d8e688bd65eb58f6 Mon Sep 17 00:00:00 2001 From: abichat Date: Mon, 29 Jul 2024 20:23:13 +0200 Subject: [PATCH 3/6] Add name explanation (closes #6) --- README.Rmd | 5 +++++ README.md | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/README.Rmd b/README.Rmd index 1caa78e..002de57 100644 --- a/README.Rmd +++ b/README.Rmd @@ -99,7 +99,12 @@ Like [**colino**](https://github.com/stevenpawley/colino), **scimo** proposes 3 * `cutoff` removes variables whose statistic is below (or above, depending on the step) it. It could be used alone or in addition to the two others. + ### Dependencies **scimo** doesn't introduce any additional dependencies compared to **recipes**. + +### But why scimo? + +*scimo* is simply the reverse of *omics*. diff --git a/README.md b/README.md index 048ae92..1ab4f38 100644 --- a/README.md +++ b/README.md @@ -175,3 +175,7 @@ proposes 3 arguments for variable selection steps based on a statistic: **scimo** doesn’t introduce any additional dependencies compared to **recipes**. + +### But why scimo? + +*scimo* is simply the reverse of *omics*. From 6a91e1f5919c1d02b55c8b477946081b3c656baa Mon Sep 17 00:00:00 2001 From: abichat Date: Wed, 23 Jul 2025 20:27:20 +0200 Subject: [PATCH 4/6] fix Rd \link{} note by providing provide package anchors --- DESCRIPTION | 2 +- R/aggregate_hclust.R | 6 +++--- R/aggregate_list.R | 6 +++--- R/rownormalize_tss.R | 6 +++--- R/select_background.R | 6 +++--- R/select_cv.R | 6 +++--- R/select_wilcoxon.R | 6 +++--- R/taxonomy.R | 6 +++--- man/step_aggregate_hclust.Rd | 6 +++--- man/step_aggregate_list.Rd | 6 +++--- man/step_rownormalize_tss.Rd | 6 +++--- man/step_select_background.Rd | 6 +++--- man/step_select_cv.Rd | 6 +++--- man/step_select_kruskal.Rd | 6 +++--- man/step_select_wilcoxon.Rd | 6 +++--- man/step_taxonomy.Rd | 6 +++--- 16 files changed, 46 insertions(+), 46 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ffc6361..3e50365 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,4 +37,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: false Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 diff --git a/R/aggregate_hclust.R b/R/aggregate_hclust.R index b8bb032..6310a93 100644 --- a/R/aggregate_hclust.R +++ b/R/aggregate_hclust.R @@ -5,7 +5,7 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role For model terms created by this step, what analysis role should #' they be assigned? By default, the new columns created by this step from #' the original variables will be used as `predictors` in a model. @@ -23,8 +23,8 @@ #' @param keep_original_cols A logical to keep the original variables in #' the output. Defaults to `FALSE`. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/aggregate_list.R b/R/aggregate_list.R index e61e632..2ec8226 100644 --- a/R/aggregate_list.R +++ b/R/aggregate_list.R @@ -5,7 +5,7 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role For model terms created by this step, what analysis role should #' they be assigned? By default, the new columns created by this step from #' the original variables will be used as `predictors` in a model. @@ -25,8 +25,8 @@ #' @param keep_original_cols A logical to keep the original variables in #' the output. Defaults to `FALSE`. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/rownormalize_tss.R b/R/rownormalize_tss.R index 0008b7d..53864a9 100644 --- a/R/rownormalize_tss.R +++ b/R/rownormalize_tss.R @@ -6,14 +6,14 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role Not used by this step since no new variables are created. #' @param trained A logical to indicate if the quantities for preprocessing #' have been estimated. #' @param res This parameter is only produced after the recipe has been trained. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/select_background.R b/R/select_background.R index 4f4c04b..7760386 100644 --- a/R/select_background.R +++ b/R/select_background.R @@ -6,7 +6,7 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role Not used by this step since no new variables are created. #' @param trained A logical to indicate if the quantities for preprocessing #' have been estimated. @@ -15,8 +15,8 @@ #' feature exceeds `background_level` to be retained. #' @param res This parameter is only produced after the recipe has been trained. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/select_cv.R b/R/select_cv.R index cd21f54..e325025 100644 --- a/R/select_cv.R +++ b/R/select_cv.R @@ -29,15 +29,15 @@ cv <- function(x, na.rm = TRUE) { #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role Not used by this step since no new variables are created. #' @param trained A logical to indicate if the quantities for preprocessing #' have been estimated. #' @inheritParams var_to_keep #' @param res This parameter is only produced after the recipe has been trained. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/select_wilcoxon.R b/R/select_wilcoxon.R index 2aff11c..23f947a 100644 --- a/R/select_wilcoxon.R +++ b/R/select_wilcoxon.R @@ -6,7 +6,7 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role Not used by this step since no new variables are created. #' @param trained A logical to indicate if the quantities for preprocessing #' have been estimated. @@ -16,8 +16,8 @@ #' `p.adjust.methods`. Default to `"none"`. #' @param res This parameter is only produced after the recipe has been trained. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/R/taxonomy.R b/R/taxonomy.R index 78e2b10..b727473 100644 --- a/R/taxonomy.R +++ b/R/taxonomy.R @@ -6,7 +6,7 @@ #' @param recipe A recipe object. The step will be added to the sequence of #' operations for this recipe. #' @param ... One or more selector functions to choose variables -#' for this step. See [selections()] for more details. +#' for this step. See [recipes::selections()] for more details. #' @param role For model terms created by this step, what analysis role should #' they be assigned? By default, the new columns created by this step from #' the original variables will be used as `predictors` in a model. @@ -19,8 +19,8 @@ #' @param keep_original_cols A logical to keep the original variables in #' the output. Defaults to `FALSE`. #' @param skip A logical. Should the step be skipped when the -#' recipe is baked by [bake()]? While all operations are baked -#' when [prep()] is run, some operations may not be able to be +#' recipe is baked by [recipes::bake()]? While all operations are baked +#' when [recipes::prep()] is run, some operations may not be able to be #' conducted on new data (e.g. processing the outcome variable(s)). #' Care should be taken when using `skip = TRUE` as it may affect #' the computations for subsequent operations. diff --git a/man/step_aggregate_hclust.Rd b/man/step_aggregate_hclust.Rd index 7fed098..21b8a05 100644 --- a/man/step_aggregate_hclust.Rd +++ b/man/step_aggregate_hclust.Rd @@ -28,7 +28,7 @@ step_aggregate_hclust( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{For model terms created by this step, what analysis role should they be assigned? By default, the new columns created by this step from @@ -56,8 +56,8 @@ variables.} the output. Defaults to \code{FALSE}.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_aggregate_list.Rd b/man/step_aggregate_list.Rd index 430976d..9cb2c55 100644 --- a/man/step_aggregate_list.Rd +++ b/man/step_aggregate_list.Rd @@ -28,7 +28,7 @@ step_aggregate_list( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{For model terms created by this step, what analysis role should they be assigned? By default, the new columns created by this step from @@ -58,8 +58,8 @@ variables that are not named in \code{list_agg}.} the output. Defaults to \code{FALSE}.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_rownormalize_tss.Rd b/man/step_rownormalize_tss.Rd index 37b10b9..79377a4 100644 --- a/man/step_rownormalize_tss.Rd +++ b/man/step_rownormalize_tss.Rd @@ -22,7 +22,7 @@ step_rownormalize_tss( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{Not used by this step since no new variables are created.} @@ -32,8 +32,8 @@ have been estimated.} \item{res}{This parameter is only produced after the recipe has been trained.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_select_background.Rd b/man/step_select_background.Rd index 6754d5b..6a7378b 100644 --- a/man/step_select_background.Rd +++ b/man/step_select_background.Rd @@ -25,7 +25,7 @@ step_select_background( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{Not used by this step since no new variables are created.} @@ -40,8 +40,8 @@ feature exceeds \code{background_level} to be retained.} \item{res}{This parameter is only produced after the recipe has been trained.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_select_cv.Rd b/man/step_select_cv.Rd index 3e98ca0..c0463ec 100644 --- a/man/step_select_cv.Rd +++ b/man/step_select_cv.Rd @@ -25,7 +25,7 @@ step_select_cv( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{Not used by this step since no new variables are created.} @@ -43,8 +43,8 @@ discarded.} \item{res}{This parameter is only produced after the recipe has been trained.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_select_kruskal.Rd b/man/step_select_kruskal.Rd index e450686..db4d7f7 100644 --- a/man/step_select_kruskal.Rd +++ b/man/step_select_kruskal.Rd @@ -27,7 +27,7 @@ step_select_kruskal( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{Not used by this step since no new variables are created.} @@ -50,8 +50,8 @@ discarded.} \item{res}{This parameter is only produced after the recipe has been trained.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_select_wilcoxon.Rd b/man/step_select_wilcoxon.Rd index 177bc46..b251066 100644 --- a/man/step_select_wilcoxon.Rd +++ b/man/step_select_wilcoxon.Rd @@ -27,7 +27,7 @@ step_select_wilcoxon( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{Not used by this step since no new variables are created.} @@ -50,8 +50,8 @@ discarded.} \item{res}{This parameter is only produced after the recipe has been trained.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} diff --git a/man/step_taxonomy.Rd b/man/step_taxonomy.Rd index f4c43bf..6b708bb 100644 --- a/man/step_taxonomy.Rd +++ b/man/step_taxonomy.Rd @@ -24,7 +24,7 @@ step_taxonomy( operations for this recipe.} \item{...}{One or more selector functions to choose variables -for this step. See \code{\link[=selections]{selections()}} for more details.} +for this step. See \code{\link[recipes:selections]{recipes::selections()}} for more details.} \item{role}{For model terms created by this step, what analysis role should they be assigned? By default, the new columns created by this step from @@ -43,8 +43,8 @@ have been estimated.} the output. Defaults to \code{FALSE}.} \item{skip}{A logical. Should the step be skipped when the -recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked -when \code{\link[=prep]{prep()}} is run, some operations may not be able to be +recipe is baked by \code{\link[recipes:bake]{recipes::bake()}}? While all operations are baked +when \code{\link[recipes:prep]{recipes::prep()}} is run, some operations may not be able to be conducted on new data (e.g. processing the outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it may affect the computations for subsequent operations.} From 8d9271194201b8222494446817a49d3f77445eb4 Mon Sep 17 00:00:00 2001 From: abichat Date: Wed, 23 Jul 2025 20:44:33 +0200 Subject: [PATCH 5/6] usethis::use_air() --- .Rbuildignore | 2 + .vscode/extensions.json | 5 + .vscode/settings.json | 10 + R/aggregate.R | 18 +- R/aggregate_hclust.R | 118 ++++++---- R/aggregate_list.R | 105 +++++---- R/checks.R | 20 +- R/rownormalize_tss.R | 51 +++-- R/select_background.R | 58 +++-- R/select_cv.R | 77 ++++--- R/select_kruskal.R | 94 +++++--- R/select_wilcoxon.R | 94 +++++--- R/taxonomy.R | 68 +++--- R/to_keep.R | 20 +- README.Rmd | 18 +- README.md | 106 ++++----- air.toml | 0 data-raw/cheese_abundance.R | 45 ++-- data-raw/pedcan_expression.R | 24 +- dev/dev_history.R | 6 +- tests/testthat/test-aggregate.R | 27 ++- tests/testthat/test-aggregate_hclust.R | 91 ++++---- tests/testthat/test-aggregate_list.R | 290 ++++++++++++++---------- tests/testthat/test-checks.R | 19 +- tests/testthat/test-rownormalize_tss.R | 4 +- tests/testthat/test-select_background.R | 112 +++++---- tests/testthat/test-select_cv.R | 8 +- tests/testthat/test-select_kruskal.R | 56 +++-- tests/testthat/test-select_wilcoxon.R | 74 +++--- tests/testthat/test-taxonomy.R | 40 ++-- tests/testthat/test-to_keep.R | 43 ++-- vignettes/pedcan.Rmd | 20 +- 32 files changed, 1036 insertions(+), 687 deletions(-) create mode 100644 .vscode/extensions.json create mode 100644 .vscode/settings.json create mode 100644 air.toml diff --git a/.Rbuildignore b/.Rbuildignore index 1065232..5afbfee 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,5 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^[.]?air[.]toml$ +^\.vscode$ diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 0000000..344f76e --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,5 @@ +{ + "recommendations": [ + "Posit.air-vscode" + ] +} diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..a9f69fe --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,10 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + }, + "[quarto]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "quarto.quarto" + } +} diff --git a/R/aggregate.R b/R/aggregate.R index b23c2dc..ae89ff0 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -1,12 +1,18 @@ -aggregate_var <- function(data, list_agg, fun_agg, - prefix = "agg_", - keep_original_cols = FALSE) { - +aggregate_var <- function( + data, + list_agg, + fun_agg, + prefix = "agg_", + keep_original_cols = FALSE +) { list_agg <- fill_name(list_agg, prefix) for (i in seq_along(list_agg)) { - data[[names(list_agg[i])]] <- apply(data[, list_agg[[i]]], - MARGIN = 1, FUN = fun_agg) + data[[names(list_agg[i])]] <- apply( + data[, list_agg[[i]]], + MARGIN = 1, + FUN = fun_agg + ) } if (!keep_original_cols) { diff --git a/R/aggregate_hclust.R b/R/aggregate_hclust.R index 6310a93..2fcfe52 100644 --- a/R/aggregate_hclust.R +++ b/R/aggregate_hclust.R @@ -50,18 +50,21 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_aggregate_hclust <- function(recipe, ..., role = "predictor", - trained = FALSE, - n_clusters, - fun_agg, - dist_metric = "euclidean", - linkage_method = "complete", - res = NULL, - prefix = "cl_", - keep_original_cols = FALSE, - skip = FALSE, - id = rand_id("aggregate_hclust")) { - +step_aggregate_hclust <- function( + recipe, + ..., + role = "predictor", + trained = FALSE, + n_clusters, + fun_agg, + dist_metric = "euclidean", + linkage_method = "complete", + res = NULL, + prefix = "cl_", + keep_original_cols = FALSE, + skip = FALSE, + id = rand_id("aggregate_hclust") +) { add_step( recipe, step_aggregate_hclust_new( @@ -82,25 +85,35 @@ step_aggregate_hclust <- function(recipe, ..., role = "predictor", } #' @importFrom recipes step -step_aggregate_hclust_new <- function(terms, role, trained, - n_clusters, fun_agg, - dist_metric, linkage_method, - res, prefix, keep_original_cols, - skip, id) { - - step(subclass = "aggregate_hclust", - terms = terms, - role = role, - trained = trained, - n_clusters = n_clusters, - fun_agg = fun_agg, - dist_metric = dist_metric, - linkage_method = linkage_method, - res = res, - prefix = prefix, - keep_original_cols = keep_original_cols, - skip = skip, - id = id) +step_aggregate_hclust_new <- function( + terms, + role, + trained, + n_clusters, + fun_agg, + dist_metric, + linkage_method, + res, + prefix, + keep_original_cols, + skip, + id +) { + step( + subclass = "aggregate_hclust", + terms = terms, + role = role, + trained = trained, + n_clusters = n_clusters, + fun_agg = fun_agg, + dist_metric = dist_metric, + linkage_method = linkage_method, + res = res, + prefix = prefix, + keep_original_cols = keep_original_cols, + skip = skip, + id = id + ) } #' @export @@ -112,12 +125,32 @@ step_aggregate_hclust_new <- function(terms, role, trained, prep.step_aggregate_hclust <- function(x, training, info = NULL, ...) { col_names <- recipes_eval_select(x$terms, training, info) check_type(training[, col_names], quant = TRUE) - check_in(x$dist_metric, name_x = "dist_metric", - values = c("euclidean", "maximum", "manhattan", - "canberra", "binary", "minkowski")) - check_in(x$linkage_method, name_x = "linkage_method", - values = c("ward.D", "ward.D2", "single", "complete", - "average", "mcquitty", "median", "centroid")) + check_in( + x$dist_metric, + name_x = "dist_metric", + values = c( + "euclidean", + "maximum", + "manhattan", + "canberra", + "binary", + "minkowski" + ) + ) + check_in( + x$linkage_method, + name_x = "linkage_method", + values = c( + "ward.D", + "ward.D2", + "single", + "complete", + "average", + "mcquitty", + "median", + "centroid" + ) + ) ct <- training[, col_names] %>% @@ -132,7 +165,6 @@ prep.step_aggregate_hclust <- function(x, training, info = NULL, ...) { enframe(name = "terms", value = "aggregate") %>% mutate(aggregate = paste0(x$prefix, .data$aggregate)) - step_aggregate_hclust_new( terms = x$terms, role = x$role, @@ -158,9 +190,13 @@ bake.step_aggregate_hclust <- function(object, new_data, ...) { list_agg_hc <- split(object$res$terms, object$res$aggregate) - aggregate_var(new_data, list_agg = list_agg_hc, fun_agg = object$fun_agg, - prefix = object$prefix, - keep_original_cols = object$keep_original_cols) + aggregate_var( + new_data, + list_agg = list_agg_hc, + fun_agg = object$fun_agg, + prefix = object$prefix, + keep_original_cols = object$keep_original_cols + ) } #' @export diff --git a/R/aggregate_list.R b/R/aggregate_list.R index 2ec8226..533f27b 100644 --- a/R/aggregate_list.R +++ b/R/aggregate_list.R @@ -54,18 +54,21 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_aggregate_list <- function(recipe, ..., role = "predictor", - trained = FALSE, - list_agg = NULL, - fun_agg = NULL, - others = "discard", - name_others = "others", - res = NULL, - prefix = "agg_", - keep_original_cols = FALSE, - skip = FALSE, - id = rand_id("aggregate_list")) { - +step_aggregate_list <- function( + recipe, + ..., + role = "predictor", + trained = FALSE, + list_agg = NULL, + fun_agg = NULL, + others = "discard", + name_others = "others", + res = NULL, + prefix = "agg_", + keep_original_cols = FALSE, + skip = FALSE, + id = rand_id("aggregate_list") +) { add_step( recipe, step_aggregate_list_new( @@ -86,24 +89,35 @@ step_aggregate_list <- function(recipe, ..., role = "predictor", } #' @importFrom recipes step -step_aggregate_list_new <- function(terms, role, trained, - list_agg, fun_agg, others, name_others, - res, prefix, keep_original_cols, - skip, id) { - - step(subclass = "aggregate_list", - terms = terms, - role = role, - trained = trained, - list_agg = list_agg, - fun_agg = fun_agg, - others = others, - name_others = name_others, - res = res, - prefix = prefix, - keep_original_cols = keep_original_cols, - skip = skip, - id = id) +step_aggregate_list_new <- function( + terms, + role, + trained, + list_agg, + fun_agg, + others, + name_others, + res, + prefix, + keep_original_cols, + skip, + id +) { + step( + subclass = "aggregate_list", + terms = terms, + role = role, + trained = trained, + list_agg = list_agg, + fun_agg = fun_agg, + others = others, + name_others = name_others, + res = res, + prefix = prefix, + keep_original_cols = keep_original_cols, + skip = skip, + id = id + ) } #' @export @@ -114,8 +128,11 @@ step_aggregate_list_new <- function(terms, role, trained, #' @importFrom tidyr unnest_longer prep.step_aggregate_list <- function(x, training, info = NULL, ...) { col_names <- recipes_eval_select(x$terms, training, info) - check_in(x$others, name_x = "others", - values = c("discard", "asis", "aggregate")) + check_in( + x$others, + name_x = "others", + values = c("discard", "asis", "aggregate") + ) updt_list_agg <- x$list_agg @@ -134,15 +151,19 @@ prep.step_aggregate_list <- function(x, training, info = NULL, ...) { res_agg_list <- tibble(terms = unname(col_names)) %>% - left_join(df_agg, - by = "terms") + left_join(df_agg, by = "terms") if (x$others == "asis") { asis <- setdiff(col_names, unlist(updt_list_agg)) res_agg_list <- res_agg_list %>% - mutate(aggregate = if_else(.data$terms %in% .env$asis, - .data$terms, .data$aggregate)) + mutate( + aggregate = if_else( + .data$terms %in% .env$asis, + .data$terms, + .data$aggregate + ) + ) } step_aggregate_list_new( @@ -169,10 +190,13 @@ bake.step_aggregate_list <- function(object, new_data, ...) { check_new_data(col_names, object, new_data) new_df <- - aggregate_var(new_data, list_agg = object$list_agg, - fun_agg = object$fun_agg, - prefix = object$prefix, - keep_original_cols = object$keep_original_cols) + aggregate_var( + new_data, + list_agg = object$list_agg, + fun_agg = object$fun_agg, + prefix = object$prefix, + keep_original_cols = object$keep_original_cols + ) if (object$others == "discard" && !object$keep_original_cols) { to_discard <- @@ -183,7 +207,6 @@ bake.step_aggregate_list <- function(object, new_data, ...) { new_df[, to_discard] <- NULL } - new_df } diff --git a/R/checks.R b/R/checks.R index 55a18e9..08bc157 100644 --- a/R/checks.R +++ b/R/checks.R @@ -1,14 +1,19 @@ check_in <- function(x, values, name_x = "x") { - if (length(x) != 1) { rlang::abort(paste0("`", name_x, "` must be a length-one vector.")) } - if (!x %in% values) { all_values <- paste0(paste0('"', values, '"'), collapse = ", ") - rlang::abort(paste0("`", name_x, "` must be one of ", - all_values, '; not "', x, '".')) + rlang::abort(paste0( + "`", + name_x, + "` must be one of ", + all_values, + '; not "', + x, + '".' + )) } invisible(x) @@ -26,8 +31,11 @@ check_binary <- function(x, name_x = "x") { check_not_null <- function(x, name_x = "x") { if (is.null(x)) { - rlang::abort(paste0("`", name_x, - "` must be specified and can't be `NULL`.")) + rlang::abort(paste0( + "`", + name_x, + "` must be specified and can't be `NULL`." + )) } invisible(x) diff --git a/R/rownormalize_tss.R b/R/rownormalize_tss.R index 53864a9..0459819 100644 --- a/R/rownormalize_tss.R +++ b/R/rownormalize_tss.R @@ -37,10 +37,15 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_rownormalize_tss <- function(recipe, ..., role = NA, trained = FALSE, - res = NULL, skip = FALSE, - id = rand_id("rownormalize_tss")) { - +step_rownormalize_tss <- function( + recipe, + ..., + role = NA, + trained = FALSE, + res = NULL, + skip = FALSE, + id = rand_id("rownormalize_tss") +) { add_step( recipe, step_normalize_tss_new( @@ -55,17 +60,26 @@ step_rownormalize_tss <- function(recipe, ..., role = NA, trained = FALSE, } #' @importFrom recipes step -step_normalize_tss_new <- function(terms, role, trained, - n_kept, prop_kept, cutoff, - res, skip, id) { - - step(subclass = "rownormalize_tss", - terms = terms, - role = role, - trained = trained, - res = res, - skip = skip, - id = id) +step_normalize_tss_new <- function( + terms, + role, + trained, + n_kept, + prop_kept, + cutoff, + res, + skip, + id +) { + step( + subclass = "rownormalize_tss", + terms = terms, + role = role, + trained = trained, + res = res, + skip = skip, + id = id + ) } #' @export @@ -101,8 +115,11 @@ bake.step_rownormalize_tss <- function(object, new_data, ...) { #' @export #' @importFrom recipes print_step -print.step_rownormalize_tss <- function(x, - width = max(20, options()$width - 35), ...) { +print.step_rownormalize_tss <- function( + x, + width = max(20, options()$width - 35), + ... +) { title <- "TSS normalization on " print_step( diff --git a/R/select_background.R b/R/select_background.R index 7760386..a25f1cc 100644 --- a/R/select_background.R +++ b/R/select_background.R @@ -42,14 +42,18 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_select_background <- function(recipe, ..., role = NA, trained = FALSE, - background_level = NULL, - n_samples = NULL, - prop_samples = NULL, - res = NULL, - skip = FALSE, - id = rand_id("select_background")) { - +step_select_background <- function( + recipe, + ..., + role = NA, + trained = FALSE, + background_level = NULL, + n_samples = NULL, + prop_samples = NULL, + res = NULL, + skip = FALSE, + id = rand_id("select_background") +) { add_step( recipe, step_select_background_new( @@ -68,21 +72,29 @@ step_select_background <- function(recipe, ..., role = NA, trained = FALSE, #' @importFrom recipes step -step_select_background_new <- function(terms, role, trained, - background_level, - n_samples, prop_samples, - res, skip, id) { - - step(subclass = "select_background", - terms = terms, - role = role, - trained = trained, - background_level = background_level, - n_samples = n_samples, - prop_samples = prop_samples, - res = res, - skip = skip, - id = id) +step_select_background_new <- function( + terms, + role, + trained, + background_level, + n_samples, + prop_samples, + res, + skip, + id +) { + step( + subclass = "select_background", + terms = terms, + role = role, + trained = trained, + background_level = background_level, + n_samples = n_samples, + prop_samples = prop_samples, + res = res, + skip = skip, + id = id + ) } #' @export diff --git a/R/select_cv.R b/R/select_cv.R index e325025..cc930dc 100644 --- a/R/select_cv.R +++ b/R/select_cv.R @@ -19,8 +19,6 @@ cv <- function(x, na.rm = TRUE) { } - - #' Feature selection step using the coefficient of variation #' #' Select variables with highest coefficient of variation. @@ -61,13 +59,18 @@ cv <- function(x, na.rm = TRUE) { #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_select_cv <- function(recipe, ..., role = NA, trained = FALSE, - n_kept = NULL, - prop_kept = NULL, - cutoff = NULL, - res = NULL, - skip = FALSE, id = rand_id("select_cv")) { - +step_select_cv <- function( + recipe, + ..., + role = NA, + trained = FALSE, + n_kept = NULL, + prop_kept = NULL, + cutoff = NULL, + res = NULL, + skip = FALSE, + id = rand_id("select_cv") +) { add_step( recipe, step_select_cv_new( @@ -85,20 +88,29 @@ step_select_cv <- function(recipe, ..., role = NA, trained = FALSE, } #' @importFrom recipes step -step_select_cv_new <- function(terms, role, trained, - n_kept, prop_kept, cutoff, - res, skip, id) { - - step(subclass = "select_cv", - terms = terms, - role = role, - trained = trained, - n_kept = n_kept, - prop_kept = prop_kept, - cutoff = cutoff, - res = res, - skip = skip, - id = id) +step_select_cv_new <- function( + terms, + role, + trained, + n_kept, + prop_kept, + cutoff, + res, + skip, + id +) { + step( + subclass = "select_cv", + terms = terms, + role = role, + trained = trained, + n_kept = n_kept, + prop_kept = prop_kept, + cutoff = cutoff, + res = res, + skip = skip, + id = id + ) } #' @export @@ -109,13 +121,19 @@ prep.step_select_cv <- function(x, training, info = NULL, ...) { col_names <- recipes_eval_select(x$terms, training, info) check_type(training[, col_names], quant = TRUE) - res_cv <- training[, col_names] %>% apply(2, cv) %>% enframe(name = "terms", value = "cv") %>% - mutate(kept = var_to_keep(.data$cv, x$n_kept, x$prop_kept, x$cutoff, - maximize = TRUE)) + mutate( + kept = var_to_keep( + .data$cv, + x$n_kept, + x$prop_kept, + x$cutoff, + maximize = TRUE + ) + ) step_select_cv_new( terms = x$terms, @@ -151,8 +169,11 @@ bake.step_select_cv <- function(object, new_data, ...) { #' @export #' @importFrom recipes print_step -print.step_select_cv <- function(x, - width = max(20, options()$width - 35), ...) { +print.step_select_cv <- function( + x, + width = max(20, options()$width - 35), + ... +) { title <- "Top CV filtering on " print_step( diff --git a/R/select_kruskal.R b/R/select_kruskal.R index bc1ac5a..9b0df13 100644 --- a/R/select_kruskal.R +++ b/R/select_kruskal.R @@ -25,16 +25,20 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_select_kruskal <- function(recipe, ..., role = NA, trained = FALSE, - outcome = NULL, - n_kept = NULL, - prop_kept = NULL, - cutoff = NULL, - correction = "none", - res = NULL, - skip = FALSE, - id = rand_id("select_kruskal")) { - +step_select_kruskal <- function( + recipe, + ..., + role = NA, + trained = FALSE, + outcome = NULL, + n_kept = NULL, + prop_kept = NULL, + cutoff = NULL, + correction = "none", + res = NULL, + skip = FALSE, + id = rand_id("select_kruskal") +) { add_step( recipe, step_select_kruskal_new( @@ -54,22 +58,33 @@ step_select_kruskal <- function(recipe, ..., role = NA, trained = FALSE, } #' @importFrom recipes step -step_select_kruskal_new <- function(terms, role, trained, outcome, - n_kept, prop_kept, cutoff, correction, - res, skip, id) { - - step(subclass = "select_kruskal", - terms = terms, - role = role, - trained = trained, - outcome = outcome, - n_kept = n_kept, - prop_kept = prop_kept, - cutoff = cutoff, - correction = correction, - res = res, - skip = skip, - id = id) +step_select_kruskal_new <- function( + terms, + role, + trained, + outcome, + n_kept, + prop_kept, + cutoff, + correction, + res, + skip, + id +) { + step( + subclass = "select_kruskal", + terms = terms, + role = role, + trained = trained, + outcome = outcome, + n_kept = n_kept, + prop_kept = prop_kept, + cutoff = cutoff, + correction = correction, + res = res, + skip = skip, + id = id + ) } #' @export @@ -91,20 +106,33 @@ prep.step_select_kruskal <- function(x, training, info = NULL, ...) { pvs[i] <- kruskal.test(formula = frml, data = training)$p.value } - res_krsk <- tibble(terms = unname(col_names), - pv = pvs) + res_krsk <- tibble(terms = unname(col_names), pv = pvs) if (x$correction == "none") { res_krsk <- res_krsk %>% - mutate(kept = var_to_keep(.data$pv, x$n_kept, x$prop_kept, x$cutoff, - maximize = FALSE)) + mutate( + kept = var_to_keep( + .data$pv, + x$n_kept, + x$prop_kept, + x$cutoff, + maximize = FALSE + ) + ) } else { res_krsk <- res_krsk %>% - mutate(qv = p.adjust(.data$pv, method = x$correction), - kept = var_to_keep(.data$qv, x$n_kept, x$prop_kept, x$cutoff, - maximize = FALSE)) + mutate( + qv = p.adjust(.data$pv, method = x$correction), + kept = var_to_keep( + .data$qv, + x$n_kept, + x$prop_kept, + x$cutoff, + maximize = FALSE + ) + ) } step_select_kruskal_new( diff --git a/R/select_wilcoxon.R b/R/select_wilcoxon.R index 23f947a..f8b2b23 100644 --- a/R/select_wilcoxon.R +++ b/R/select_wilcoxon.R @@ -44,16 +44,20 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_select_wilcoxon <- function(recipe, ..., role = NA, trained = FALSE, - outcome = NULL, - n_kept = NULL, - prop_kept = NULL, - cutoff = NULL, - correction = "none", - res = NULL, - skip = FALSE, - id = rand_id("select_wilcoxon")) { - +step_select_wilcoxon <- function( + recipe, + ..., + role = NA, + trained = FALSE, + outcome = NULL, + n_kept = NULL, + prop_kept = NULL, + cutoff = NULL, + correction = "none", + res = NULL, + skip = FALSE, + id = rand_id("select_wilcoxon") +) { add_step( recipe, step_select_wilcoxon_new( @@ -73,22 +77,33 @@ step_select_wilcoxon <- function(recipe, ..., role = NA, trained = FALSE, } #' @importFrom recipes step -step_select_wilcoxon_new <- function(terms, role, trained, outcome, - n_kept, prop_kept, cutoff, correction, - res, skip, id) { - - step(subclass = "select_wilcoxon", - terms = terms, - role = role, - trained = trained, - outcome = outcome, - n_kept = n_kept, - prop_kept = prop_kept, - cutoff = cutoff, - correction = correction, - res = res, - skip = skip, - id = id) +step_select_wilcoxon_new <- function( + terms, + role, + trained, + outcome, + n_kept, + prop_kept, + cutoff, + correction, + res, + skip, + id +) { + step( + subclass = "select_wilcoxon", + terms = terms, + role = role, + trained = trained, + outcome = outcome, + n_kept = n_kept, + prop_kept = prop_kept, + cutoff = cutoff, + correction = correction, + res = res, + skip = skip, + id = id + ) } #' @export @@ -111,20 +126,33 @@ prep.step_select_wilcoxon <- function(x, training, info = NULL, ...) { pvs[i] <- wilcox.test(formula = frml, data = training)$p.value } - res_wlcx <- tibble(terms = unname(col_names), - pv = pvs) + res_wlcx <- tibble(terms = unname(col_names), pv = pvs) if (x$correction == "none") { res_wlcx <- res_wlcx %>% - mutate(kept = var_to_keep(.data$pv, x$n_kept, x$prop_kept, x$cutoff, - maximize = FALSE)) + mutate( + kept = var_to_keep( + .data$pv, + x$n_kept, + x$prop_kept, + x$cutoff, + maximize = FALSE + ) + ) } else { res_wlcx <- res_wlcx %>% - mutate(qv = p.adjust(.data$pv, method = x$correction), - kept = var_to_keep(.data$qv, x$n_kept, x$prop_kept, x$cutoff, - maximize = FALSE)) + mutate( + qv = p.adjust(.data$pv, method = x$correction), + kept = var_to_keep( + .data$qv, + x$n_kept, + x$prop_kept, + x$cutoff, + maximize = FALSE + ) + ) } step_select_wilcoxon_new( diff --git a/R/taxonomy.R b/R/taxonomy.R index b727473..19b519e 100644 --- a/R/taxonomy.R +++ b/R/taxonomy.R @@ -47,11 +47,17 @@ #' rec #' tidy(rec, 1) #' bake(rec, new_data = NULL) -step_taxonomy <- function(recipe, ..., role = "predictor", trained = FALSE, - rank = NULL, res = NULL, - keep_original_cols = FALSE, - skip = FALSE, id = rand_id("taxonomy")) { - +step_taxonomy <- function( + recipe, + ..., + role = "predictor", + trained = FALSE, + rank = NULL, + res = NULL, + keep_original_cols = FALSE, + skip = FALSE, + id = rand_id("taxonomy") +) { add_step( recipe, step_taxonomy_new( @@ -68,19 +74,27 @@ step_taxonomy <- function(recipe, ..., role = "predictor", trained = FALSE, } #' @importFrom recipes step -step_taxonomy_new <- function(terms, role, trained, - rank, res, - keep_original_cols, skip, id) { - - step(subclass = "taxonomy", - terms = terms, - role = role, - trained = trained, - rank = rank, - res = res, - keep_original_cols = keep_original_cols, - skip = skip, - id = id) +step_taxonomy_new <- function( + terms, + role, + trained, + rank, + res, + keep_original_cols, + skip, + id +) { + step( + subclass = "taxonomy", + terms = terms, + role = role, + trained = trained, + rank = rank, + res = res, + keep_original_cols = keep_original_cols, + skip = skip, + id = id + ) } #' @export @@ -91,9 +105,7 @@ prep.step_taxonomy <- function(x, training, info = NULL, ...) { check_type(training[, col_names], quant = FALSE) check_not_null(x$rank, "rank") - - res_txn <- expand_grid(terms = unname(col_names), - rank = x$rank) + res_txn <- expand_grid(terms = unname(col_names), rank = x$rank) step_taxonomy_new( terms = x$terms, @@ -117,9 +129,13 @@ bake.step_taxonomy <- function(object, new_data, ...) { for (i in seq_len(nrow(object$res))) { new_col <- paste0(object$res$terms[i], "_", object$res$rank[i]) - yatah_call <- call2("get_clade", .ns = "yatah", - lineage = new_data[[object$res$terms[i]]], - rank = object$res$rank[i], same = TRUE) + yatah_call <- call2( + "get_clade", + .ns = "yatah", + lineage = new_data[[object$res$terms[i]]], + rank = object$res$rank[i], + same = TRUE + ) new_data[[new_col]] <- eval_tidy(yatah_call) } @@ -132,8 +148,7 @@ bake.step_taxonomy <- function(object, new_data, ...) { #' @export #' @importFrom recipes print_step -print.step_taxonomy <- function(x, - width = max(20, options()$width - 35), ...) { +print.step_taxonomy <- function(x, width = max(20, options()$width - 35), ...) { title <- "Taxonomy features from " print_step( @@ -180,4 +195,3 @@ tidy.step_taxonomy <- function(x, ...) { required_pkgs.step_taxonomy <- function(x, ...) { c("yatah", "scimo") } - diff --git a/R/to_keep.R b/R/to_keep.R index be2b287..92b8844 100644 --- a/R/to_keep.R +++ b/R/to_keep.R @@ -21,24 +21,22 @@ #' @examples #' scimo:::var_to_keep(1:5, n_kept = 3, maximize = TRUE) #' scimo:::var_to_keep(1:10, cutoff = 8, maximize = FALSE) -var_to_keep <- function(values, n_kept = NULL, prop_kept = NULL, - cutoff = NULL, maximize = TRUE) { - - +var_to_keep <- function( + values, + n_kept = NULL, + prop_kept = NULL, + cutoff = NULL, + maximize = TRUE +) { if (!is.null(n_kept) & !is.null(prop_kept)) { - abort("`n_kept` and `prop_kept` are mutually exclusive.") - } else if (!is.null(n_kept)) { - if (maximize) { to_keep <- rank(-values, ties.method = "min") <= n_kept } else { to_keep <- rank(values, ties.method = "min") <= n_kept } - } else if (!is.null(prop_kept)) { - n_from_prop <- prop_kept * length(values) if (maximize) { @@ -46,14 +44,10 @@ var_to_keep <- function(values, n_kept = NULL, prop_kept = NULL, } else { to_keep <- rank(values, ties.method = "min") <= n_from_prop } - } else if (is.null(n_kept) & is.null(prop_kept)) { - to_keep <- rep(TRUE, length(values)) - } - if (!is.null(cutoff)) { if (maximize) { to_keep[values < cutoff] <- FALSE diff --git a/README.Rmd b/README.Rmd index 002de57..7b594ee 100644 --- a/README.Rmd +++ b/README.Rmd @@ -69,12 +69,18 @@ The following recipe will ```{r recipe} rec <- - recipe(cheese ~ ., data = cheese_abundance) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = list_family, fun_agg = sum) %>% - step_rownormalize_tss(all_numeric_predictors()) %>% - step_select_kruskal(all_numeric_predictors(), - outcome = "cheese", cutoff = 0.05) %>% + recipe(cheese ~ ., data = cheese_abundance) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = list_family, + fun_agg = sum + ) %>% + step_rownormalize_tss(all_numeric_predictors()) %>% + step_select_kruskal( + all_numeric_predictors(), + outcome = "cheese", + cutoff = 0.05 + ) %>% prep() rec diff --git a/README.md b/README.md index 1ab4f38..e16a54c 100644 --- a/README.md +++ b/README.md @@ -35,37 +35,36 @@ data("cheese_abundance", "cheese_taxonomy") cheese_abundance #> # A tibble: 9 × 77 -#> sample cheese rind_type asv_01 asv_02 asv_03 asv_04 asv_05 asv_06 asv_07 -#> -#> 1 sample1-1 Saint-Ne… Natural 1 0 38 40 1 2 31 -#> 2 sample1-2 Saint-Ne… Natural 3 4 38 61 4 4 48 -#> 3 sample1-3 Saint-Ne… Natural 28 16 33 23 31 29 21 -#> 4 sample2-1 Livarot Washed 0 2 1 0 5 1 0 -#> 5 sample2-2 Livarot Washed 0 0 4 0 1 1 2 -#> 6 sample2-3 Livarot Washed 0 1 2 0 2 1 0 -#> 7 sample3-1 Epoisses Washed 4 2 3 0 2 5 0 -#> 8 sample3-2 Epoisses Washed 0 0 0 0 0 0 0 -#> 9 sample3-3 Epoisses Washed 0 0 1 0 0 0 2 -#> # ℹ 67 more variables: asv_08 , asv_09 , asv_10 , asv_11 , -#> # asv_12 , asv_13 , asv_14 , asv_15 , asv_16 , -#> # asv_17 , asv_18 , asv_19 , asv_20 , asv_21 , -#> # asv_22 , asv_23 , asv_24 , asv_25 , asv_26 , -#> # asv_27 , asv_28 , asv_29 , asv_30 , asv_31 , -#> # asv_32 , asv_33 , asv_34 , asv_35 , asv_36 , -#> # asv_37 , asv_38 , asv_39 , asv_40 , asv_41 , … +#> sample cheese rind_type asv_01 asv_02 asv_03 asv_04 asv_05 asv_06 asv_07 asv_08 asv_09 asv_10 asv_11 asv_12 asv_13 asv_14 asv_15 asv_16 asv_17 asv_18 +#> +#> 1 sample1-1 Saint-… Natural 1 0 38 40 1 2 31 8 15 20076 160 92 64 24 51 0 0 10 +#> 2 sample1-2 Saint-… Natural 3 4 38 61 4 4 48 14 20 32101 403 143 165 39 104 1 0 28 +#> 3 sample1-3 Saint-… Natural 28 16 33 23 31 29 21 1 7 12921 134 53 55 16 45 2 3 10 +#> 4 sample2-1 Livarot Washed 0 2 1 0 5 1 0 0 0 7823 2 0 0 42 0 2 3 2 +#> 5 sample2-2 Livarot Washed 0 0 4 0 1 1 2 0 0 6740 4 1 0 45 0 1 4 0 +#> 6 sample2-3 Livarot Washed 0 1 2 0 2 1 0 0 0 7484 6 1 0 43 0 7 1 1 +#> 7 sample3-1 Epoiss… Washed 4 2 3 0 2 5 0 0 0 2486 1 1 1 23 0 24 10 0 +#> 8 sample3-2 Epoiss… Washed 0 0 0 0 0 0 0 0 0 3686 2 0 0 28 0 54 23 1 +#> 9 sample3-3 Epoiss… Washed 0 0 1 0 0 0 2 0 0 2988 2 1 0 22 0 36 12 1 +#> # ℹ 56 more variables: asv_19 , asv_20 , asv_21 , asv_22 , asv_23 , asv_24 , asv_25 , asv_26 , asv_27 , +#> # asv_28 , asv_29 , asv_30 , asv_31 , asv_32 , asv_33 , asv_34 , asv_35 , asv_36 , asv_37 , +#> # asv_38 , asv_39 , asv_40 , asv_41 , asv_42 , asv_43 , asv_44 , asv_45 , asv_46 , asv_47 , +#> # asv_48 , asv_49 , asv_50 , asv_51 , asv_52 , asv_53 , asv_54 , asv_55 , asv_56 , asv_57 , +#> # asv_58 , asv_59 , asv_60 , asv_61 , asv_62 , asv_63 , asv_64 , asv_65 , asv_66 , asv_67 , +#> # asv_68 , asv_69 , asv_70 , asv_71 , asv_72 , asv_73 , asv_74 glimpse(cheese_taxonomy) #> Rows: 74 #> Columns: 9 -#> $ asv "asv_01", "asv_02", "asv_03", "asv_04", "asv_05", "asv_06", "a… -#> $ lineage "k__Fungi|p__Ascomycota|c__Dothideomycetes|o__Dothideales|f__D… -#> $ kingdom "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi",… -#> $ phylum "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascom… -#> $ class "Dothideomycetes", "Eurotiomycetes", "Eurotiomycetes", "Euroti… -#> $ order "Dothideales", "Eurotiales", "Eurotiales", "Eurotiales", "Euro… -#> $ family "Dothioraceae", "Aspergillaceae", "Aspergillaceae", "Aspergill… -#> $ genus "Aureobasidium", "Aspergillus", "Penicillium", "Penicillium", … -#> $ species "Aureobasidium Group pullulans", "Aspergillus fumigatus", "Pen… +#> $ asv "asv_01", "asv_02", "asv_03", "asv_04", "asv_05", "asv_06", "asv_07", "asv_08", "asv_09", "asv_10", "asv_11", "asv_12", "asv_13", "asv_14… +#> $ lineage "k__Fungi|p__Ascomycota|c__Dothideomycetes|o__Dothideales|f__Dothioraceae|g__Aureobasidium|s__Aureobasidium_Group_pullulans", "k__Fungi|p… +#> $ kingdom "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "F… +#> $ phylum "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota… +#> $ class "Dothideomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomy… +#> $ order "Dothideales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Saccharom… +#> $ family "Dothioraceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillace… +#> $ genus "Aureobasidium", "Aspergillus", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", … +#> $ species "Aureobasidium Group pullulans", "Aspergillus fumigatus", "Penicillium Group camemberti caseifulvum fuscoglaucum commune", "Penicillium b… ``` ``` r @@ -75,8 +74,7 @@ head(list_family, 2) #> [1] "asv_02" "asv_03" "asv_04" "asv_05" "asv_06" "asv_07" "asv_08" "asv_09" #> #> $Debaryomycetaceae -#> [1] "asv_10" "asv_11" "asv_12" "asv_13" "asv_14" "asv_15" "asv_16" "asv_17" -#> [9] "asv_18" "asv_19" "asv_20" "asv_21" "asv_22" +#> [1] "asv_10" "asv_11" "asv_12" "asv_13" "asv_14" "asv_15" "asv_16" "asv_17" "asv_18" "asv_19" "asv_20" "asv_21" "asv_22" ``` The following recipe will @@ -89,17 +87,23 @@ The following recipe will ``` r rec <- - recipe(cheese ~ ., data = cheese_abundance) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = list_family, fun_agg = sum) %>% - step_rownormalize_tss(all_numeric_predictors()) %>% - step_select_kruskal(all_numeric_predictors(), - outcome = "cheese", cutoff = 0.05) %>% + recipe(cheese ~ ., data = cheese_abundance) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = list_family, + fun_agg = sum + ) %>% + step_rownormalize_tss(all_numeric_predictors()) %>% + step_select_kruskal( + all_numeric_predictors(), + outcome = "cheese", + cutoff = 0.05 + ) %>% prep() rec #> -#> ── Recipe ────────────────────────────────────────────────────────────────────── +#> ── Recipe ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── #> #> ── Inputs #> Number of variables by role @@ -110,25 +114,23 @@ rec #> Training data contained 9 data points and no incomplete rows. #> #> ── Operations -#> • Aggregation of: asv_01, asv_02, asv_03, asv_04, asv_05, ... | Trained -#> • TSS normalization on: Aspergillaceae and Debaryomycetaceae, ... | Trained -#> • Kruskal filtering against cheese on: Aspergillaceae, ... | Trained +#> • Aggregation of: asv_01, asv_02, asv_03, asv_04, asv_05, asv_06, asv_07, asv_08, asv_09, asv_10, asv_11, asv_12, asv_13, asv_14, asv_15, ... | Trained +#> • TSS normalization on: Aspergillaceae, Debaryomycetaceae, Dipodascaceae, Dothioraceae, Lichtheimiaceae, Metschnikowiaceae, Mucoraceae, ... | Trained +#> • Kruskal filtering against cheese on: Aspergillaceae, Debaryomycetaceae, Dipodascaceae, Dothioraceae, Lichtheimiaceae, ... | Trained bake(rec, new_data = NULL) #> # A tibble: 9 × 8 -#> sample rind_type cheese Debaryomycetaceae Dipodascaceae Saccharomycetaceae -#> -#> 1 sample1-1 Natural Saint-… 0.719 0.0684 0.113 -#> 2 sample1-2 Natural Saint-… 0.715 0.0725 0.119 -#> 3 sample1-3 Natural Saint-… 0.547 0.277 0.0938 -#> 4 sample2-1 Washed Livarot 0.153 0.845 0.000854 -#> 5 sample2-2 Washed Livarot 0.150 0.848 0.00106 -#> 6 sample2-3 Washed Livarot 0.160 0.837 0.00108 -#> 7 sample3-1 Washed Epoiss… 0.0513 0.944 0.00327 -#> 8 sample3-2 Washed Epoiss… 0.0558 0.941 0.00321 -#> 9 sample3-3 Washed Epoiss… 0.0547 0.942 0.00329 -#> # ℹ 2 more variables: `Saccharomycetales fam Incertae sedis` , -#> # Trichosporonaceae +#> sample rind_type cheese Debaryomycetaceae Dipodascaceae Saccharomycetaceae `Saccharomycetales fam Incertae sedis` Trichosporonaceae +#> +#> 1 sample1-1 Natural Saint-Nectaire 0.719 0.0684 0.113 0.00130 0.000702 +#> 2 sample1-2 Natural Saint-Nectaire 0.715 0.0725 0.119 0.000801 0.000628 +#> 3 sample1-3 Natural Saint-Nectaire 0.547 0.277 0.0938 0.000289 0.00239 +#> 4 sample2-1 Washed Livarot 0.153 0.845 0.000854 0 0.000349 +#> 5 sample2-2 Washed Livarot 0.150 0.848 0.00106 0 0.000176 +#> 6 sample2-3 Washed Livarot 0.160 0.837 0.00108 0 0.000212 +#> 7 sample3-1 Washed Epoisses 0.0513 0.944 0.00327 0 0.000140 +#> 8 sample3-2 Washed Epoisses 0.0558 0.941 0.00321 0 0.000176 +#> 9 sample3-3 Washed Epoisses 0.0547 0.942 0.00329 0 0.000125 ``` To see which variables are kept and the associated p-values, you can use diff --git a/air.toml b/air.toml new file mode 100644 index 0000000..e69de29 diff --git a/data-raw/cheese_abundance.R b/data-raw/cheese_abundance.R index ccc8460..96cd309 100644 --- a/data-raw/cheese_abundance.R +++ b/data-raw/cheese_abundance.R @@ -10,33 +10,46 @@ cheese_taxonomy <- tax_table() %>% as.data.frame() %>% as_tibble(rownames = "sequence") %>% - mutate(lineage = glue("k__{Kingdom}|p__{Phylum}|c__{Class}|o__{Order}|f__{Family}|g__{Genus}|s__{Species}"), - lineage = str_replace_all(lineage, " ", "_")) %>% + mutate( + lineage = glue( + "k__{Kingdom}|p__{Phylum}|c__{Class}|o__{Order}|f__{Family}|g__{Genus}|s__{Species}" + ), + lineage = str_replace_all(lineage, " ", "_") + ) %>% arrange(lineage) %>% rowid_to_column(var = "asv") %>% - mutate(asv = if_else(asv >= 10, - paste0("asv_", asv), - paste0("asv_0", asv))) %>% + mutate( + asv = if_else(asv >= 10, paste0("asv_", asv), paste0("asv_0", asv)) + ) %>% select(asv, lineage, everything()) %>% janitor::clean_names() cheese_abundance <- cheese_taxonomy %>% select(asv, sequence) %>% - left_join(otu_table(phylo_cheese)@.Data %>% - as_tibble(rownames = "sequence"), by = "sequence") %>% + left_join( + otu_table(phylo_cheese)@.Data %>% + as_tibble(rownames = "sequence"), + by = "sequence" + ) %>% select(-sequence) %>% pivot_longer(-asv, names_to = "sample", values_to = "count") %>% pivot_wider(names_from = asv, values_from = count) %>% - mutate(sample = str_remove_all(sample, "_ITS2_CURATED"), - sample = str_replace_all(sample, "echantillon", "sample")) %>% - mutate(cheese = str_remove_all(sample, "sample"), - cheese = str_remove_all(cheese, "-[1-3]"), - cheese = case_when(cheese == 1 ~ "Saint-Nectaire", - cheese == 2 ~ "Livarot", - cheese == 3 ~ "Epoisses"), - rind_type = if_else(cheese == "Saint-Nectaire", "Natural", "Washed"), - .after = sample) + mutate( + sample = str_remove_all(sample, "_ITS2_CURATED"), + sample = str_replace_all(sample, "echantillon", "sample") + ) %>% + mutate( + cheese = str_remove_all(sample, "sample"), + cheese = str_remove_all(cheese, "-[1-3]"), + cheese = case_when( + cheese == 1 ~ "Saint-Nectaire", + cheese == 2 ~ "Livarot", + cheese == 3 ~ "Epoisses" + ), + rind_type = if_else(cheese == "Saint-Nectaire", "Natural", "Washed"), + .after = sample + ) cheese_taxonomy <- select(cheese_taxonomy, -sequence) diff --git a/data-raw/pedcan_expression.R b/data-raw/pedcan_expression.R index 7b178d9..af96217 100644 --- a/data-raw/pedcan_expression.R +++ b/data-raw/pedcan_expression.R @@ -19,12 +19,23 @@ df_expr_raw <- df_model <- df_model_raw %>% - select(model_id, cell_line = cell_line_name, sex, - event = primary_or_metastasis, - disease = oncotree_primary_disease) %>% - filter(disease %in% c("Ewing Sarcoma", "Rhabdomyosarcoma", - "Osteosarcoma", "Embryonal Tumor", - "Neuroblastoma")) %>% + select( + model_id, + cell_line = cell_line_name, + sex, + event = primary_or_metastasis, + disease = oncotree_primary_disease + ) %>% + filter( + disease %in% + c( + "Ewing Sarcoma", + "Rhabdomyosarcoma", + "Osteosarcoma", + "Embryonal Tumor", + "Neuroblastoma" + ) + ) %>% mutate(event = if_else(is.na(event), "Unknown", event)) %>% arrange(cell_line) @@ -40,5 +51,4 @@ pedcan_expression <- inner_join(df_expr, by = "model_id") %>% select(-model_id) - # usethis::use_data(pedcan_expression, overwrite = TRUE) diff --git a/dev/dev_history.R b/dev/dev_history.R index 1ad2d32..527de77 100644 --- a/dev/dev_history.R +++ b/dev/dev_history.R @@ -16,7 +16,6 @@ library(testthat) # use_package_doc() # use_pipe() - # use_r("select_cv") # use_r("to_keep") @@ -70,6 +69,7 @@ library(testthat) # scimo scimo website +# use_air() #### @@ -92,7 +92,8 @@ goodpractice::goodpractice() #### devtools::install(upgrade = "never") -rmarkdown::render("README.Rmd"); file.remove("README.html") +rmarkdown::render("README.Rmd") +file.remove("README.html") devtools::install(upgrade = "never") @@ -100,4 +101,3 @@ devtools::install(upgrade = "never") pkgdown::check_pkgdown() pkgdown::build_site() unlink("pkgdown/", recursive = TRUE) - diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 5256c9d..4f4f547 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -1,19 +1,26 @@ test_that("aggregate_var works", { - list_iris <- - list(sepal = c("Sepal.Length", "Sepal.Width"), - petal = c("Petal.Length", "Petal.Width"), - c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")) + list( + sepal = c("Sepal.Length", "Sepal.Width"), + petal = c("Petal.Length", "Petal.Width"), + c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") + ) - agg1 <- aggregate_var(iris, list_agg = list_iris, fun_agg = prod, - prefix = "group", keep_original_cols = TRUE) + agg1 <- aggregate_var( + iris, + list_agg = list_iris, + fun_agg = prod, + prefix = "group", + keep_original_cols = TRUE + ) - expect_equal(colnames(agg1), - c(names(iris), names(list_iris[1:2]), "group3")) + expect_equal(colnames(agg1), c(names(iris), names(list_iris[1:2]), "group3")) expect_equal(agg1[, 1:5], iris) expect_equal(agg1$sepal, iris$Sepal.Length * iris$Sepal.Width) - expect_equal(agg1$group3, iris$Sepal.Length * iris$Sepal.Width * - iris$Petal.Length * iris$Petal.Width) + expect_equal( + agg1$group3, + iris$Sepal.Length * iris$Sepal.Width * iris$Petal.Length * iris$Petal.Width + ) agg2 <- aggregate_var(iris, list_agg = list_iris, fun_agg = prod) diff --git a/tests/testthat/test-aggregate_hclust.R b/tests/testthat/test-aggregate_hclust.R index c4b9b13..c1f4b5f 100644 --- a/tests/testthat/test-aggregate_hclust.R +++ b/tests/testthat/test-aggregate_hclust.R @@ -20,13 +20,16 @@ rnd_asv_group <- names(clustering[clustering == clustering[rnd_asv]]) test_that("step_aggregate_hclust works", { - rec <- - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_hclust(all_numeric_predictors(), - n_clusters = nc, fun_agg = sum, - prefix = "hc_", dist_metric = "manhattan", - linkage_method = "ward.D2") + recipe(~., data = cheese_abundance) %>% + step_aggregate_hclust( + all_numeric_predictors(), + n_clusters = nc, + fun_agg = sum, + prefix = "hc_", + dist_metric = "manhattan", + linkage_method = "ward.D2" + ) expect_equal(nrow(tidy(rec, 1)), 1) @@ -35,14 +38,16 @@ test_that("step_aggregate_hclust works", { expect_equal(nrow(hclust_tidy), ncol(cheese_abundance) - 3) - - # check set equality on random cluster + # check set equality on random cluster expect_setequal( hclust_tidy %>% - filter(aggregate %in% - filter(hclust_tidy, terms == rnd_asv)$aggregate) %>% + filter( + aggregate %in% + filter(hclust_tidy, terms == rnd_asv)$aggregate + ) %>% pull(terms), - rnd_asv_group) + rnd_asv_group + ) # check equality on groups cardinal expect_setequal( @@ -53,15 +58,14 @@ test_that("step_aggregate_hclust works", { clustering %>% table() %>% sort() %>% - unname()) - + unname() + ) expect_setequal(summary(prepped)$role, "predictor") baked <- bake(prepped, new_data = NULL) - expect_equal(colnames(baked), - c("sample", "cheese", "rind_type", new_names)) + expect_equal(colnames(baked), c("sample", "cheese", "rind_type", new_names)) expect_equal(rowSums(baked[, -c(1:3)]), rowSums(cheese_abundance[, -c(1:3)])) cl <- sample(new_names, size = 1) @@ -70,52 +74,57 @@ test_that("step_aggregate_hclust works", { filter(aggregate == cl) %>% pull(terms) - - expect_equal(baked[[cl]], - cheese_abundance %>% - select(all_of(asv_in_cl)) %>% - rowSums()) + expect_equal( + baked[[cl]], + cheese_abundance %>% + select(all_of(asv_in_cl)) %>% + rowSums() + ) ## keep_original_cols baked2 <- - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_hclust(all_numeric_predictors(), - n_clusters = nc, fun_agg = sum, - prefix = "hc_", dist_metric = "manhattan", - linkage_method = "ward.D2", - keep_original_cols = TRUE) %>% + recipe(~., data = cheese_abundance) %>% + step_aggregate_hclust( + all_numeric_predictors(), + n_clusters = nc, + fun_agg = sum, + prefix = "hc_", + dist_metric = "manhattan", + linkage_method = "ward.D2", + keep_original_cols = TRUE + ) %>% prep() %>% bake(new_data = NULL) - expect_equal(colnames(baked2), - c(colnames(cheese_abundance), new_names)) - + expect_equal(colnames(baked2), c(colnames(cheese_abundance), new_names)) expect_invisible(recipes_pkg_check(required_pkgs.step_aggregate_hclust())) - }) test_that("step_aggregate_hclust throws errors", { - expect_error( - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_hclust(all_numeric_predictors(), - n_clusters = nc, fun_agg = sum, - dist_metric = "hello") %>% + recipe(~., data = cheese_abundance) %>% + step_aggregate_hclust( + all_numeric_predictors(), + n_clusters = nc, + fun_agg = sum, + dist_metric = "hello" + ) %>% prep(), '`dist_metric` must be one of "euclidean",' ) expect_error( - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_hclust(all_numeric_predictors(), - n_clusters = nc, fun_agg = sum, - linkage_method = "hello") %>% + recipe(~., data = cheese_abundance) %>% + step_aggregate_hclust( + all_numeric_predictors(), + n_clusters = nc, + fun_agg = sum, + linkage_method = "hello" + ) %>% prep(), '`linkage_method` must be one of "ward.D",' ) - - }) diff --git a/tests/testthat/test-aggregate_list.R b/tests/testthat/test-aggregate_list.R index b8720db..e695e06 100644 --- a/tests/testthat/test-aggregate_list.R +++ b/tests/testthat/test-aggregate_list.R @@ -9,9 +9,12 @@ rk_list <- split(cheese_taxonomy$asv, cheese_taxonomy[[rk]]) test_that("step_aggregate_list() works", { rec <- - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = rk_list, fun_agg = sum) + recipe(~., data = cheese_abundance) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = rk_list, + fun_agg = sum + ) expect_equal(nrow(tidy(rec, 1)), 1) @@ -19,210 +22,263 @@ test_that("step_aggregate_list() works", { agglist_tidy <- tidy(prepped, 1) expect_equal(nrow(agglist_tidy), ncol(cheese_abundance) - 3) - expect_equal(agglist_tidy[-3], - select(cheese_taxonomy, terms = asv, aggregate = all_of(rk))) + expect_equal( + agglist_tidy[-3], + select(cheese_taxonomy, terms = asv, aggregate = all_of(rk)) + ) expect_setequal(summary(prepped)$role, "predictor") baked <- bake(prepped, new_data = NULL) - expect_equal(colnames(baked), - c("sample", "cheese", "rind_type", names(rk_list))) + expect_equal( + colnames(baked), + c("sample", "cheese", "rind_type", names(rk_list)) + ) expect_equal(rowSums(baked[, -c(1:3)]), rowSums(cheese_abundance[, -c(1:3)])) cl <- sample(names(rk_list), size = 1) - - expect_equal(baked[[cl]], - cheese_abundance %>% - select(all_of(rk_list[[cl]])) %>% - rowSums()) + expect_equal( + baked[[cl]], + cheese_abundance %>% + select(all_of(rk_list[[cl]])) %>% + rowSums() + ) ## keep_original_cols baked2 <- - recipe(~ ., data = cheese_abundance) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = rk_list, fun_agg = sum, - keep_original_cols = TRUE) %>% + recipe(~., data = cheese_abundance) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = rk_list, + fun_agg = sum, + keep_original_cols = TRUE + ) %>% prep() %>% bake(new_data = NULL) - expect_equal(colnames(baked2), - c(colnames(cheese_abundance), names(rk_list))) - + expect_equal(colnames(baked2), c(colnames(cheese_abundance), names(rk_list))) expect_invisible(recipes_pkg_check(required_pkgs.step_aggregate_list())) - }) test_that("`others` argument works", { - ### All variables are present in list_agg - l1 <- list(petal.size = c("Petal.Width", "Petal.Length"), - sepal.size = c("Sepal.Length", "Sepal.Width")) - + l1 <- list( + petal.size = c("Petal.Width", "Petal.Length"), + sepal.size = c("Sepal.Length", "Sepal.Width") + ) # Discard original columns rec1_discori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l1, fun_agg = prod, - others = "discard") %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l1, + fun_agg = prod, + others = "discard" + ) %>% prep() - expect_equal(colnames(bake(rec1_discori, new_data = NULL)), - c("Species", names(l1))) - - expect_equal(tidy(rec1_discori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec1_discori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", "petal.size")) + expect_equal( + colnames(bake(rec1_discori, new_data = NULL)), + c("Species", names(l1)) + ) + expect_equal(tidy(rec1_discori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec1_discori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", "petal.size") + ) # Keep original columns rec1_keepori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l1, fun_agg = prod, - others = "discard", - keep_original_cols = TRUE) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l1, + fun_agg = prod, + others = "discard", + keep_original_cols = TRUE + ) %>% prep() - expect_equal(colnames(bake(rec1_keepori, new_data = NULL)), - c(colnames(iris), names(l1))) + expect_equal( + colnames(bake(rec1_keepori, new_data = NULL)), + c(colnames(iris), names(l1)) + ) - expect_equal(tidy(rec1_keepori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec1_keepori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", "petal.size")) + expect_equal(tidy(rec1_keepori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec1_keepori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", "petal.size") + ) ### One variable is missing in list_agg - l2 <- list(petal.size = c("Petal.Length"), - sepal.size = c("Sepal.Width", "Sepal.Length")) - + l2 <- list( + petal.size = c("Petal.Length"), + sepal.size = c("Sepal.Width", "Sepal.Length") + ) # Discard other columns and discard original columns rec2_discoth_disori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - others = "discard", - list_agg = l2, fun_agg = prod) %>% + step_aggregate_list( + all_numeric_predictors(), + others = "discard", + list_agg = l2, + fun_agg = prod + ) %>% prep() - expect_equal(colnames(bake(rec2_discoth_disori, new_data = NULL)), - c("Species", names(l2))) - - expect_equal(tidy(rec2_discoth_disori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec2_discoth_disori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", NA)) + expect_equal( + colnames(bake(rec2_discoth_disori, new_data = NULL)), + c("Species", names(l2)) + ) + expect_equal(tidy(rec2_discoth_disori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec2_discoth_disori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", NA) + ) # Discard other columns and keep original columns rec2_discoth_keepori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l2, fun_agg = prod, - others = "discard", - keep_original_cols = TRUE) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l2, + fun_agg = prod, + others = "discard", + keep_original_cols = TRUE + ) %>% prep() - expect_equal(colnames(bake(rec2_discoth_keepori, new_data = NULL)), - c(colnames(iris), names(l2))) - - expect_equal(tidy(rec2_discoth_keepori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec2_discoth_keepori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", NA)) + expect_equal( + colnames(bake(rec2_discoth_keepori, new_data = NULL)), + c(colnames(iris), names(l2)) + ) + expect_equal(tidy(rec2_discoth_keepori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec2_discoth_keepori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", NA) + ) # Keep other columns and discard original columns rec2_keepoth_disori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l2, fun_agg = prod, - others = "asis", - keep_original_cols = FALSE) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l2, + fun_agg = prod, + others = "asis", + keep_original_cols = FALSE + ) %>% prep() - expect_equal(colnames(bake(rec2_keepoth_disori, new_data = NULL)), - c("Petal.Width", "Species", names(l2))) - - expect_equal(tidy(rec2_keepoth_disori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec2_keepoth_disori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", "Petal.Width")) + expect_equal( + colnames(bake(rec2_keepoth_disori, new_data = NULL)), + c("Petal.Width", "Species", names(l2)) + ) + expect_equal(tidy(rec2_keepoth_disori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec2_keepoth_disori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", "Petal.Width") + ) # Keep other columns and keep original columns rec2_keepoth_keepori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l2, fun_agg = prod, - others = "asis", - keep_original_cols = TRUE) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l2, + fun_agg = prod, + others = "asis", + keep_original_cols = TRUE + ) %>% prep() - expect_equal(colnames(bake(rec2_keepoth_keepori, new_data = NULL)), - c(names(iris), names(l2))) + expect_equal( + colnames(bake(rec2_keepoth_keepori, new_data = NULL)), + c(names(iris), names(l2)) + ) - expect_equal(tidy(rec2_keepoth_keepori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec2_keepoth_keepori, 1)$aggregate, - c("sepal.size", "sepal.size", "petal.size", "Petal.Width")) + expect_equal(tidy(rec2_keepoth_keepori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec2_keepoth_keepori, 1)$aggregate, + c("sepal.size", "sepal.size", "petal.size", "Petal.Width") + ) ### Some variables are missing in list_agg l3 <- list(sepal.size = c("Sepal.Width", "Sepal.Length")) - # Aggregate other columns and discard original columns rec3_aggoth_disori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - others = "aggregate", name_others = "Oth", - list_agg = l3, fun_agg = prod) %>% + step_aggregate_list( + all_numeric_predictors(), + others = "aggregate", + name_others = "Oth", + list_agg = l3, + fun_agg = prod + ) %>% prep() - expect_equal(colnames(bake(rec3_aggoth_disori, new_data = NULL)), - c("Species", names(l3), "Oth")) - - expect_equal(tidy(rec3_aggoth_disori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec3_aggoth_disori, 1)$aggregate, - c("sepal.size", "sepal.size", "Oth", "Oth")) + expect_equal( + colnames(bake(rec3_aggoth_disori, new_data = NULL)), + c("Species", names(l3), "Oth") + ) - expect_equal(bake(rec3_aggoth_disori, new_data = NULL)$Oth, - iris$Petal.Length * iris$Petal.Width) + expect_equal(tidy(rec3_aggoth_disori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec3_aggoth_disori, 1)$aggregate, + c("sepal.size", "sepal.size", "Oth", "Oth") + ) + expect_equal( + bake(rec3_aggoth_disori, new_data = NULL)$Oth, + iris$Petal.Length * iris$Petal.Width + ) # Aggregate other columns and keep original columns rec3_aggcoth_keepori <- iris %>% recipe(formula = Species ~ .) %>% - step_aggregate_list(all_numeric_predictors(), - list_agg = l3, fun_agg = prod, - others = "aggregate", name_others = "Oth", - keep_original_cols = TRUE) %>% + step_aggregate_list( + all_numeric_predictors(), + list_agg = l3, + fun_agg = prod, + others = "aggregate", + name_others = "Oth", + keep_original_cols = TRUE + ) %>% prep() - expect_equal(colnames(bake(rec3_aggcoth_keepori, new_data = NULL)), - c(colnames(iris), names(l3), "Oth")) - - expect_equal(tidy(rec3_aggcoth_keepori, 1)$terms, - colnames(iris)[-5]) - expect_equal(tidy(rec3_aggcoth_keepori, 1)$aggregate, - c("sepal.size", "sepal.size", "Oth", "Oth")) - - expect_equal(bake(rec3_aggcoth_keepori, new_data = NULL)$Oth, - iris$Petal.Length * iris$Petal.Width) - + expect_equal( + colnames(bake(rec3_aggcoth_keepori, new_data = NULL)), + c(colnames(iris), names(l3), "Oth") + ) + + expect_equal(tidy(rec3_aggcoth_keepori, 1)$terms, colnames(iris)[-5]) + expect_equal( + tidy(rec3_aggcoth_keepori, 1)$aggregate, + c("sepal.size", "sepal.size", "Oth", "Oth") + ) + + expect_equal( + bake(rec3_aggcoth_keepori, new_data = NULL)$Oth, + iris$Petal.Length * iris$Petal.Width + ) }) diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index 8460c51..44b6043 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -3,25 +3,26 @@ test_that("check_in works", { expect_error(check_in("a", LETTERS), "must be one of") expect_error(check_in(c("a", "b"), letters), "must be a length-one vector") - - expect_error(check_in(c("FDR"), p.adjust.methods, name_x = "correction"), - "correction") - expect_error(check_in(c("FDR"), p.adjust.methods, name_x = "correction"), - "fdr") + expect_error( + check_in(c("FDR"), p.adjust.methods, name_x = "correction"), + "correction" + ) + expect_error( + check_in(c("FDR"), p.adjust.methods, name_x = "correction"), + "fdr" + ) }) test_that("check_binary works", { expect_invisible(check_binary(letters[1:2])) expect_error(check_binary(letters), "must be a binary vector") - expect_error(check_binary(iris$Species, name_x = "outcome"), - "outcome") + expect_error(check_binary(iris$Species, name_x = "outcome"), "outcome") }) test_that("check_not_null works", { expect_invisible(check_not_null(letters)) expect_error(check_not_null(NULL), "must be specified and can't be `NULL`.") - expect_error(check_binary(NULL, name_x = "rank"), - "rank") + expect_error(check_binary(NULL, name_x = "rank"), "rank") }) diff --git a/tests/testthat/test-rownormalize_tss.R b/tests/testthat/test-rownormalize_tss.R index 7585660..65c0f04 100644 --- a/tests/testthat/test-rownormalize_tss.R +++ b/tests/testthat/test-rownormalize_tss.R @@ -2,7 +2,7 @@ data("cheese_abundance") test_that("step_rownormalize_tss() works", { rec <- - recipe(~ ., data = cheese_abundance) %>% + recipe(~., data = cheese_abundance) %>% step_rownormalize_tss(all_numeric_predictors()) expect_equal(nrow(tidy(rec, 1)), 1) @@ -17,7 +17,5 @@ test_that("step_rownormalize_tss() works", { expect_equal(colnames(baked), colnames(cheese_abundance)) expect_equal(rowSums(baked[, -c(1:3)]), rep(1, nrow(cheese_abundance))) - expect_invisible(recipes_pkg_check(required_pkgs.step_rownormalize_tss())) - }) diff --git a/tests/testthat/test-select_background.R b/tests/testthat/test-select_background.R index e476624..679c5ce 100644 --- a/tests/testthat/test-select_background.R +++ b/tests/testthat/test-select_background.R @@ -8,21 +8,25 @@ df_expr <- test_that("step_select_background works", { - level <- runif(1, min = 1, max = 6) prop <- runif(1) n <- sample(1:20, size = 1) quants <- df_expr %>% - summarize(across(where(is.numeric), - ~ unname(quantile(., probs = 1 - prop, type = 1)))) %>% + summarize(across( + where(is.numeric), + ~ unname(quantile(., probs = 1 - prop, type = 1)) + )) %>% unlist() rec <- recipe(disease ~ ., data = df_expr) %>% - step_select_background(all_numeric_predictors(), - background_level = level, prop_samples = prop) + step_select_background( + all_numeric_predictors(), + background_level = level, + prop_samples = prop + ) expect_equal(nrow(tidy(rec, 1)), 1) @@ -30,69 +34,81 @@ test_that("step_select_background works", { bkg_tidy <- tidy(prepped, 1) expect_equal(nrow(bkg_tidy), ncol(df_expr) - 2) - expect_equal(bkg_tidy[bkg_tidy$kept, "terms", drop = TRUE], - names(quants[quants >= level])) - + expect_equal( + bkg_tidy[bkg_tidy$kept, "terms", drop = TRUE], + names(quants[quants >= level]) + ) baked <- bake(prepped, new_data = NULL) - expect_setequal(colnames(baked), - c(bkg_tidy[bkg_tidy$kept, ]$terms, "event", "disease")) - + expect_setequal( + colnames(baked), + c(bkg_tidy[bkg_tidy$kept, ]$terms, "event", "disease") + ) kepts <- df_expr %>% - summarize(across(where(is.numeric), - ~ sum(. >= level) >= n)) %>% + summarize(across(where(is.numeric), ~ sum(. >= level) >= n)) %>% unlist() - bkg_tidy2 <- recipe(disease ~ ., data = df_expr) %>% - step_select_background(all_numeric_predictors(), - background_level = level, n_samples = n) %>% + step_select_background( + all_numeric_predictors(), + background_level = level, + n_samples = n + ) %>% prep() %>% tidy(1) - - expect_equal(bkg_tidy2[bkg_tidy2$kept, "terms", drop = TRUE], - names(kepts[kepts])) - + expect_equal( + bkg_tidy2[bkg_tidy2$kept, "terms", drop = TRUE], + names(kepts[kepts]) + ) expect_invisible(recipes_pkg_check(required_pkgs.step_select_background())) - }) test_that("step_select_background throw errors", { - rec <- recipe(disease ~ ., data = df_expr) - expect_error(rec %>% - step_select_background(all_numeric_predictors(), - n_samples = 10) %>% - prep(), - "background_level") - - expect_error(rec %>% - step_select_background(all_numeric_predictors(), - background_level = 2) %>% - prep(), - "n_samples.*prop_samples") - - expect_error(rec %>% - step_select_background(all_numeric_predictors(), - background_level = 2, n_samples = 10, - prop_samples = 0.10) %>% - prep(), - "are mutually exclusive") - - expect_error(rec %>% - step_select_background(all_predictors(), - background_level = 2, n_samples = 10, - prop_samples = 0.10) %>% - prep(), - "numeric") - + expect_error( + rec %>% + step_select_background(all_numeric_predictors(), n_samples = 10) %>% + prep(), + "background_level" + ) + + expect_error( + rec %>% + step_select_background(all_numeric_predictors(), background_level = 2) %>% + prep(), + "n_samples.*prop_samples" + ) + + expect_error( + rec %>% + step_select_background( + all_numeric_predictors(), + background_level = 2, + n_samples = 10, + prop_samples = 0.10 + ) %>% + prep(), + "are mutually exclusive" + ) + + expect_error( + rec %>% + step_select_background( + all_predictors(), + background_level = 2, + n_samples = 10, + prop_samples = 0.10 + ) %>% + prep(), + "numeric" + ) }) diff --git a/tests/testthat/test-select_cv.R b/tests/testthat/test-select_cv.R index c54322b..b362481 100644 --- a/tests/testthat/test-select_cv.R +++ b/tests/testthat/test-select_cv.R @@ -5,13 +5,12 @@ data(pedcan_expression) df_expr <- select(pedcan_expression, starts_with("A")) test_that("step_select_cv works", { - means <- apply(df_expr, 2, mean) sds <- apply(df_expr, 2, sd) cvs <- sds / means rec <- - recipe(~ ., data = df_expr) %>% + recipe(~., data = df_expr) %>% step_select_cv(all_numeric_predictors(), cutoff = 1) expect_equal(nrow(tidy(rec, 1)), 1) @@ -26,10 +25,7 @@ test_that("step_select_cv works", { baked <- bake(prepped, new_data = NULL) - expect_setequal(colnames(baked), - names(cvs[cvs > 1])) - + expect_setequal(colnames(baked), names(cvs[cvs > 1])) expect_invisible(recipes_pkg_check(required_pkgs.step_select_cv())) - }) diff --git a/tests/testthat/test-select_kruskal.R b/tests/testthat/test-select_kruskal.R index 6a04362..bd7dab9 100644 --- a/tests/testthat/test-select_kruskal.R +++ b/tests/testthat/test-select_kruskal.R @@ -12,14 +12,17 @@ g <- df_expr$disease kt <- kruskal.test(x = x, g = g) test_that("step_select_kruskal works", { - my_cutoff <- 0.05 my_correction <- "BH" rec <- recipe(disease ~ ., data = df_expr) %>% - step_select_kruskal(all_numeric_predictors(), outcome = "disease", - correction = my_correction, cutoff = my_cutoff) + step_select_kruskal( + all_numeric_predictors(), + outcome = "disease", + correction = my_correction, + cutoff = my_cutoff + ) expect_equal(nrow(tidy(rec, 1)), 1) @@ -32,34 +35,41 @@ test_that("step_select_kruskal works", { expect_true(all(wt_tidy[!wt_tidy$kept, ]$qv > my_cutoff)) expect_equal(p.adjust(wt_tidy$pv, method = my_correction), wt_tidy$qv) - baked <- bake(prepped, new_data = NULL) - expect_setequal(colnames(baked), - c(wt_tidy[wt_tidy$kept, ]$terms, "event", "disease")) - + expect_setequal( + colnames(baked), + c(wt_tidy[wt_tidy$kept, ]$terms, "event", "disease") + ) expect_invisible(recipes_pkg_check(required_pkgs.step_select_kruskal())) - }) test_that("step_select_kruskal throw errors", { - rec <- recipe(disease ~ ., data = df_expr) - expect_error(rec %>% - step_select_kruskal(all_numeric_predictors(), - outcome = "event", - correction = c("BH", "fdr"), - cutoff = 0.05) %>% - prep(), "`correction` must be a length-one vector.") - - expect_error(rec %>% - step_select_kruskal(all_numeric_predictors(), - outcome = "event", - correction = "FDR", - cutoff = 0.05) %>% - prep(), '`correction` must be one of "holm", "hochberg", ') - + expect_error( + rec %>% + step_select_kruskal( + all_numeric_predictors(), + outcome = "event", + correction = c("BH", "fdr"), + cutoff = 0.05 + ) %>% + prep(), + "`correction` must be a length-one vector." + ) + + expect_error( + rec %>% + step_select_kruskal( + all_numeric_predictors(), + outcome = "event", + correction = "FDR", + cutoff = 0.05 + ) %>% + prep(), + '`correction` must be one of "holm", "hochberg", ' + ) }) diff --git a/tests/testthat/test-select_wilcoxon.R b/tests/testthat/test-select_wilcoxon.R index eaf6279..57c36e9 100644 --- a/tests/testthat/test-select_wilcoxon.R +++ b/tests/testthat/test-select_wilcoxon.R @@ -13,14 +13,17 @@ gy <- df_expr[df_expr$event == "Metastatic", gene, drop = TRUE] gwt <- wilcox.test(x = gx, y = gy) test_that("step_select_wilcoxon works", { - my_cutoff <- 0.05 my_correction <- "BH" rec <- recipe(event ~ ., data = df_expr) %>% - step_select_wilcoxon(all_numeric_predictors(), outcome = "event", - correction = my_correction, cutoff = my_cutoff) + step_select_wilcoxon( + all_numeric_predictors(), + outcome = "event", + correction = my_correction, + cutoff = my_cutoff + ) expect_equal(nrow(tidy(rec, 1)), 1) @@ -33,41 +36,52 @@ test_that("step_select_wilcoxon works", { expect_true(all(wt_tidy[!wt_tidy$kept, ]$qv > my_cutoff)) expect_equal(p.adjust(wt_tidy$pv, method = my_correction), wt_tidy$qv) - baked <- bake(prepped, new_data = NULL) - expect_setequal(colnames(baked), - c(wt_tidy[wt_tidy$kept, ]$terms, "event", "disease")) - + expect_setequal( + colnames(baked), + c(wt_tidy[wt_tidy$kept, ]$terms, "event", "disease") + ) expect_invisible(recipes_pkg_check(required_pkgs.step_select_wilcoxon())) - }) test_that("step_select_wilcoxon throw errors", { - rec <- recipe(disease ~ ., data = df_expr) - expect_error(rec %>% - step_select_wilcoxon(all_numeric_predictors(), - outcome = "disease", - cutoff = 0.05) %>% - prep(), - "`outcome` must be a binary vector.") - - expect_error(rec %>% - step_select_wilcoxon(all_numeric_predictors(), - outcome = "event", - correction = c("BH", "fdr"), - cutoff = 0.05) %>% - prep(), "`correction` must be a length-one vector.") - - expect_error(rec %>% - step_select_wilcoxon(all_numeric_predictors(), - outcome = "event", - correction = "FDR", - cutoff = 0.05) %>% - prep(), '`correction` must be one of "holm", "hochberg", ') - + expect_error( + rec %>% + step_select_wilcoxon( + all_numeric_predictors(), + outcome = "disease", + cutoff = 0.05 + ) %>% + prep(), + "`outcome` must be a binary vector." + ) + + expect_error( + rec %>% + step_select_wilcoxon( + all_numeric_predictors(), + outcome = "event", + correction = c("BH", "fdr"), + cutoff = 0.05 + ) %>% + prep(), + "`correction` must be a length-one vector." + ) + + expect_error( + rec %>% + step_select_wilcoxon( + all_numeric_predictors(), + outcome = "event", + correction = "FDR", + cutoff = 0.05 + ) %>% + prep(), + '`correction` must be one of "holm", "hochberg", ' + ) }) diff --git a/tests/testthat/test-taxonomy.R b/tests/testthat/test-taxonomy.R index 8a354c4..67523ed 100644 --- a/tests/testthat/test-taxonomy.R +++ b/tests/testthat/test-taxonomy.R @@ -4,15 +4,13 @@ data("cheese_taxonomy") test_that("step_taxonomy works", { skip_if_not_installed("yatah", minimum_version = "1.0.0") - rks <- c("kingdom", "phylum", "class", "order", - "family", "genus", "species") + rks <- c("kingdom", "phylum", "class", "order", "family", "genus", "species") rec <- cheese_taxonomy %>% - recipe(~ .) %>% + recipe(~.) %>% step_taxonomy(lineage, rank = rks) - expect_equal(nrow(tidy(rec, 1)), 1) prepped <- prep(rec) @@ -32,40 +30,43 @@ test_that("step_taxonomy works", { expect_equal(baked$lineage_genus, cheese_taxonomy$genus) expect_equal(gsub("_", " ", baked$lineage_species), cheese_taxonomy$species) - rks2 <- c("genus", "order", "phylum") prepped2 <- cheese_taxonomy %>% select(asv, lineage) %>% mutate(lin2 = sample(lineage)) %>% - recipe(~ .) %>% - step_taxonomy(starts_with("lin"), rank = rks2, - keep_original_cols = TRUE) %>% + recipe(~.) %>% + step_taxonomy( + starts_with("lin"), + rank = rks2, + keep_original_cols = TRUE + ) %>% prep() txn_tidy2 <- tidy(prepped2, 1) - expect_equal(pull(txn_tidy2, terms), - rep(c("lineage", "lin2"), each = length(rks2))) + expect_equal( + pull(txn_tidy2, terms), + rep(c("lineage", "lin2"), each = length(rks2)) + ) expect_equal(pull(txn_tidy2, rank), rep(rks2, times = 2)) baked2 <- bake(prepped2, new_data = NULL) - expect_equal(colnames(baked2), c("asv", "lineage", "lin2", - paste0("lineage_", rks2), - paste0("lin2_", rks2))) - + expect_equal( + colnames(baked2), + c("asv", "lineage", "lin2", paste0("lineage_", rks2), paste0("lin2_", rks2)) + ) rec_error <- cheese_taxonomy %>% - recipe(~ .) %>% + recipe(~.) %>% step_taxonomy(lineage) expect_error(prep(rec_error), "`rank` must") expect_invisible(recipes_pkg_check(required_pkgs.step_taxonomy())) - }) @@ -73,6 +74,9 @@ test_that("step_taxonomy fails witout yatah", { skip_if(rlang::is_installed("yatah")) suppressMessages( - expect_message(recipes::recipes_pkg_check(required_pkgs.step_taxonomy()), - ".*yatah.*")) + expect_message( + recipes::recipes_pkg_check(required_pkgs.step_taxonomy()), + ".*yatah.*" + ) + ) }) diff --git a/tests/testthat/test-to_keep.R b/tests/testthat/test-to_keep.R index 6d1ceeb..f631065 100644 --- a/tests/testthat/test-to_keep.R +++ b/tests/testthat/test-to_keep.R @@ -1,14 +1,20 @@ - test_that("var_to_keep() keep the correct values", { - - expect_equal(var_to_keep(1:5, n_kept = 3, maximize = TRUE), - c(rep(FALSE, 2), rep(TRUE, 3))) - expect_equal(var_to_keep(1:10, prop_kept = 0.4, maximize = FALSE), - c(rep(TRUE, 4), rep(FALSE, 6))) - expect_equal(var_to_keep(1:10, cutoff = 8, maximize = FALSE), - c(rep(TRUE, 8), rep(FALSE, 2))) - expect_equal(var_to_keep(1:10, prop_kept = 0.8, cutoff = 7), - c(rep(FALSE, 6), rep(TRUE, 4))) + expect_equal( + var_to_keep(1:5, n_kept = 3, maximize = TRUE), + c(rep(FALSE, 2), rep(TRUE, 3)) + ) + expect_equal( + var_to_keep(1:10, prop_kept = 0.4, maximize = FALSE), + c(rep(TRUE, 4), rep(FALSE, 6)) + ) + expect_equal( + var_to_keep(1:10, cutoff = 8, maximize = FALSE), + c(rep(TRUE, 8), rep(FALSE, 2)) + ) + expect_equal( + var_to_keep(1:10, prop_kept = 0.8, cutoff = 7), + c(rep(FALSE, 6), rep(TRUE, 4)) + ) N <- 1234 x1 <- rnorm(N, sd = 10) @@ -39,16 +45,15 @@ test_that("var_to_keep() keep the correct values", { k17 <- var_to_keep(x1, prop_kept = 0.5, cutoff = 0, maximize = FALSE) expect_true(max(x1[k17]) <= 0) - expect_true(mean(k17) <= N/2) + expect_true(mean(k17) <= N / 2) k18 <- var_to_keep(x1, prop_kept = 0.5, cutoff = 0, maximize = TRUE) expect_true(max(x1[k18]) >= 0) - expect_true(mean(k18) <= N/2) + expect_true(mean(k18) <= N / 2) k19 <- var_to_keep(x1) expect_true(all(k19)) - # with ties x2 <- sample(1:100, N, replace = TRUE) @@ -58,17 +63,15 @@ test_that("var_to_keep() keep the correct values", { expect_true(min(x2[k21]) > max(x2[!k21])) k22 <- var_to_keep(x2, prop = 0.3, maximize = FALSE) - expect_true(mean(k22) >= 0.3 - 1/N) + expect_true(mean(k22) >= 0.3 - 1 / N) expect_true(max(rank(x2, ties.method = "min")[k22]) <= 0.30 * N) expect_true(max(x2[k22]) < min(x2[!k22])) - }) - test_that("var_to_keep() throw error when needed", { - - expect_error(var_to_keep(1:5, n_kept = 2, prop_kept = 0.2), - regexp = "mutually exclusive") - + expect_error( + var_to_keep(1:5, n_kept = 2, prop_kept = 0.2), + regexp = "mutually exclusive" + ) }) diff --git a/vignettes/pedcan.Rmd b/vignettes/pedcan.Rmd index b5d08c2..b7caab9 100644 --- a/vignettes/pedcan.Rmd +++ b/vignettes/pedcan.Rmd @@ -44,14 +44,14 @@ One approach to exploring this dataset is by performing PCA. ```{r} rec_naive_pca <- - recipe(~ ., data = pedcan_expression) %>% - step_zv(all_numeric_predictors()) %>% - step_normalize(all_numeric_predictors()) %>% - step_pca(all_numeric_predictors()) %>% + recipe(~., data = pedcan_expression) %>% + step_zv(all_numeric_predictors()) %>% + step_normalize(all_numeric_predictors()) %>% + step_pca(all_numeric_predictors()) %>% prep() -rec_naive_pca %>% - bake(new_data = NULL) %>% +rec_naive_pca %>% + bake(new_data = NULL) %>% ggplot() + aes(x = PC1, y = PC2, color = disease) + geom_point() @@ -61,14 +61,14 @@ To improve the appearance of PCA, one can precede it with a feature selection st ```{r} rec_cv_pca <- - recipe(~ ., data = pedcan_expression) %>% - step_select_cv(all_numeric_predictors(), prop_kept = 1/4) %>% + recipe(~., data = pedcan_expression) %>% + step_select_cv(all_numeric_predictors(), prop_kept = 1 / 4) %>% step_normalize(all_numeric_predictors()) %>% step_pca(all_numeric_predictors()) %>% prep() -rec_cv_pca %>% - bake(new_data = NULL) %>% +rec_cv_pca %>% + bake(new_data = NULL) %>% ggplot() + aes(x = PC1, y = PC2, color = disease) + geom_point() From 47d2eb3d64d71d8d2a76b05279fa882b95d3ad57 Mon Sep 17 00:00:00 2001 From: abichat Date: Thu, 24 Jul 2025 20:17:35 +0200 Subject: [PATCH 6/6] v0.0.3 --- .gitignore | 2 ++ DESCRIPTION | 2 +- NEWS.md | 3 +- README.md | 90 ++++++++++++++++++++++++++++------------------------- 4 files changed, 52 insertions(+), 45 deletions(-) diff --git a/.gitignore b/.gitignore index 0fe92f5..69154e7 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,5 @@ inst/doc docs pkgdown + +/.quarto/ diff --git a/DESCRIPTION b/DESCRIPTION index 3e50365..d42075c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: scimo Title: Extra Recipes Steps for Dealing with Omics Data -Version: 0.0.2.9000 +Version: 0.0.3 Authors@R: c( person("Antoine", "BICHAT", , "antoine.bichat@proton.me", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-6599-7081")), diff --git a/NEWS.md b/NEWS.md index 083c068..3f9bb67 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -# scimo 0.0.2.9000 +# scimo 0.0.3 * Add a dependency on **recipes** >= 1.1 to avoid stack overflow errors with long formulas, as this issue has been resolved in this version (#2). +* Small improvements in documentation (#6, CRAN notes). # scimo 0.0.2 diff --git a/README.md b/README.md index e16a54c..0916f7c 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ -![packageversion](https://img.shields.io/badge/version-0.0.2.9000-orange.svg) +![packageversion](https://img.shields.io/badge/version-0.0.3-orange.svg) [![R-CMD-check](https://github.com/abichat/scimo/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/abichat/scimo/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/scimo)](https://CRAN.R-project.org/package=scimo) @@ -35,36 +35,37 @@ data("cheese_abundance", "cheese_taxonomy") cheese_abundance #> # A tibble: 9 × 77 -#> sample cheese rind_type asv_01 asv_02 asv_03 asv_04 asv_05 asv_06 asv_07 asv_08 asv_09 asv_10 asv_11 asv_12 asv_13 asv_14 asv_15 asv_16 asv_17 asv_18 -#> -#> 1 sample1-1 Saint-… Natural 1 0 38 40 1 2 31 8 15 20076 160 92 64 24 51 0 0 10 -#> 2 sample1-2 Saint-… Natural 3 4 38 61 4 4 48 14 20 32101 403 143 165 39 104 1 0 28 -#> 3 sample1-3 Saint-… Natural 28 16 33 23 31 29 21 1 7 12921 134 53 55 16 45 2 3 10 -#> 4 sample2-1 Livarot Washed 0 2 1 0 5 1 0 0 0 7823 2 0 0 42 0 2 3 2 -#> 5 sample2-2 Livarot Washed 0 0 4 0 1 1 2 0 0 6740 4 1 0 45 0 1 4 0 -#> 6 sample2-3 Livarot Washed 0 1 2 0 2 1 0 0 0 7484 6 1 0 43 0 7 1 1 -#> 7 sample3-1 Epoiss… Washed 4 2 3 0 2 5 0 0 0 2486 1 1 1 23 0 24 10 0 -#> 8 sample3-2 Epoiss… Washed 0 0 0 0 0 0 0 0 0 3686 2 0 0 28 0 54 23 1 -#> 9 sample3-3 Epoiss… Washed 0 0 1 0 0 0 2 0 0 2988 2 1 0 22 0 36 12 1 -#> # ℹ 56 more variables: asv_19 , asv_20 , asv_21 , asv_22 , asv_23 , asv_24 , asv_25 , asv_26 , asv_27 , -#> # asv_28 , asv_29 , asv_30 , asv_31 , asv_32 , asv_33 , asv_34 , asv_35 , asv_36 , asv_37 , -#> # asv_38 , asv_39 , asv_40 , asv_41 , asv_42 , asv_43 , asv_44 , asv_45 , asv_46 , asv_47 , -#> # asv_48 , asv_49 , asv_50 , asv_51 , asv_52 , asv_53 , asv_54 , asv_55 , asv_56 , asv_57 , -#> # asv_58 , asv_59 , asv_60 , asv_61 , asv_62 , asv_63 , asv_64 , asv_65 , asv_66 , asv_67 , -#> # asv_68 , asv_69 , asv_70 , asv_71 , asv_72 , asv_73 , asv_74 +#> sample cheese rind_type asv_01 asv_02 asv_03 asv_04 asv_05 asv_06 asv_07 asv_08 +#> +#> 1 sample… Saint… Natural 1 0 38 40 1 2 31 8 +#> 2 sample… Saint… Natural 3 4 38 61 4 4 48 14 +#> 3 sample… Saint… Natural 28 16 33 23 31 29 21 1 +#> 4 sample… Livar… Washed 0 2 1 0 5 1 0 0 +#> 5 sample… Livar… Washed 0 0 4 0 1 1 2 0 +#> 6 sample… Livar… Washed 0 1 2 0 2 1 0 0 +#> 7 sample… Epois… Washed 4 2 3 0 2 5 0 0 +#> 8 sample… Epois… Washed 0 0 0 0 0 0 0 0 +#> 9 sample… Epois… Washed 0 0 1 0 0 0 2 0 +#> # ℹ 66 more variables: asv_09 , asv_10 , asv_11 , asv_12 , +#> # asv_13 , asv_14 , asv_15 , asv_16 , asv_17 , +#> # asv_18 , asv_19 , asv_20 , asv_21 , asv_22 , +#> # asv_23 , asv_24 , asv_25 , asv_26 , asv_27 , +#> # asv_28 , asv_29 , asv_30 , asv_31 , asv_32 , +#> # asv_33 , asv_34 , asv_35 , asv_36 , asv_37 , +#> # asv_38 , asv_39 , asv_40 , asv_41 , asv_42 , … glimpse(cheese_taxonomy) #> Rows: 74 #> Columns: 9 -#> $ asv "asv_01", "asv_02", "asv_03", "asv_04", "asv_05", "asv_06", "asv_07", "asv_08", "asv_09", "asv_10", "asv_11", "asv_12", "asv_13", "asv_14… -#> $ lineage "k__Fungi|p__Ascomycota|c__Dothideomycetes|o__Dothideales|f__Dothioraceae|g__Aureobasidium|s__Aureobasidium_Group_pullulans", "k__Fungi|p… -#> $ kingdom "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "F… -#> $ phylum "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota… -#> $ class "Dothideomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiomy… -#> $ order "Dothideales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Eurotiales", "Saccharom… -#> $ family "Dothioraceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillaceae", "Aspergillace… -#> $ genus "Aureobasidium", "Aspergillus", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", "Penicillium", … -#> $ species "Aureobasidium Group pullulans", "Aspergillus fumigatus", "Penicillium Group camemberti caseifulvum fuscoglaucum commune", "Penicillium b… +#> $ asv "asv_01", "asv_02", "asv_03", "asv_04", "asv_05", "asv_06", "asv… +#> $ lineage "k__Fungi|p__Ascomycota|c__Dothideomycetes|o__Dothideales|f__Dot… +#> $ kingdom "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "Fungi", "… +#> $ phylum "Ascomycota", "Ascomycota", "Ascomycota", "Ascomycota", "Ascomyc… +#> $ class "Dothideomycetes", "Eurotiomycetes", "Eurotiomycetes", "Eurotiom… +#> $ order "Dothideales", "Eurotiales", "Eurotiales", "Eurotiales", "Euroti… +#> $ family "Dothioraceae", "Aspergillaceae", "Aspergillaceae", "Aspergillac… +#> $ genus "Aureobasidium", "Aspergillus", "Penicillium", "Penicillium", "P… +#> $ species "Aureobasidium Group pullulans", "Aspergillus fumigatus", "Penic… ``` ``` r @@ -74,7 +75,8 @@ head(list_family, 2) #> [1] "asv_02" "asv_03" "asv_04" "asv_05" "asv_06" "asv_07" "asv_08" "asv_09" #> #> $Debaryomycetaceae -#> [1] "asv_10" "asv_11" "asv_12" "asv_13" "asv_14" "asv_15" "asv_16" "asv_17" "asv_18" "asv_19" "asv_20" "asv_21" "asv_22" +#> [1] "asv_10" "asv_11" "asv_12" "asv_13" "asv_14" "asv_15" "asv_16" "asv_17" +#> [9] "asv_18" "asv_19" "asv_20" "asv_21" "asv_22" ``` The following recipe will @@ -103,7 +105,7 @@ rec <- rec #> -#> ── Recipe ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── +#> ── Recipe ──────────────────────────────────────────────────────────────────────── #> #> ── Inputs #> Number of variables by role @@ -114,23 +116,25 @@ rec #> Training data contained 9 data points and no incomplete rows. #> #> ── Operations -#> • Aggregation of: asv_01, asv_02, asv_03, asv_04, asv_05, asv_06, asv_07, asv_08, asv_09, asv_10, asv_11, asv_12, asv_13, asv_14, asv_15, ... | Trained -#> • TSS normalization on: Aspergillaceae, Debaryomycetaceae, Dipodascaceae, Dothioraceae, Lichtheimiaceae, Metschnikowiaceae, Mucoraceae, ... | Trained -#> • Kruskal filtering against cheese on: Aspergillaceae, Debaryomycetaceae, Dipodascaceae, Dothioraceae, Lichtheimiaceae, ... | Trained +#> • Aggregation of: asv_01, asv_02, asv_03, asv_04, asv_05, ... | Trained +#> • TSS normalization on: Aspergillaceae Debaryomycetaceae, ... | Trained +#> • Kruskal filtering against cheese on: Aspergillaceae, ... | Trained bake(rec, new_data = NULL) #> # A tibble: 9 × 8 -#> sample rind_type cheese Debaryomycetaceae Dipodascaceae Saccharomycetaceae `Saccharomycetales fam Incertae sedis` Trichosporonaceae -#> -#> 1 sample1-1 Natural Saint-Nectaire 0.719 0.0684 0.113 0.00130 0.000702 -#> 2 sample1-2 Natural Saint-Nectaire 0.715 0.0725 0.119 0.000801 0.000628 -#> 3 sample1-3 Natural Saint-Nectaire 0.547 0.277 0.0938 0.000289 0.00239 -#> 4 sample2-1 Washed Livarot 0.153 0.845 0.000854 0 0.000349 -#> 5 sample2-2 Washed Livarot 0.150 0.848 0.00106 0 0.000176 -#> 6 sample2-3 Washed Livarot 0.160 0.837 0.00108 0 0.000212 -#> 7 sample3-1 Washed Epoisses 0.0513 0.944 0.00327 0 0.000140 -#> 8 sample3-2 Washed Epoisses 0.0558 0.941 0.00321 0 0.000176 -#> 9 sample3-3 Washed Epoisses 0.0547 0.942 0.00329 0 0.000125 +#> sample rind_type cheese Debaryomycetaceae Dipodascaceae Saccharomycetaceae +#> +#> 1 sample1-1 Natural Saint-Ne… 0.719 0.0684 0.113 +#> 2 sample1-2 Natural Saint-Ne… 0.715 0.0725 0.119 +#> 3 sample1-3 Natural Saint-Ne… 0.547 0.277 0.0938 +#> 4 sample2-1 Washed Livarot 0.153 0.845 0.000854 +#> 5 sample2-2 Washed Livarot 0.150 0.848 0.00106 +#> 6 sample2-3 Washed Livarot 0.160 0.837 0.00108 +#> 7 sample3-1 Washed Epoisses 0.0513 0.944 0.00327 +#> 8 sample3-2 Washed Epoisses 0.0558 0.941 0.00321 +#> 9 sample3-3 Washed Epoisses 0.0547 0.942 0.00329 +#> # ℹ 2 more variables: `Saccharomycetales fam Incertae sedis` , +#> # Trichosporonaceae ``` To see which variables are kept and the associated p-values, you can use