Merge pull request #101 from adrientaudiere/dev

v 0.10.1

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: MiscMetabar
 Type: Package
 Title: Miscellaneous Functions for Metabarcoding Analysis
-Version: 0.9.4
+Version: 0.10.1
 Authors@R: person("Adrien", "Taudière", email = "adrien.taudiere@zaclys.net",
   role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0003-1088-1182"))
 Description: Facilitate the description, transformation, exploration, and reproducibility of metabarcoding analyses. 'MiscMetabar' is mainly built on top of the 'phyloseq', 'dada2' and 'targets' R packages. It helps to build reproducible and robust bioinformatics pipelines in R. 'MiscMetabar' makes ecological analysis of alpha and beta-diversity easier, more reproducible and more powerful by integrating a large number of tools. Important features are described in Taudière A. (2023) <doi:10.21105/joss.06038>.
@@ -47,7 +47,6 @@ Suggests:
     jsonlite,
     knitr,
     magrittr,
-    metacoder,
     methods,
     mia,
     mixtools,

NAMESPACE

@@ -54,7 +54,6 @@ export(ggscatt_pq)
 export(ggvenn_pq)
 export(glmutli_pq)
 export(graph_test_pq)
-export(heat_tree_pq)
 export(hill_phyloseq)
 export(hill_pq)
 export(hill_test_rarperm_pq)
@@ -85,7 +84,6 @@ export(otu_circle)
 export(perc)
 export(phyloseq_to_edgeR)
 export(physeq_graph_test)
-export(physeq_heat_tree)
 export(physeq_or_string_to_dna)
 export(plot_LCBD_pq)
 export(plot_SCBD_pq)

NEWS.md

@@ -1,12 +1,19 @@
 
-# MiscMetabar 0.9.5 (in development)
+# MiscMetabar 0.10.1 (in development)
+
+- Delete function `heat_tree_pq()` because {metacoder} package is archived from CRAN.
+
 
 # MiscMetabar 0.9.4 
 
 - Set a seed in the example of `build_tree_pq` to resubmit to CRAN
+   Add a param `return_a_vector` in function `filter_trim()` to make possible to return a vector of path as it is usefull when used with `targets::tar_targets(..., format="file")`)
+- Make some storage amelioration by replacing `list()` by `vector(list, ...)` 
 
 # MiscMetabar 0.9.3
 
+> CRAN 2024-09-09
+
 - Homogenize terminology replacing ASV by taxa/taxon in documentation and code
 - Build an alias function `filter_taxa_blast()` for `filter_asv_blast()`
 - Build an alias function `postcluster_pq()` for `asv2otu()`
@@ -19,7 +26,6 @@
 - Replacing misnamed param `reorder_asv` by `reorder_taxons` in `clean_pq()`
 
 
-
 # MiscMetabar 0.9.2
 
 - Add param `default_fun` in function `merge_samples2()` in order to replace the default function that change the sample data in case of merging. A useful parameter is `default_fun=diff_fct_diff_class`.
@@ -29,6 +35,8 @@
 
 # MiscMetabar 0.9.1
 
+> CRAN 2024-04-28
+
 ## New functions 
 - Add functions `taxa_as_rows()` and `taxa_as_columns()` to replace verbose called to `clean_pq()`
 - Add function `ggscatt_pq()` to plot and test for effect of a numerical columns in sam_data on Hill number. Its the equivalent for numerical variables of `ggbetween_pq()` which focus on the effect of a factor. 
@@ -61,6 +69,8 @@
 - Fix a bug in the class of the return object of function `chimera_removal_vs()`. Now it return a matrix to be able to be parsed on to [dada2::getUniques()] 
 
 # MiscMetabar 0.7
