abstracted matrix export function

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: romic
 Type: Package
 Title: R for High-Dimensional Omic Data
-Version: 1.2.0
+Version: 1.2.1
 Authors@R: c(
     person(
       given = "Sean",
@@ -45,6 +45,6 @@ Encoding: UTF-8
 LazyData: true
 URL: https://calico.github.io/romic/, https://github.com/calico/romic
 BugReports: https://github.com/calico/romic/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -53,6 +53,7 @@ export(sort_tomic)
 export(tidy_to_triple)
 export(tomic_sort_status)
 export(tomic_to)
+export(tomic_to_matrix)
 export(triple_to_tidy)
 export(update_tidy_omic)
 export(update_tomic)

R/dim_reduction.R

@@ -358,15 +358,15 @@ value_var_handler <- function(value_var = NULL, design) {
   if (length(possible_value_vars) == 0) {
     stop(
       "no quantitative (numeric or integer) variables were found in the
-      triple_omic measurements table pca can only be applied to quantitative
-      variables"
+      triple_omic measurements table."
     )
   }
 
   if (length(possible_value_vars) > 1 && is.null(value_var)) {
-    stop(
-      "value_var must be specified since multiple quantitative measurement
-      variables exist"
+    cli::cli_abort(
+      "{.var \"value_var\"} was not provided and an appropriate value could not
+        be automatically chosen since there are {length(possible_value_vars)}
+        valid value variables: {.field {possible_value_vars}}"
     )
   }
 

R/export.R

@@ -92,8 +92,7 @@ export_tomic_as_tidy <- function(tomic, dir_path, name_preamble, verbose = TRUE)
 #'   Use transpose to treat samples as rows
 #' filename
 #' @inheritParams export_tomic_as_triple
-#' @param value_var measurement variable to use for the matrix
-#' @param transpose if TRUE then samples will be stored as rows
+#' @inheritParams tomic_to_matrix
 #' @inheritParams create_tidy_omic
 #'
 #' @returns Export one table which contains metabolites as rows and samples
@@ -106,13 +105,13 @@ export_tomic_as_tidy <- function(tomic, dir_path, name_preamble, verbose = TRUE)
 #' }
 #' @export
 export_tomic_as_wide <- function(
-    tomic,
-    dir_path,
-    name_preamble,
-    value_var = NULL,
-    transpose = FALSE,
-    verbose = TRUE
-    ) {
+  tomic,
+  dir_path,
+  name_preamble,
+  value_var = NULL,
+  transpose = FALSE,
+  verbose = TRUE
+  ) {
   checkmate::assertDirectory(dir_path)
   checkmate::assertString(name_preamble)
   checkmate::assertLogical(transpose, len = 1)
@@ -121,41 +120,7 @@ export_tomic_as_wide <- function(
   triple_omic <- tomic_to(tomic, "triple_omic")
   design <- triple_omic$design
 
-  valid_value_vars <- design$measurements %>%
-    dplyr::filter(
-      !(type %in% c("feature_primary_key", "sample_primary_key"))
-    ) %>%
-    {
-      .$variable
-    }
-
-  if (is.null(value_var)) {
-    if (length(valid_value_vars) == 1) {
-      value_var <- valid_value_vars
-    } else {
-      stop(glue::glue(
-        "\"value_var\" was not provided and an appropriate value could not
-        - be automatically chosen since there are {length(valid_value_vars)}
-        - valid value variables: {paste(valid_value_vars, collapse = ', ')}"
-      ))
-    }
-  } else {
-    checkmate::assertChoice(value_var, valid_value_vars)
-  }
-
-  # structure measurements
-  if (transpose) {
-    cast_formula <- stats::as.formula(glue::glue(
-      "{design$sample_pk} ~ {design$feature_pk}"
-    ))
-  } else {
-    cast_formula <- stats::as.formula(glue::glue(
-      "{design$feature_pk} ~ {design$sample_pk}"
-    ))
-  }
-
-  measurements_matrix <- triple_omic$measurements %>%
-    reshape2::acast(formula = cast_formula, value.var = value_var)
+  measurements_matrix <- tomic_to_matrix(triple_omic, value_var)
 
   if (transpose) {
     feature_labels <- colnames(measurements_matrix)
@@ -262,16 +227,93 @@ export_tomic_as_wide <- function(
   }
 
   filename <- paste0(name_preamble, "_", "wide.tsv")
+  filepath <- file.path(dir_path, filename)
   if (verbose) {
-    message(glue::glue("Saving {filename} to {dir_path}"))
+    cli::cli_alert_info("Saving wide data {.file {filepath}}")
   }
 
   output %>%
     as.data.frame() %>%
     readr::write_tsv(
-      file = file.path(dir_path, filename),
+      file = filepath,
       col_names = FALSE
     )
 
   invisible(0)
 }
+
+#' Tomic To Matrix
+#'
+#' Convert a T*Omic object to a feature x sample matrix matching the feature
+#' and sample ordering of a Triple Omic object.
+#'
+#' @inheritParams export_tomic_as_triple
+#' @param value_var measurement variable to use for the matrix
+#' @param transpose if TRUE then samples will be stored as rows.
+#'   If FALSE (default) then samples will be columns.
+#'
+#' @returns a matrix with features as rows and samples as columns (if transpose
+#'   FALSE) or features as columns and samples as rows (if transpose is TRUE).
+#'
+#' @details Comparing the matrix to feature or sample variable vectors should
+#' work because the orders are matched. But, if features or samples are reordered
+#' after creating the matrix then the matrix's dimensions will no longer be
+#' aligned to feature and samples.
+#'
+#' @export
+#'
+#' @examples
+#' tomic_to_matrix(brauer_2008_triple)
+tomic_to_matrix <- function(
+  tomic,
+  value_var = NULL,
+  transpose = FALSE
+) {
+
+  triple_omic <- tomic_to(tomic, "triple_omic")
+  design <- triple_omic$design
+
+  value_var = value_var_handler(value_var, design)
+  checkmate::assertLogical(transpose, len = 1)
+
+  # structure measurements
+  if (transpose) {
+    cast_formula <- stats::as.formula(glue::glue(
+      "{design$sample_pk} ~ {design$feature_pk}"
+    ))
+  } else {
+    cast_formula <- stats::as.formula(glue::glue(
+      "{design$feature_pk} ~ {design$sample_pk}"
+    ))
+  }
+
+  # get the order of features and samples in their respective tables.
+  # that way we can set the matrix rows/columns to match this order
+  # feature / sample variables can be used with the indexes already matching
+  # the matrices row and column names.
+  feature_fcts <- get_tomic_table(tomic, "features")[[design$feature_pk]]
+  sample_fcts <- get_tomic_table(tomic, "samples")[[design$sample_pk]]
+
+  measurements_matrix <- triple_omic$measurements %>%
+    dplyr::mutate(
+      !!rlang::sym(design$sample_pk) := factor(
+        !!rlang::sym(design$sample_pk),
+        levels = sample_fcts
+      ),
+      !!rlang::sym(design$feature_pk) := factor(
+        !!rlang::sym(design$feature_pk),
+        levels = feature_fcts
+      )
+    ) %>%
+    reshape2::acast(formula = cast_formula, value.var = value_var)
+
+  if (transpose) {
+    stopifnot(all(colnames(measurements_matrix) == feature_fcts))
+    stopifnot(all(rownames(measurements_matrix) == sample_fcts))
+  } else {
+    stopifnot(all(rownames(measurements_matrix) == feature_fcts))
+    stopifnot(all(colnames(measurements_matrix) == sample_fcts))
+  }
+
+  return(measurements_matrix)
+}

tests/testthat/test-export.R

@@ -98,3 +98,7 @@ test_that("Read and Write Wide Data", {
     stopifnot(!file.exists(wide_path))
   }
 })
+
+test_that("Format results as a matrix", {
+  expect_equal(dim(tomic_to_matrix(brauer_2008_triple)), c(500, 36))
+})