diff --git a/NAMESPACE b/NAMESPACE index bd18a909fb9c44fd7cc1be201c38b86a400b7267..14fd9f162351b132d517597b28cb68d7d406a9bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -159,7 +159,7 @@ export(removeDigitsAtEnd) export(removeDuplicatedWord) export(renameColumns) export(reorderColumns) -export(replaceReferenceEffectBy0) +export(replaceUnexpectedInteractionValuesBy0) export(replicateByGroup) export(replicateMatrix) export(replicateRows) diff --git a/R/mock_rnaseq.R b/R/mock_rnaseq.R index e880f9bda25ff37d279dbd17bd92e499baa4b1e2..f727fa57317b6c20d790d9f0430e0570cce50c4d 100644 --- a/R/mock_rnaseq.R +++ b/R/mock_rnaseq.R @@ -105,9 +105,6 @@ warning_too_low_mu_ij_row <- function(mu_ij_matrix, threshold = 1 ){ #' @param normal_distr Specifies the distribution type for generating effects. Choose between 'univariate' or 'multivariate' (default). #' - 'univariate': Effects are drawn independently from univariate normal distributions. #' - 'multivariate': Effects are drawn jointly from a multivariate normal distribution. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @return List containing the ground truth, counts, and metadata #' @export #' @examples @@ -116,10 +113,10 @@ warning_too_low_mu_ij_row <- function(mu_ij_matrix, threshold = 1 ){ #' max_replicates = 4) mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, sequencing_depth = NULL, basal_expression = 0 , dispersion = stats::runif(n_genes, min = 0, max = 1000), - normal_distr = "multivariate", fix_reference_effect = FALSE) { + normal_distr = "multivariate") { ## -- get my effect - df_inputSimulation <- getInput2simulation(list_var, n_genes, normal_distr, fix_reference_effect ) + df_inputSimulation <- getInput2simulation(list_var, n_genes, normal_distr ) ## -- add column logQij df_inputSimulation <- getLog_qij(df_inputSimulation) df_inputSimulation <- addBasalExpression(df_inputSimulation, n_genes, basal_expression) @@ -150,6 +147,8 @@ mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, seque mu_ij_matx_rep <- as.matrix(mu_ij_dtf_rep) ## -- rescaling effect df_inputSimulation$log_qij_scaled <- df_inputSimulation$log_qij_scaled + log(mean(scaling_factors, na.rm = T)) + } else{ + scaling_factors <- NULL } invisible(warning_too_low_mu_ij_row(mu_ij_matx_rep)) @@ -163,11 +162,11 @@ mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, seque metaData <- getSampleMetadata(list_var, n_genes, matx_bool_replication) libSize <- sum(colSums(dtf_countsTable)) settings_df <- getSettingsTable(n_genes, min_replicates, max_replicates, libSize) - list2ret <- list( settings = settings_df, init = list_var, groundTruth = list(effects = df_inputSimulation, gene_dispersion = genes_dispersion), counts = dtf_countsTable, - metadata = metaData) + metadata = metaData, + scaling_factors = scaling_factors) ## -- clean garbage collector to save memory invisible(gc(reset = TRUE, verbose = FALSE)); diff --git a/R/simulation.R b/R/simulation.R index 0fb1d3e5fd7e56b92f338a564695004a4d28143f..ae12e0405f9f9723d0905eff2cb35d576998d533 100644 --- a/R/simulation.R +++ b/R/simulation.R @@ -10,9 +10,6 @@ #' @param normal_distr Specifies the distribution type for generating effects. Choose between 'univariate' or 'multivariate' (default). #' - 'univariate': Effects are drawn independently from univariate normal distributions. #' - 'multivariate': Effects are drawn jointly from a multivariate normal distribution. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @param input2mvrnorm Input to the \code{mvrnorm} function for simulating data from multivariate normal distribution (default: NULL) #' @return A data frame with input coefficients for simulation #' @export @@ -20,7 +17,7 @@ #' # Example usage #' list_var <- init_variable() #' getInput2simulation(list_var, n_genes = 10) -getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivariate", fix_reference_effect = FALSE, input2mvrnorm = NULL) { +getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivariate", input2mvrnorm = NULL) { stopifnot( normal_distr %in% c("multivariate", "univariate") ) @@ -29,7 +26,7 @@ getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivari l_dataFrom_normdistr <- getDataFromMvrnorm(list_var, input2mvrnorm, n_genes) } if (normal_distr == "univariate"){ - l_dataFrom_normdistr <- getDataFromRnorm(list_var, n_genes, fix_reference_effect) + l_dataFrom_normdistr <- getDataFromRnorm(list_var, n_genes) } l_dataFromUser = getDataFromUser(list_var) @@ -61,34 +58,30 @@ getRefLevel <- function(data){ return(l_labels_ref) } -#' Replace the reference effect by 0 in the data +#' Replace the effect by 0 in the data #' -#' This function replaces the effect corresponding to the reference level with 0 in the data. +#' This function replaces the effect in interactions columns by 0, when needed. #' #' @param list_var The list of variables containing the effects to modify. #' @param l_labels_ref A list containing the reference level for each categorical variable. #' @param data The data frame containing the effects to modify. -#' @return The modified data frame with reference effects replaced by 0. +#' @return The modified data frame #' @export -replaceReferenceEffectBy0 <- function(list_var, l_labels_ref , data){ - varInitialized <- c(getListVar(list_var), getListVar(list_var$interactions)) - varInitialized <- varInitialized[varInitialized != 'interactions'] - df_effects_with0 <- sapply(varInitialized, function(var){ +replaceUnexpectedInteractionValuesBy0 <- function(list_var, l_labels_ref , data){ + varInteraction <- getListVar(list_var$interactions) + df_interaction_with0 <- sapply(varInteraction, function(var){ + var <- varInteraction categorical_var <- paste("label", unlist(strsplit(var, ":")), sep = "_") - if (length(categorical_var) == 1) - idx_0 <- data[[categorical_var]] == l_labels_ref[[categorical_var]] - else { - bool_matrix <- sapply(categorical_var, function(uniq_cat_var) data[uniq_cat_var] == l_labels_ref[uniq_cat_var]) - idx_0 <- rowSums(bool_matrix) == length(categorical_var) - } - return(replace(data[[var]], idx_0, 0)) - } - ) + bool_matrix <- sapply(categorical_var, function(uniq_cat_var) data[uniq_cat_var] == l_labels_ref[uniq_cat_var]) + idx_0 <- rowSums(bool_matrix) > 0 ## line without interactions effects + return(replace(data[[var]], idx_0, 0)) + }) col_names <- colnames(data) categorical_vars <- col_names[grepl(col_names, pattern = "label_")] - data <- cbind(data[c("geneID", categorical_vars)], df_effects_with0) + data[, varInteraction] <- df_interaction_with0 return(data) -} +} + @@ -98,12 +91,9 @@ replaceReferenceEffectBy0 <- function(list_var, l_labels_ref , data){ #' #' @param list_var A list of variables (already initialized) #' @param n_genes Number of genes to generate data for. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @return A dataframe containing gene metadata and effects generated from a normal distribution. #' @export -getDataFromRnorm <- function(list_var, n_genes, fix_reference_effect = FALSE){ +getDataFromRnorm <- function(list_var, n_genes){ ## -- check if all data have been provided by user if (is.null(getInput2mvrnorm(list_var)$covMatrix)) return(list()) @@ -111,9 +101,9 @@ getDataFromRnorm <- function(list_var, n_genes, fix_reference_effect = FALSE){ df_effects <- get_effects_from_rnorm(list_var, metadata) data <- cbind(metadata, df_effects) - if (isTRUE(fix_reference_effect)){ + if(!is.null(getListVar(list_var$interactions))){ l_labels_ref <- getRefLevel(data) - data <- replaceReferenceEffectBy0(input_var_list, l_labels_ref, data) + data <- replaceUnexpectedInteractionValuesBy0(list_var, l_labels_ref, data) } return(list(data)) diff --git a/R/utils.R b/R/utils.R index ae4ac4ea8d2e51d6b708d17f97124dfd6df907fe..3bd7ea68cf01aac6f5d5a05b0dfb076652b1dbdd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -358,7 +358,7 @@ isValidMock_obj <- function(obj) { stop(message_err) } - expected_names <- c("settings", "init", "groundTruth", "counts", "metadata") + expected_names <- c("settings", "init", "groundTruth", "counts", "metadata", "scaling_factors") if (!all(expected_names %in% names(obj))) { stop(message_err) diff --git a/dev/flat_full.Rmd b/dev/flat_full.Rmd index f9e1c8eaca791e659406eb154546a94b43ba7b74..742804ca54d617435c8fbc4754f3c0f536ce9a0c 100644 --- a/dev/flat_full.Rmd +++ b/dev/flat_full.Rmd @@ -383,7 +383,7 @@ isValidMock_obj <- function(obj) { stop(message_err) } - expected_names <- c("settings", "init", "groundTruth", "counts", "metadata") + expected_names <- c("settings", "init", "groundTruth", "counts", "metadata", "scaling_factors") if (!all(expected_names %in% names(obj))) { stop(message_err) @@ -1527,9 +1527,6 @@ test_that("set_correlation sets the correlation between variables correctly", { #' @param normal_distr Specifies the distribution type for generating effects. Choose between 'univariate' or 'multivariate' (default). #' - 'univariate': Effects are drawn independently from univariate normal distributions. #' - 'multivariate': Effects are drawn jointly from a multivariate normal distribution. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @param input2mvrnorm Input to the \code{mvrnorm} function for simulating data from multivariate normal distribution (default: NULL) #' @return A data frame with input coefficients for simulation #' @export @@ -1537,7 +1534,7 @@ test_that("set_correlation sets the correlation between variables correctly", { #' # Example usage #' list_var <- init_variable() #' getInput2simulation(list_var, n_genes = 10) -getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivariate", fix_reference_effect = FALSE, input2mvrnorm = NULL) { +getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivariate", input2mvrnorm = NULL) { stopifnot( normal_distr %in% c("multivariate", "univariate") ) @@ -1546,7 +1543,7 @@ getInput2simulation <- function(list_var, n_genes = 1, normal_distr = "multivari l_dataFrom_normdistr <- getDataFromMvrnorm(list_var, input2mvrnorm, n_genes) } if (normal_distr == "univariate"){ - l_dataFrom_normdistr <- getDataFromRnorm(list_var, n_genes, fix_reference_effect) + l_dataFrom_normdistr <- getDataFromRnorm(list_var, n_genes) } l_dataFromUser = getDataFromUser(list_var) @@ -1578,34 +1575,30 @@ getRefLevel <- function(data){ return(l_labels_ref) } -#' Replace the reference effect by 0 in the data +#' Replace the effect by 0 in the data #' -#' This function replaces the effect corresponding to the reference level with 0 in the data. +#' This function replaces the effect in interactions columns by 0, when needed. #' #' @param list_var The list of variables containing the effects to modify. #' @param l_labels_ref A list containing the reference level for each categorical variable. #' @param data The data frame containing the effects to modify. -#' @return The modified data frame with reference effects replaced by 0. +#' @return The modified data frame #' @export -replaceReferenceEffectBy0 <- function(list_var, l_labels_ref , data){ - varInitialized <- c(getListVar(list_var), getListVar(list_var$interactions)) - varInitialized <- varInitialized[varInitialized != 'interactions'] - df_effects_with0 <- sapply(varInitialized, function(var){ +replaceUnexpectedInteractionValuesBy0 <- function(list_var, l_labels_ref , data){ + varInteraction <- getListVar(list_var$interactions) + df_interaction_with0 <- sapply(varInteraction, function(var){ + var <- varInteraction categorical_var <- paste("label", unlist(strsplit(var, ":")), sep = "_") - if (length(categorical_var) == 1) - idx_0 <- data[[categorical_var]] == l_labels_ref[[categorical_var]] - else { - bool_matrix <- sapply(categorical_var, function(uniq_cat_var) data[uniq_cat_var] == l_labels_ref[uniq_cat_var]) - idx_0 <- rowSums(bool_matrix) == length(categorical_var) - } - return(replace(data[[var]], idx_0, 0)) - } - ) + bool_matrix <- sapply(categorical_var, function(uniq_cat_var) data[uniq_cat_var] == l_labels_ref[uniq_cat_var]) + idx_0 <- rowSums(bool_matrix) > 0 ## line without interactions effects + return(replace(data[[var]], idx_0, 0)) + }) col_names <- colnames(data) categorical_vars <- col_names[grepl(col_names, pattern = "label_")] - data <- cbind(data[c("geneID", categorical_vars)], df_effects_with0) + data[, varInteraction] <- df_interaction_with0 return(data) -} +} + @@ -1615,12 +1608,9 @@ replaceReferenceEffectBy0 <- function(list_var, l_labels_ref , data){ #' #' @param list_var A list of variables (already initialized) #' @param n_genes Number of genes to generate data for. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @return A dataframe containing gene metadata and effects generated from a normal distribution. #' @export -getDataFromRnorm <- function(list_var, n_genes, fix_reference_effect = FALSE){ +getDataFromRnorm <- function(list_var, n_genes){ ## -- check if all data have been provided by user if (is.null(getInput2mvrnorm(list_var)$covMatrix)) return(list()) @@ -1628,9 +1618,9 @@ getDataFromRnorm <- function(list_var, n_genes, fix_reference_effect = FALSE){ df_effects <- get_effects_from_rnorm(list_var, metadata) data <- cbind(metadata, df_effects) - if (isTRUE(fix_reference_effect)){ + if(!is.null(getListVar(list_var$interactions))){ l_labels_ref <- getRefLevel(data) - data <- replaceReferenceEffectBy0(input_var_list, l_labels_ref, data) + data <- replaceUnexpectedInteractionValuesBy0(list_var, l_labels_ref, data) } return(list(data)) @@ -2270,7 +2260,7 @@ test_that("getRefLevel returns correct reference levels", { }) # Test for replaceReferenceEffectBy0 function -test_that("replaceReferenceEffectBy0 replaces reference effects correctly", { +test_that("replaceUnexpectedInteractionValuesBy0 replaces effects correctly", { input_var_list <- init_variable( name = "genotype", mu = 0, sd = 2.18, level = 2) %>% init_variable( name = "env", mu = 0, sd = 0.57, level = 4 ) %>% @@ -2413,9 +2403,6 @@ warning_too_low_mu_ij_row <- function(mu_ij_matrix, threshold = 1 ){ #' @param normal_distr Specifies the distribution type for generating effects. Choose between 'univariate' or 'multivariate' (default). #' - 'univariate': Effects are drawn independently from univariate normal distributions. #' - 'multivariate': Effects are drawn jointly from a multivariate normal distribution. -#' @param fix_reference_effect A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -#' reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -#' randomly from the distribution specified by the user. This option works only when `normal_distr` is set to 'univariate'. Default is FALSE. #' @return List containing the ground truth, counts, and metadata #' @export #' @examples @@ -2424,10 +2411,10 @@ warning_too_low_mu_ij_row <- function(mu_ij_matrix, threshold = 1 ){ #' max_replicates = 4) mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, sequencing_depth = NULL, basal_expression = 0 , dispersion = stats::runif(n_genes, min = 0, max = 1000), - normal_distr = "multivariate", fix_reference_effect = FALSE) { + normal_distr = "multivariate") { ## -- get my effect - df_inputSimulation <- getInput2simulation(list_var, n_genes, normal_distr, fix_reference_effect ) + df_inputSimulation <- getInput2simulation(list_var, n_genes, normal_distr ) ## -- add column logQij df_inputSimulation <- getLog_qij(df_inputSimulation) df_inputSimulation <- addBasalExpression(df_inputSimulation, n_genes, basal_expression) @@ -2458,6 +2445,8 @@ mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, seque mu_ij_matx_rep <- as.matrix(mu_ij_dtf_rep) ## -- rescaling effect df_inputSimulation$log_qij_scaled <- df_inputSimulation$log_qij_scaled + log(mean(scaling_factors, na.rm = T)) + } else{ + scaling_factors <- NULL } invisible(warning_too_low_mu_ij_row(mu_ij_matx_rep)) @@ -2471,11 +2460,11 @@ mock_rnaseq <- function(list_var, n_genes, min_replicates, max_replicates, seque metaData <- getSampleMetadata(list_var, n_genes, matx_bool_replication) libSize <- sum(colSums(dtf_countsTable)) settings_df <- getSettingsTable(n_genes, min_replicates, max_replicates, libSize) - list2ret <- list( settings = settings_df, init = list_var, groundTruth = list(effects = df_inputSimulation, gene_dispersion = genes_dispersion), counts = dtf_countsTable, - metadata = metaData) + metadata = metaData, + scaling_factors = scaling_factors) ## -- clean garbage collector to save memory invisible(gc(reset = TRUE, verbose = FALSE)); diff --git a/man/getDataFromRnorm.Rd b/man/getDataFromRnorm.Rd index afcdf4af0c967f434b956d8cf49d81cd7d7d7295..a9354eb34558fa52b66a835ba46c70aecd7257b5 100644 --- a/man/getDataFromRnorm.Rd +++ b/man/getDataFromRnorm.Rd @@ -4,16 +4,12 @@ \alias{getDataFromRnorm} \title{Prepare data using effects from a normal distribution} \usage{ -getDataFromRnorm(list_var, n_genes, fix_reference_effect = FALSE) +getDataFromRnorm(list_var, n_genes) } \arguments{ \item{list_var}{A list of variables (already initialized)} \item{n_genes}{Number of genes to generate data for.} - -\item{fix_reference_effect}{A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -randomly from the distribution specified by the user. This option works only when \code{normal_distr} is set to 'univariate'. Default is FALSE.} } \value{ A dataframe containing gene metadata and effects generated from a normal distribution. diff --git a/man/getInput2simulation.Rd b/man/getInput2simulation.Rd index a4cca47f2f67f9936677c922c2b0e622f188d306..f50ce204662c9713702ee8d742e7f47673f691c9 100644 --- a/man/getInput2simulation.Rd +++ b/man/getInput2simulation.Rd @@ -8,7 +8,6 @@ getInput2simulation( list_var, n_genes = 1, normal_distr = "multivariate", - fix_reference_effect = FALSE, input2mvrnorm = NULL ) } @@ -23,10 +22,6 @@ getInput2simulation( \item 'multivariate': Effects are drawn jointly from a multivariate normal distribution. }} -\item{fix_reference_effect}{A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -randomly from the distribution specified by the user. This option works only when \code{normal_distr} is set to 'univariate'. Default is FALSE.} - \item{input2mvrnorm}{Input to the \code{mvrnorm} function for simulating data from multivariate normal distribution (default: NULL)} } \value{ diff --git a/man/mock_rnaseq.Rd b/man/mock_rnaseq.Rd index 0d86249be2f99beb4ff1f66e248b11cc9659f800..c68b463527ad693a563fadcf00fd6deb5b6a765d 100644 --- a/man/mock_rnaseq.Rd +++ b/man/mock_rnaseq.Rd @@ -12,8 +12,7 @@ mock_rnaseq( sequencing_depth = NULL, basal_expression = 0, dispersion = stats::runif(n_genes, min = 0, max = 1000), - normal_distr = "multivariate", - fix_reference_effect = FALSE + normal_distr = "multivariate" ) } \arguments{ @@ -36,10 +35,6 @@ mock_rnaseq( \item 'univariate': Effects are drawn independently from univariate normal distributions. \item 'multivariate': Effects are drawn jointly from a multivariate normal distribution. }} - -\item{fix_reference_effect}{A logical value indicating whether the effect of the reference label should be fixed to zero. If set to TRUE, the effect of the -reference label is constrained to zero, ensuring that it does not contribute to the model. If set to FALSE, the effect from the reference label is picked -randomly from the distribution specified by the user. This option works only when \code{normal_distr} is set to 'univariate'. Default is FALSE.} } \value{ List containing the ground truth, counts, and metadata diff --git a/man/replaceReferenceEffectBy0.Rd b/man/replaceUnexpectedInteractionValuesBy0.Rd similarity index 52% rename from man/replaceReferenceEffectBy0.Rd rename to man/replaceUnexpectedInteractionValuesBy0.Rd index 2a8380efcb7945ff1a2fe61783401800776d07b6..a0dc7ff93b321f5bf11733c5f6693acedd702596 100644 --- a/man/replaceReferenceEffectBy0.Rd +++ b/man/replaceUnexpectedInteractionValuesBy0.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/simulation.R -\name{replaceReferenceEffectBy0} -\alias{replaceReferenceEffectBy0} -\title{Replace the reference effect by 0 in the data} +\name{replaceUnexpectedInteractionValuesBy0} +\alias{replaceUnexpectedInteractionValuesBy0} +\title{Replace the effect by 0 in the data} \usage{ -replaceReferenceEffectBy0(list_var, l_labels_ref, data) +replaceUnexpectedInteractionValuesBy0(list_var, l_labels_ref, data) } \arguments{ \item{list_var}{The list of variables containing the effects to modify.} @@ -14,8 +14,8 @@ replaceReferenceEffectBy0(list_var, l_labels_ref, data) \item{data}{The data frame containing the effects to modify.} } \value{ -The modified data frame with reference effects replaced by 0. +The modified data frame } \description{ -This function replaces the effect corresponding to the reference level with 0 in the data. +This function replaces the effect in interactions columns by 0, when needed. } diff --git a/tests/testthat/test-simulation.R b/tests/testthat/test-simulation.R index 28e804d27bce135c9cb18290deb4a48b2a1dbd3a..edc46c05589d963098540bb2e7108e07b86b0085 100644 --- a/tests/testthat/test-simulation.R +++ b/tests/testthat/test-simulation.R @@ -271,7 +271,7 @@ test_that("getRefLevel returns correct reference levels", { }) # Test for replaceReferenceEffectBy0 function -test_that("replaceReferenceEffectBy0 replaces reference effects correctly", { +test_that("replaceUnexpectedInteractionValuesBy0 replaces effects correctly", { input_var_list <- init_variable( name = "genotype", mu = 0, sd = 2.18, level = 2) %>% init_variable( name = "env", mu = 0, sd = 0.57, level = 4 ) %>%