diff --git a/R/simulation.R b/R/simulation.R index 9bf7d01e1f643c9c3676df3b0f904ade90bea64a..d507012664d1c9fdbaddbede8f9579542586ccbb 100644 --- a/R/simulation.R +++ b/R/simulation.R @@ -79,13 +79,15 @@ get_effects_from_rnorm <- function(list_var, metadata){ variable_2rnorm <- names(list_stdev) l_effects <- lapply(stats::setNames(variable_2rnorm, variable_2rnorm) , function(var){ - col_labels <- paste("label", var, sep = "_") - list_combinations <- paste(metadata[["geneID"]], metadata[[col_labels]]) + col_labels <- paste("label", unlist(strsplit(var, ":")), sep = "_") + cols2paste <- c("geneID", col_labels) + list_combinations <- apply( metadata[ , cols2paste ] , 1 , paste , collapse = "-" ) list_effects <- unique(list_combinations) list_beta <- rnorm(length(list_effects), mean = list_mu[var], sd = list_stdev[var]) names(list_beta) <- list_effects unname(list_beta[list_combinations]) }) + df_effects <- do.call("cbind", l_effects) return(df_effects) diff --git a/dev/flat_full.Rmd b/dev/flat_full.Rmd index d070e85983cc738b84845b9e047f1791c29bcc56..70b35a89607213acc89a0f6c300434df357f4656 100644 --- a/dev/flat_full.Rmd +++ b/dev/flat_full.Rmd @@ -79,7 +79,7 @@ first_non_null_index <- function(lst) { #' @return A logical vector indicating rows below the threshold #' @export detect_row_matx_bellow_threshold <- function(matrix, threshold) { - apply(matrix, 1, function(row) all(row < threshold)) + apply(matrix, 1, function(row) all(row < threshold)) } @@ -1596,13 +1596,15 @@ get_effects_from_rnorm <- function(list_var, metadata){ variable_2rnorm <- names(list_stdev) l_effects <- lapply(stats::setNames(variable_2rnorm, variable_2rnorm) , function(var){ - col_labels <- paste("label", var, sep = "_") - list_combinations <- paste(metadata[["geneID"]], metadata[[col_labels]]) + col_labels <- paste("label", unlist(strsplit(var, ":")), sep = "_") + cols2paste <- c("geneID", col_labels) + list_combinations <- apply( metadata[ , cols2paste ] , 1 , paste , collapse = "-" ) list_effects <- unique(list_combinations) list_beta <- rnorm(length(list_effects), mean = list_mu[var], sd = list_stdev[var]) names(list_beta) <- list_effects unname(list_beta[list_combinations]) }) + df_effects <- do.call("cbind", l_effects) return(df_effects) @@ -2268,7 +2270,7 @@ get_messages_sequencing_depth <- function(scaling_factors, threshold_cov_var = 1 warning_too_low_mu_ij_row <- function(mu_ij_matrix, threshold = 1 ){ n_too_low_row <- length(which(detect_row_matx_bellow_threshold(mu_ij_matrix, threshold))) if (n_too_low_row > 0){ - msg <- paste("INFO:", n_too_low_row, "genes have all(mu_ij) < 1, indicating very low counts. Consider removing them for future analysis using prepareData2fit with row_cnt_threshold = 10. To detect them, try increasing sequencing depth.\n", + msg <- paste("INFO:", n_too_low_row, "genes have all(mu_ij) < 1, indicating very low counts. Consider removing them for future analysis using prepareData2fit with row_threshold = 10. To detect them in future experiment, try increasing sequencing depth.\n", sep = " ") message(msg) } @@ -2694,7 +2696,7 @@ prepareData2fit <- function(countMatrix, metadata, response_name = "kij", if (row_threshold > 0){ message(paste("INFO: filtering", response_name, "<", row_threshold, sep = " " )) idx <- detect_row_matx_bellow_threshold(countMatrix, threshold = row_threshold) - message(paste(length(idx), "genes removed from data.", sep = " ")) + message(paste(length(which(idx)), "genes removed from data.", sep = " ")) countMatrix <- countMatrix[ !idx , ] }