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 diff --git a/DESCRIPTION b/DESCRIPTION index 3d6c603..bb7cec4 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,13 @@ biocViews: License: Artistic-2.0 Encoding: UTF-8 Depends: - R (>= 4.1) -Imports: - ariadne, + R (>= 4.1), igraph, shiny, visNetwork +Imports: + ariadne, + bslib Suggests: BiocStyle, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index f5b970a..8162d16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,7 @@ 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) +importFrom(bslib,bs_theme) +importFrom(bslib,page_sidebar) +importFrom(bslib,sidebar) diff --git a/R/app.R b/R/app.R index afc6738..8cb6425 100644 --- a/R/app.R +++ b/R/app.R @@ -1,35 +1,185 @@ -#' @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({ - + 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({ + visIgraph(graph, randomSeed = 123) |> visNodes(color = "darkorange") |> - visEdges(color = "lightgrey", value = "source") |> - visOptions( - selectedBy = list(variable = "id"), - highlightNearest = TRUE + visEdges(color = list(color = "lightgrey", highlight = "red")) |> + visInteraction( + dragNodes = FALSE, + multiselect = TRUE, + selectConnectedEdges = FALSE ) |> - visInteraction(multiselect = TRUE) + visEvents( + select = "function(x) { + Shiny.onInputChange('net_data', x); + ;}" + ) + }) + + 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) < 2L) + + edge_df$label <- " " + + 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) + + path_by <- c(nodes[1], nodes[length(nodes)]) |> + paste(collapse = "~") |> + as.formula() + + include <- if(length(nodes) > 2L) nodes[2:(length(nodes) - 1)] else NULL + + 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_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 + ) + + if( input$focus ){ + + visNetworkProxy("network") |> + visFit(nodes = nodes) + } }) } -#' @importFrom shiny fluidPage -#' @importFrom visNetwork visNetworkOutput + +#' @importFrom bslib page_sidebar bs_theme sidebar ui <- function(){ - fluidPage( - visNetworkOutput("ariadne", height = "100vh", width = "100vw") + + graph <- ariadne() + + page_sidebar( + fillable = FALSE, + theme = bs_theme(bootswatch = "united"), + sidebar = sidebar( + + 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")) + ), + visNetworkOutput("network", height = "100vh", width = "100vw") ) } + #' @export -#' @importFrom shiny shinyApp shinePath <- function(){ shinyApp(ui = ui(), server = server) }