Spaces:
Running
Running
Update app.R
Browse files
app.R
CHANGED
@@ -2,9 +2,8 @@
|
|
2 |
|
3 |
library(shiny)
|
4 |
library(dplyr)
|
5 |
-
library(plotly)
|
6 |
library(fields) # For image.plot in heatMap
|
7 |
-
library(akima) # For interpolation
|
8 |
|
9 |
# Load the data from sm.csv
|
10 |
sm <- read.csv("sm.csv")
|
@@ -16,7 +15,7 @@ f2n <- function(x) as.numeric(as.character(x))
|
|
16 |
sm$MaxImageDimsLeft <- unlist(lapply(strsplit(sm$MaxImageDims, split = "_"), function(x) sort(f2n(x))[1]))
|
17 |
sm$MaxImageDimsRight <- unlist(lapply(strsplit(sm$MaxImageDims, split = "_"), function(x) sort(f2n(x))[2]))
|
18 |
|
19 |
-
#
|
20 |
heatMap <- function(x, y, z,
|
21 |
main = "",
|
22 |
N, yaxt = NULL,
|
@@ -40,7 +39,8 @@ heatMap <- function(x, y, z,
|
|
40 |
includeMarginals = FALSE,
|
41 |
marginalJitterSD_x = 0.01,
|
42 |
marginalJitterSD_y = 0.01,
|
43 |
-
openBrowser = FALSE
|
|
|
44 |
if (openBrowser) { browser() }
|
45 |
s_ <- akima::interp(x = x, y = y, z = z,
|
46 |
xo = seq(min(x), max(x), length = N),
|
@@ -78,11 +78,16 @@ heatMap <- function(x, y, z,
|
|
78 |
points(rep(xlim[1] * 1.1, length(x)),
|
79 |
y + rnorm(length(y), sd = sd(y) * marginalJitterSD_y), pch = "-", col = "darkgray")
|
80 |
}
|
|
|
|
|
|
|
|
|
|
|
81 |
}
|
82 |
|
83 |
# UI Definition
|
84 |
ui <- fluidPage(
|
85 |
-
titlePanel("Multiscale Heatmap
|
86 |
sidebarLayout(
|
87 |
sidebarPanel(
|
88 |
selectInput("application", "Application",
|
@@ -91,27 +96,29 @@ ui <- fluidPage(
|
|
91 |
selectInput("model", "Model",
|
92 |
choices = unique(sm$optimizeImageRep),
|
93 |
selected = "clip"),
|
94 |
-
# Removed "Perturb Center" input
|
95 |
selectInput("metric", "Metric",
|
96 |
choices = c("AUTOC_rate_std_ratio_mean", "AUTOC_rate_mean", "AUTOC_rate_std_mean",
|
97 |
"AUTOC_rate_std_ratio_mean_pc", "AUTOC_rate_mean_pc", "AUTOC_rate_std_mean_pc",
|
98 |
"MeanVImportHalf1", "MeanVImportHalf2", "FracTopkHalf1", "RMSE"),
|
99 |
selected = "AUTOC_rate_std_ratio_mean"),
|
100 |
-
|
101 |
-
choices = c("Heatmap", "Surface"),
|
102 |
-
selected = "Heatmap")
|
103 |
),
|
104 |
mainPanel(
|
105 |
-
|
106 |
)
|
107 |
)
|
108 |
)
|
109 |
|
110 |
# Server Definition
|
111 |
server <- function(input, output) {
|
|
|
|
|
|
|
|
|
|
|
|
|
112 |
# Reactive data processing
|
113 |
filteredData <- reactive({
|
114 |
-
# Removed filtering by 'perturbCenter'
|
115 |
df <- sm %>%
|
116 |
filter(application == input$application,
|
117 |
optimizeImageRep == input$model) %>%
|
@@ -122,26 +129,12 @@ server <- function(input, output) {
|
|
122 |
df
|
123 |
})
|
124 |
|
125 |
-
#
|
126 |
-
|
127 |
-
data <- filteredData()
|
128 |
-
if (is.null(data)) {
|
129 |
-
return(tags$p("No data available for the selected filters."))
|
130 |
-
}
|
131 |
-
|
132 |
-
if (input$plotType == "Heatmap") {
|
133 |
-
plotOutput("heatmapPlot", height = "600px")
|
134 |
-
} else {
|
135 |
-
plotlyOutput("surfacePlot", height = "600px")
|
136 |
-
}
|
137 |
-
})
|
138 |
-
|
139 |
-
# Heatmap Output
|
140 |
-
output$heatmapPlot <- renderPlot({
|
141 |
data <- filteredData()
|
142 |
if (is.null(data)) return(NULL)
|
143 |
|
144 |
-
# Group data
|
145 |
grouped_data <- data %>%
|
146 |
group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
|
147 |
summarise(
|
@@ -151,81 +144,115 @@ server <- function(input, output) {
|
|
151 |
.groups = "drop"
|
152 |
)
|
153 |
|
154 |
-
|
155 |
-
|
156 |
-
|
157 |
-
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
158 |
} else {
|
159 |
-
|
160 |
-
y <- grouped_data$MaxImageDimsRight
|
161 |
-
z <- grouped_data$mean_metric
|
162 |
-
|
163 |
-
# Slightly more appealing color palette
|
164 |
-
customPalette <- colorRampPalette(c("blue", "white", "red"))(50)
|
165 |
-
|
166 |
-
heatMap(x = x,
|
167 |
-
y = y,
|
168 |
-
z = z,
|
169 |
-
N = 50,
|
170 |
-
main = paste(input$application, "-", input$metric),
|
171 |
-
# More descriptive axis labels
|
172 |
-
xlab = "Maximum Image Dimensions (Left)",
|
173 |
-
ylab = "Maximum Image Dimensions (Right)",
|
174 |
-
useLog = "xy",
|
175 |
-
myCol = customPalette,
|
176 |
-
cex.lab = 1.4)
|
177 |
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
178 |
})
|
179 |
|
180 |
-
#
|
181 |
-
output$
|
182 |
-
|
183 |
-
if (is.null(
|
|
|
|
|
|
|
|
|
184 |
|
185 |
-
|
186 |
grouped_data <- data %>%
|
187 |
group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
|
188 |
summarise(
|
189 |
mean_metric = mean(as.numeric(get(input$metric)), na.rm = TRUE),
|
190 |
-
se_metric = sd(as.numeric(get(input$metric)), na.rm = TRUE) / sqrt(n()),
|
191 |
-
n = n(),
|
192 |
.groups = "drop"
|
193 |
)
|
194 |
|
195 |
-
|
196 |
-
|
197 |
-
|
198 |
-
|
|
|
|
|
199 |
|
200 |
-
|
201 |
-
|
202 |
-
|
203 |
-
|
204 |
-
|
205 |
-
|
206 |
-
|
207 |
-
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
208 |
}
|
209 |
|
210 |
-
|
211 |
-
|
212 |
-
|
213 |
-
|
214 |
-
|
215 |
-
|
216 |
-
|
217 |
-
|
218 |
-
|
219 |
-
|
220 |
-
|
221 |
-
|
222 |
-
|
223 |
-
yaxis = list(title = "Maximum Image Dimensions (Left)"),
|
224 |
-
zaxis = list(title = input$metric)
|
225 |
-
)
|
226 |
-
)
|
227 |
})
|
228 |
}
|
229 |
|
230 |
# Run the Shiny App
|
231 |
-
shinyApp(ui = ui, server = server)
|
|
|
2 |
|
3 |
library(shiny)
|
4 |
library(dplyr)
|
|
|
5 |
library(fields) # For image.plot in heatMap
|
6 |
+
library(akima) # For interpolation
|
7 |
|
8 |
# Load the data from sm.csv
|
9 |
sm <- read.csv("sm.csv")
|
|
|
15 |
sm$MaxImageDimsLeft <- unlist(lapply(strsplit(sm$MaxImageDims, split = "_"), function(x) sort(f2n(x))[1]))
|
16 |
sm$MaxImageDimsRight <- unlist(lapply(strsplit(sm$MaxImageDims, split = "_"), function(x) sort(f2n(x))[2]))
|
17 |
|
18 |
+
# Heatmap function with optimal_point parameter
|
19 |
heatMap <- function(x, y, z,
|
20 |
main = "",
|
21 |
N, yaxt = NULL,
|
|
|
39 |
includeMarginals = FALSE,
|
40 |
marginalJitterSD_x = 0.01,
|
41 |
marginalJitterSD_y = 0.01,
|
42 |
+
openBrowser = FALSE,
|
43 |
+
optimal_point = NULL) {
|
44 |
if (openBrowser) { browser() }
|
45 |
s_ <- akima::interp(x = x, y = y, z = z,
|
46 |
xo = seq(min(x), max(x), length = N),
|
|
|
78 |
points(rep(xlim[1] * 1.1, length(x)),
|
79 |
y + rnorm(length(y), sd = sd(y) * marginalJitterSD_y), pch = "-", col = "darkgray")
|
80 |
}
|
81 |
+
|
82 |
+
# Add green star at optimal point if provided
|
83 |
+
if (!is.null(optimal_point)) {
|
84 |
+
points(optimal_point$x, optimal_point$y, pch = 8, col = "green", cex = 3, lwd = 4)
|
85 |
+
}
|
86 |
}
|
87 |
|
88 |
# UI Definition
|
89 |
ui <- fluidPage(
|
90 |
+
titlePanel("Multiscale Heatmap Explorer"),
|
91 |
sidebarLayout(
|
92 |
sidebarPanel(
|
93 |
selectInput("application", "Application",
|
|
|
96 |
selectInput("model", "Model",
|
97 |
choices = unique(sm$optimizeImageRep),
|
98 |
selected = "clip"),
|
|
|
99 |
selectInput("metric", "Metric",
|
100 |
choices = c("AUTOC_rate_std_ratio_mean", "AUTOC_rate_mean", "AUTOC_rate_std_mean",
|
101 |
"AUTOC_rate_std_ratio_mean_pc", "AUTOC_rate_mean_pc", "AUTOC_rate_std_mean_pc",
|
102 |
"MeanVImportHalf1", "MeanVImportHalf2", "FracTopkHalf1", "RMSE"),
|
103 |
selected = "AUTOC_rate_std_ratio_mean"),
|
104 |
+
checkboxInput("compareToBest", "Compare to best single scale", value = FALSE)
|
|
|
|
|
105 |
),
|
106 |
mainPanel(
|
107 |
+
plotOutput("heatmapPlot", height = "600px")
|
108 |
)
|
109 |
)
|
110 |
)
|
111 |
|
112 |
# Server Definition
|
113 |
server <- function(input, output) {
|
114 |
+
# Function to determine whether to maximize or minimize the metric
|
115 |
+
get_better_direction <- function(metric) {
|
116 |
+
#if (grepl("std|RMSE", metric)) "min" else "max"
|
117 |
+
if (grepl(metric, pattern = "std_mean|RMSE")) "min" else "max"
|
118 |
+
}
|
119 |
+
|
120 |
# Reactive data processing
|
121 |
filteredData <- reactive({
|
|
|
122 |
df <- sm %>%
|
123 |
filter(application == input$application,
|
124 |
optimizeImageRep == input$model) %>%
|
|
|
129 |
df
|
130 |
})
|
131 |
|
132 |
+
# Reactive expression to compute interpolated data and optimal point
|
133 |
+
interpolated_data <- reactive({
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
134 |
data <- filteredData()
|
135 |
if (is.null(data)) return(NULL)
|
136 |
|
137 |
+
# Group data
|
138 |
grouped_data <- data %>%
|
139 |
group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
|
140 |
summarise(
|
|
|
144 |
.groups = "drop"
|
145 |
)
|
146 |
|
147 |
+
better_dir <- get_better_direction(input$metric)
|
148 |
+
single_scale_data <- grouped_data %>% filter(MaxImageDimsLeft == MaxImageDimsRight)
|
149 |
+
best_single_scale_metric <- if (nrow(single_scale_data) > 0) {
|
150 |
+
if (better_dir == "max") max(single_scale_data$mean_metric, na.rm = TRUE)
|
151 |
+
else min(single_scale_data$mean_metric, na.rm = TRUE)
|
152 |
+
} else NA
|
153 |
+
|
154 |
+
grouped_data <- grouped_data %>%
|
155 |
+
mutate(improvement = if (better_dir == "max") {
|
156 |
+
mean_metric - best_single_scale_metric
|
157 |
+
} else {
|
158 |
+
best_single_scale_metric - mean_metric
|
159 |
+
})
|
160 |
+
|
161 |
+
# Select z based on checkbox
|
162 |
+
z_to_interpolate <- if (input$compareToBest) grouped_data$improvement else grouped_data$mean_metric
|
163 |
+
x <- grouped_data$MaxImageDimsLeft
|
164 |
+
y <- grouped_data$MaxImageDimsRight
|
165 |
+
|
166 |
+
# Check if interpolation is possible
|
167 |
+
if (length(unique(x)) < 2 || length(unique(y)) < 2 || nrow(grouped_data) < 3) {
|
168 |
+
return(NULL)
|
169 |
+
}
|
170 |
+
|
171 |
+
# Compute interpolated grid
|
172 |
+
s_ <- akima::interp(x = x,
|
173 |
+
y = y,
|
174 |
+
z = z_to_interpolate,
|
175 |
+
xo = seq(min(x), max(x), length = 50),
|
176 |
+
yo = seq(min(y), max(y), length = 50),
|
177 |
+
duplicate = "mean")
|
178 |
+
|
179 |
+
# Find optimal point from interpolated grid
|
180 |
+
max_idx <- if (input$compareToBest || better_dir == "max") {
|
181 |
+
which.max(s_$z)
|
182 |
} else {
|
183 |
+
which.min(s_$z)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
184 |
}
|
185 |
+
|
186 |
+
row_col <- arrayInd(max_idx, .dim = dim(s_$z))
|
187 |
+
optimal_x <- s_$x[row_col[1,1]]
|
188 |
+
optimal_y <- s_$y[row_col[1,2]]
|
189 |
+
optimal_z <- s_$z[row_col[1,1], row_col[1,2]]
|
190 |
+
|
191 |
+
list(s_ = s_,
|
192 |
+
optimal_point = list(x = optimal_x,
|
193 |
+
y = optimal_y,
|
194 |
+
z = optimal_z))
|
195 |
})
|
196 |
|
197 |
+
# Heatmap Output
|
198 |
+
output$heatmapPlot <- renderPlot({
|
199 |
+
interp_data <- interpolated_data()
|
200 |
+
if (is.null(interp_data)) {
|
201 |
+
plot.new()
|
202 |
+
text(0.5, 0.5, "Insufficient data for interpolation", cex = 1.5)
|
203 |
+
return(NULL)
|
204 |
+
}
|
205 |
|
206 |
+
data <- filteredData()
|
207 |
grouped_data <- data %>%
|
208 |
group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
|
209 |
summarise(
|
210 |
mean_metric = mean(as.numeric(get(input$metric)), na.rm = TRUE),
|
|
|
|
|
211 |
.groups = "drop"
|
212 |
)
|
213 |
|
214 |
+
better_dir <- get_better_direction(input$metric)
|
215 |
+
single_scale_data <- grouped_data %>% filter(MaxImageDimsLeft == MaxImageDimsRight)
|
216 |
+
best_single_scale_metric <- if (nrow(single_scale_data) > 0) {
|
217 |
+
if (better_dir == "max") max(single_scale_data$mean_metric, na.rm = TRUE)
|
218 |
+
else min(single_scale_data$mean_metric, na.rm = TRUE)
|
219 |
+
} else NA
|
220 |
|
221 |
+
grouped_data <- grouped_data %>%
|
222 |
+
mutate(improvement = if (better_dir == "max") {
|
223 |
+
mean_metric - best_single_scale_metric
|
224 |
+
} else {
|
225 |
+
best_single_scale_metric - mean_metric
|
226 |
+
})
|
227 |
+
|
228 |
+
x <- grouped_data$MaxImageDimsLeft
|
229 |
+
y <- grouped_data$MaxImageDimsRight
|
230 |
+
if (input$compareToBest) {
|
231 |
+
z <- grouped_data$improvement
|
232 |
+
main <- paste(input$application, "-", input$metric, "improvement over best single scale")
|
233 |
+
max_abs <- max(abs(z), na.rm = TRUE)
|
234 |
+
zlim <- if (!is.na(max_abs)) c(-max_abs, max_abs) else NULL
|
235 |
+
} else {
|
236 |
+
z <- grouped_data$mean_metric
|
237 |
+
main <- paste(input$application, "-", input$metric)
|
238 |
+
zlim <- range(z, na.rm = TRUE) # Changed from zlim <- NULL
|
239 |
}
|
240 |
|
241 |
+
customPalette <- colorRampPalette(c("blue", "white", "red"))(50)
|
242 |
+
heatMap(x = x,
|
243 |
+
y = y,
|
244 |
+
z = z,
|
245 |
+
N = 50,
|
246 |
+
main = main,
|
247 |
+
xlab = "Image Dimension 1",
|
248 |
+
ylab = "Image Dimensions 2",
|
249 |
+
useLog = "xy",
|
250 |
+
myCol = customPalette,
|
251 |
+
cex.lab = 1.4,
|
252 |
+
zlim = zlim,
|
253 |
+
optimal_point = interp_data$optimal_point)
|
|
|
|
|
|
|
|
|
254 |
})
|
255 |
}
|
256 |
|
257 |
# Run the Shiny App
|
258 |
+
shinyApp(ui = ui, server = server)
|