rshinyprocessmapr

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


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)

Solution

  • 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.