From 579e3b0035a1b3d25552c05497b7798f77c001cf Mon Sep 17 00:00:00 2001 From: Danilo Imparato Date: Wed, 2 Oct 2024 06:09:09 +0800 Subject: [PATCH] refactor: splits main logic into multiple steps and introduces caching --- DESCRIPTION | 1 + R/app.R | 142 ++++++++++++++++++++++++++++++++++------------------ 2 files changed, 93 insertions(+), 50 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0921c9a..e1f949d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,6 +10,7 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Imports: + digest, dplyr, igraph, jsonlite, diff --git a/R/app.R b/R/app.R index f3c7f78..93edb98 100644 --- a/R/app.R +++ b/R/app.R @@ -21,25 +21,24 @@ #' } #' @export easylayout <- function(graph) { - precompute_iterations <- 1000 - initial_size_multiplier <- 75 - # Nodes must have some sort of identifier. # Falls back to 1, 2, 3... if "name" is not available. if (is.null(igraph::V(graph)$name)) { igraph::V(graph)$name <- as.character(1:igraph::vcount(graph)) } - graph_components <- igraph::components(graph) - largest_component_id <- graph_components$csize |> which.max() + if (is.matrix(layout)) { + print("Loading user-specified initial layout...") + return(start_app(graph, layout)) + } - # Nodes outside the largest component - # will receive special treatment in the web app - flag_for_grouping <- ifelse( - test = graph_components$membership == largest_component_id, - yes = NA, - no = as.character(graph_components$membership) - ) + hash <- igraph::as_edgelist(graph) |> digest::digest() + cached_layout <- get_layout(hash) + + if (!is.null(cached_layout)) { + print("Using cached layout from previous run...") + return(start_app(graph, cached_layout$layout)) + } # Magic precomputing vertices <- igraph::as_data_frame(graph, "vertices") @@ -51,55 +50,44 @@ easylayout <- function(graph) { factor_columns <- vertices |> dplyr::select(-name) |> dplyr::select_if(is.factor) |> - dplyr::mutate(dplyr::across(dplyr::everything(), ~ as.numeric)) + dplyr::mutate(dplyr::across(dplyr::everything(), ~as.numeric)) bound_columns <- cbind(numeric_columns, factor_columns) - print(head(bound_columns)) # Precomputing only works if there are numeric columns - both_dimensions_not_empty <- all(bound_columns |> dim() > 0) + columns_not_empty <- all(bound_columns |> dim() > 0) - if (both_dimensions_not_empty) { - print("The following columns will be used to precompute initial positions:") + if (columns_not_empty) { + print("easylayout will use the following columns to precompute initial positions:") print(colnames(bound_columns)) - distance_matrix <- numeric_columns |> - apply(2, rescale, from = 0, to = 1) |> - dist() |> - as.matrix() - - similarity_matrix <- 1 / (distance_matrix^2) - - similarity_matrix[similarity_matrix == Inf] <- max(similarity_matrix[similarity_matrix < Inf]) - - row.names(similarity_matrix) <- igraph::V(graph)$name - colnames(similarity_matrix) <- igraph::V(graph)$name - - similarity_graph <- igraph::graph_from_adjacency_matrix( - adjmatrix = similarity_matrix, - mode = "undirected", - weighted = TRUE, - diag = FALSE - ) - - similarity_layout <- igraph::layout_with_fr( - graph = similarity_graph, - niter = precompute_iterations - ) * initial_size_multiplier + precomputed_layout <- precompute_layout(graph = graph, cols = bound_columns) + return(start_app(graph, precomputed_layout)) + } - # Centers layout around origin = [0, 0] - similarity_layout[, 1] <- similarity_layout[, 1] - mean(similarity_layout[, 1]) - similarity_layout[, 2] <- similarity_layout[, 2] - mean(similarity_layout[, 2]) + # If any of the previous attempts at retrieving an initial layout failed, + # then we just run the app without any initial layout + return(start_app(graph)) +} - igraph::V(graph)$x <- similarity_layout[, 1] - igraph::V(graph)$y <- similarity_layout[, 2] +start_app <- function(graph, layout) { + if (!missing(layout)) { + # Browser stuff generally considers [0, 0] to be the top-left corner + # of the screen, therefore we need to invert the Y axis + igraph::V(graph)$y <- layout[, 2] * -1 + igraph::V(graph)$x <- layout[, 1] } - # TODO: Handle user given layout - # if (is.matrix(layout)) { - # igraph::V(graph)$x <- layout[, 1] - # igraph::V(graph)$y <- layout[, 2] - # } + graph_components <- igraph::components(graph) + largest_component_id <- graph_components$csize |> which.max() + + # Only nodes outside the largest component + # will receive special treatment in the web app + flag_for_grouping <- ifelse( + test = graph_components$membership == largest_component_id, + yes = NA, + no = as.character(graph_components$membership) + ) igraph::V(graph)$component <- flag_for_grouping @@ -136,9 +124,63 @@ easylayout <- function(graph) { layout[, 2] <- -1 * layout[, 2] + hash <- igraph::as_edgelist(graph) |> digest::digest() + + set_layout(hash, list(layout = layout, opts = "lalala")) + layout } +precompute_layout <- function(graph, cols) { + LAYOUT_SIZE_FACTOR <- 75 + + distance_matrix <- cols |> + apply(2, rescale, from = 0, to = 1) |> + dist() |> + as.matrix() + + similarity_matrix <- 1 / (distance_matrix^2) + + similarity_matrix[similarity_matrix == Inf] <- max(similarity_matrix[similarity_matrix < Inf]) + + row.names(similarity_matrix) <- igraph::V(graph)$name + colnames(similarity_matrix) <- igraph::V(graph)$name + + similarity_graph <- igraph::graph_from_adjacency_matrix( + adjmatrix = similarity_matrix, + mode = "undirected", + weighted = TRUE, + diag = FALSE + ) + + similarity_layout <- igraph::layout_with_fr( + graph = similarity_graph, + niter = 1000 + ) * LAYOUT_SIZE_FACTOR + + # Centers layout around origin = [0, 0] + similarity_layout[, 1] <- similarity_layout[, 1] - mean(similarity_layout[, 1]) + similarity_layout[, 2] <- similarity_layout[, 2] - mean(similarity_layout[, 2]) + + similarity_layout +} + rescale <- function(x, from, to) approxfun(range(x), c(from, to))(x) has_at_least_two_values <- function(x) length(unique(x)) > 1 + +# https://hydroecology.net/implementing-session-cache-r-packages/ +# https://github.com/tidyverse/ggplot2/blob/main/R/plot-last.R +.layout_store <- function() { + .layout_map <- NULL + + list( + get = function(hash) .layout_map[[hash]], + set = function(hash, value) .layout_map[[hash]] <<- value + ) +} +.store <- .layout_store() + +set_layout <- function(hash, value) .store$set(hash, value) + +get_layout <- function(hash) .store$get(hash)