diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 1161c7c0..6ce22a06 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -656,7 +656,11 @@ generate_interaction_plot_configs <- function(df, variables) { AUC = c(-6500, 6500) ) - df_filtered <- filter_data(df, variables, filter_na = TRUE, limits_map = limits_map) + # Filtering out NAs and outlying values + df_filtered <- df %>% + filter(across(names(limits_map), + ~ !is.na(.x) & + between(.x, limits_map[[.names]][1], limits_map[[.names]][2]))) # Define annotation label functions generate_annotation_labels <- function(df, var, annotation_name) { @@ -747,7 +751,7 @@ generate_interaction_plot_configs <- function(df, variables) { return(configs) } -generate_rank_plot_configs <- function(df, variables, is_lm = FALSE, overlap_color = FALSE) { +generate_rank_plot_configs <- function(df, variables, is_lm = FALSE, adjust = FALSE, overlap_color = FALSE) { sd_bands <- c(1, 2, 3) @@ -977,39 +981,6 @@ generate_correlation_plot_configs <- function(df) { return(configs) } -filter_data <- function(df, variables, filter_nf = FALSE, filter_na = FALSE, limits_map = NULL) { - - avg_zscore_cols <- paste0("Avg_Zscore_", variables) - z_lm_cols <- paste0("Z_lm_", variables) - rank_avg_zscore_cols <- paste0("Rank_", variables) - rank_z_lm_cols <- paste0("Rank_lm_", variables) - - if (filter_nf) { - message("Filtering non-finite values") - df <- df %>% - filter(if_all(all_of(variables), ~ is.finite(.))) - } - - if (filter_na) { - message("Filtering NA values") - df <- df %>% - filter(if_all(all_of(variables), ~ !is.na(.))) - } - - if (!is.null(limits_map)) { - message("Filtering data outside y-limits (for plotting)") - for (variable in names(limits_map)) { - if (variable %in% variables) { - ylim_vals <- limits_map[[variable]] - df <- df %>% - filter(.data[[variable]] >= ylim_vals[1] & .data[[variable]] <= ylim_vals[2]) - } - } - } - - return(df) -} - main <- function() { lapply(names(args$experiments), function(exp_name) { exp <- args$experiments[[exp_name]]