refactored roxygen2 and improved error handling

Author: agusinac

NEWS.md

@@ -1,35 +1,7 @@
-# OmicFlow 1.6.0.9003
+# OmicFlow 1.6.0.9005
 
 ## Changed
-- Re-factoring `roxygen2` code & documentation style & error handling.
-    - Follow order of `tests/testthat.R` file
-    - Finished:
-        - test-omics.R
-        - test-omics-transformation.R
-        - test-omics-subsetting.R
-        - test-omics-rankstat.R
-        - test-omics-ordination.R
-        - test-omics-feature_merge.R
-        - test-omics-composition.R
-        - test-omics-alpha_diversity.R
-        - test-omics-autoFlow.R [SKIP, finish later with issue #43]
-        - test-omics-foldchange.R [SKIP, finish later with issue #43]
-        - test-metagenomics.R
-        - test-metagenomics-write_biom.R
-        - test-proteomics.R
-        - test-util-colormap.R
-        - test-util-column_exists.R
-        - test-util-combine_conditions.R
-        - test-util-matrix_to_dtable.R
-        - test-util-wholenumber.R
-        - test-metrics-diversity.R
-        - test-metrics-hill_taxa.R
-        - test-metrics-distances.R
-        - test-statistics-pairwise_stats.R
-        - test-visualisation-diversity_plot.R [TODO]
-        - test-visualisation-ordination_plot.R [TODO]
-        - test-visualisation-plot_pairwise_stats.R [TODO]
-        - test-visualisation-volcano_plot.R [TODO]
+- Re-factoring and improving `roxygen2` code, documentation style and error handling.
 - TODO: Add `tryCatch` where neccessary
 - Added `tryCatch` and better error handling in `omics$sample_subset`, `omics$feature_subset` and `omics$samplepair_subset`.
 - Replaced `jsonlite` by `yyjsonr` functionality, much faster and cleaner code.

R/bray.R

@@ -59,7 +59,7 @@ bray <- function(x, weighted = TRUE, threads = 1) {
     if (length(threads) != 1) {
         cli::cli_abort("{.val threads} must be a single whole number.")
     } else if (!is.wholenumber(threads)) {
-        cli::cli_abort("{.val {threads}} must be a whole number.")
+        cli::cli_abort("{.val threads} must be a whole number.")
     }
 
     ## MAIN

R/canberra.R

@@ -57,7 +57,7 @@ canberra <- function(x, weighted = TRUE, threads = 1) {
     if (length(threads) != 1) {
         cli::cli_abort("{.val threads} must be a single whole number.")
     } else if (!is.wholenumber(threads)) {
-        cli::cli_abort("{.val {threads}} must be a whole number.")
+        cli::cli_abort("{.val threads} must be a whole number.")
     }
 
     ## MAIN

R/colormap.R

@@ -29,18 +29,18 @@ colormap <- function(data,
   OPTIONS <- rownames(RColorBrewer::brewer.pal.info)
 
   if (!inherits(data, "data.frame") && !inherits(data, "data.table"))
-    cli::cli_abort("Data must be a {.cls data.frame} or {.cls data.table}.")
+    cli::cli_abort("{.val data} must be a {.cls data.frame} or {.cls data.table}.")
 
   if (!is.character(col_name) || length(col_name) != 1) {
-    cli::cli_abort("{.val {col_name}} needs to contain characters with length of 1.")
+    cli::cli_abort("{.val col_name} needs to contain characters with length of 1.")
   } else if (!column_exists(col_name, data)) {
-    cli::cli_abort("The {.val {col_name}} column does not exist in the provided data.")
+    cli::cli_abort("The {.val col_name} column does not exist in the provided data.")
   }
 
   if (!is.character(Brewer.palID) || length(Brewer.palID) != 1) {
-    cli::cli_abort("The {.val {Brewer.palID}} needs to contain characters with length of 1.")
+    cli::cli_abort("The {.val Brewer.palID} needs to contain characters with length of 1.")
   } else if (!c(Brewer.palID %in% OPTIONS)) {
-    cli::cli_abort("{.val {Brewer.palID}} is not a valid Brewer pal ID. \nValid options: {.val {OPTIONS}}.")
+    cli::cli_abort("{.val Brewer.palID} is not a valid Brewer pal ID. \nValid options: {.val {OPTIONS}}.")
   }
 
   ## MAIN

R/composition_plot.R

@@ -4,10 +4,10 @@
 #' The function is compatible with the class \link{omics} method \code{composition()}.
 #'
 #' @param data A \link[base]{data.frame} or \link[data.table]{data.table}.
-#' @param palette An object with names and hexcode or color names, see \link{colormap}.
-#' @param feature_rank A character variable of the feature column.
-#' @param title_name A character to set the \code{ggtitle} of the \link[ggplot2]{ggplot}, (Default: NULL).
-#' @param group_by A character variable to aggregate the stacked bars by group (Default: NULL).
+#' @param palette A \link[stats]{setNames}, see \link{colormap}.
+#' @param feature_rank A column name containing the feature names.
+#' @param title_name A character to set the \code{ggtitle} of the \link[ggplot2]{ggplot}, (default: \code{NULL}).
+#' @param group_by A character variable to aggregate the stacked bars by group (default: \code{NULL}).
 #' @return A \link[ggplot2]{ggplot2} object to be further modified
 #' 
 #' @examples
@@ -75,30 +75,33 @@ composition_plot <- function(data,
   #--------------------------------------------------------------------#
 
   if (!inherits(data, "data.frame") && !inherits(data, "data.table"))
-    cli::cli_abort("Data must be a {.cls data.frame} or {.cls data.table}.")
+    cli::cli_abort("{.val data} must be a {.cls data.frame} or {.cls data.table}.")
 
   if (!is.character(palette))
-    cli::cli_abort("{.val {palette}} needs to contain characters.")
+    cli::cli_abort("{.val palette} needs to contain characters.")
 
-  if (!is.character(feature_rank) && length(feature_rank) != 1) {
-    cli::cli_abort("{.val {feature_rank}} needs to contain characters with length of 1.")
+  if (!is.character(feature_rank) || length(feature_rank) != 1) {
+    cli::cli_abort("{.val feature_rank} needs to contain characters with length of 1.")
   } else if (!column_exists(feature_rank, data)) {
-    cli::cli_abort("The {.val {feature_rank}} column does not exist in the provided {.arg data}.")
+    cli::cli_abort("The {.val {feature_rank}} column does not exist in the provided {.val data}.")
   }
 
-  if (!is.null(title_name) && !is.character(title_name))
-    cli::cli_abort("{.val {title_name}} needs to be of type character.")
+  if (!is.null(title_name)) {
+    if (!is.character(title_name) || length(title_name) != 1) {
+      cli::cli_abort("{.val title_name} must be a character and of length 1")
+    }
+  }
 
   if (!is.null(group_by)) {
-    if (!is.character(group_by) && length(group_by) != 1) {
-      cli::cli_abort("{.val {group_by}} must be a character and of length 1")
+    if (!is.character(group_by) || length(group_by) != 1) {
+      cli::cli_abort("{.val group_by} must be a character and of length 1")
     } else if (!column_exists(group_by, data)) {
-      cli::cli_abort("The specified {.val {group_by}} does not exist in the provided {.arg data}.")
+      cli::cli_abort("The specified {.val {group_by}} does not exist in the provided {.val data}.")
     }
   }
 
   if (!column_exists("SAMPLE_ID", data))
-    cli::cli_abort("{.arg SAMPLE_ID} needs to exist within the provided {.arg data}.")
+    cli::cli_abort("{.arg SAMPLE_ID} needs to exist within the provided {.val data}.")
 
   ## MAIN
   #--------------------------------------------------------------------#

R/cosine.R

@@ -57,7 +57,7 @@ cosine <- function(x, weighted = TRUE, threads = 1) {
     if (length(threads) != 1) {
         cli::cli_abort("{.val threads} must be a single whole number.")
     } else if (!is.wholenumber(threads)) {
-        cli::cli_abort("{.val {threads}} must be a whole number.")
+        cli::cli_abort("{.val threads} must be a whole number.")
     }
 
     ## MAIN

R/diversity.R

@@ -66,9 +66,9 @@ diversity <- function(x,
 
   OPTIONS <- c("shannon", "simpson", "invsimpson")
   if (!is.character(metric) || length(metric) != 1) {
-    cli::cli_abort("{.val {metric}} needs to contain characters with length of 1.")
+    cli::cli_abort("{.val metric} needs to contain characters with length of 1.")
   } else if (!metric %in% OPTIONS) {
-    cli::cli_abort("{.val {metric}} is not a valid metric. Valid options: <{.val {OPTIONS}}>")
+    cli::cli_abort("{.val {metric}} is not a valid {.arg metric}.\nValid options: <{.val {OPTIONS}}>")
   }
 
   ## MAIN

R/diversity_plot.R

@@ -5,10 +5,10 @@
 #' @param data A \link[base]{data.frame} or \link[data.table]{data.table} computed from \link{diversity}.
 #' @param values A column name of a continuous variable.
 #' @param col_name A column name of a categorical variable.
-#' @param group_by A column name to perform grouped statistical test (default: NULL).
+#' @param group_by A column name to perform grouped statistical test (default: \code{NULL}).
 #' @param palette An object with names and hexcode or color names, see \link{colormap}.
-#' @param method A character variable indicating what method is used to compute the diversity.
-#' @param paired A boolean value to perform paired analysis in \link[stats]{wilcox.test}.
+#' @param method A character variable indicating what method is used to compute the diversity (default: \code{"custom"}).
+#' @param paired A boolean value to perform paired analysis in \link[stats]{wilcox.test} (default: \code{FALSE}).
 #' @param p.adjust.method A character variable to specify the p.adjust.method to be used (Default: fdr).
 #' @return A \link[ggplot2]{ggplot2} object to be further modified
 #' 
@@ -76,7 +76,7 @@ diversity_plot <- function(
   col_name,
   group_by = NULL,
   palette,
-  method,
+  method = "custom",
   paired = FALSE,
   p.adjust.method = "fdr"
   ) {
@@ -85,45 +85,49 @@ diversity_plot <- function(
   #--------------------------------------------------------------------#
 
   if (!inherits(data, "data.frame") && !inherits(data, "data.table"))
-    cli::cli_abort("Data must be a {.cls data.frame} or {.cls data.table}.")
-  
-  if (!is.character(palette))
-    cli::cli_abort("{.val {palette}} needs to contain characters.")
-  
-  if (!is.character(method)) {
-    cli::cli_abort("{.val {method}} needs to be a character {.cls vector}.")
-  }
-  
-  if (!is.character(values) && length(values) != 1) {
-    cli::cli_abort("{.val {values}} needs to contain characters with length of 1.")
+    cli::cli_abort("{.val data} must be a {.cls data.frame} or {.cls data.table}.")
+
+  if (!is.character(values) || length(values) != 1) {
+    cli::cli_abort("{.val values} needs to contain characters with length of 1.")
   } else if (!column_exists(values, data)) {
-    cli::cli_abort("The {.val values}} column does not exist in the provided {.arg data}.")
+    cli::cli_abort("The {.val values} column does not exist in the provided {.arg data}.")
   }
 
-  if (!is.character(col_name) && length(col_name) != 1) {
-    cli::cli_abort("{.val {col_name}} needs to contain characters with length of 1.")
+  if (!is.character(col_name) || length(col_name) != 1) {
+    cli::cli_abort("{.val col_name} needs to contain characters with length of 1.")
   } else if (!column_exists(col_name, data)) {
-    cli::cli_abort("The {.val {col_name}} column does not exist in the provided {.arg data}.")
+    cli::cli_abort("The {.val col_name} column does not exist in the provided {.arg data}.")
   }
 
   if (!is.null(group_by)) {
-    if (!is.character(group_by) && length(group_by) != 1) {
-      cli::cli_abort("{.val {group_by}} needs to contain characters with length of 1.")
+    if (!is.character(group_by) || length(group_by) != 1) {
+      cli::cli_abort("{.val group_by} needs to contain characters with length of 1.")
     } else if (!column_exists(group_by, data)) {
-      cli::cli_abort("The {.val {group_by}} column does not exist in the provided {.arg data}.")
+      cli::cli_abort("The {.val group_by} column does not exist in the provided {.arg data}.")
     }
   }
+
+  if (!is.character(palette))
+    cli::cli_abort("{.val palette} needs to contain characters.")
 
+  if (!is.character(method)) {
+    cli::cli_abort("{.val method} needs to be a character {.cls vector}.")
+  }
+
+  if (!is.logical(paired))
+    cli::cli_abort("{.val paired} needs to be either `TRUE` or `FALSE`.")
+
   if (!c(p.adjust.method %in% stats::p.adjust.methods))
     cli::cli_abort("{.val {p.adjust.method}} is not a valid option. \nValid options: {.val {p.adjust.methods}}")
 
   ## MAIN
   #--------------------------------------------------------------------#
 
+  data_tmp <- data.table::copy(data)
   result <- list()
 
   if (!is.null(group_by)) {
-    pvalues_adjusted <- data[, {
+    pvalues_adjusted <- data_tmp[, {
       tmp <- rstatix::pairwise_wilcox_test(
         data = .SD,
         formula = stats::reformulate(col_name, response = values),
@@ -136,17 +140,17 @@ diversity_plot <- function(
     }, by = group_by]
 
     # Creates box_stats for half geom_box
-    data.table::setnames(data, old = group_by, new = "group_col")
+    data.table::setnames(data_tmp, old = group_by, new = "group_col")
     group_by <- "group_col"
-    box_stats <- data[, .(
+    box_stats <- data_tmp[, .(
       ymin = base::min(base::get(values)),
       ymax = base::max(base::get(values)),
       lower = stats::quantile(base::get(values), 0.25),
       middle = stats::median(base::get(values)),
       upper = stats::quantile(base::get(values), 0.75)
     ), by = .(group_numeric = as.numeric(as.factor(base::get(col_name))), group_col)]
   } else {
-    pvalues_adjusted <- data[, {
+    pvalues_adjusted <- data_tmp[, {
       tmp <- rstatix::pairwise_wilcox_test(
         data = .SD,
         formula = stats::reformulate(col_name, response = values),
@@ -158,7 +162,7 @@ diversity_plot <- function(
     }]
 
     # Creates box_stats for half geom_box
-    box_stats <- data[, .(
+    box_stats <- data_tmp[, .(
       ymin = base::min(base::get(values)),
       ymax = base::max(base::get(values)),
       lower = stats::quantile(base::get(values), 0.25),
@@ -169,7 +173,7 @@ diversity_plot <- function(
   pvalues_adjusted.filtered <- pvalues_adjusted[grepl("\\*", pvalues_adjusted$p.adj.signif) ,]
 
   plt <- ggplot2::ggplot(
-    data = data,
+    data = data_tmp,
     mapping = ggplot2::aes(
       x = as.numeric(as.factor(.data[[col_name]])),
       y = .data[[values]]
@@ -276,8 +280,8 @@ diversity_plot <- function(
     ) +
     # Restore proper x-axis labels
     ggplot2::scale_x_continuous(
-      breaks = seq_along(unique(data[[col_name]])),
-      labels = levels(as.factor(data[[col_name]]))
+      breaks = seq_along(unique(data_tmp[[col_name]])),
+      labels = levels(as.factor(data_tmp[[col_name]]))
     ) +
     ggplot2::scale_colour_manual(
       name = "groups",

R/euclidean.R

@@ -55,7 +55,7 @@ euclidean <- function(x, weighted = TRUE, threads = 1) {
     if (length(threads) != 1) {
         cli::cli_abort("{.val threads} must be a single whole number.")
     } else if (!is.wholenumber(threads)) {
-        cli::cli_abort("{.val {threads}} must be a whole number.")
+        cli::cli_abort("{.val threads} must be a whole number.")
     }
 
     ## MAIN

R/hill_taxa.R

@@ -58,11 +58,11 @@ hill_taxa <- function (
     cli::cli_abort("{.val x} must be non-negative.")
 
   if (length(q) != 1) {
-    cli::cli_abort("{.val {q}} needs to be a single whole number.")
+    cli::cli_abort("{.val q} needs to be a single whole number.")
   } else if (!is.wholenumber(q)) {
-    cli::cli_abort("{.val {q}} is not a whole number.")
+    cli::cli_abort("{.val q} is not a whole number.")
   } else if (!c(q %in% c(0, 1, 2))) {
-    cli::cli_abort("{.val {q}} needs to be a whole number of either {.val 0}, {.val 1} or {.val 2}.")
+    cli::cli_abort("{.val q} needs to be a whole number of either {.val 0}, {.val 1} or {.val 2}.")
   }
 
   if (!is.logical(normalize))