Issue 76 - misc bugfixes

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: romic
 Type: Package
 Title: R for High-Dimensional Omic Data
-Version: 1.1.4.9000
+Version: 1.2.0
 Authors@R: c(
     person(
       given = "Sean",

NAMESPACE

@@ -36,6 +36,7 @@ export(plot_heatmap)
 export(plot_univariate)
 export(plotsaverInput)
 export(plotsaverServer)
+export(reform_tidy_omic)
 export(remove_missing_values)
 export(shiny_filter_test)
 export(shiny_ggbiv_test)

R/app_heatmap.R

@@ -105,7 +105,7 @@
       observe({
         # need double parenthesis since its a reactive of a reactive
         print(glue::glue(
           "Filtering results: tidy_filtered_samples is {nrow(tidy_filtered_samples()()$data)} rows"
         ))
       })
 
@@ -302,7 +302,7 @@
 #' )
 #' @export
 plot_heatmap <- function(
     tomic,
     feature_var = NULL,
     sample_var = NULL,
     value_var = NULL,
@@ -315,7 +315,7 @@
     x_label = NULL,
     y_label = NULL,
     colorbar_label = NULL
     ) {
   checkmate::assertClass(tomic, "tomic")
 
   if ("NULL" %in% class(feature_var)) {
@@ -338,12 +338,12 @@
   checkmate::assertNumber(max_display_features)
 
   if ("NULL" %in% class(x_label)) {
-    x_label <- feature_var
+    x_label <- sample_var
   }
   checkmate::assertMultiClass(x_label, c("character", "expression"))
 
   if ("NULL" %in% class(y_label)) {
-    y_label <- sample_var
+    y_label <- feature_var
   }
   checkmate::assertMultiClass(y_label, c("character", "expression"))
 
@@ -410,7 +410,7 @@
     nrow()
 
   heatmap_theme <- theme_minimal() +
      theme(
        text = element_text(size = 16, color = "black"),
        title = element_text(size = 20, color = "black"),
        strip.text = element_text(size = 18),
@@ -423,7 +423,7 @@
       theme(axis.text.y = element_blank())
   } else {
     heatmap_theme <- heatmap_theme +
       theme(axis.text.y = element_text(size = pmin(20, 60 * sqrt(1 / n_features))))
   }
 
   if (n_samples > 200) {
@@ -470,7 +470,7 @@
     return(heatmap_plot)
   } else if (plot_type == "plotly") {
     suppressWarnings(
-      plotly::ggplotly(heatmap_plot) %>%
+      plotly::ggplotly(p = heatmap_plot) %>%
         plotly::layout(margin = 0)
     )
   } else {

R/data_classes.R

@@ -59,14 +59,14 @@
 #' )
 #' @export
 create_tidy_omic <- function(
     df,
     feature_pk,
     feature_vars = NULL,
     sample_pk,
     sample_vars = NULL,
     omic_type_tag = "general",
     verbose = TRUE
     ) {
 
   checkmate::assertDataFrame(df)
   checkmate::assertString(omic_type_tag)
@@ -86,7 +86,7 @@
 
   n_var_uses <- table(c(feature_pk, feature_vars, sample_pk, sample_vars))
   if (any(n_var_uses > 1)) {
     invalid_vars <- names(n_var_uses)[n_var_uses > 1]
 
     cli::cli_abort(
       "{paste(invalid_vars, collapse = ', ')} were assigned to multiple
@@ -134,7 +134,7 @@
     measurement_vars <- setdiff(
       output$design$measurements$variable,
       c(feature_pk, sample_pk)
       )
 
     message(glue::glue(
       "{length(measurement_vars)} measurement variables were defined as the
@@ -638,6 +638,11 @@
   output$data <- tidy_output
   output$design <- triple_omic$design
 
+  if ("unstructured" %in% names(triple_omic)) {
+    # copy unstructured data as-is
+    output$unstructured <- triple_omic$unstructured
+  }
+
   class(output) <- c("tidy_omic", "tomic", class(triple_omic)[3])
 
   output
@@ -691,6 +696,11 @@
     design = tidy_omic$design
   )
 
+  if ("unstructured" %in% names(tidy_omic)) {
+    # copy unstructured data as-is
+    output$unstructured <- tidy_omic$unstructured
+  }
+
   class(output) <- c("triple_omic", "tomic", class(tidy_omic)[3])
 
   output
@@ -1009,3 +1019,40 @@
   return(table_type)
 }
 
+#' Reform Tidy Omic
+#'
+#' This function recreates a `tidy_omic` object from the "data" and "design"
+#' attributes of this object.
+#'
+#' @param tidy_data A tibble containing measurements along with sample metadata. This
+#'   table can be obtained as the "data" attribute from a romic "tidy_omic" object.
+#' @inheritParams check_design
+#'
+#' @details This is handy for passing data and metadata through approaches like parsnip
+#' which expect data to be formatted as a data.frame
+#'
+#' @examples
+#' tidy_data <- romic::brauer_2008_tidy$data
+#' reform_tidy_omic(tidy_data, romic::brauer_2008_tidy$design)
+#'
+#' @export
+reform_tidy_omic <- function(tidy_data, tomic_design) {
+
+  checkmate::assertTibble(tidy_data)
+  romic::check_design(tomic_design)
+
+  feature_attributes <- tomic_design$features$variable[tomic_design$features$type != "feature_primary_key"]
+  sample_attributes <- tomic_design$samples$variable[tomic_design$samples$type != "sample_primary_key"]
+
+  tidy_omic <- romic::create_tidy_omic(
+    df = tidy_data,
+    feature_pk = tomic_design$feature_pk,
+    feature_vars = feature_attributes,
+    sample_pk = tomic_design$sample_pk,
+    sample_vars = sample_attributes,
+    verbose = FALSE
+  )
+
+  return(tidy_omic)
+}
+

R/dim_reduction.R

@@ -251,7 +251,9 @@ impute_missing_values <- function(
     tomic,
     impute_var_name = "imputed",
     value_var = NULL,
-    ...) {
+    ...
+    ){
+
   if (!("impute" %in% rownames(utils::installed.packages()))) {
     stop("Install \"impute\" using remotes::install_bioc(\"impute\") to use this function")
   }
@@ -309,6 +311,20 @@ impute_missing_values <- function(
     ) %>%
     dplyr::as_tibble()
 
+  # coerce feature and/or sample variables to their original classes
+  # (they will be converted to characters by impute.knn)
+
+  imputed_measurements[[feature_pk]] <- coerce_to_classes(
+    imputed_measurements[[feature_pk]],
+    triple_omic$features[[feature_pk]]
+  )
+
+  imputed_measurements[[sample_pk]] <- coerce_to_classes(
+    imputed_measurements[[sample_pk]],
+    triple_omic$samples[[sample_pk]]
+  )
+
+  # if in-place imputation is desired then remove the old variable
   updated_measurements <- triple_omic$measurements
   if (value_var == impute_var_name) {
     updated_measurements <- updated_measurements %>%

tests/testthat/test-data_classes.R

@@ -111,6 +111,19 @@ test_that("Create triple omic", {
     sample_pk = "sample_id"
   )
 
+  testthat::expect_s3_class(simple_triple, "triple_omic")
+})
+
+test_that("Unstructured data preserved using tomic_to", {
+
+  triple_omic <- tomic_to(simple_triple, "triple_omic")
+  triple_omic$unstructured$dat <- "test"
+
+  tidy_copy <- triple_to_tidy(triple_omic)
+  expect_equal(tidy_copy$unstructured$dat, "test")
+
+  triple_restore <- tidy_to_triple(tidy_copy)
+  expect_equal(triple_restore$unstructured$dat, "test")
 })
 
 
@@ -159,3 +172,10 @@ test_that("Test that get_tomic_table() can retrieve various tables", {
     error = TRUE
   )
 })
+
+test_that("reform_tidy_omic() can create a tidy_omic object from its attributes", {
+  tidy_data <- romic::brauer_2008_tidy$data
+  tomic <- reform_tidy_omic(tidy_data, romic::brauer_2008_tidy$design)
+
+  expect_s3_class(tomic, "tidy_omic")
+})

tests/testthat/test-dim_reduction.R

@@ -26,3 +26,18 @@ test_that("Removing missing values works", {
   expect_equal(nrow(filtered_brauer$samples), 34)
   expect_equal(nrow(filtered_brauer$measurements), 15674)
 })
+
+test_that("Matrices keys are reconstructed with appropriate classes", {
+
+  tomic_with_missing_values <- simple_triple
+  tomic_with_missing_values$measurements <- tomic_with_missing_values$measurements %>%
+    dplyr::slice(-c(1:5))
+
+  if (!("impute" %in% rownames(utils::installed.packages()))) {
+    cli::cli_alert("{.pkg impute} is not available for testing; imputation tests will be skipped")
+  } else{
+    imputed_tomic <- impute_missing_values(tomic_with_missing_values)
+    expect_s3_class(imputed_tomic, "triple_omic")
+  }
+
+})