Merged Type 2 Clustering

infinity-a11y · Aug 21, 2024 · 5739cfd · 5739cfd
2 parents a711c43 + 131f476
commit 5739cfd
Showing 1 changed file with 92 additions and 10 deletions.
diff --git a/App.R b/App.R
@@ -1399,11 +1399,38 @@ ui <- dashboardPage(
                           placement = "top-start",
                           theme = "translucent",
                           width = 5,
-                          selectInput(
-                            "mst_cluster_col_scale",
-                            label = h5("Color Scale", style = "color:white; margin-bottom: 0px;"),
-                            choices = c("Rainbow", "Viridis"),
-                            width = "150px"
+                          fluidRow(
+                            column(
+                              width = 12,
+                              align = "center",
+                              selectInput(
+                                "mst_cluster_col_scale",
+                                label = h5("Color Scale", style = "color:white; margin-bottom: 0px;"),
+                                choices = c("Viridis", "Rainbow"),
+                                width = "150px"
+                              ),
+                              br(),
+                              selectInput(
+                                "mst_cluster_type",
+                                label = h5("Cluster Type", style = "color:white; margin-bottom: 0px;"),
+                                choices = c("Area", "Skeleton"),
+                                width = "150px"
+                              ),
+                              br(),
+                              conditionalPanel(
+                                "input.mst_cluster_type=='Skeleton'",
+                                sliderInput(
+                                  "mst_cluster_width",
+                                  label = h5("Skeleton Width", style = "color:white; margin-bottom: 0px;"),
+                                  value = 24,
+                                  step = 1,
+                                  min = 1,
+                                  max = 50,
+                                  ticks = FALSE,
+                                  width = "150px"
+                                )
+                              )
+                            )f
                           )
                         )
                       )
@@ -5620,6 +5647,7 @@ server <- function(input, output, session) {
   # Compute clusters to use in visNetwork
   compute_clusters <- function(nodes, edges, threshold) {
     groups <- rep(0, length(nodes$id))
+    edges_groups <- rep(0, length(edges$from))
 
     edges_table <- data.frame(
       from = edges$from,
@@ -5639,13 +5667,15 @@ server <- function(input, output, session) {
         if (nrow(sub_tb) == 0 | length(unique(c(sub_tb$from, sub_tb$to))) == length(cluster)) {
           count <- count + 1
           groups[nodes$id %in% cluster] <- paste("Group", count)
+          edges_groups[edges$from %in% cluster & edges$to %in% cluster] <- paste("Group", count)
           break
         } else {
           cluster <- unique(c(sub_tb$from, sub_tb$to))
         }
       }
     }
-    groups
+    list(groups = groups,
+         edges = edges_groups)
   }
 
   # Check gene screening status
@@ -18163,7 +18193,10 @@ server <- function(input, output, session) {
                                 opacity = input$mst_edge_opacity)
 
     if (input$mst_show_clusters) {
-      data$nodes$group <- compute_clusters(data$nodes, data$edges, input$mst_cluster_threshold)
+      clusters <- compute_clusters(data$nodes, data$edges, input$mst_cluster_threshold)
+      if (input$mst_cluster_type == "Area") {
+        data$nodes$group <- clusters$group
+      }
     }
 
     visNetwork_graph <- visNetwork(data$nodes, data$edges,
@@ -18196,13 +18229,62 @@ server <- function(input, output, session) {
     if (input$mst_show_clusters) {
       if (input$mst_cluster_col_scale == "Viridis") {
         color_palette <- viridis(length(unique(data$nodes$group)))
+        color_edges <- viridis(length(unique(clusters$edges)))
       } else {
         color_palette <- rainbow(length(unique(data$nodes$group)))
+        color_edges <- rainbow(length(unique(clusters$edges)))
       }
 
-      for (i in 1:length(unique(data$nodes$group))) {
-        visNetwork_graph <- visNetwork_graph %>% 
-          visGroups(groupname = unique(data$nodes$group)[i], color = color_palette[i])
+      if (input$mst_cluster_type == "Area") {
+        for (i in 1:length(unique(data$nodes$group))) {
+          visNetwork_graph <- visNetwork_graph %>% 
+            visGroups(groupname = unique(data$nodes$group)[i], color = color_palette[i])
+        }
+      } else {
+        thin_edges <- data$edges
+        thin_edges$width <- 2
+        thin_edges$color <- "black"
+
+        thick_edges <- data$edges
+        thick_edges$width <- input$mst_cluster_width
+        thick_edges$color <- rep("rgba(0, 0, 0, 0)", length(data$edges$from))
+
+        for (i in 1:length(unique(clusters$edges))) {
+          if (unique(clusters$edges)[i] != "0") {
+            edge_color <- paste(col2rgb(color_edges[i]), collapse=", ")
+            thick_edges$color[clusters$edges == unique(clusters$edges)[i]] <- paste0("rgba(", edge_color, ", 0.5)")
+          }
+        }
+        merged_edges <- rbind(thick_edges, thin_edges)
+        data$edges <- merged_edges
+        visNetwork_graph <- visNetwork(data$nodes, data$edges,
+                                       main = mst_title(),
+                                       background = mst_background_color(),
+                                       submain = mst_subtitle()) %>%
+          visNodes(size = mst_node_size(),
+                   shape = input$mst_node_shape,
+                   shadow = input$mst_shadow,
+                   color = mst_color_node(),
+                   ctxRenderer = ctxRendererJS,
+                   scaling = list(min = mst_node_size_min(),
+                                  max = mst_node_size_max()),
+                   font = list(color = node_font_color(),
+                               size = input$node_label_fontsize)) %>%
+          visEdges(color = mst_color_edge(),
+                   font = list(color = mst_edge_font_color(),
+                               size = mst_edge_font_size(),
+                               strokeWidth = 4),
+                   smooth = FALSE,
+                   physics = FALSE) %>%
+          visOptions(collapse = TRUE) %>%
+          visInteraction(hover = TRUE) %>%
+          visLayout(randomSeed = 1) %>%
+          visLegend(useGroups = FALSE,
+                    zoom = TRUE,
+                    width = legend_width(),
+                    position = input$mst_legend_ori,
+                    ncol = legend_col(),
+                    addNodes = mst_legend())
       }
     }
     visNetwork_graph