Update app.R

app.R

@@ -86,6 +86,35 @@ heatMap <- function(x, y, z,
   }
 }
 
+##############################################################################
+# IMPORTANT: Store the meaningful labels for metric in a named vector.
+# The "name" is what is displayed to the user in the dropdown,
+# while the "value" is the underlying column in the dataset.
+##############################################################################
+metric_choices <- c(
+  "Mean AUTOC RATE Ratio"            = "AUTOC_rate_std_ratio_mean",
+  "Mean AUTOC RATE"                  = "AUTOC_rate_mean",
+  "Mean SD of AUTOC RATE"            = "AUTOC_rate_std_mean",
+  "Mean AUTOC RATE Ratio with PC"    = "AUTOC_rate_std_ratio_mean_pc",
+  "Mean AUTOC RATE with PC"          = "AUTOC_rate_mean_pc",
+  "Mean SD of AUTOC RATE with PC"    = "AUTOC_rate_std_mean_pc",
+  "Mean Variable Importance (Split 1)" = "MeanVImportHalf1",
+  "Mean Variable Importance (Split 2)" = "MeanVImportHalf2",
+  "Mean Fraction of Top k Features (Split 1)" = "FracTopkHalf1",
+  "Mean RMSE"                        = "RMSE"
+)
+
+##############################################################################
+# Helper function to retrieve the *label* from its code
+##############################################################################
+getMetricLabel <- function(metric_value) {
+  # This returns, e.g., "Mean AUTOC RATE" if metric_value == "AUTOC_rate_mean".
+  # If it doesn't find a match, return the code itself.
+  lbl <- names(metric_choices)[which(metric_choices == metric_value)]
+  if (length(lbl) == 0) return(metric_value)
+  lbl
+}
+
 # UI Definition
 ui <- fluidPage(
   titlePanel("Multiscale Heatmap Explorer"),
@@ -97,11 +126,14 @@ ui <- fluidPage(
       selectInput("model", "Model",
                   choices = unique(sm$optimizeImageRep),
                   selected = "clip"),
+      
+      ########################################################################
+      # Use our named vector 'metric_choices' directly in selectInput
+      ########################################################################
       selectInput("metric", "Metric",
-                  choices = c("AUTOC_rate_std_ratio_mean", "AUTOC_rate_mean", "AUTOC_rate_std_mean",
-                              "AUTOC_rate_std_ratio_mean_pc", "AUTOC_rate_mean_pc", "AUTOC_rate_std_mean_pc",
-                              "MeanVImportHalf1", "MeanVImportHalf2", "FracTopkHalf1", "RMSE"),
+                  choices = metric_choices,
                   selected = "AUTOC_rate_std_ratio_mean"),
+      
       checkboxInput("compareToBest", "Compare to best single scale", value = FALSE)
     ),
     mainPanel(
@@ -141,9 +173,9 @@ server <- function(input, output) {
       group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
       summarise(
         mean_metric = mean(as.numeric(get(input$metric)), na.rm = TRUE),
-        se_metric = sd(as.numeric(get(input$metric)), na.rm = TRUE) / sqrt(n()),
-        n = n(),
-        .groups = "drop"
+        se_metric   = sd(as.numeric(get(input$metric)), na.rm = TRUE) / sqrt(n()),
+        n           = n(),
+        .groups     = "drop"
       )
     
     better_dir <- get_better_direction(input$metric)
@@ -171,29 +203,30 @@ server <- function(input, output) {
     }
     
     # Compute interpolated grid
-    s_ <- akima::interp(x = x, 
-                        y = y, 
-                        z = z_to_interpolate,
-                        xo = seq(min(x), max(x), length = 50),
-                        yo = seq(min(y), max(y), length = 50),
-                        duplicate = "mean")
-  
+    s_ <- akima::interp(
+      x = x, 
+      y = y, 
+      z = z_to_interpolate,
+      xo = seq(min(x), max(x), length = 50),
+      yo = seq(min(y), max(y), length = 50),
+      duplicate = "mean"
+    )
+    
     # Find optimal point from interpolated grid
     max_idx <- if (input$compareToBest || better_dir == "max") {
       which.max(s_$z)
     } else {
       which.min(s_$z)
     }
-    
     row_col <- arrayInd(max_idx, .dim = dim(s_$z))
     optimal_x <- s_$x[row_col[1,1]]
     optimal_y <- s_$y[row_col[1,2]]
     optimal_z <- s_$z[row_col[1,1], row_col[1,2]]
     
-    list(s_ = s_, 
-         optimal_point = list(x = optimal_x, 
-                              y = optimal_y, 
-                              z = optimal_z))
+    list(
+      s_ = s_, 
+      optimal_point = list(x = optimal_x, y = optimal_y, z = optimal_z)
+    )
   })
   
   # Heatmap Output
@@ -227,79 +260,85 @@ server <- function(input, output) {
         best_single_scale_metric - mean_metric
       })
     
