Introduce Weave tab

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,9 @@ Depends:
     visNetwork
 Imports:
     ariadne,
-    bslib
+    bslib,
+    data.table,
+    htmltools
 Suggests:
     BiocStyle,
     rmarkdown,

NAMESPACE

@@ -3,6 +3,15 @@
 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)
+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)

R/app.R

@@ -1,18 +1,19 @@
 
-#' @importFrom ariadne ariadne drawPath
+#' @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")) |>
@@ -27,61 +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,
@@ -90,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) |>
@@ -109,71 +113,158 @@ server <- function(input, output) {
                 edgesId = edges,
                 highlightEdges = FALSE
             )
-
-        if( input$focus ){
-
-            visNetworkProxy("network") |>
-                visFit(nodes = nodes)
-        }
+        # 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))
+    })
+    # 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")
+        }
+    )
 }
 
 
-#' @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()
 
     page_sidebar(
         fillable = FALSE,
         theme = bs_theme(bootswatch = "united"),
-        sidebar = sidebar(
+        sidebar = sidebar(navset_tab(
 
-            textInput("by", "Path:", placeholder = "from ~ to"),
+            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),
 
-            numericInput("k", "k:", value = 1, min = 1),
+                checkboxInput("focus", "Focus"),
+                checkboxInput("prune", "Prune"),
 
-            selectInput("include", "Include:", choices = V(graph)$name,
-                selected = NULL, multiple = TRUE),
+                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))),
 
-            selectInput("exclude", "Exclude:", choices = V(graph)$name,
-                selected = NULL, multiple = TRUE),
+                div(style = "margin-top: +20px"),
 
-            selectInput("resource", "Resource:",
-                choices = unique(E(graph)$source), selected = NULL,
-                multiple = TRUE),
+                downloadButton(outputId = "draw", label = "Draw",
+                    class = "btn-warning", icon = icon("pencil"),
+                    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),
 
-            tags$style(HTML("
-                .shiny-options-group .radio-inline {margin-right: 1rem;}
-            ")),
+                conditionalPanel(condition = "input.init_type == 'text'",
 
-            radioButtons(
-                "init_type", "Initial values as:", choices = c("text", "file"),
-                inline = TRUE,
-            ),
+                    selectizeInput("init_text", "Initial values:",
+                        choices = NULL, multiple = TRUE,
+                        options = list(create = TRUE))),
 
-            conditionalPanel(
-                condition = "input.init_type == 'text'",
+                conditionalPanel(condition = "input.init_type == 'file'",
 
-                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"))
-        ),
+                    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("threshold", "Threshold:", min = 0, max = 1,
+                        value = 0, step = 0.01, ticks = FALSE)),
+
+                downloadButton(outputId = "weave", label = "Weave",
+                    class = "btn-warning", icon = icon("pencil"),
+                    style = "float: right;")))),
+
         visNetworkOutput("network", height = "100vh", width = "100vw")
     )
 }