Drop lm grouping

qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -829,31 +829,13 @@ generate_rank_plot_configs <- function(df_filtered, variables, is_lm = FALSE) {
         rectangles <- NULL
       }
       
-      # Fit linear model grouped by OrfRep, Gene, num
+      # Fit linear model
-      lm_results <- df_filtered %>%
+      lm_model <- lm(as.formula(paste(y_var, "~", x_var)), data = df_filtered)
-        group_by(OrfRep, Gene, num) %>%
+      lm_summary <- summary(lm_model)
-        do({
-          model <- try(lm(as.formula(paste(y_var, "~", x_var)), data = .), silent = TRUE)
-          if (inherits(model, "try-error")) {
-            # Return NA if model fails
-            data.frame(intercept = NA, slope = NA, r_squared = NA)
-          } else {
-            summary_model <- summary(model)
-            data.frame(
-              intercept = coef(model)[1],
-              slope = coef(model)[2],
-              r_squared = summary_model$r.squared
-            )
-          }
-        }) %>%
-        ungroup()
       
-      aggregated_lm <- lm_results %>%
+      # Extract intercept and slope from the model coefficients
-        summarize(
+      intercept <- coef(lm_model)[1]
-          intercept = mean(intercept, na.rm = TRUE),
+      slope <- coef(lm_model)[2]
-          slope = mean(slope, na.rm = TRUE),
-          r_squared = mean(r_squared, na.rm = TRUE)
-        )
         
       configs[[length(configs) + 1]] <- list(
         df = df_filtered,
@@ -865,14 +847,14 @@ generate_rank_plot_configs <- function(df_filtered, variables, is_lm = FALSE) {
           list(
             x = 0,
             y = 0,
-            label = paste("R-squared =", round(aggregated_lm$r_squared, 2))
+            label = paste("R-squared =", round(lm_summary$r.squared, 2))
           )
         ),
         sd_band_values = NULL, # Not applicable
         shape = 3,
         size = 0.1,
         add_smooth = TRUE,
-        lm_line = list(intercept = aggregated_lm$intercept, slope = aggregated_lm$slope),
+        lm_line = list(intercept = intercept, slope = slope),
         legend_position = "right",
         color_var = "Overlap",
         x_label = x_var,
@@ -1002,7 +984,7 @@ filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FAL
     }
   }
   
-  # Calculate Rank Columns if 'rank' is TRUE
+  # Calculate and add rank columns
   if (rank) {
     if (verbose) message("Calculating ranks for variable(s): ", paste(variables, collapse = ", "))