Merge pull request #116 from svteichman/main

if `k` or `j` in `test_kj` are strings that correspond to covariate or taxon names, replace them with the correct indices

Author: svteichman

.github/workflows/test-coverage.yaml

@@ -28,7 +28,7 @@ jobs:
         shell: Rscript {0}
 
       - name: Restore R package cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}

R/emuFit.R

@@ -212,6 +212,7 @@ emuFit <- function(Y,
   X <- check_results$X
   cluster <- check_results$cluster
   B_null_list <- check_results$B_null_list
+  test_kj <- check_results$test_kj
 
   if (length(constraint_fn) == 1 & is.numeric(constraint_fn)) {
     constraint_cat <- constraint_fn

R/emuFit_check.R

@@ -186,6 +186,24 @@ ignoring argument 'cluster'.")
     }
   }
 
+  # check that test kj values are numbers, if they are strings that convert if possible to numbers
+  if (!is.null(test_kj)) {
+    if (!(is.numeric(test_kj$k))) {
+      if (sum(!(test_kj$k %in% colnames(X))) == 0) {
+        test_kj$k <- as.vector(sapply(test_kj$k, function(x) {which(colnames(X) == x)}))
+      } else {
+        stop("Make sure that the values of `k` in `test_kj` are numeric or correspond to column names of the `X` matrix.")
+      }
+    }
+    if (!(is.numeric(test_kj$j))) {
+      if (sum(!(test_kj$j %in% colnames(Y))) == 0) {
+        test_kj$j <- as.vector(sapply(test_kj$j, function(x) {which(colnames(Y) == x)}))
+      } else {
+        stop("Make sure that the values of `j` in `test_kj` are numeric or correspond to column names of the `Y` matrix.")
+      }
+    }
+  }
+  
   # check for valid argument remove_zero_comparison_pvals 
   if (remove_zero_comparison_pvals != TRUE & remove_zero_comparison_pvals != FALSE) {
     if (!(is.numeric(remove_zero_comparison_pvals) & remove_zero_comparison_pvals <= 1 &
@@ -194,6 +212,6 @@ ignoring argument 'cluster'.")
     }
   }
 
-  return(list(Y = Y, X = X, cluster = cluster, B_null_list = B_null_list))
+  return(list(Y = Y, X = X, cluster = cluster, B_null_list = B_null_list, test_kj = test_kj))
 
 }

tests/testthat/test-emuFit.R

@@ -658,3 +658,13 @@ test_that("emuFit refits starting at provided value if `B` or `fitted_model` are
   expect_true(length(message1) > length(message3))
 
 })
+
+test_that("giving test_kj as valid strings works", {
+  colnames(Y) <- paste0("taxon", 1:6)
+  colnames(X) <- c("int", "group")
+  res <- emuFit(Y = Y, X = X, compute_cis = FALSE, test_kj = data.frame(k = "group", j = "taxon3"),
+                penalize = FALSE, tolerance = 0.1)
+  expect_true(!is.na(res$coef$pval[3]))
+  expect_error(emuFit(Y = Y, X = X, compute_cis = FALSE, test_kj = data.frame(k = "group", j = "taxa3"),
+                      penalize = FALSE, tolerance = 0.1))
+})