diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index eafd973b..6901b126 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -384,84 +384,91 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_layout = NULL) { message("Generating html and pdf plots for: ", file_name) - plots <- lapply(plot_configs, function(config) { + # Prepare lists to collect plots + static_plots <- list() + plotly_plots <- list() + + for (i in seq_along(plot_configs)) { + config <- plot_configs[[i]] df <- config$df - # Build the aesthetic mapping - aes_mapping <- - if (is.null(config$color_var)) { - if (is.null(config$y_var)) { - aes(x = !!sym(config$x_var)) - } else { - aes(x = !!sym(config$x_var), y = !!sym(config$y_var)) - } + # Build the aes_mapping based on config + aes_mapping <- if (is.null(config$color_var)) { + if (is.null(config$y_var)) { + aes(x = .data[[config$x_var]]) } else { - if (is.null(config$y_var)) { - aes(x = !!sym(config$x_var), color = as.factor(!!sym(config$color_var))) - } else { - aes( - x = !!sym(config$x_var), - y = !!sym(config$y_var), - color = as.factor(!!sym(config$color_var)) - ) - } + aes(x = .data[[config$x_var]], y = .data[[config$y_var]]) + } + } else { + if (is.null(config$y_var)) { + aes(x = .data[[config$x_var]], color = as.factor(.data[[config$color_var]])) + } else { + aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = as.factor(.data[[config$color_var]])) + } + } + + # Start building the plot with aes_mapping + plot_base <- ggplot(df, aes_mapping) + + # Function to generate the plot + generate_plot <- function(interactive) { + # Use appropriate helper function based on plot type + plot <- switch(config$plot_type, + "scatter" = generate_scatter_plot(plot_base, config, interactive = interactive), + "box" = generate_box_plot(plot_base, config), + "density" = plot_base + geom_density(), + "bar" = plot_base + geom_bar(), + plot_base # default case if no type matches + ) + + # Apply additional settings if provided + if (!is.null(config$legend_position)) { + plot <- plot + theme(legend.position = config$legend_position) } - # Start building the plot - plot <- ggplot(df, aes_mapping) + # Add title and labels if provided + if (!is.null(config$title)) { + plot <- plot + ggtitle(config$title) + } + if (!is.null(config$x_label)) { + plot <- plot + xlab(config$x_label) + } + if (!is.null(config$y_label)) { + plot <- plot + ylab(config$y_label) + } - # Generate non-interactive plot - static_plot <- switch( - config$plot_type, - "scatter" = generate_scatter_plot(plot, config, interactive = FALSE), - "box" = generate_box_plot(plot, config), - "density" = plot + geom_density(), - "bar" = plot + geom_bar(), - plot # default case if no type matches - ) + # Return the plot + plot + } - # Generate interactive plot - interactive_plot <- switch( - config$plot_type, - "scatter" = generate_scatter_plot(plot, config, interactive = TRUE), - "box" = generate_box_plot(plot, config), - "density" = plot + geom_density(), - "bar" = plot + geom_bar(), - plot # default case if no type matches - ) + # Generate the static plot + static_plot <- generate_plot(interactive = FALSE) - return(list(static_plot = static_plot, interactive_plot = interactive_plot, config = config)) - }) + # Generate the interactive plot + interactive_plot <- generate_plot(interactive = TRUE) - # PDF saving logic with static plots + # Convert to plotly object + plotly_plot <- ggplotly(interactive_plot, tooltip = "text") + if (!is.null(config$legend_position) && config$legend_position == "bottom") { + plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h")) + } + + # Add plots to lists + static_plots[[i]] <- static_plot + plotly_plots[[i]] <- plotly_plot + } + + # PDF saving logic pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9) - lapply(plots, function(item) print(item$static_plot)) + lapply(static_plots, print) dev.off() - # HTML saving logic with interactive plots - plotly_plots <- lapply(plots, function(item) { - plot <- item$interactive_plot - config <- item$config - if (!is.null(config$legend_position) && config$legend_position == "bottom") { - suppressWarnings( - ggplotly(plot, tooltip = "text") %>% layout(legend = list(orientation = "h")) - ) - } else { - ggplotly(plot, tooltip = "text") - } - }) - combined_plot <- subplot( - plotly_plots, - nrows = grid_layout$nrow %||% length(plots), - margin = 0.05 - ) - saveWidget( - combined_plot, - file = file.path(output_dir, paste0(file_name, ".html")), - selfcontained = TRUE - ) + # Combine and save interactive plots + combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plotly_plots), margin = 0.05) + saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE) } + generate_scatter_plot <- function(plot, config, interactive = FALSE) { # Check for missing or out-of-range data missing_data <- config$df %>% @@ -579,6 +586,15 @@ generate_scatter_plot <- function(plot, config, interactive = FALSE) { } } + # Add titles and themes if specified + if (!is.null(config$title)) { + plot <- plot + ggtitle(config$title) + } + + if (!is.null(config$legend_position)) { + plot <- plot + theme(legend.position = config$legend_position) + } + return(plot) }