cjerzak commited on
Commit
f91b361
·
verified ·
1 Parent(s): 8e0061f

Update app.R

Browse files
Files changed (1) hide show
  1. app.R +222 -49
app.R CHANGED
@@ -1,58 +1,231 @@
 
 
1
  library(shiny)
2
- library(bslib)
3
  library(dplyr)
4
- library(ggplot2)
5
-
6
- df <- readr::read_csv("penguins.csv")
7
- # Find subset of columns that are suitable for scatter plot
8
- df_num <- df |> select(where(is.numeric), -Year)
9
-
10
- ui <- page_sidebar(
11
- theme = bs_theme(bootswatch = "minty"),
12
- title = "Penguins explorer",
13
- sidebar = sidebar(
14
- varSelectInput("xvar", "X variable", df_num, selected = "Bill Length (mm)"),
15
- varSelectInput("yvar", "Y variable", df_num, selected = "Bill Depth (mm)"),
16
- checkboxGroupInput("species", "Filter by species",
17
- choices = unique(df$Species), selected = unique(df$Species)
18
- ),
19
- hr(), # Add a horizontal rule
20
- checkboxInput("by_species", "Show species", TRUE),
21
- checkboxInput("show_margins", "Show marginal plots", TRUE),
22
- checkboxInput("smooth", "Add smoother"),
23
- ),
24
- plotOutput("scatter")
25
- )
26
 
27
- server <- function(input, output, session) {
28
- subsetted <- reactive({
29
- req(input$species)
30
- df |> filter(Species %in% input$species)
31
- })
32
 
33
- output$scatter <- renderPlot(
34
- {
35
- p <- ggplot(subsetted(), aes(!!input$xvar, !!input$yvar)) +
36
- theme_light() +
37
- list(
38
- theme(legend.position = "bottom"),
39
- if (input$by_species) aes(color = Species),
40
- geom_point(),
41
- if (input$smooth) geom_smooth()
42
- )
43
 
44
- if (input$show_margins) {
45
- margin_type <- if (input$by_species) "density" else "histogram"
46
- p <- p |> ggExtra::ggMarginal(
47
- type = margin_type, margins = "both",
48
- size = 8, groupColour = input$by_species, groupFill = input$by_species
49
- )
50
- }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
51
 
52
- p
53
- },
54
- res = 100
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
55
  )
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
56
  }
57
 
58
- shinyApp(ui, server)
 
 
1
+ # setwd('~/Dropbox/ImageSeq/')
2
+
3
  library(shiny)
 
4
  library(dplyr)
5
+ library(plotly)
6
+ library(fields) # For image.plot in heatMap
7
+ library(akima) # For interpolation in heatMap
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
8
 
9
+ # Load the data from sm.csv
10
+ sm <- read.csv("sm.csv")
 
 
 
11
 
12
+ # Define function to convert to numeric
13
+ f2n <- function(x) as.numeric(as.character(x))
 
 
 
 
 
 
 
 
14
 
