|
| 1 | +linear_regression_server <- function(input, output, session, merged_data) { |
| 2 | + |
| 3 | + regression_results_rv <- reactiveVal(NULL) |
| 4 | + |
| 5 | + # Generate covariate inputs dynamically |
| 6 | + output$covariate_inputs <- renderUI({ |
| 7 | + req(input$num_covariates) |
| 8 | + num <- input$num_covariates |
| 9 | + |
| 10 | + lapply(seq_len(num), function(i) { |
| 11 | + tagList( |
| 12 | + selectInput(paste0("covariate", i), paste("Select Covariate", i), |
| 13 | + choices = colnames(merged_data()), selected = NULL), |
| 14 | + radioButtons(paste0("cov_type", i), paste("Covariate", i, "Type"), |
| 15 | + choices = c("Character", "Factor", "Numeric"), inline = TRUE) |
| 16 | + ) |
| 17 | + }) |
| 18 | + }) |
| 19 | + |
| 20 | + # Update dependent variable choices based on merged_data |
| 21 | +output$dependent_var_ui <- renderUI({ |
| 22 | + req(merged_data()) |
| 23 | + numeric_cols <- names(merged_data())[sapply(merged_data(), is.numeric)] |
| 24 | + selectInput("dependent_var", "Select Dependent Variable", choices = numeric_cols) |
| 25 | +}) |
| 26 | + |
| 27 | + |
| 28 | +observe({ |
| 29 | + req(merged_data()) |
| 30 | + cols <- colnames(merged_data()) |
| 31 | + |
| 32 | + num_covs <- as.numeric(input$num_covariates %||% 0) |
| 33 | + for (i in seq_len(num_covs)) { |
| 34 | + updateSelectInput(session, paste0("covariate", i), choices = c("None", cols)) |
| 35 | + } |
| 36 | +}) |
| 37 | + |
| 38 | + |
| 39 | + |
| 40 | + # Perform linear regression on NPX variables |
| 41 | + observeEvent(input$run_regression, { |
| 42 | + req(merged_data()) |
| 43 | + df <- merged_data() |
| 44 | + |
| 45 | + # Identify numeric variables (potential biomarkers) |
| 46 | + excluded_cols <- c(input$dependent_var, unlist(lapply(seq_len(input$num_covariates), function(i) input[[paste0("covariate", i)]]))) |
| 47 | + npx_vars <- colnames(df)[sapply(df, is.numeric) & !(colnames(df) %in% excluded_cols)] |
| 48 | + |
| 49 | + |
| 50 | + # Standardize NPX if Z-score selected |
| 51 | + if (input$npx_or_zscore == "Z-score") { |
| 52 | + df <- df %>% |
| 53 | + mutate(across(all_of(npx_vars), ~ scale(.), .names = "{.col}_z")) |
| 54 | + npx_vars <- paste0(npx_vars, "_z") |
| 55 | + } |
| 56 | + |
| 57 | + # Collect user input |
| 58 | + dep_var <- input$dependent_var |
| 59 | + covariates <- unlist(lapply(seq_len(input$num_covariates), function(i) input[[paste0("covariate", i)]])) |
| 60 | + covariates <- covariates[!is.na(covariates) & covariates != ""] |
| 61 | + |
| 62 | + # Preprocess covariate types |
| 63 | + for (i in seq_along(covariates)) { |
| 64 | + cov <- covariates[i] |
| 65 | + cov_type <- input[[paste0("cov_type", i)]] |
| 66 | + if (!is.null(cov_type)) { |
| 67 | + df[[cov]] <- switch(cov_type, |
| 68 | + "Character" = as.character(df[[cov]]), |
| 69 | + "Factor" = as.factor(df[[cov]]), |
| 70 | + "Numeric" = as.numeric(df[[cov]])) |
| 71 | + } |
| 72 | + } |
| 73 | + |
| 74 | + # Run linear regression |
| 75 | + results <- purrr::map_dfr(npx_vars, function(var) { |
| 76 | + form <- as.formula( |
| 77 | + paste(dep_var, "~", paste(c(var, covariates), collapse = " + ")) |
| 78 | + ) |
| 79 | + model <- tryCatch(lm(form, data = df), error = function(e) NULL) |
| 80 | + if (is.null(model)) return(NULL) |
| 81 | + |
| 82 | + broom::tidy(model) %>% |
| 83 | + filter(term == var) %>% |
| 84 | + mutate(biomarker = gsub("_z$", "", var)) |
| 85 | + }) |
| 86 | + |
| 87 | + # Format and adjust |
| 88 | + if (nrow(results) > 0) { |
| 89 | + results_clean <- results %>% |
| 90 | + mutate(adj.p.value = p.adjust(p.value, method = "BH")) %>% |
| 91 | + select(biomarker, estimate, std.error, p.value, adj.p.value) %>% |
| 92 | + arrange(adj.p.value) |
| 93 | + |
| 94 | + regression_results_rv(results_clean) |
| 95 | + |
| 96 | + output$regression_results <- DT::renderDataTable({ |
| 97 | + DT::datatable(results_clean, options = list(pageLength = 15), rownames = FALSE) |
| 98 | + }) |
| 99 | + } else { |
| 100 | + output$regression_results <- DT::renderDataTable({ |
| 101 | + DT::datatable(data.frame(Message = "No valid models or no significant results."), rownames = FALSE) |
| 102 | + }) |
| 103 | + } |
| 104 | + }) |
| 105 | + |
| 106 | + output$download_regression <- downloadHandler( |
| 107 | + filename = function() { |
| 108 | + paste0("linear_regression_results_", Sys.Date(), ".csv") |
| 109 | + }, |
| 110 | + content = function(file) { |
| 111 | + results <- regression_results_rv() |
| 112 | + if (!is.null(results)) { |
| 113 | + readr::write_csv(results, file) |
| 114 | + } |
| 115 | + } |
| 116 | +) |
| 117 | + |
| 118 | +} |
0 commit comments