diff --git a/NAMESPACE b/NAMESPACE index 6ae9268..5f73a81 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,2 +1,3 @@ # Generated by roxygen2: do not edit by hand +export(prepare) diff --git a/R/generate_xy.R b/R/generate_xy.R new file mode 100644 index 0000000..640f960 --- /dev/null +++ b/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) +} diff --git a/tests/testthat/test-generate_xy.R b/tests/testthat/test-generate_xy.R new file mode 100644 index 0000000..d492419 --- /dev/null +++ b/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) +})