bryan/hartman-server
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make grid lines configurable

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-07 15:19:10 -04:00
parent 15f99ad41b
commit a23565fad4
2 changed files with 75 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
qhtcp-workflow/apps/r/calculate_interaction_zscores.R
View File

@@ -685,6 +685,22 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
if (!is.null(config$y_label)) plot <- plot + ylab(config$y_label)
if (!is.null(config$coord_cartesian)) plot <- plot + coord_cartesian(ylim = config$coord_cartesian)
if (!is.null(config$axis_text_size)) {
plot <- plot + theme(
axis.text.x = element_text(size = config$axis_text_size$x),
axis.text.y = element_text(size = config$axis_text_size$y),
axis.title.x = element_text(size = config$axis_title_size$x),
axis.title.y = element_text(size = config$axis_title_size$y)
)
}
if (!is.null(config$grid_lines)) {
plot <- plot + theme(
panel.grid.major = if (config$grid_lines$major) element_line() else element_blank(),
panel.grid.minor = if (config$grid_lines$minor) element_line() else element_blank()
)
}
#plotly_plot <- suppressWarnings(plotly::ggplotly(plot))
static_plots[[i]] <- plot
@@ -736,8 +752,6 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
generate_scatter_plot <- function(plot, config) {
# Define the points
shape <- if (!is.null(config$shape)) config$shape else 3
size <- if (!is.null(config$size)) config$size else 1.5
position <-
if (!is.null(config$position) && config$position == "jitter") {
position_jitter(width = 0.4, height = 0.1)
@@ -746,8 +760,9 @@ generate_scatter_plot <- function(plot, config) {
}
plot <- plot + geom_point(
shape = shape,
size = size,
shape = ifelse(!is.null(config$shape), config$shape, 3),
size = ifelse(!is.null(config$size), config$size, 1.5),
color = ifelse(!is.null(config$color), config$color, "black"),
position = position
)
@@ -900,22 +915,6 @@ generate_scatter_plot <- function(plot, config) {
)
}
# # Add rectangles if specified
# if (!is.null(config$rectangles)) {
# for (rect in config$rectangles) {
# plot <- plot + annotate(
# "rect",
# xmin = rect$xmin,
# xmax = rect$xmax,
# ymin = rect$ymin,
# ymax = rect$ymax,
# fill = ifelse(is.null(rect$fill), NA, rect$fill),
# color = ifelse(is.null(rect$color), "black", rect$color),
# alpha = ifelse(is.null(rect$alpha), 0.1, rect$alpha)
# )
# }
# }
# Customize X-axis if specified
if (!is.null(config$x_breaks) && !is.null(config$x_labels) && !is.null(config$x_label)) {
# Check if x_var is factor or character (for discrete x-axis)
@@ -1283,7 +1282,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, filter_na = FALSE, ove
generate_correlation_plot_configs <- function(df, df_reference) {
# Define relationships for different-variable correlations
relationships <- list(
list(x = "L", y = "K"), # x-var is predictor, y-var is reponse
list(x = "L", y = "K"),
list(x = "L", y = "r"),
list(x = "L", y = "AUC"),
list(x = "K", y = "r"),
@@ -1304,61 +1303,55 @@ generate_correlation_plot_configs <- function(df, df_reference) {
for (highlight_cyan in highlight_cyan_options) {
for (rel in relationships) {
# Extract relevant variable names for Z_lm values
x_var <- paste0("Z_lm_", rel$x) # predictor
y_var <- paste0("Z_lm_", rel$y) # response
print(paste("rel$x:", rel$x))
print(paste("rel$y:", rel$y))
print(paste("Generating correlation plot for response(y):", y_var, "and predictor(x):", x_var))
print(paste("Relationship suffix:", rel$y, "_", rel$x))
# Extract the R-squared, intercept, and slope from the df (first value)
x_var <- paste0("Z_lm_", rel$x)
y_var <- paste0("Z_lm_", rel$y)
intercept <- df[[paste0("Z_lm_intercept_", rel$y, "_", rel$x)]][1]
slope <- df[[paste0("Z_lm_slope_", rel$y, "_", rel$x)]][1]
r_squared <- df[[paste0("Z_lm_R_squared_", rel$y, "_", rel$x)]][1]
print(paste("intercept:", intercept))
print(paste("slope:", slope))
print(paste("r_squared:", r_squared))
r_squared_rounded <- round(r_squared, 4)
r_squared_label <- paste("R-squared =", r_squared_rounded)
print(paste("r_squared_label:", r_squared_label))
# Find the max and min of both dataframes for printing linear regression line
xmin <- min(c(min(df[[x_var]]), min(df_reference[[x_var]])))
xmax <- max(c(max(df[[x_var]]), max(df_reference[[x_var]])))
# Generate the label for the plot
plot_label <- paste("Interaction", rel$x, "vs.", rel$y)
plot_label <- paste("Interaction", rel$x, "vs. Interaction", rel$y)
# Construct plot config
plot_config <- list(
df = df,
df_reference = df_reference,
x_var = x_var,
y_var = y_var,
plot_type = "scatter",
title = plot_label,
annotations = list(
list(
x = mean(df[[x_var]], na.rm = TRUE),
y = mean(df[[y_var]], na.rm = TRUE),
label = r_squared_label
)
),
lm_line = list(
if (highlight_cyan) {
lm_line <- NULL
} else {
lm_line <- list(
intercept = intercept,
slope = slope,
color = "tomato3",
linewidth = 0.8,
xmin = xmin,
xmax = xmax
),
)
}
plot_config <- list(
df = df,
df_reference = df_reference,
x_var = x_var,
y_var = y_var,
x_label = paste("z-score", rel$x),
y_label = paste("z-score", rel$y),
plot_type = "scatter",
title = plot_label,
color = "gray70",
filter_na = TRUE,
cyan_points = highlight_cyan # include cyan points or not based on the loop
annotations = list(
list(
x = mean(df[[x_var]]),
y = mean(df[[y_var]]),
label = r_squared_label
)
),
lm_line = lm_line,
cyan_points = highlight_cyan,
axis_text_size = list(x = 16, y = 16),
axis_title_size = list(x = 18, y = 18),
grid_lines = list(major = FALSE, minor = FALSE)
)
plot_configs <- append(plot_configs, list(plot_config))
@@ -1804,7 +1797,27 @@ main <- function() {
)
generate_and_save_plots(out_dir, "correlation_cpps", correlation_plot_configs,
page_width = 10, page_height = 7)
# TODO for now quit after one iteration
quit()
})
})
}
main()
# For generate_scatter_plot()
# # Add rectangles if specified
# if (!is.null(config$rectangles)) {
# for (rect in config$rectangles) {
# plot <- plot + annotate(
# "rect",
# xmin = rect$xmin,
# xmax = rect$xmax,
# ymin = rect$ymin,
# ymax = rect$ymax,
# fill = ifelse(is.null(rect$fill), NA, rect$fill),
# color = ifelse(is.null(rect$color), "black", rect$color),
# alpha = ifelse(is.null(rect$alpha), 0.1, rect$alpha)
# )
# }
# }