15
+ # Compute MaxImageDimsLeft and MaxImageDimsRight from MaxImageDims
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
+ # Define the heatMap function (unchanged except for updated default color palette)
20
+ heatMap <- function(x, y, z,
21
+ main = "",
22
+ N, yaxt = NULL,
23
+ xlab = "",
24
+ ylab = "",
25
+ horizontal = FALSE,
26
+ useLog = "",
27
+ legend.width = 1,
28
+ ylim = NULL,
29
+ xlim = NULL,
30
+ zlim = NULL,
31
+ add.legend = TRUE,
32
+ legend.only = FALSE,
33
+ vline = NULL,
34
+ col_vline = "black",
35
+ hline = NULL,
36
+ col_hline = "black",
37
+ cex.lab = 2,
38
+ cex.main = 2,
39
+ myCol = NULL,
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),
47
+ yo = seq(min(y), max(y), length = N),
48
+ duplicate = "mean")
49
+ if (is.null(xlim)) { xlim = range(s_$x, finite = TRUE) }
50
+ if (is.null(ylim)) { ylim = range(s_$y, finite = TRUE) }
51
+ imageFxn <- if (add.legend) fields::image.plot else graphics::image
52
+ if (!grepl(useLog, pattern = "z")) {
53
+ imageFxn(s_, xlab = xlab, ylab = ylab, log = useLog, cex.lab = cex.lab, main = main,
54
+ cex.main = cex.main, col = myCol, xlim = xlim, ylim = ylim,
55
+ legend.width = legend.width, horizontal = horizontal, yaxt = yaxt,
56
+ zlim = zlim, legend.only = legend.only)
57
+ } else {
58
+ useLog <- gsub(useLog, pattern = "z", replace = "")
59
+ zTicks <- summary(c(s_$z))
60
+ ep_ <- 0.001
61
+ zTicks[zTicks < ep_] <- ep_
62
+ zTicks <- exp(seq(log(min(zTicks)), log(max(zTicks)), length.out = 10))
63
+ zTicks <- round(zTicks, abs(min(log(zTicks, base = 10))))
64
+ s_$z[s_$z < ep_] <- ep_
65
+ imageFxn(s_$x, s_$y, log(s_$z), yaxt = yaxt,
66
+ axis.args = list(at = log(zTicks), labels = zTicks),
67
+ main = main, cex.main = cex.main, xlab = xlab, ylab = ylab,
68
+ log = useLog, cex.lab = cex.lab, xlim = xlim, ylim = ylim,
69
+ horizontal = horizontal, col = myCol, legend.width = legend.width,
70
+ zlim = zlim, legend.only = legend.only)
71
+ }
72
+ if (!is.null(vline)) { abline(v = vline, lwd = 10, col = col_vline) }
73
+ if (!is.null(hline)) { abline(h = hline, lwd = 10, col = col_hline) }
74
+
75
+ if (includeMarginals) {
76
+ points(x + rnorm(length(y), sd = marginalJitterSD_x * sd(x)),
77
+ rep(ylim[1] * 1.1, length(y)), pch = "|", col = "darkgray")
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 & Surface Explorer"),
86
+ sidebarLayout(
87
+ sidebarPanel(
88
+ selectInput("application", "Application",
89
+ choices = unique(sm$application),
90
+ selected = unique(sm$application)[1]),
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
+ radioButtons("plotType", "Plot Type",
101
+ choices = c("Heatmap", "Surface"),
102
+ selected = "Heatmap")
103
+ ),
104
+ mainPanel(
105
+ uiOutput("plotOutput")
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) %>%
118
+ mutate(MaxImageDimsRight = ifelse(is.na(MaxImageDimsRight),
119
+ MaxImageDimsLeft,
120
+ MaxImageDimsRight))
121
+ if (nrow(df) == 0) return(NULL)
122
+ df
123
+ })
124
+
125
+ # Render the plot output dynamically
126
+ output$plotOutput <- renderUI({
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 for heatmap
145
+ grouped_data <- data %>%
146
+ group_by(MaxImageDimsLeft, MaxImageDimsRight) %>%
147
+ summarise(
148
+ mean_metric = mean(as.numeric(get(input$metric)), na.rm = TRUE),
149
+ se_metric = sd(as.numeric(get(input$metric)), na.rm = TRUE) / sqrt(n()),
150
+ n = n(),
151
+ .groups = "drop"
152
+ )
153
+
154
+ # Check for sufficient data points for interpolation
155
+ if (nrow(grouped_data) < 3) {
156
+ plot.new()
157
+ text(0.5, 0.5, "Insufficient data points for interpolation", cex = 1.5)
158
+ } else {
159
+ x <- grouped_data$MaxImageDimsLeft
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
+ # Surface Plot Output
181
+ output$surfacePlot <- renderPlotly({
182
+ data <- filteredData()
183
+ if (is.null(data)) return(NULL)
184
+
185
+ # Group data for surface plot
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
+ # Create grid for surface plot
196
+ all_scales <- sort(unique(c(grouped_data$MaxImageDimsLeft, grouped_data$MaxImageDimsRight)))
197
+ z_matrix <- matrix(NA, nrow = length(all_scales), ncol = length(all_scales))
198
+ tooltip_matrix <- matrix("", nrow = length(all_scales), ncol = length(all_scales))
199
+
200
+ for (i in 1:nrow(grouped_data)) {
201
+ left_idx <- which(all_scales == grouped_data$MaxImageDimsLeft[i])
202
+ right_idx <- which(all_scales == grouped_data$MaxImageDimsRight[i])
203
+ z_matrix[left_idx, right_idx] <- grouped_data$mean_metric[i]
204
+ tooltip_matrix[left_idx, right_idx] <- sprintf("Mean: %.2f<br>SE: %.2f<br>n: %d",
205
+ grouped_data$mean_metric[i],
206
+ grouped_data$se_metric[i],
207
+ grouped_data$n[i])
208
+ }
209
+
210
+ # Render interactive 3D surface plot
211
+ plot_ly(
212
+ x = all_scales,
213
+ y = all_scales,
214
+ z = z_matrix,
215
+ type = "surface",
216
+ text = tooltip_matrix,
217
+ hoverinfo = "text"
218
+ ) %>%
219
+ layout(
220
+ title = paste("Surface Plot for", input$metric, "in", input$application),
221
+ scene = list(
222
+ xaxis = list(title = "Maximum Image Dimensions (Right)"),
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)