+
+> CRAN 2024-03-08
  
 - Add functions `chimera_detection_vs()` and `chimera_removal_vs()` to process chimera detection and removal using [vsearch](https://github.com/torognes/vsearch) software 
 - Add functions `filter_trim()`, `sample_data_with_new_names()` and `rename_samples()` to facilitate the use of [targets](https://books.ropensci.org/targets/) for bioinformatic pipeline.

R/alpha_div_test.R

@@ -52,7 +52,7 @@ hill_tuckey_pq <- function(
     )
 
   colnames(otu_hill) <- paste0("Hill_", hill_scales)
-  tuk <- list()
+  tuk <- vector("list", length(hill_scales))
   for (i in seq_along(hill_scales)) {
     if (correction_for_sample_size) {
       tuk[[i]] <-
@@ -175,8 +175,8 @@ hill_test_rarperm_pq <- function(physeq,
                                  type = "non-parametrique",
                                  ...) {
   verify_pq(physeq)
-  res_perm <- list()
-  p_perm <- list()
+  res_perm <- list() # no pre-set values because nested structure
+  p_perm <- list() # no pre-set values because nested structure
   if (progress_bar) {
     pb <- txtProgressBar(
       min = 0,
@@ -210,8 +210,8 @@ hill_test_rarperm_pq <- function(physeq,
           hill_scales = hill_scales
         ))
     }
-    p_perm[[i]] <- list()
-    res_perm[[i]] <- list()
+    p_perm[[i]] <- vector("list", length(hill_scales))
+    res_perm[[i]] <- vector("list", length(hill_scales))
     for (j in seq_along(hill_scales)) {
       p_perm[[i]][[j]] <-
         ggstatsplot::ggbetweenstats(psm, !!fact, !!paste0("Hill_", hill_scales[[j]]),
@@ -378,7 +378,7 @@ glmutli_pq <-
     cf <- cf %>% filter(!grepl("Intercept", variable))
 
     if (fitfunction == "lm") {
-      test <- list()
+      test <- vector("list", nrow(top_glmulti))
       R2__h0 <- NULL
       for (i in 1:nrow(top_glmulti)) {
         test[[i]] <- summary(res_glmulti@objects[[i]])

R/beta_div_test.R

@@ -263,7 +263,7 @@ adonis_rarperm_pq <- function(physeq,
                               quantile_prob = 0.975,
                               sample.size = min(sample_sums(physeq)),
                               ...) {
-  res_perm <- list()
+  res_perm <- vector("list", nperm)
   if (progress_bar) {
     pb <- txtProgressBar(
       min = 0,
@@ -296,7 +296,7 @@ adonis_rarperm_pq <- function(physeq,
       setTxtProgressBar(pb, i)
     }
   }
-  res_adonis <- list()
+  res_adonis <- list("mean" = NULL, "quantile_min" = NULL, "quantile_max" = NULL)
   res_adonis[["mean"]] <-
     apply(array(unlist(res_perm), c(dim(
       as.data.frame(res_perm[[1]])
@@ -486,7 +486,7 @@ plot_LCBD_pq <- function(physeq,
     if (is.null(sam_variables)) {
       return(p_LCBD)
     } else {
-      p_heatmap <- list()
+      p_heatmap <- vector("list", length(sam_variables))
       for (i in seq_len(length(sam_variables))) {
         p_heatmap[[i]] <- ggplot(filter(resLCBD, p.adj < pval)) +
           geom_tile(inherit.aes = FALSE, aes(
@@ -513,7 +513,7 @@ plot_LCBD_pq <- function(physeq,
     if (is.null(sam_variables)) {
       return(p_LCBD)
     } else {
-      p_heatmap <- list()
+      p_heatmap <- vector("list", length(sam_variables))
       for (i in seq_len(length(sam_variables))) {
         p_heatmap[[i]] <- ggplot(resLCBD) +
           geom_tile(inherit.aes = FALSE, aes(
@@ -527,9 +527,9 @@ plot_LCBD_pq <- function(physeq,
       }
 
       p <-
-        p_LCBD + patchwork::wrap_plots(p_heatmap) + patchwork::plot_layout(
-          widths = c(3, 1), guides =
-            "collect"
+        p_LCBD + patchwork::wrap_plots(p_heatmap) +
+        patchwork::plot_layout(
+          widths = c(3, 1), guides = "collect"
         )
       return(p)
     }
@@ -1245,7 +1245,7 @@ var_par_pq <-
     }
 
     if (dbrda_computation) {
-      res_varpart$dbrda_result <- list()
+      res_varpart$dbrda_result <- vector("list", length(list_component))
       for (i in seq_along(list_component)) {
         res_varpart$dbrda_result[[i]] <-
           anova(vegan::dbrda(
@@ -1363,7 +1363,7 @@ var_par_rarperm_pq <-
       dist_physeq <- phyloseq::distance(physeq, method = dist_method)
     }
 
-    res_perm <- list()
+    res_perm <- vector("list", nperm)
     for (i in 1:nperm) {
       res_perm[[i]] <-
         var_par_pq(

R/controls.R

@@ -25,8 +25,8 @@
 #' @author Adrien Taudière
 
 search_exact_seq_pq <- function(physeq, seq2search) {
-  res <- list()
   sequences <- seq2search
+  res <- vector("list", length(sequences))
   for (i in seq_along(sequences)) {
     original <- sequences[[i]]
     rev <- Biostrings::reverse(sequences[[i]])
@@ -90,7 +90,7 @@ search_exact_seq_pq <- function(physeq, seq2search) {
 dist_pos_control <- function(physeq, samples_names, method = "bray") {
   verify_pq(physeq)
 
-  res <- list()
+  res <- vector("list", 2)
   dist_control <- vector()
 
   for (i in levels(as.factor(samples_names))) {

R/dada_phyloseq.R

@@ -468,8 +468,9 @@ track_wkflow_samples <- function(list_pq_obj, ...) {
   if (sum(!unlist(lapply(list_pq_obj, inherits, "phyloseq"))) != 0) {
     stop("At least one object in your list_pq_obj is not a phyloseq obj.")
   }
-  res <- list()
   sam_names <- unique(unlist(lapply(list_pq_obj, sample_names)))
+  res <- vector("list", length(sam_names))
+  names(res) <- sam_names
   for (s in sam_names) {
     list_pq_obj_samples <-
       lapply(list_pq_obj, function(physeq) {
@@ -1021,7 +1022,6 @@ read_pq <- function(path = NULL,
     sample_names(physeq) <- unclass(physeq@sam_data[, sam_names])[[1]]
   }
 
-
   return(physeq)
 }
 
@@ -1060,6 +1060,7 @@ read_pq <- function(path = NULL,
 #' - "merged_ASV": the data.frame used to merged ASV
 #'
 #' @export
+#' @seealso [mumu_pq()]
 #' @examplesIf MiscMetabar::is_vsearch_installed()
 #' \donttest{
 #' lulu_pq(data_fungi_sp_known)
@@ -1208,6 +1209,7 @@ lulu_pq <- function(physeq,
 #'   bash to obtain details about columns' signification.
 #'
 #' @export
+#' @seealso [lulu_pq()]
 #' @examplesIf MiscMetabar::is_mumu_installed()
 #' \dontrun{
 #' mumu_pq(data_fungi_sp_known)

R/deprecated.R

@@ -7,8 +7,8 @@
 #' @name MiscMetabar-deprecated
 #' @param ... Parameters to be passed on to the modern version of the function
 #' @return Depend on the functions.
-#' @export  physeq_graph_test adonis_phyloseq clean_physeq lulu_phyloseq otu_circle biplot_physeq read_phyloseq write_phyloseq sankey_phyloseq summary_plot_phyloseq plot_deseq2_phyloseq plot_edgeR_phyloseq venn_phyloseq ggVenn_phyloseq hill_tuckey_phyloseq hill_phyloseq physeq_heat_tree
-#' @aliases physeq_graph_test adonis_phyloseq clean_physeq lulu_phyloseq otu_circle biplot_physeq read_phyloseq write_phyloseq sankey_phyloseq summary_plot_phyloseq plot_deseq2_phyloseq plot_edgeR_phyloseq venn_phyloseq ggVenn_phyloseq hill_tuckey_phyloseq hill_phyloseq physeq_heat_tree
+#' @export  physeq_graph_test adonis_phyloseq clean_physeq lulu_phyloseq otu_circle biplot_physeq read_phyloseq write_phyloseq sankey_phyloseq summary_plot_phyloseq plot_deseq2_phyloseq plot_edgeR_phyloseq venn_phyloseq ggVenn_phyloseq hill_tuckey_phyloseq hill_phyloseq 
+#' @aliases physeq_graph_test adonis_phyloseq clean_physeq lulu_phyloseq otu_circle biplot_physeq read_phyloseq write_phyloseq sankey_phyloseq summary_plot_phyloseq plot_deseq2_phyloseq plot_edgeR_phyloseq venn_phyloseq ggVenn_phyloseq hill_tuckey_phyloseq hill_phyloseq 
 #' @section Details:
 #' \tabular{rl}{
 #'   [graph_test_pq] \tab now a synonym for `physeq_graph_test`\cr
@@ -27,7 +27,7 @@
 #'   [ggvenn_pq] \tab now a synonym for `ggVenn_phyloseq`\cr
 #'   [hill_tuckey_pq] \tab now a synonym for `hill_tuckey_phyloseq`\cr
 #'   [hill_pq] \tab now a synonym for `hill_phyloseq`\cr
-#'   [heat_tree_pq] \tab now a synonym for `physeq_heat_tree`\cr
+#'   heat_tree_pq \tab now a synonym for `physeq_heat_tree`\cr
 #'   [compare_pairs_pq] \tab now a synonym for `multiple_share_bisamples`\cr
 #' }
 #'
@@ -113,10 +113,10 @@ hill_phyloseq <- function(...) {
   hill_pq(...)
 }
 
-physeq_heat_tree <- function(...) {
-  .Deprecated("heat_tree_pq", package = "MiscMetabar")
-  heat_tree_pq(...)
-}
+# physeq_heat_tree <- function(...) {
+#   .Deprecated("heat_tree_pq", package = "MiscMetabar")
+#   heat_tree_pq(...)
+# }
 
 multiple_share_bisamples <- function(...) {
   .Deprecated("compare_pairs_pq", package = "MiscMetabar")

R/miscellanous.R

@@ -72,9 +72,7 @@ dist_bycol <- function(x,
     stop("x and y must be of the same dimension")
   }
 
-  res <- list()
-  res$obs <- rep(NA, ncol(x))
-  res$null <- list(length = nperm)
+  res <- list(obs = rep(NA, ncol(x)), null = list(length = nperm))
 
   for (i in seq_len(ncol(x))) {
     res$obs[i] <-