rprocessmapr

Control Edges in Processmap

library(processmapR)
library(lgr)
library(eventdataR)
library(dplyr)
library(rpart)
library(readxl)
library(processmapR)
library(bupaR)
library(processanimateR)
library(reshape2)
library(yaml)
library(ggplot2)
library(openxlsx)
library(DiagrammeR)
library(pmap)


positions <- data.frame(act = c("ARTIFICIAL_START", "Registration",  "Triage and Assessment", "X-Ray", "Blood test", "MRI SCAN", "Discuss Results", "Check-out", "ARTIFICIAL_END"),
                        x = c(1,3,4,4,8,6,4,8,9),
                        y = c(9,9,8,6,5,4,3,2,1),
                        stringsAsFactors = F
)
graph = process_map(patients, layout = layout_pm(positions), render = TRUE)

graph

Here, I determine the positions for the nodes, I want to do the same for the edges. Akin to determining certain points they have to cross besides the position of the from and to.

How can I determine the positions of edges?

How it is right now:

enter image description here

How I want it to be for example:

enter image description here

Solution

  • I found a way. It might not be the most elegant but for me it does the trick. If anyone knows a less complicated option i'd love to hear about it of course.

    library(shiny)
library(shinydashboard)

# Define UI
ui <- dashboardPage(
  dashboardHeader(title = "My Shiny Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Graph", tabName = "graph")
      
    )
  ),
  dashboardBody(
    tags$head(
      tags$script(HTML(
        '
        Shiny.addCustomMessageHandler("updatePathD", function(newD) {
          var path = $("g#edge10 path");
          path.attr("d", newD);
        });
        Shiny.addCustomMessageHandler("updateTextY", function(newY) {
          var text = $("g#edge10 text");
          text.attr("y", newY);
        });
        
        '
      ))
    ),
    tabItems(
      tabItem(
        tabName = "graph",
        fluidRow(
          box(
            title = "Graph Output",
            status = "primary",
            solidHeader = TRUE,
            processMapOutput("plot"),
            actionButton("changePathBtn", "Change Path")
          )
        )
      )
      
    )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  
  output$plot <- renderProcessMap({
    patients%>%process_map
    
    patients$handling%>%unique
    
    
    positions <- data.frame(act = c("ARTIFICIAL_START", "Registration",  "Triage and Assessment", "X-Ray", "Blood test", "MRI SCAN", "Discuss Results", "Check-out", "ARTIFICIAL_END"),
                            x = c(1,3,4,4,8,6,4,8,9),
                            y = c(9,9,8,6,5,4,3,2,1),
                            stringsAsFactors = F
    )
    graph = process_map(patients, layout = layout_pm(positions), render = F)
    
    
    render_graph(graph)
  })
  observeEvent(input$changePathBtn, {
    
    new_d <- "M250.0266,-508.0903 L250.0266,-550.0435 L500.1703,-550.0435 L500.1703,-300.0559"
    session$sendCustomMessage("updatePathD", new_d)
    newY="-552.9746"
    session$sendCustomMessage("updateTextY", newY)
  })
}
 shinyApp(ui = ui, server = server)

    Result