From bc3da6c98fb3291f8f40dce2c2d78c551fe48fe7 Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Sun, 14 Jun 2026 18:18:06 +0300 Subject: [PATCH 1/3] Add weave tab and improve param layout --- DESCRIPTION | 5 ++- NAMESPACE | 6 +++ R/app.R | 126 ++++++++++++++++++++++++++++++++++------------------ 3 files changed, 91 insertions(+), 46 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bb7cec4..d719614 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: ariadneApp -Version: 0.0.2 +Version: 0.0.3 Authors@R: c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", @@ -25,7 +25,8 @@ Depends: visNetwork Imports: ariadne, - bslib + bslib, + htmltools Suggests: BiocStyle, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 8162d16..e0b7075 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,12 @@ export(shinePath) importFrom(ariadne,ariadne) importFrom(ariadne,drawPath) +importFrom(bslib,accordion) +importFrom(bslib,accordion_panel) importFrom(bslib,bs_theme) +importFrom(bslib,nav_panel) +importFrom(bslib,navset_tab) importFrom(bslib,page_sidebar) importFrom(bslib,sidebar) +importFrom(htmltools,br) +importFrom(htmltools,div) diff --git a/R/app.R b/R/app.R index 8cb6425..6876da3 100644 --- a/R/app.R +++ b/R/app.R @@ -64,6 +64,7 @@ server <- function(input, output) { } updateTextInput(inputId = "by", value = NA) + updateNumericInput(inputId = "k", value = 1) updateSelectInput(inputId = "include", selected = NA) updateSelectInput(inputId = "exclude", selected = NA) }) @@ -119,7 +120,8 @@ server <- function(input, output) { } -#' @importFrom bslib page_sidebar bs_theme sidebar +#' @importFrom htmltools br div +#' @importFrom bslib page_sidebar bs_theme sidebar navset_tab nav_panel accordion accordion_panel ui <- function(){ graph <- ariadne() @@ -127,53 +129,89 @@ ui <- function(){ page_sidebar( fillable = FALSE, theme = bs_theme(bootswatch = "united"), - sidebar = sidebar( + sidebar = sidebar(navset_tab( + + nav_panel("Explore", br(), + + textInput("by", "Path:", placeholder = "from ~ to"), + + numericInput("k", "k:", value = 1, min = 1), + + selectInput("include", "Include:", choices = V(graph)$name, + selected = NULL, multiple = TRUE), + + selectInput("exclude", "Exclude:", choices = V(graph)$name, + selected = NULL, multiple = TRUE), + + selectInput("resource", "Resource:", + choices = unique(E(graph)$source), selected = NULL, + multiple = TRUE), - textInput("by", "Path:", placeholder = "from ~ to"), - - numericInput("k", "k:", value = 1, min = 1), - - selectInput("include", "Include:", choices = V(graph)$name, - selected = NULL, multiple = TRUE), - - selectInput("exclude", "Exclude:", choices = V(graph)$name, - selected = NULL, multiple = TRUE), - - selectInput("resource", "Resource:", - choices = unique(E(graph)$source), selected = NULL, - multiple = TRUE), - - tags$style(HTML(" - .shiny-options-group .radio-inline {margin-right: 1rem;} - ")), - - radioButtons( - "init_type", "Initial values as:", choices = c("text", "file"), - inline = TRUE, - ), - - conditionalPanel( - condition = "input.init_type == 'text'", - - selectizeInput( - "init_text", "Initial values:", choices = NULL, - multiple = TRUE, options = list(create = TRUE) - ) - ), - - conditionalPanel( - condition = "input.init_type == 'file'", - - fileInput( - "init_file", "Initial values:", accept = c("csv", "tsv") - ) - ), - checkboxInput("focus", "Focus"), checkboxInput("prune", "Prune"), - actionButton("weave", "Weave", class = "btn-warning", icon = icon("pencil")) - ), + accordion(open = FALSE, height = "80%", + + accordion_panel("Advanced", + + numericInput("buffer", "Buffer factor:", value = 2, + min = 1, step = 1), + + numericInput("max_attempt", "Max attempts:", value = 5, + min = 1, step = 1))), + + div(style = "margin-top: +20px"), + + actionButton("download", "Download", class = "btn-warning", + icon = icon("download"), style = "float: right;")), + + nav_panel("Weave", br(), + + tags$style(HTML(" + .shiny-options-group .radio-inline {margin-right: 1rem;} + ")), + + radioButtons("weave_type", "Type:", + choices = c("simple", "complex"), inline = TRUE), + + radioButtons("init_type", "Initial values as:", + choices = c("text", "file"), inline = TRUE), + + conditionalPanel(condition = "input.init_type == 'text'", + + selectizeInput("init_text", "Initial values:", + choices = NULL, multiple = TRUE, + options = list(create = TRUE))), + + conditionalPanel(condition = "input.init_type == 'file'", + + fileInput("init_file", "Initial values:", + accept = c("csv", "tsv"))), + + checkboxInput("names", "Add names", value = TRUE), + + accordion(open = FALSE, height = "80%", + + accordion_panel("Advanced", + + checkboxInput("weave_prune", "Prune", value = TRUE), + + numericInput("batch_size", "Batch size:", + value = NULL, min = 1), + + numericInput("factor", "Jobs per unit:", value = 3, + min = 1, step = 1))), + + div(style = "margin-top: +20px"), + + conditionalPanel(condition = "input.weave_type == 'complex'", + + sliderInput("weave_complex", "Threshold:", min = 0, max = 1, + value = 0, step = 0.01, ticks = FALSE)), + + actionButton("weave", "Weave", class = "btn-warning", + icon = icon("pencil"), style = "float: right;")))), + visNetworkOutput("network", height = "100vh", width = "100vw") ) } From 31c9fff57bfa8964408c48623b348d5dbcff467e Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Mon, 15 Jun 2026 10:39:51 +0300 Subject: [PATCH 2/3] Initialise weave functionality --- DESCRIPTION | 1 + NAMESPACE | 3 ++ R/app.R | 93 +++++++++++++++++++++++++++++++++++++++++------------ 3 files changed, 76 insertions(+), 21 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d719614..bb48aa4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,7 @@ Depends: Imports: ariadne, bslib, + data.table, htmltools Suggests: BiocStyle, diff --git a/NAMESPACE b/NAMESPACE index e0b7075..bda2d8f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,8 @@ export(shinePath) importFrom(ariadne,ariadne) importFrom(ariadne,drawPath) +importFrom(ariadne,weaveComplex) +importFrom(ariadne,weavePath) importFrom(bslib,accordion) importFrom(bslib,accordion_panel) importFrom(bslib,bs_theme) @@ -10,5 +12,6 @@ importFrom(bslib,nav_panel) importFrom(bslib,navset_tab) importFrom(bslib,page_sidebar) importFrom(bslib,sidebar) +importFrom(data.table,fwrite) importFrom(htmltools,br) importFrom(htmltools,div) diff --git a/R/app.R b/R/app.R index 6876da3..50cffea 100644 --- a/R/app.R +++ b/R/app.R @@ -1,5 +1,6 @@ -#' @importFrom ariadne ariadne drawPath +#' @importFrom ariadne ariadne drawPath weavePath weaveComplex +#' @importFrom data.table fwrite server <- function(input, output) { graph <- ariadne() |> @@ -110,13 +111,61 @@ server <- function(input, output) { edgesId = edges, highlightEdges = FALSE ) - - if( input$focus ){ - - visNetworkProxy("network") |> - visFit(nodes = nodes) - } }) + + observeEvent(input$focus, { + + visNetworkProxy("network") |> + visFit(nodes = unlist(input$net_data$nodes)) + }, ignoreInit = TRUE) + + observeEvent(input$draw, { + + path_name <- input$by |> + as.formula() |> + all.vars() |> + paste(collapse = "2") + + output$draw <- downloadHandler( + filename = paste0(path_name, "-path-", Sys.Date(), ".tsv"), + content = function(file) fwrite(path_df, file, sep = "\t") + ) + }, ignoreInit = TRUE) + + observeEvent(input$weave, { + + FUN <- switch( + input$weave_type, simple = weavePath, complex = weaveComplex + ) + + path_by <- as.formula(input$by) + + x2y <- FUN( + graph, + by = path_by, + k = input$k, + include = input$include, + exclude = input$exclude, + res.name = input$resource, + init = input$text_init, + prune = input$weave_prune, + use.names = input$names, + threshold = input$threshold, + batch.size = input$batch_size, + factor = input$factor#, + #buffer, maxattempt + ) + + path_name <- path_by |> + all.vars() |> + paste(collapse = "2") + + output$weave <- downloadHandler( + filename = paste0(path_name, "-links-", Sys.Date(), ".tsv"), + content = function(file) fwrite(x2y, file, sep = "\t") + ) + + }, ignoreInit = TRUE) } @@ -147,23 +196,24 @@ ui <- function(){ choices = unique(E(graph)$source), selected = NULL, multiple = TRUE), - checkboxInput("focus", "Focus"), - checkboxInput("prune", "Prune"), + checkboxInput("focus", "Focus"), + checkboxInput("prune", "Prune"), - accordion(open = FALSE, height = "80%", + accordion(open = FALSE, height = "80%", - accordion_panel("Advanced", + accordion_panel("Advanced", - numericInput("buffer", "Buffer factor:", value = 2, - min = 1, step = 1), + numericInput("buffer", "Buffer factor:", value = 2, + min = 1, step = 1), - numericInput("max_attempt", "Max attempts:", value = 5, - min = 1, step = 1))), + numericInput("max_attempt", "Max attempts:", value = 5, + min = 1, step = 1))), - div(style = "margin-top: +20px"), + div(style = "margin-top: +20px"), - actionButton("download", "Download", class = "btn-warning", - icon = icon("download"), style = "float: right;")), + downloadButton(outputId = "draw", label = "Draw", + class = "btn-warning", icon = icon("pencil"), + style = "float: right;")), nav_panel("Weave", br(), @@ -208,9 +258,10 @@ ui <- function(){ sliderInput("weave_complex", "Threshold:", min = 0, max = 1, value = 0, step = 0.01, ticks = FALSE)), - - actionButton("weave", "Weave", class = "btn-warning", - icon = icon("pencil"), style = "float: right;")))), + + downloadButton(outputId = "weave", label = "Weave", + class = "btn-warning", icon = icon("pencil"), + style = "float: right;")))), visNetworkOutput("network", height = "100vh", width = "100vw") ) From dc1d358a64afba4c8f1ff95c4f35da7f23bc7a39 Mon Sep 17 00:00:00 2001 From: Giulio Date: Mon, 15 Jun 2026 12:02:03 +0300 Subject: [PATCH 3/3] Finalise basic app function and layout --- R/app.R | 160 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 81 insertions(+), 79 deletions(-) diff --git a/R/app.R b/R/app.R index 50cffea..764f518 100644 --- a/R/app.R +++ b/R/app.R @@ -2,18 +2,18 @@ #' @importFrom ariadne ariadne drawPath weavePath weaveComplex #' @importFrom data.table fwrite server <- function(input, output) { - + # Import ariadne graph graph <- ariadne() |> as_undirected(mode = "each") - + # Set node and edge ids vertex_attr(graph, "id") <- V(graph)$name edge_attr(graph, "id") <- seq_along(E(graph)) - + # Retrieve node and edge data node_df <- as_data_frame(graph, what = "vertices") edge_df <- as_data_frame(graph, what = "edges") - + # Create default network output$network <- renderVisNetwork({ - + # Define default network visIgraph(graph, randomSeed = 123) |> visNodes(color = "darkorange") |> visEdges(color = list(color = "lightgrey", highlight = "red")) |> @@ -28,62 +28,64 @@ server <- function(input, output) { ;}" ) }) - + # Select resources observe({ - + # Based on whether resources are defined if( is.null(input$resource) ){ + # Select all nodes and edges node_df$hidden <- FALSE edge_df$hidden <- FALSE }else{ + # Find edges included in selected resources edge_selected <- edge_df$source %in% input$resource - + # Find nodes included in selected resources nodes <- unique( c(edge_df$from[edge_selected], edge_df$to[edge_selected]) ) - + # Hide edges and nodes absent in selected resources edge_df$hidden <- !edge_selected node_df$hidden <- !node_df$id %in% nodes } - + # Update network visNetworkProxy("network") |> visUpdateNodes(nodes = node_df) |> visUpdateEdges(edges = edge_df) }) - + # Reset parameters when one or less nodes are selected observe({ - + # Check observe requirements nodes <- unlist(input$net_data$nodes) req(length(nodes) < 2L) - + # Reset edge labels edge_df$label <- " " - + # If one node is selected if( !is.null(nodes) ){ - + # Reset network visNetworkProxy("network") |> visUpdateEdges(edges = edge_df) |> visSetSelection(nodesId = nodes, highlightEdges = FALSE) } - + # Reset observers to default updateTextInput(inputId = "by", value = NA) updateNumericInput(inputId = "k", value = 1) updateSelectInput(inputId = "include", selected = NA) updateSelectInput(inputId = "exclude", selected = NA) }) - + # Draw pathway when two or more nodes are selected observe({ - + # Check observe requirements nodes <- unlist(input$net_data$nodes) req(length(nodes) > 1L) - + # Define pathway formula path_by <- c(nodes[1], nodes[length(nodes)]) |> paste(collapse = "~") |> as.formula() - + # Add intermediate nodes to include argument include <- if(length(nodes) > 2L) nodes[2:(length(nodes) - 1)] else NULL - + # Update observers based on selected pathway updateTextInput(inputId = "by", value = deparse(path_by)) updateSelectInput(inputId = "include", selected = include) - + # Draw selected pathway path_df <- drawPath( graph, by = path_by, @@ -92,17 +94,17 @@ server <- function(input, output) { exclude = input$exclude, res.name = input$resource ) - + # Get id of edges in the selected pathway edges <- get_edge_ids(graph, path_df) - + # Find selected edges and nodes edge_selected <- edge_df$id %in% edges node_selected <- node_df$id %in% union(path_df$from, path_df$to) - + # Label selected edges with resource name edge_df$label <- ifelse(edge_selected, edge_df$source, " ") - + # If prune is on, hide unselected nodes and edges node_df$hidden <- if(input$prune) !node_selected else FALSE edge_df$hidden <- if(input$prune) !edge_selected else FALSE - + # Update network visNetworkProxy("network") |> visUpdateNodes(nodes = node_df) |> visUpdateEdges(edges = edge_df) |> @@ -111,61 +113,61 @@ server <- function(input, output) { edgesId = edges, highlightEdges = FALSE ) + # Download map table + output$draw <- downloadHandler( + filename = function(){ + # Make file name from formula + path_name <- path_by |> + all.vars() |> + paste(collapse = "2") + # Complete file name + paste0(path_name, "-map-", Sys.Date(), ".tsv") + }, + content = function(file) fwrite(path_df, file, sep = "\t") + ) }) - + # If focus is turned on observeEvent(input$focus, { - + # Fit network visNetworkProxy("network") |> visFit(nodes = unlist(input$net_data$nodes)) - }, ignoreInit = TRUE) - - observeEvent(input$draw, { - - path_name <- input$by |> - as.formula() |> - all.vars() |> - paste(collapse = "2") - - output$draw <- downloadHandler( - filename = paste0(path_name, "-path-", Sys.Date(), ".tsv"), - content = function(file) fwrite(path_df, file, sep = "\t") - ) - }, ignoreInit = TRUE) - - observeEvent(input$weave, { - - FUN <- switch( - input$weave_type, simple = weavePath, complex = weaveComplex - ) - - path_by <- as.formula(input$by) - - x2y <- FUN( - graph, - by = path_by, - k = input$k, - include = input$include, - exclude = input$exclude, - res.name = input$resource, - init = input$text_init, - prune = input$weave_prune, - use.names = input$names, - threshold = input$threshold, - batch.size = input$batch_size, - factor = input$factor#, - #buffer, maxattempt - ) - - path_name <- path_by |> - all.vars() |> - paste(collapse = "2") - - output$weave <- downloadHandler( - filename = paste0(path_name, "-links-", Sys.Date(), ".tsv"), - content = function(file) fwrite(x2y, file, sep = "\t") - ) - - }, ignoreInit = TRUE) + }) + # Weave and download linkmap + output$weave <- downloadHandler( + filename = function(){ + # Make file name from formula + path_name <- input$by |> + as.formula() |> + all.vars() |> + paste(collapse = "2") + # Complete file name + paste0(path_name, "-links-", Sys.Date(), ".tsv") + }, + content = function(file){ + # Select function by weave type + FUN <- switch( + input$weave_type, simple = weavePath, complex = weaveComplex + ) + # Weave pathway + x2y <- FUN( + graph, + by = as.formula(input$by), + k = input$k, + include = input$include, + exclude = input$exclude, + res.name = input$resource, + init = input$text_init, + prune = input$weave_prune, + use.names = input$names, + threshold = input$threshold, + batch.size = input$batch_size, + factor = input$factor#, + #buffer, maxattempt + ) + # Write linkmap to file + fwrite(x2y, file, sep = "\t") + } + ) } @@ -256,7 +258,7 @@ ui <- function(){ conditionalPanel(condition = "input.weave_type == 'complex'", - sliderInput("weave_complex", "Threshold:", min = 0, max = 1, + sliderInput("threshold", "Threshold:", min = 0, max = 1, value = 0, step = 0.01, ticks = FALSE)), downloadButton(outputId = "weave", label = "Weave",