diff --git a/DESCRIPTION b/DESCRIPTION index bb7cec4..bb48aa4 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,9 @@ Depends: visNetwork Imports: ariadne, - bslib + bslib, + data.table, + htmltools Suggests: BiocStyle, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 8162d16..bda2d8f 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/app.R b/R/app.R index 8cb6425..764f518 100644 --- a/R/app.R +++ b/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,17 +113,66 @@ 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() @@ -127,53 +180,91 @@ ui <- function(){ 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") ) }