Change function to add host col to metadata and formula and integrate with run_mtxDE

Author: klterwelp

R/mtxDE.R

@@ -392,7 +392,7 @@ add_perc_host_metadata <- function(metadata, sampleID,
     }
   }
   # select only the sampleID and host column in report
-  report <- report %>% dplyr::select(sampleID, host_col)
+  report <- report %>% dplyr::select(all_of(sampleID), all_of(host_col))
 
   # left join percent host based on sampleID to metadata file
   new_metadata <- dplyr::left_join(metadata, report, by = sampleID)
@@ -633,32 +633,34 @@ filter_tables_by_shared_columns <- function(table1, table2, table1_name,
 
 #' Add percent host column to formula
 #'
-#' @param data A data frame containing the merged feature table and metadata,
+#' @param metadata A data frame containing the merged feature table and metadata,
 #' ready for regression.
+#' @param formula  A string representing the formula for the regression model.
 #' @param host_col A string representing the name of the percent host column
 #' within the `data` data.frame.
-#' @param formula  A string representing the formula for the regression model.
-#' @param fixed.vars A vector of strings representing the fixed effect
-#' variables to include in the regression.
-#' @param reg.method A string indicating the regression method to be used.
-#' Options include "zibr", "gamlss", "lm", and "lmer".
-#'
-#'
-#' @returns list of updated `formula` and `fixed.vars` with the matching dna
-#' column added to them
+#' @param report A dataframe that contains the percent host
+#' column `host_col` and the `sampleID` column.
+#' @param sampleID A string representing the column name in `metadata`
+#' that contains the sample IDs.
+#' @returns list of updated `formula` and `fixed.vars` with the
+#' `host_col`added to them
 #'
 #' @keywords internal
-.add_host_to_formula <- function(data, host_col, formula=NULL, fixed.vars=NULL,
-                 reg.method) {
-  if (!(host_col %in% colnames(data))) {
-    stop("The given percent host column not found in data: ", host_col)
-  }
-  if (reg.method == "zibr") {
-    fixed.vars <- c(fixed.vars, host_col)
-  } else {
-    formula <- paste0(formula, " + ", host_col)
+.add_host_to_formula_metadata <- function(metadata, formula, sampleID,
+                                          report=NULL, host_col=NULL) {
+  if (!is.null(host_col)) {
+    if (host_col %in% all.vars(as.formula(formula)) == FALSE) {
+      formula <- paste0(formula, " + ", host_col)
+    }
+    if (!is.null(report)) {
+      if ((host_col %in% colnames(metadata)) == FALSE) {
+        # add host_col to metadata, assuming sampleID col in report
+        metadata <- add_perc_host_metadata(metadata, sampleID,
+                                           report, host_col)
+      }
+    }
   }
-  return(list(formula = formula, fixed.vars = fixed.vars))
+  return(list(formula = formula, metadata = metadata))
 }
 
 
@@ -928,7 +930,9 @@ run_mtxDE <- function(formula, feature.table, metadata, sampleID,
                         zibr_time_ind=NULL,
                         ncores=1,
                         show_progress=TRUE,
-                        dna.table=NULL){
+                        dna.table=NULL,
+                        host_col=NULL,
+                        report=NULL){
     if(reg.method %in% c("zibr", "gamlss")){
         check_for_ones(feature.table) # Beta regression can't handle ones
         feature.table <- filter_undetected(feature.table) # or undetected feats
@@ -938,6 +942,12 @@ run_mtxDE <- function(formula, feature.table, metadata, sampleID,
         }
     }
     formula <- paste0(" ~ ", formula)
+    if (!is.null(host_col)) {
+      add_host <- .add_host_to_formula_metadata(metadata, formula,
+                                                sampleID, report, host_col)
+      metadata <- add_host$metadata
+      formula <- add_host$formula
+    }
     data <- .prepare_data_mtxDE(feature.table, metadata,
                                 formula, sampleID, zibr_time_ind,
                                 dna.table = dna.table)

tests/testthat/test-mtxDE.R

@@ -234,32 +234,30 @@ test_that(".add_dna_to_formula correctly adds dna col", {
 
 })
 
-test_that(".add_host_to_formula works", {
-  data <-data.frame(
-    Row.names=paste0("sample_", seq_len(4)),
-    a=c(0.1, 0.0, 0.0, 0.0),
-    b=c(0.5, 0.5, 0.5, 0.4),
-    phenotype=c(0,0,1,1),
-    a_mgx=c(0.1, 0.0, 0.0, 0.0),
-    b_mgx=c(0.5, 0.5, 0.5, 0.4),
-    percent_host=c(0.5, 0.6, 0.8, 0.9)
-  )
+test_that(".add_host_to_formula_metadata works", {
+  metadata <- data.frame(SampleID=paste0("sample_", seq_len(4)),
+                         phenotype=c(0,0,1,1),
+                         participant=c(0,1,0,1),
+                         timepoint=c(0,0,1,1))
+  report <- data.frame(SampleID=paste0("sample_", seq_len(4)),
+                       percent_host=c(0.9, 0.8, 0.5, 0.9))
+  expected_metadata <- data.frame(SampleID=paste0("sample_", seq_len(4)),
+                                  phenotype=c(0,0,1,1),
+                                  participant=c(0,1,0,1),
+                                  timepoint=c(0,0,1,1),
+                                  percent_host=c(0.9, 0.8, 0.5, 0.9))
+
   formula <- " ~ phenotype"
   expected_formula <- " ~ phenotype + percent_host"
-  expected_fixed.vars <- c("phenotype", "percent_host")
 
-  result <- .add_host_to_formula(data = data,
-                                 host_col = "percent_host",
+  result <- .add_host_to_formula_metadata(metadata = metadata,
                                  formula = formula,
-                                 fixed.vars = c("phenotype"),
-                                 reg.method = "zibr")
-  result2 <- .add_host_to_formula(data = data,
-                                  host_col = "percent_host",
-                                  formula = formula,
-                                  fixed.vars = c("phenotype"),
-                                  reg.method = "lm")
-  expect_equal(result$fixed.vars, expected_fixed.vars)
-  expect_equal(result2$formula, expected_formula)
+                                 sampleID = "SampleID",
+                                 report = report,
+                                 host_col = "percent_host")
+
+  expect_equal(result$metadata, expected_metadata)
+  expect_equal(result$formula, expected_formula)
 })
 
 test_that("run_mtxDE works", {