generate_xy successfully tested

NAMESPACE

@@ -1,2 +1,3 @@
 # Generated by roxygen2: do not edit by hand
 
+export(prepare)

R/generate_xy.R

@@ -0,0 +1,39 @@
+mapper <- list(
+    "cox_lasso_zerosum" = c("pfs_yrs", "progression"),
+    "lasso_zerosum" = "pfs_leq"
+)
+
+generate_predictor <- function(
+    expr_df,
+    pheno_df,
+    include_from_continuous_pheno,
+    include_from_discrete_pheno
+){
+    x <- t(as.matrix(expr_df))
+    bind_continuous <- pheno_df[, include_from_continuous_pheno, drop = FALSE] |> 
+        as.matrix()
+    bind_discrete <- pheno_df[, include_from_discrete_pheno, drop = FALSE] |>
+        tibble_to_binary()
+    x <- x |> cbind(bind_continuous, bind_discrete)
+    return(x)
+}
+
+# generate the response matrix or vector in a model-specific way
+generate_response <- function(
+    pheno_tbl,
+    model,
+    pfs_leq = 2.0
+){
+    use <- mapper[[model]]
+    y <- NULL
+    if(length(use) == 1 && use == "pfs_leq"){
+        # remove patients consored before pfs_leq
+        rm_bool <- (pheno_tbl[["pfs_yrs"]] <= pfs_leq) & (pheno_tbl[["progression"]] == 0)
+        y <- pheno_tbl[["pfs_yrs"]] <= pfs_leq
+        names(y) <- rownames(pheno_tbl)
+        y <- y[!rm_bool]
+    } else {
+        y <- pheno_tbl[, use]
+    }
+    return(y)
+}

tests/testthat/test-generate_xy.R

@@ -0,0 +1,48 @@
+test_that("generate_predictor works", {
+
+  expr_df <- matrix(1:12, nrow = 4)
+  pheno_df <- data.frame(
+    continuous_var = c(1, 2, 3),
+    discrete_var = c("A", "B", "A")
+  )
+  include_from_continuous_pheno <- "continuous_var"
+  include_from_discrete_pheno <- "discrete_var"
+
+  result <- generate_predictor(
+    expr_df,
+    pheno_df,
+    include_from_continuous_pheno,
+    include_from_discrete_pheno
+  )
+
+  expect_identical(dim(result), c(3L, 6L))
+  expect_identical(
+    colnames(result)[5:6], 
+    c("continuous_var", "discrete_var_B")
+  )
+})
+
+# Define test cases
+test_that("generate_response works", {
+  # Create a sample pheno_tbl
+  pheno_tbl <- data.frame(
+    pfs_yrs = c(1.5, 2.5, 3.0, 4.0),
+    progression = c(0, 1, 0, 0),
+    use_column = c("A", "B", "C", "D")
+  )
+  rownames(pheno_tbl) <- 1:4
+
+  # Test case 1: model == "lasso_zerosum"
+  model <- "lasso_zerosum"
+  pfs_leq <- 2.0
+  expected <- rep(FALSE, 3)
+  names(expected) <- c("2", "3", "4")
+  output <- generate_response(pheno_tbl, model, pfs_leq)
+  expect_equal(output, expected)
+
+  # Test case 2: model == "cox_lasso_zerosum"
+  model <- "cox_lasso_zerosum"
+  expected <- pheno_tbl[, c("pfs_yrs", "progression")]
+  output <- generate_response(pheno_tbl, model)
+  expect_equal(output, expected)
+})