response-matrix row names in ModelSpec, glmnet part of tests

R/generate_xy.R

@@ -106,6 +106,7 @@ generate_response <- function(
     } else if(response_type == "survival_censored"){
         y <- pheno_tbl[, c(pfs_col, progression_col)] |> as.matrix()
         rownames(y) <- pheno_tbl[[patient_id_col]]
+        colnames(y) <- model_spec$response_colnames
     }
 
     return(y)

R/model_spec.R

@@ -4,6 +4,7 @@ new_ModelSpec <- function(
     fitter,
     optional_fitter_args,
     response_type,
+    response_colnames,
     include_from_continuous_pheno,
     include_from_discrete_pheno,
     append_to_includes,
@@ -18,6 +19,7 @@ new_ModelSpec <- function(
     check_fitter(fitter, optional_fitter_args)
     stopifnot(is.character(name))
     stopifnot(is.character(response_type))
+    stopifnot(is.character(response_colnames))
     stopifnot(is.character(include_from_continuous_pheno) || is.null(include_from_continuous_pheno))
     stopifnot(is.character(include_from_discrete_pheno) || is.null(include_from_discrete_pheno))
     stopifnot(is.character(append_to_includes))
@@ -33,6 +35,7 @@ new_ModelSpec <- function(
         "fitter" = fitter,
         "optional_fitter_args" = optional_fitter_args,
         "response_type" = response_type,
+        "response_colnames" = response_colnames,
         "include_from_continuous_pheno" = include_from_continuous_pheno,
         "include_from_discrete_pheno" = include_from_discrete_pheno,
         "append_to_includes" = append_to_includes,
@@ -60,6 +63,13 @@ new_ModelSpec <- function(
 #' passed to `fitter`.
 #' @param response_type string. The type of response to be used. One of `"binary"` or
 #' `"survival_censored"`. Default is `NULL`.
+#' @param response_colnames string vector of length 2. If `response_type == "survival_censored"`,
+#' use as column names for the response matrix. 
+#' * The first element is the name of the column holding the time until the event or 
+#' censoring, and 
+#' * the second one is the anme of the column holding the event status (1 = event, 0 =
+#' censoring). 
+#' Default is `c("time", "status")`.
 #' @param include_from_continuous_pheno vector of strings. The names of the 
 #' *continuous* variables in the pheno data (to be) included in the predictor matrix. The
 #' values will be coerced to numeric. Default is `NULL`, which means no continuous pheno
@@ -90,6 +100,7 @@ ModelSpec <- function(
     fitter,
     optional_fitter_args = NULL,
     response_type = c("binary", "survival_censored"),
+    response_colnames = c("time", "status"),
     include_from_continuous_pheno = NULL,
     include_from_discrete_pheno = NULL,
     append_to_includes = "++",
@@ -109,6 +120,7 @@ ModelSpec <- function(
         fitter = fitter,
         optional_fitter_args = optional_fitter_args,
         response_type = response_type,
+        response_colnames = response_colnames,
         include_from_continuous_pheno = include_from_continuous_pheno,
         include_from_discrete_pheno = include_from_discrete_pheno,
         append_to_includes = append_to_includes,

tests/testthat/helper.R

@@ -64,7 +64,7 @@ generate_mock_data <- function(
         size = n_samples,
         replace = TRUE
     )
-    pheno_tbl[["pfs_years"]] <- rnorm(n_samples, 2, 1)
+    pheno_tbl[["pfs_years"]] <- runif(n_samples, 0, 4)
     pheno_tbl[["discrete_var"]] <- sample(1:3, size = n_samples, replace = TRUE)
     pheno_tbl[["continuous_var"]] <- rnorm(n_samples, 10, 10)
     pheno_tbl[["ipi"]] <- sample(1:5, size = n_samples, replace = TRUE)

tests/testthat/test-generate_xy.R

@@ -134,6 +134,6 @@ test_that("generate_response() works", {
     model_spec = model_spec
   )
   expect_equal(rownames(y), as.character(pheno_tbl[["patient"]]))
-  expect_equal(colnames(y), c("pfs", "prog"))
+  expect_equal(colnames(y), model_spec$response_colnames)
   expect_type(y, "double")
 })

tests/testthat/test-prepare_and_fit.R

@@ -5,7 +5,7 @@ test_that("prepare_and_fit() works", {
   n_samples <- 30
   n_genes <- 5
   n_na_in_pheno <- 5
-  n_fold <- 2
+  n_fold <- 3
   lambda <- 1
 
   data <- generate_mock_data(
@@ -21,8 +21,8 @@ test_that("prepare_and_fit() works", {
   # Case 1: Fit all models specified
   model_spec_1 <- ModelSpec(
     name = "cox-zerosum",
-    fitter = zeroSum::zeroSum,
-    optional_fitter_args = list(family = "cox", alpha = 1, nFold = n_fold, lambda = lambda),
+    fitter = glmnet::cv.glmnet,
+    optional_fitter_args = list(family = "cox", alpha = 1, nfolds = n_fold, lambda = c(lambda, 2)),
     response_type = "survival_censored",
     include_from_continuous_pheno = NULL,
     include_from_discrete_pheno = NULL,
@@ -31,7 +31,8 @@ test_that("prepare_and_fit() works", {
   model_spec_2 <- ModelSpec(
     name = "binomial-zerosum",
     fitter = zeroSum::zeroSum,
-    optional_fitter_args = list(family = "binomial", alpha = 1, nFold = n_fold, lambda = lambda),
+    optional_fitter_args = list(family = "binomial", alpha = 1, 
+      nFold = n_fold, lambda = lambda, zeroSum = FALSE),
     response_type = "binary",
     include_from_continuous_pheno = "continuous_var",
     include_from_discrete_pheno = "discrete_var",