-    x <- grouped_data$MaxImageDimsLeft
-    y <- grouped_data$MaxImageDimsRight
+    # Retrieve the *label* for the chosen metric:
+    chosen_metric_label <- getMetricLabel(input$metric)
+    
     if (input$compareToBest) {
       z <- grouped_data$improvement
-      main <- paste(input$application, "-", input$metric, "improvement over best single scale")
-      #max_abs <- max(abs(z), na.rm = TRUE)
-      #zlim <- if (!is.na(max_abs)) c(-max_abs, max_abs) else NULL
-      zlim <- range(z, na.rm = TRUE) 
+      main_title <- paste(input$application, "-", chosen_metric_label, "improvement over best single scale")
     } else {
       z <- grouped_data$mean_metric
-      main <- paste(input$application, "-", input$metric)
-      zlim <- range(z, na.rm = TRUE) 
+      main_title <- paste(input$application, "-", chosen_metric_label)
     }
     
+    x <- grouped_data$MaxImageDimsLeft
+    y <- grouped_data$MaxImageDimsRight
+    zlim <- range(z, na.rm = TRUE)
+    
     customPalette <- colorRampPalette(c("blue", "white", "red"))(50)
-    heatMap(x = x,
-            y = y,
-            z = z,
-            N = 50,
-            main = main,
-            xlab = "Image Dimension 1",
-            ylab = "Image Dimension 2",
-            useLog = "xy",
-            myCol = customPalette,
-            cex.lab = 1.4,
-            zlim = zlim,
-            optimal_point = interp_data$optimal_point)
+    heatMap(
+      x = x,
+      y = y,
+      z = z,
+      N = 50,
+      main = main_title,
+      xlab = "Image Dimension 1",
+      ylab = "Image Dimension 2",
+      useLog = "xy",
+      myCol = customPalette,
+      cex.lab = 1.4,
+      zlim = zlim,
+      optimal_point = interp_data$optimal_point
+    )
   })
   
   # Contextual Note Output
   output$contextNote <- renderText({
+    SharedContextText <- c(
+      "The Peru RCT involves a multifaceted graduation program treatment to reduce poverty outcomes.",
+      "The Uganda RCT involves a cash grant program to stimulate human capital and living conditions among the poor.",
+      "For more information, see <a href='https://arxiv.org/abs/2411.02134' target='_blank'>https://arxiv.org/abs/2411.02134</a>", 
+      "<div style='font-size: 10px; line-height: 1.5;'>",
+      "<b>Glossary:</b><br>",
+      "• <b>Model:</b> The neural-network backbone (e.g., clip-rsicd) transforming satellite images into numerical representations.<br>",
+      "• <b>Metric:</b> The criterion (e.g., RATE Ratio, RMSE) measuring performance or heterogeneity detection.<br>",
+      "• <b>Compare to best single-scale:</b> Toggle showing metric improvement relative to the best single-scale baseline.<br>",
+      "• <b>ImageDim1, ImageDim2:</b> Image sizes (e.g., 64×64, 128×128) for multi-scale analysis.<br>",
+      "• <b>RATE Ratio:</b> A t-statistic-like quantity indicating how much a data-model combination captures treatment-effect variation. Ratio of the RATE and its standard error. It can employ two weighting scemes (AUTOC and Qini).<br>",
+      "• <b>PC:</b> Principal Components; a compression step of neural representations.<br>",
+      "• <b>MeanDiff, MeanDiff_pc:</b> Gain in RATE Ratio from multi-scale vs. single-scale, with '_pc' for compressed data.<br>",
+      "• <b>RMSE:</b> Root Mean Squared Error, measuring prediction accuracy in simulations.<br>",
+      "</div>"
+    )
+    
+    chosen_metric_label <- getMetricLabel(input$metric)
+    
     if (input$compareToBest) {
-      paste("This heatmap shows the improvement in", input$metric, 
-            "over the best single scale for", input$application, 
-            "using the", input$model, "model. The green star marks the optimal point.",
-            "The Peru RCT involves a multifaceted graduation program treatment to reduce poverty outcomes.",
-            "The Uganda RCT involves a cash grant program to stimulate human capital and living conditions among the poor.",
-            "For more information, see <a href='https://arxiv.org/abs/2411.02134' target='_blank'>https://arxiv.org/abs/2411.02134</a>", 
-            "<div style='font-size: 10px; line-height: 1.5;'>",
-            "<b>Glossary:</b><br>",
-            "• <b>Model:</b> The neural-network backbone (e.g., clip-rsicd) transforming satellite images into numerical representations.<br>",
-            "• <b>Metric:</b> The criterion (e.g., RATE Ratio, RMSE) measuring performance or heterogeneity detection.<br>",
-            "• <b>Compare to best single-scale:</b> Toggle showing metric improvement relative to the best single-scale baseline.<br>",
-            "• <b>ImageDim1, ImageDim2:</b> Image sizes (e.g., 64×64, 128×128) for multi-scale analysis.<br>",
-            "• <b>RATE Ratio:</b> Statistic indicating how well the model detects treatment-effect variation.<br>",
-            "• <b>PC:</b> Principal Components; a compression step of neural representations.<br>",
-            "• <b>MeanDiff, MeanDiff_pc:</b> Gain in RATE Ratio from multi-scale vs. single-scale, with '_pc' for compressed data.<br>",
-            "• <b>RMSE:</b> Root Mean Squared Error, measuring prediction accuracy in simulations.<br>",
-            "</div>"
-            )
+      c(
+        paste(
+          "This heatmap shows the improvement in",
+          paste0("'", chosen_metric_label, "'"),
+          "over the best single scale for",
+          input$application, 
+          "using the", input$model, "model. The green star marks the optimal point."
+        ), 
+        SharedContextText
+      )
     } else {
-      paste("This heatmap displays", input$metric, 
-            "for", input$application, 
-            "using the", input$model, 
-            "model across different image dimension combinations. The green star marks the optimal point.",
-            "The Peru RCT involves a multifaceted graduation program treatment to reduce poverty outcomes.",
-            "The Uganda RCT involves a cash grant program to stimulate human capital and living conditions among the poor.",
-            "For more information, see <a href='https://arxiv.org/abs/2411.02134' target='_blank'>https://arxiv.org/abs/2411.02134</a>", 
-            "<div style='font-size: 10px; line-height: 1.5;'>",
-            "<b>Glossary:</b><br>",
-            "• <b>Model:</b> The neural-network backbone (e.g., clip-rsicd) transforming satellite images into numerical representations.<br>",
-            "• <b>Metric:</b> The criterion (e.g., RATE Ratio, RMSE) measuring performance or heterogeneity detection.<br>",
-            "• <b>Compare to best single-scale:</b> Toggle showing metric improvement relative to the best single-scale baseline.<br>",
-            "• <b>ImageDim1, ImageDim2:</b> Image sizes (e.g., 64×64, 128×128) for multi-scale analysis.<br>",
-            "• <b>RATE Ratio:</b> Statistic indicating how well the model detects treatment-effect variation.<br>",
-            "• <b>PC:</b> Principal Components; a compression step of neural representations.<br>",
-            "• <b>MeanDiff, MeanDiff_pc:</b> Gain in RATE Ratio from multi-scale vs. single-scale, with '_pc' for compressed data.<br>",
-            "• <b>RMSE:</b> Root Mean Squared Error, measuring prediction accuracy in simulations.<br>",
-            "</div>"
-            )
+      c(
+        paste(
+          "This heatmap displays",
+          paste0("'", chosen_metric_label, "'"),
+          "for", input$application, 
+          "using the", input$model, 
+          "model across different image dimension combinations. The green star marks the optimal point."
+        ), 
+        SharedContextText
+      )
     }
   })
 }
 
 # Run the Shiny App
-shinyApp(ui = ui, server = server)
+shinyApp(ui = ui, server = server)
+