add checkboxes for dose response curves for log transformation and increasing assumption

R/constants.R

@@ -10,22 +10,27 @@ 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",
+  visualization_plot_output = "visualization_plot_output",
+  visualization_plot_height_slider = "visualization_plot_height_slider"
 )
 
 CONSTANTS_STATMODEL = list(

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 (!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)
+    )
+  }
+}
+
 # Todo: Add helper function to build dose response curve mapper matrix
 
 # ============================================================================
@@ -419,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]]
@@ -435,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]]
@@ -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)
       })
@@ -778,59 +794,56 @@ 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[[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) {
-          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_plot <- renderPlot({ 
             visualizeResponseProtein(
               data = dia_prepared,
               protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]],
               drug_name = input[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]],
               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"))
+
         } 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)
         }
 
-        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(
+          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")
+          },
+          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")
+          }
         )
       })
 

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_increasing_trend), 
+    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) {

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
   )
 }
 

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))