bupaR Docs | Animate Process Maps

---

Animate Process Maps

library(bupaverse)
library(processanimateR)

Here, we use the patients event log provided by the eventdataR package.

A basic animation with static color and token size:

animate_process(patients)

Default token color, size, or image can be changed as follows:

animate_process(patients, mapping = token_aes(size = token_scale(12), shape = "rect"))

animate_process(patients, mapping = token_aes(color = token_scale("red")))

The example animation on the top of this site:

animate_process(patients, mode = "relative", jitter = 10, legend = "color",
  mapping = token_aes(color = token_scale("employee", 
    scale = "ordinal", 
    range = RColorBrewer::brewer.pal(7, "Paired"))))

Tokens can also be assigned images, for example:

animate_process(patients,
   mapping = token_aes(shape = "image",
    size = token_scale(10),
    image = token_scale("https://upload.wikimedia.org/wikipedia/en/5/5f/Pacman.gif")))

Use external data

It is possible to use a secondary data frame to determine the aesthetics of tokens regardless of the timestamps at which activities occurred. This could be useful if some measurements were taken throughout a process, but the measurement event itself should not be included in the process map.

For example, the lacticacid measurements of the sepsis data set could be used in that way:

library(processanimateR)
library(dplyr)
library(bupaR)
# Extract only the lacticacid measurements
lactic <- sepsis %>%
    mutate(lacticacid = as.numeric(lacticacid)) %>%
    filter_activity(c("LacticAcid")) %>%
    as.data.frame() %>%
    select("case" = case_id, 
            "time" =  timestamp, 
            value = lacticacid) # format needs to be 'case,time,value'

# Remove the measurement events from the sepsis log
sepsisBase <- sepsis %>%
    filter_activity(c("LacticAcid", "CRP", "Leucocytes", "Return ER",
                      "IV Liquid", "IV Antibiotics"), reverse = T) %>%
    filter_trace_frequency(percentage = 0.95)

# Animate with the secondary data frame `lactic`
animate_process(sepsisBase, 
                mode = "relative", 
                duration = 300,
                legend = "color", 
                mapping = token_aes(color = token_scale(lactic, 
                                                        scale = "linear", 
                                                        range = c("#fff5eb","#7f2704")))) 

processanimateR animation can be also used interactively as part of a (Shiny) web-application. Here, an example application that expects attributes are of an appropriate data type and automatically chooses appropriate color scales is given. We first define a function ianimate_process() that defines our Shiny application as follows:

Shiny

library(processanimateR)
library(shiny)
library(shinycssloaders)
ianimate_process <- function(eventlog, min.time = 30, max.time = 600, default.time = 60) {

  ui <- function(request) {
    fluidPage(
      tags$head(tags$style("#process{height:90vh !important;}")),
      titlePanel("Hello processanimateR!"),

      sidebarLayout(

        sidebarPanel(
          width = 2,
          sliderInput("duration", "Animation duration", min.time, max.time, default.time),
          selectInput("type", "Animation type", c("relative", "absolute"), "relative"),
          selectInput("sizeAttribute", "Size attribute", c("none", colnames(eventlog)), "none"),
          selectInput("colorAttribute", "Color attribute", c("none", colnames(eventlog)), "none"),
          selectInput("orientation", "Orientation", c("horizontal"="LR", "vertical"="TB"), "horizontal"),
          h4("Selected cases"),
          textOutput("token_selection"),
          h4("Selected activities"),
          textOutput("activity_selection")
        ),

        mainPanel(
          width = 10,
          shinycssloaders::withSpinner(processanimaterOutput("process"))
        )
      )
    )
  }

  server <- function(session, input, output) {

    data <- reactive({

      if (input$colorAttribute != "none") {
        attr <- rlang::sym(input$colorAttribute)
        val <- eventlog %>% pull(!!attr)
        if (!(is.character(val) || is.factor(val))) {
          warning("Trying to use a numeric attribute for the token color!")
        }
      }

      if (input$sizeAttribute != "none") {
        # This only works for numeric attributes
        attr <- rlang::sym(input$sizeAttribute)
        val <- eventlog %>% pull(!!attr)
        if (!is.numeric(val)) {
          warning("Trying to use a non-numeric attribute for the token size!")
        }
      }

      eventlog

    })

    output$token_selection <- renderText({

      paste0(input$process_tokens, ",")

    })

    output$activity_selection <- renderText({

      paste0(input$process_activities, ",")

    })

    output$process <- renderProcessanimater(expr = {
      graph <- processmapR::process_map(data(), render = F)
      model <- DiagrammeR::add_global_graph_attrs(graph, attr = "rankdir", value = input$orientation, attr_type = "graph")
      if (input$sizeAttribute != "none" && input$colorAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "color",
                        mapping = token_aes(color = token_scale(input$colorAttribute, scale = "ordinal", 
                                                                range = RColorBrewer::brewer.pal(5, "YlOrBr")),
                                            size = token_scale(input$sizeAttribute, scale = "linear", range = c(6,10))),
                        duration = input$duration)
      } else if (input$sizeAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "size",
                        mapping = token_aes(size = token_scale(input$sizeAttribute, scale = "linear", range = c(6,10))),
                        duration = input$duration)

      } else if (input$colorAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "color",
                        mapping = token_aes(color = token_scale(input$colorAttribute, scale = "ordinal", range = RColorBrewer::brewer.pal(5, "YlOrBr"))),
                        duration = input$duration)
      } else {
        animate_process(data(), model,
                        mode = input$type,
                        duration = input$duration)
      }

    })

  }

  shinyApp(ui, server, options = list(height = 500))

}

