From 81a8b169503ba1b80f221dc0af4e5a41d970586d Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 10 Feb 2026 16:08:17 -0500 Subject: [PATCH 1/4] add checkboxes for dose response curves for log transformation and increasing assumption --- R/constants.R | 33 +++++++++++++++++-------------- R/module-statmodel-server.R | 16 +++++++++++++++ R/statmodel-ui-options-modeling.R | 30 ++++++++++++++++++++++++++++ 3 files changed, 64 insertions(+), 15 deletions(-) diff --git a/R/constants.R b/R/constants.R index f3c70ce..bdd8ff7 100644 --- a/R/constants.R +++ b/R/constants.R @@ -10,22 +10,25 @@ NAMESPACE_STATMODEL = list( comparisons_custom_nonpairwise_name = "comparisons_custom_nonpairwise_name", comparisons_custom_nonpairwise_weights = "comparisons_custom_nonpairwise_weights", modeling_start = "modeling_start", # "calculate" - modeling_significance_level = "modeling_significance_level", # "signif" - modeling_tmt_moderation = "modeling_tmt_moderation", # "moderated" - visualization_plot_options_conditional_panel = "plot_options_conditional_panel", # plot_specific_options - visualization_plot_type = "visualization_plot_type", # typeplot - visualization_logp_base = "visualization_logp_base", # logp - visualization_which_protein = "visualization_which_protein", # WhichProt - visualization_fold_change_checkbox = "visualization_fold_change_checkbox", # FC1 - visualization_fold_change_input = "visualization_fold_change_input", # FC - visualization_which_comparison = "visualization_which_comparison", # WhichComp - visualization_volcano_display_protein_name = "visualization_volcano_display_protein_name", # pname - visualization_volcano_significance_cutoff = "visualization_volcano_significance_cutoff", # sig - visualization_heatmap_number_proteins = "visualization_heatmap_number_proteins", # nump - visualization_heatmap_cluster_option = "visualization_heatmap_cluster_option", # cluster + modeling_significance_level = "modeling_significance_level", + modeling_tmt_moderation = "modeling_tmt_moderation", + modeling_response_curve_fitting_options = "modeling_response_curve_fitting_options", + modeling_response_curve_increasing_trend = "modeling_response_curve_increasing_trend", + modeling_response_curve_log_xaxis = "modeling_response_curve_log_xaxis", + visualization_plot_options_conditional_panel = "plot_options_conditional_panel", + visualization_plot_type = "visualization_plot_type", + visualization_logp_base = "visualization_logp_base", + visualization_which_protein = "visualization_which_protein", + visualization_fold_change_checkbox = "visualization_fold_change_checkbox", + visualization_fold_change_input = "visualization_fold_change_input", + visualization_which_comparison = "visualization_which_comparison", + visualization_volcano_display_protein_name = "visualization_volcano_display_protein_name", + visualization_volcano_significance_cutoff = "visualization_volcano_significance_cutoff", + visualization_heatmap_number_proteins = "visualization_heatmap_number_proteins", + visualization_heatmap_cluster_option = "visualization_heatmap_cluster_option", visualization_response_curve_which_drug = "visualization_response_curve_which_drug", - visualization_view_results = "visualization_view_results", # viewresults - visualization_download_plot_results = "visualization_download_plot_results" # plotresults + visualization_view_results = "visualization_view_results", + visualization_download_plot_results = "visualization_download_plot_results" ) CONSTANTS_STATMODEL = list( diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 7b078ad..83474e2 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -322,6 +322,17 @@ get_tmt_moderation_radio_button <- function(loadpage_input, ns) { } } +#' Get response curve fitting options conditioned on if contrast mode is response curve +#' @noRd +get_response_curve_fitting_options <- function(mode, ns) { + if (mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { + tagList( + create_response_curve_log_xaxis_checkbox(ns), + create_response_curve_increasing_trend_checkbox(ns) + ) + } +} + # Todo: Add helper function to build dose response curve mapper matrix # ============================================================================ @@ -688,6 +699,11 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, contrast$matrix = NULL }) + output[[NAMESPACE_STATMODEL$modeling_response_curve_fitting_options]] <- renderUI({ + get_response_curve_fitting_options( + input[[NAMESPACE_STATMODEL$comparison_mode]], session$ns) + }) + output[[NAMESPACE_STATMODEL$modeling_tmt_moderation]] <- renderUI({ get_tmt_moderation_radio_button(loadpage_input(), session$ns) }) diff --git a/R/statmodel-ui-options-modeling.R b/R/statmodel-ui-options-modeling.R index f2e4c10..822583d 100644 --- a/R/statmodel-ui-options-modeling.R +++ b/R/statmodel-ui-options-modeling.R @@ -11,6 +11,7 @@ create_modeling_section <- function(ns) { p("Please add a comparison matrix before modeling."), disabled(actionButton(ns(NAMESPACE_STATMODEL$modeling_start), "Start")), tags$hr(), + uiOutput(ns(NAMESPACE_STATMODEL$modeling_response_curve_fitting_options)), uiOutput(ns(NAMESPACE_STATMODEL$modeling_tmt_moderation)), create_significance_slider(ns), # need option for increasing or decreasing trend for dose response @@ -31,6 +32,35 @@ create_moderation_radio_buttons <- function(ns) { ) } +create_response_curve_log_xaxis_checkbox <- function(ns) { + checkboxInput( + ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), + label = tags$div("Log scale for treatment values", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Check this box to use a log scale for the x-axis of dose response curves. + This is typically used when doses are in a log scale (e.g. 0.1, 1, 10, 100). + But if your scale is linear, e.g. time 1, 2, 3 hours, then we recommend unchecking this box", + class = "icon-tooltip") + ), + value = TRUE + ) +} + +create_response_curve_increasing_trend_checkbox <- function(ns) { + checkboxInput( + ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), + label = tags$div("Increasing trend for dose response curves", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Check this box if you expect an increasing trend in your dose response curve, e.g. higher doses lead to higher protein abundance. + Uncheck if you expect a decreasing trend, e.g. higher doses lead to lower protein abundance.", + class = "icon-tooltip") + ), + value = FALSE + ) +} + #' Create significance level slider #' @noRd create_significance_slider <- function(ns) { From deea65703364a545e204d2f2103b26fc2f0fa046 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 10 Feb 2026 16:25:24 -0500 Subject: [PATCH 2/4] Enable options for modeling, ensured they work --- R/module-statmodel-server.R | 6 +++--- R/statmodel-ui-options-modeling.R | 2 +- R/utils.R | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 83474e2..945ae6d 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -325,7 +325,7 @@ get_tmt_moderation_radio_button <- function(loadpage_input, ns) { #' Get response curve fitting options conditioned on if contrast mode is response curve #' @noRd get_response_curve_fitting_options <- function(mode, ns) { - if (mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { + if (!is.null(mode) && mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { tagList( create_response_curve_log_xaxis_checkbox(ns), create_response_curve_increasing_trend_checkbox(ns) @@ -818,9 +818,9 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ratio_response = TRUE, show_ic50 = TRUE, add_ci = TRUE, - transform_dose = TRUE, + transform_dose = input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]], n_samples = 1000, - increasing = FALSE + increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) }) op = plotOutput(ns("comp_plots")) diff --git a/R/statmodel-ui-options-modeling.R b/R/statmodel-ui-options-modeling.R index 822583d..7d69163 100644 --- a/R/statmodel-ui-options-modeling.R +++ b/R/statmodel-ui-options-modeling.R @@ -49,7 +49,7 @@ create_response_curve_log_xaxis_checkbox <- function(ns) { create_response_curve_increasing_trend_checkbox <- function(ns) { checkboxInput( - ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), + ns(NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend), label = tags$div("Increasing trend for dose response curves", class = "icon-wrapper", icon("question-circle", lib = "font-awesome"), diff --git a/R/utils.R b/R/utils.R index 778458f..6de9884 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1308,8 +1308,8 @@ fitResponseCurves <- function(statmodel_input, matrix, input_data) { dia_prepared <- prepare_dose_response_fit(protein_level_data) response_results <- doseResponseFit( data = dia_prepared, - increasing = FALSE, - transform_dose = TRUE, + increasing = statmodel_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]], + transform_dose = statmodel_input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]], ratio_response = FALSE ) return(list(ComparisonResult = response_results)) From 37776a2f941423085ef462bf84b4f75fc63aca6c Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 10 Feb 2026 16:42:27 -0500 Subject: [PATCH 3/4] made statistical modeling plots render properly --- R/module-statmodel-server.R | 51 +++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 945ae6d..1a99fcc 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -794,23 +794,25 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison_code) # Plot rendering - observeEvent(input[[NAMESPACE_STATMODEL$visualization_view_results]], { - ns = session$ns + output$comparison_plots <- renderUI({ + req(input[[NAMESPACE_STATMODEL$visualization_view_results]]) + ns <- session$ns + if (loadpage_input()$BIO == "PTM") { - output$comp_plots = renderPlot({ + output$comp_plots <- renderPlot({ create_group_comparison_plot( input, loadpage_input(), data_comparison() ) }) - op = plotOutput(ns("comp_plots")) + op <- plotOutput(ns("comp_plots")) + } else if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_response_curve) { - matrix = contrast$matrix + matrix <- contrast$matrix protein_level_data <- merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP") - dia_prepared <- prepare_dose_response_fit( - data = protein_level_data - ) - output$comp_plots = renderPlot({ + dia_prepared <- prepare_dose_response_fit(data = protein_level_data) + + output$comp_plots <- renderPlot({ visualizeResponseProtein( data = dia_prepared, protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]], @@ -823,29 +825,28 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) }) - op = plotOutput(ns("comp_plots")) + op <- plotOutput(ns("comp_plots")) + } else { - output$comp_plots = renderPlotly({ + output$comp_plots <- renderPlotly({ create_group_comparison_plot( input, loadpage_input(), data_comparison() ) }) - op = plotlyOutput(ns("comp_plots"), height = input$height) + op <- plotlyOutput(ns("comp_plots"), height = input$height) } - insertUI( - selector = paste0("#", ns("comparison_plots")), - ui = tags$div( - op, - conditionalPanel( - condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_volcano_plot, "' && input['loadpage-BIO']!='PTM'"), - h5("Hover over plot for details") - ), - conditionalPanel( - condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_heatmap, "'"), - sliderInput(ns("height"), "Plot height", - value = 500, min = 200, max = 1300, post = "px") - ) + # Return the UI + tags$div( + op, + conditionalPanel( + condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_volcano_plot, "' && input['loadpage-BIO']!='PTM'"), + h5("Hover over plot for details") + ), + conditionalPanel( + condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_heatmap, "'"), + sliderInput(ns("height"), "Plot height", + value = 500, min = 200, max = 1300, post = "px") ) ) }) From b5a3370bf75582c0264ae5e2d7fba98c94704434 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 10 Feb 2026 17:02:40 -0500 Subject: [PATCH 4/4] refactoring plotting --- R/constants.R | 4 +++- R/module-statmodel-server.R | 30 +++++++++++++----------------- R/statmodel-ui-results.R | 2 +- 3 files changed, 17 insertions(+), 19 deletions(-) diff --git a/R/constants.R b/R/constants.R index bdd8ff7..4900342 100644 --- a/R/constants.R +++ b/R/constants.R @@ -28,7 +28,9 @@ NAMESPACE_STATMODEL = list( visualization_heatmap_cluster_option = "visualization_heatmap_cluster_option", visualization_response_curve_which_drug = "visualization_response_curve_which_drug", visualization_view_results = "visualization_view_results", - visualization_download_plot_results = "visualization_download_plot_results" + visualization_download_plot_results = "visualization_download_plot_results", + visualization_plot_output = "visualization_plot_output", + visualization_plot_height_slider = "visualization_plot_height_slider" ) CONSTANTS_STATMODEL = list( diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 1a99fcc..dc727f3 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -430,7 +430,7 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], - height = input$height, + height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]], address = "Ex_", isPlotly = TRUE )[[1]] @@ -446,7 +446,7 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], - height = input$height, + height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]], address = "Ex_", isPlotly = TRUE )[[1]] @@ -794,17 +794,16 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison_code) # Plot rendering - output$comparison_plots <- renderUI({ + output[[NAMESPACE_STATMODEL$visualization_plot_output]] <- renderUI({ req(input[[NAMESPACE_STATMODEL$visualization_view_results]]) ns <- session$ns if (loadpage_input()$BIO == "PTM") { - output$comp_plots <- renderPlot({ + output_plot <- renderPlot({ create_group_comparison_plot( input, loadpage_input(), data_comparison() ) }) - op <- plotOutput(ns("comp_plots")) } else if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_response_curve) { @@ -812,7 +811,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, protein_level_data <- merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP") dia_prepared <- prepare_dose_response_fit(data = protein_level_data) - output$comp_plots <- renderPlot({ + output_plot <- renderPlot({ visualizeResponseProtein( data = dia_prepared, protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]], @@ -825,29 +824,26 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) }) - op <- plotOutput(ns("comp_plots")) } else { - output$comp_plots <- renderPlotly({ + output_plot <- renderPlotly({ create_group_comparison_plot( input, loadpage_input(), data_comparison() ) }) - op <- plotlyOutput(ns("comp_plots"), height = input$height) } # Return the UI tags$div( - op, - conditionalPanel( - condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_volcano_plot, "' && input['loadpage-BIO']!='PTM'"), + output_plot, + if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_volcano_plot && + loadpage_input()$BIO != "PTM") { h5("Hover over plot for details") - ), - conditionalPanel( - condition = paste0("input['statmodel-", NAMESPACE_STATMODEL$visualization_plot_type, "'] == '", CONSTANTS_STATMODEL$plot_type_heatmap, "'"), - sliderInput(ns("height"), "Plot height", + }, + if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_heatmap) { + sliderInput(ns(NAMESPACE_STATMODEL$visualization_plot_height_slider), "Plot height", value = 500, min = 200, max = 1300, post = "px") - ) + } ) }) diff --git a/R/statmodel-ui-results.R b/R/statmodel-ui-results.R index 3784d95..6ab1e8c 100644 --- a/R/statmodel-ui-results.R +++ b/R/statmodel-ui-results.R @@ -18,7 +18,7 @@ create_results_section <- function(ns) { uiOutput(ns("matrix")), # rename to something else to capture response curve mappings create_results_tables(ns), # should include tables for isotonic regression & ic50 calculations tags$br(), - uiOutput(ns("comparison_plots")) # rename to model_plots_output to encapsulate all models + uiOutput(ns(NAMESPACE_STATMODEL$visualization_plot_output)) # rename to model_plots_output to encapsulate all models ) }