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