Then, the application can be, for example, launched by calling:

library(eventdataR)
library(edeaR)
library(dplyr)
ianimate_process(sepsis %>%
  filter_trace_frequency(percentage = 0.2) %>%
  filter_activity(c("Return ER"), reverse = T) %>%
  # we fix the datatype of some of the attributes to allow proper rendering of the token color
  # the token size option currently only support numeric attributes
  mutate_at(c("lacticacid", "leucocytes", "crp", "age"), as.numeric) %>%
  mutate_at(c("disfuncorg", "sirscriteria2ormore", "infectionsuspected"), as.logical))

Selections

Selections made in the processanimateR animation can be used as input by Shiny applications. Here a simple example in which a Shiny module is created that renders the case identifiers of selected tokens and the identifiers and names of selected activities:

library(shiny)
library(processanimateR)
library(eventdataR)
library(jsonlite)

shinyAnimation <- function(eventlog, min.time = 30, max.time = 600, default.time = 60) {

  # Define Shiny Module
  animationUI <- function(id, title) {
    ns <- NS(id)
    tagList(
      h2(title),
      processanimaterOutput(ns("process")),
      h4("Selected cases"),
      textOutput(ns("token_selection")),
      h4("Selected activities"),
      textOutput(ns("activity_selection")),
      h4("Current time"),
      textOutput(ns("activity_time"))
    )
  }

  animation <- function(input, output, session, ...) {

    output$token_selection <- renderText({
      if (is.null(input$process_tokens)) {
        "None"
      } else {
        paste0(input$process_tokens, collapse = ",")
      }
    })

    output$activity_selection <- renderText({
      if (is.null(input$process_activities)) {
        "None"
      } else {
        activities <- jsonlite::fromJSON(input$process_activities)
        paste0("(", activities$id, ",", activities$activity, ")", collapse = ",")
      }
    })
    
    output$activity_time <- renderText({
      if (is.null(input$process_time)) {
        "0"
      } else {
        input$process_time
      }
    })    

    output$process <- renderProcessanimater(expr = {
      animate_process(eventlog, ...)
    })

  }

  ui <- fluidPage(
    animationUI("module1", "Relative"),
    animationUI("module2", "Absolute")
  )

  # Two animations
  server <- function(input, output, session) {
    callModule(animation, "module1", mode = "relative")
    callModule(animation, "module2")
  }

  shinyApp(ui, server, options = list(height = 500))

}

shinyAnimation(patients)

User defined bins

Contributed by Dominic Rowney.

It is possible to change the aesthetics of tokens based on the timestamp of the animation.

For example, the number of days a ‘patient’ has been in the system.

# Libraries ---------------------------------------------------------------
library(dplyr)            ##pipes
library(tidyr)            ##tidy data, partcularly the crossing() function

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:processcheckR':
## 
##     contains

library(lubridate)        ##date time manipulation

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(bupaR)            ##buisness process analytics
library(processanimateR)  ##animates process


# Create performance time flags ------------------------------------------------
my_flags <- data.frame(value = c(0,2,4,8,16)) %>% 
            mutate(day = days(value)) #convert numeric value into days

This will change the colour of the token at 0, 2, 4, 8, and 16 days.

crossing() joins the cases from patients to my_flags and creates all possible combinations.

# Create timestamps of flags ----------------------------------------------

my_timeflags <- patients %>% 
                cases %>%
                crossing(my_flags) %>% ##similar to a SQL outer join
                mutate(time = start_timestamp + day) %>% 
                filter(time <= complete_timestamp) %>% 
                select("case" = patient,time,value) ##must be case, time, value

The data for the token_scale() must have the column headings ‘case, time, value’.

Without setting domain = my_flags$value the flags follow alphabetic order (e.g. 0, 16, 2, 4, 8) rather than the numeric order we want. See d3-legend for further information.

# Animate process ---------------------------------------------------------

patients %>%
  animate_process(mode ="absolute",
                  jitter=10,
                  legend = "color", 
                  mapping = token_aes(
                    color = token_scale(my_timeflags
                                        , scale = "ordinal"
                                        , domain = my_flags$value
                                        , range = rev(RColorBrewer::brewer.pal(5,"Spectral"))
                    )))

The colors can be adjusted by the range argument. In this case the scale is reversed with rev() to go from blue to red. See RColorBrewer::brewer.pal.info for all options:

Acknowledgement

Thanks to Dominic Rowney for this nice example of an advanced processanimateR usage. The original example code can be found here.

Token scales

Several aesthetics of tokens (color, size, opacity, image) can be dynamically determined based on event log attributes using D3 scales.

Ordinal scales

animate_process(patients, 
                legend = "color", 
                mapping = token_aes(color = token_scale("employee", 
                                                        scale = "ordinal", 
                                                        range = RColorBrewer::brewer.pal(8, "Paired"))))

Linear scales

animate_process(sample_n(traffic_fines, 1000) %>% filter_trace_frequency(percentage = 0.95),
                mode = "relative",
                legend = "color", 
                mapping = token_aes(color = token_scale("amount", 
                                                        scale = "linear", 
                                                        range = c("yellow","red"))))

Time scales

animate_process(patients, 
                mapping = token_aes(color = token_scale("time", 
                                                        scale = "time", 
                                                        range = c("blue","red"))))

Source: https://bupaverse.github.io/processanimateR/

---

Read more:

Frequency Maps Performance Maps Advanced Maps Animate Maps Process Matrix Dotted Chart Trace Explorer Performance Spectrum

---

Copyright © 2023 bupaR - Hasselt University