From e2dcfc8d3571805cd2ac5fb28315136b21111054 Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Fri, 12 Jun 2026 15:35:17 +0300 Subject: [PATCH 1/5] Add sidebar with inactive params --- DESCRIPTION | 3 ++- NAMESPACE | 4 ++- R/app.R | 72 +++++++++++++++++++++++++++++++++++++++++++++++------ 3 files changed, 70 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3d6c603..b3a9bb1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: ariadneApp -Version: 0.0.1 +Version: 0.0.2 Authors@R: c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", @@ -22,6 +22,7 @@ Depends: R (>= 4.1) Imports: ariadne, + bslib, igraph, shiny, visNetwork diff --git a/NAMESPACE b/NAMESPACE index f5b970a..c26fdf1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,8 +2,10 @@ export(shinePath) importFrom(ariadne,ariadne) +importFrom(bslib,bs_theme) +importFrom(bslib,page_sidebar) +importFrom(bslib,sidebar) importFrom(igraph,as_undirected) -importFrom(shiny,fluidPage) importFrom(shiny,shinyApp) importFrom(visNetwork,renderVisNetwork) importFrom(visNetwork,visEdges) diff --git a/R/app.R b/R/app.R index afc6738..1cc40c9 100644 --- a/R/app.R +++ b/R/app.R @@ -12,19 +12,77 @@ server <- function(input, output) { visIgraph(graph, randomSeed = 123) |> visNodes(color = "darkorange") |> visEdges(color = "lightgrey", value = "source") |> - visOptions( - selectedBy = list(variable = "id"), - highlightNearest = TRUE - ) |> + #visOptions( + # selectedBy = list(variable = "id"), + # highlightNearest = TRUE + #) |> visInteraction(multiselect = TRUE) }) + + observe({ + visNetworkProxy("network_proxy_nodes") %>% + visNodes(color = input$color) + }) } -#' @importFrom shiny fluidPage +#' @importFrom bslib page_sidebar bs_theme sidebar #' @importFrom visNetwork visNetworkOutput ui <- function(){ - fluidPage( - visNetworkOutput("ariadne", height = "100vh", width = "100vw") + + page_sidebar( + fillable = FALSE, + theme = bs_theme(bootswatch = "united"), + sidebar = sidebar( + + textInput("formula", "Path:", placeholder = "from ~ to"), + + numericInput("k", "k:", value = 1, min = 1), + + selectInput( + "include", "Include:", choices = NULL, multiple = TRUE + ), + + selectInput( + "exclude", "Exclude:", choices = NULL, multiple = TRUE + ), + + selectInput( + "resource", "Resource:", multiple = TRUE, + choices = NULL + ), + + 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")) + ), + visNetworkOutput("ariadne", height = "100vh", width = "100vw"), ) } From 37119a4e643d48a5464c455ba98bd82d98e3225c Mon Sep 17 00:00:00 2001 From: Giulio Date: Sat, 13 Jun 2026 23:31:54 +0300 Subject: [PATCH 2/5] Finalise interactive path choice --- DESCRIPTION | 10 ++++---- NAMESPACE | 11 +------- R/app.R | 72 +++++++++++++++++++++++++++++++++++++++++------------ 3 files changed, 62 insertions(+), 31 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3d6c603..460e97c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ariadneApp -Version: 0.0.1 -Authors@R: +Version: 0.0.2 +Authors@R: c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", comment = c(ORCID = "0000-0002-8732-7692")), @@ -19,12 +19,12 @@ biocViews: License: Artistic-2.0 Encoding: UTF-8 Depends: - R (>= 4.1) -Imports: - ariadne, + R (>= 4.1), igraph, shiny, visNetwork +Imports: + ariadne, Suggests: BiocStyle, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index f5b970a..cb3755e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,4 @@ export(shinePath) importFrom(ariadne,ariadne) -importFrom(igraph,as_undirected) -importFrom(shiny,fluidPage) -importFrom(shiny,shinyApp) -importFrom(visNetwork,renderVisNetwork) -importFrom(visNetwork,visEdges) -importFrom(visNetwork,visIgraph) -importFrom(visNetwork,visInteraction) -importFrom(visNetwork,visNetworkOutput) -importFrom(visNetwork,visNodes) -importFrom(visNetwork,visOptions) +importFrom(ariadne,drawPath) diff --git a/R/app.R b/R/app.R index afc6738..6f7d66f 100644 --- a/R/app.R +++ b/R/app.R @@ -1,35 +1,75 @@ -#' @importFrom ariadne ariadne -#' @importFrom igraph as_undirected -#' @importFrom visNetwork renderVisNetwork visIgraph visNodes visEdges visOptions visInteraction +#' @importFrom ariadne ariadne drawPath server <- function(input, output) { graph <- ariadne() |> - as_undirected(mode = "collapse") + as_undirected(mode = "each") - output$ariadne <- renderVisNetwork({ - + edge_attr(graph, "id") <- seq_along(E(graph)) + + edge_df <- as_data_frame(graph, what = "edges") + + output$network <- renderVisNetwork({ + visIgraph(graph, randomSeed = 123) |> visNodes(color = "darkorange") |> - visEdges(color = "lightgrey", value = "source") |> - visOptions( - selectedBy = list(variable = "id"), - highlightNearest = TRUE - ) |> - visInteraction(multiselect = TRUE) + visEdges(color = list(color = "lightgrey", highlight = "red")) |> + visInteraction(multiselect = TRUE, selectConnectedEdges = FALSE) |> + visEvents( + select = "function(x) { + Shiny.onInputChange('net_data', x); + ;}" + ) + }) + + observe({ + + nodes <- unlist(input$net_data$nodes) + req(length(nodes) == 1L && !is.null(input$net_data$edges)) + + edge_df$label <- " " + + visNetworkProxy("network") |> + visUpdateEdges(edges = edge_df) |> + visSetSelection(nodesId = nodes, highlightEdges = FALSE) + }) + + observe({ + + nodes <- unlist(input$net_data$nodes) + req(length(nodes) > 1L) + + by <- c(nodes[1], nodes[length(nodes)]) |> + paste(collapse = "~") |> + as.formula() + + include <- if(length(nodes) > 2L) nodes[2:(length(nodes) - 1)] else NULL + + path_df <- drawPath(graph, by, k = input$k, include = include) + + edges <- get_edge_ids(graph, path_df) + edge_df$label <- ifelse(edge_df$id %in% edges, edge_df$source, " ") + + visNetworkProxy("network") |> + visUpdateEdges(edges = edge_df) |> + visSetSelection( + nodesId = nodes, + edgesId = edges, + highlightEdges = FALSE + ) }) } -#' @importFrom shiny fluidPage -#' @importFrom visNetwork visNetworkOutput + ui <- function(){ fluidPage( - visNetworkOutput("ariadne", height = "100vh", width = "100vw") + numericInput("k", "k:", value = 1, min = 1), + visNetworkOutput("network", height = "100vh", width = "100vw") ) } + #' @export -#' @importFrom shiny shinyApp shinePath <- function(){ shinyApp(ui = ui(), server = server) } From 0e0d08187907c8d7721d476f2a69e99df2865dec Mon Sep 17 00:00:00 2001 From: Giulio Date: Sat, 13 Jun 2026 23:40:27 +0300 Subject: [PATCH 3/5] Minor fixes --- NAMESPACE | 3 ++- R/app.R | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9b37c60..46f8402 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,8 @@ export(shinePath) importFrom(ariadne,ariadne) +importFrom(ariadne,drawPath) importFrom(bslib,bs_theme) importFrom(bslib,page_sidebar) importFrom(bslib,sidebar) -importFrom(ariadne,drawPath) +importFrom(visNetwork,visNetworkOutput) diff --git a/R/app.R b/R/app.R index 47a3840..cd30509 100644 --- a/R/app.R +++ b/R/app.R @@ -123,7 +123,7 @@ ui <- function(){ actionButton("weave", "Weave", class = "btn-warning", icon = icon("pencil")) ), - visNetworkOutput("ariadne", height = "100vh", width = "100vw"), + visNetworkOutput("network", height = "100vh", width = "100vw"), ) } From fe451dccf1b767040d5237df9f02a7ba0fdbf400 Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Sun, 14 Jun 2026 13:19:02 +0300 Subject: [PATCH 4/5] Finalise parameter interaction except for init and weave --- NAMESPACE | 1 - R/app.R | 105 ++++++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 78 insertions(+), 28 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 46f8402..8162d16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,4 +6,3 @@ importFrom(ariadne,drawPath) importFrom(bslib,bs_theme) importFrom(bslib,page_sidebar) importFrom(bslib,sidebar) -importFrom(visNetwork,visNetworkOutput) diff --git a/R/app.R b/R/app.R index cd30509..8cb6425 100644 --- a/R/app.R +++ b/R/app.R @@ -5,8 +5,10 @@ server <- function(input, output) { graph <- ariadne() |> as_undirected(mode = "each") + vertex_attr(graph, "id") <- V(graph)$name edge_attr(graph, "id") <- seq_along(E(graph)) + node_df <- as_data_frame(graph, what = "vertices") edge_df <- as_data_frame(graph, what = "edges") output$network <- renderVisNetwork({ @@ -14,7 +16,11 @@ server <- function(input, output) { visIgraph(graph, randomSeed = 123) |> visNodes(color = "darkorange") |> visEdges(color = list(color = "lightgrey", highlight = "red")) |> - visInteraction(multiselect = TRUE, selectConnectedEdges = FALSE) |> + visInteraction( + dragNodes = FALSE, + multiselect = TRUE, + selectConnectedEdges = FALSE + ) |> visEvents( select = "function(x) { Shiny.onInputChange('net_data', x); @@ -22,75 +28,120 @@ server <- function(input, output) { ) }) + observe({ + + if( is.null(input$resource) ){ + node_df$hidden <- FALSE + edge_df$hidden <- FALSE + }else{ + edge_selected <- edge_df$source %in% input$resource + + nodes <- unique( + c(edge_df$from[edge_selected], edge_df$to[edge_selected]) + ) + + edge_df$hidden <- !edge_selected + node_df$hidden <- !node_df$id %in% nodes + } + + visNetworkProxy("network") |> + visUpdateNodes(nodes = node_df) |> + visUpdateEdges(edges = edge_df) + }) + observe({ nodes <- unlist(input$net_data$nodes) - req(length(nodes) == 1L && !is.null(input$net_data$edges)) + req(length(nodes) < 2L) edge_df$label <- " " - visNetworkProxy("network") |> - visUpdateEdges(edges = edge_df) |> - visSetSelection(nodesId = nodes, highlightEdges = FALSE) + if( !is.null(nodes) ){ + + visNetworkProxy("network") |> + visUpdateEdges(edges = edge_df) |> + visSetSelection(nodesId = nodes, highlightEdges = FALSE) + } + + updateTextInput(inputId = "by", value = NA) + updateSelectInput(inputId = "include", selected = NA) + updateSelectInput(inputId = "exclude", selected = NA) }) observe({ nodes <- unlist(input$net_data$nodes) req(length(nodes) > 1L) - - by <- c(nodes[1], nodes[length(nodes)]) |> + + path_by <- c(nodes[1], nodes[length(nodes)]) |> paste(collapse = "~") |> as.formula() include <- if(length(nodes) > 2L) nodes[2:(length(nodes) - 1)] else NULL - path_df <- drawPath(graph, by, k = input$k, include = include) + updateTextInput(inputId = "by", value = deparse(path_by)) + updateSelectInput(inputId = "include", selected = include) + + path_df <- drawPath( + graph, + by = path_by, + k = input$k, + include = input$include, + exclude = input$exclude, + res.name = input$resource + ) edges <- get_edge_ids(graph, path_df) - edge_df$label <- ifelse(edge_df$id %in% edges, edge_df$source, " ") + + edge_selected <- edge_df$id %in% edges + node_selected <- node_df$id %in% union(path_df$from, path_df$to) + + edge_df$label <- ifelse(edge_selected, edge_df$source, " ") + + node_df$hidden <- if(input$prune) !node_selected else FALSE + edge_df$hidden <- if(input$prune) !edge_selected else FALSE visNetworkProxy("network") |> + visUpdateNodes(nodes = node_df) |> visUpdateEdges(edges = edge_df) |> visSetSelection( nodesId = nodes, edgesId = edges, highlightEdges = FALSE ) - }) - - observe({ - visNetworkProxy("network_proxy_nodes") %>% - visNodes(color = input$color) + + if( input$focus ){ + + visNetworkProxy("network") |> + visFit(nodes = nodes) + } }) } #' @importFrom bslib page_sidebar bs_theme sidebar -#' @importFrom visNetwork visNetworkOutput ui <- function(){ + graph <- ariadne() + page_sidebar( fillable = FALSE, theme = bs_theme(bootswatch = "united"), sidebar = sidebar( - textInput("formula", "Path:", placeholder = "from ~ to"), + textInput("by", "Path:", placeholder = "from ~ to"), numericInput("k", "k:", value = 1, min = 1), - selectInput( - "include", "Include:", choices = NULL, multiple = TRUE - ), + selectInput("include", "Include:", choices = V(graph)$name, + selected = NULL, multiple = TRUE), - selectInput( - "exclude", "Exclude:", choices = NULL, multiple = TRUE - ), + selectInput("exclude", "Exclude:", choices = V(graph)$name, + selected = NULL, multiple = TRUE), - selectInput( - "resource", "Resource:", multiple = TRUE, - choices = NULL - ), + selectInput("resource", "Resource:", + choices = unique(E(graph)$source), selected = NULL, + multiple = TRUE), tags$style(HTML(" .shiny-options-group .radio-inline {margin-right: 1rem;} @@ -123,7 +174,7 @@ ui <- function(){ actionButton("weave", "Weave", class = "btn-warning", icon = icon("pencil")) ), - visNetworkOutput("network", height = "100vh", width = "100vw"), + visNetworkOutput("network", height = "100vh", width = "100vw") ) } From 86ba6f82cf45158827dcb0ebe7b0092055a6d2d1 Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Sun, 14 Jun 2026 13:23:02 +0300 Subject: [PATCH 5/5] Add GitHub Actions workflow for testing --- .github/workflows/test.yml | 50 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 .github/workflows/test.yml diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..7159398 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,50 @@ +name: test +'on': + pull_request: + branches: + - devel +env: + CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} +jobs: + rworkflows: + permissions: write-all + runs-on: ${{ matrix.config.os }} + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + container: ${{ matrix.config.cont }} + strategy: + fail-fast: ${{ false }} + matrix: + config: + - os: ubuntu-latest + bioc: devel + r: auto + cont: ghcr.io/bioconductor/bioconductor_docker:devel + rspm: ~ + - os: macOS-latest + bioc: devel + r: auto + cont: ~ + rspm: ~ + - os: windows-latest + bioc: devel + r: auto + cont: ~ + rspm: ~ + steps: + - uses: neurogenomics/rworkflows@master + with: + run_bioccheck: ${{ true }} + run_rcmdcheck: ${{ true }} + as_cran: ${{ true }} + run_vignettes: ${{ false }} + has_testthat: ${{ true }} + run_covr: ${{ false }} + run_pkgdown: ${{ false }} + has_runit: ${{ false }} + has_latex: ${{ false }} + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run_docker: ${{ false }} + DOCKER_TOKEN: ${{ secrets.DOCKER_TOKEN }} + runner_os: ${{ runner.os }} + cache_version: cache-v1 + docker_registry: ghcr.io