Hide and display multiple edges from process_map() using selectInput()

Question

I have the shiny app below in which I create a process map. What I want to do is subset this process map based on the transitions selectInput().

All the transitions can be seen from the obect edges which I extract from the process_map() object at the beginning but then how can I pass the selected from the selectInput() again to the process_map() object?what I acually need is to hide/display the edges between the nodes if deselect/select one transition pair.

This is how I make it work but I cannot make it work for multiple selection ,using multiple=T inside the selectInput().

library(shiny)
library(bupaR)
library(svgPanZoom)
library(DiagrammeRsvg)
library(DiagrammeR)
library(processmapR)

edges <- patients %>% process_map(performance(mean, "days"))
edges <- attr(edges, "edges")
colnames(edges)[1]<-"predecessor"
colnames(edges)[2]<-"successor"

graph <- process_map(patients
                     , type_nodes = frequency("absolute",color_scale = "Greys")
                     ,type_edges = frequency("absolute",color_edges = "Greys"),
                     rankdir = "LR", render = FALSE)

ui <-shinyUI(fluidPage(
  selectInput("tran","transitions"
              ,choices = c("All",paste(edges$predecessor,"-",edges$successor)),
              #multiple=T
              ,selected = "All"),
  svgPanZoomOutput("pmap",height = 500,width = 1600)
  
))
server <- function(input, output) {
  
  output$pmap <- renderSvgPanZoom({
    req(input$tran)
    
    if (input$tran != "All"){
      pre <- strsplit(input$tran, " - ")[[1]][[1]]
      suc <- strsplit(input$tran, " - ")[[1]][[2]]
      #creating copy of graph for processing
      ndf = get_node_df(graph)
      edf = get_edge_df(graph)
      newg = create_graph(nodes_df = ndf, edges_df = edf)
      newg$global_attrs <- graph$global_attrs
      
      #Finding edges to remove based on pre/suc nodes, selecting edge, removing
      #using startWith due termination chars being added
      from_nodes = newg %>% clear_selection() %>% 
        select_nodes(conditions = startsWith(tooltip,pre)) %>% get_selection()
      to_nodes = newg %>% clear_selection() %>% 
        select_nodes(conditions = startsWith(tooltip,suc)) %>% get_selection()
      newg <- newg %>% clear_selection() %>% 
        select_edges(from = from_nodes, to = to_nodes) %>% delete_edges_ws
      # newg %>% render_graph # debugging
    } else {
      newg <- graph
    }
    
    newg %>% generate_dot() %>% grViz(width = 1000, height = 2000) %>% 
      export_svg %>% svgPanZoom(height=800, controlIconsEnabled = TRUE)
  })
  
}
shinyApp(ui=ui,server=server)

score 1 · Accepted Answer · answered Sep 20 '22 at 02:04

The (naive) solution simply revolves around iterating over selected values and filtering the graph accordingly.

library(shiny)
library(bupaR)
library(svgPanZoom)
library(DiagrammeRsvg)
library(DiagrammeR)
library(processmapR)

edges <- patients %>% process_map(performance(mean, "days"))
edges <- attr(edges, "edges")
colnames(edges)[1]<-"predecessor"
colnames(edges)[2]<-"successor"

graph <- process_map(patients
                     , type_nodes = frequency("absolute",color_scale = "Greys")
                     ,type_edges = frequency("absolute",color_edges = "Greys"),
                     rankdir = "LR", render = FALSE)

ui <-shinyUI(fluidPage(
  checkboxGroupInput("tran","Filter Transitions"
              ,choices = paste(edges$predecessor,"-",edges$successor)),
  svgPanZoomOutput("pmap",height = 500,width = 1600)
  
))
server <- function(input, output) {
  
  output$pmap <- renderSvgPanZoom({
    if (all(!is.null(input$tran))){
      #creating copy of graph for processing
      ndf = get_node_df(graph)
      edf = get_edge_df(graph)
      newg = create_graph(nodes_df = ndf, edges_df = edf)
      newg$global_attrs <- graph$global_attrs
      
      for (t in input$tran){
        pre <- strsplit(t, " - ")[[1]][[1]]
        suc <- strsplit(t, " - ")[[1]][[2]]
        #Finding edges to remove based on pre/suc nodes, selecting edge, removing
        #using startWith due termination chars being added
        from_nodes = newg %>% clear_selection() %>% 
          select_nodes(conditions = startsWith(tooltip,pre)) %>% get_selection()
        to_nodes = newg %>% clear_selection() %>% 
          select_nodes(conditions = startsWith(tooltip,suc)) %>% get_selection()
        newg <- newg %>% clear_selection() %>% 
          select_edges(from = from_nodes, to = to_nodes) %>% delete_edges_ws
        # newg %>% render_graph # debugging
      }
    } else {
      newg <- graph
    }
    
    newg %>% generate_dot() %>% grViz(width = 1000, height = 2000) %>% 
      export_svg %>% svgPanZoom(height=800, controlIconsEnabled = TRUE)
  })
  
}
shinyApp(ui=ui,server=server)

Potential performance improvement would be to pre-calculate the edges selection, then the loop iteration would "just" take care of removing these.

I think I have located the issue https://stackoverflow.com/questions/75373046/select-and-exclude-edges-from-graph-in-a-shiny-app — firmo23, Feb 07 '23 at 12:01

Hide and display multiple edges from process_map() using selectInput()

1 Answers1

Linked