Process_Mining_R_Healthcare/Process_Mining_R_test_data.R at main · RubyNixx/Process_Mining_R_Healthcare · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
install.packages("bupaverse")
install.packages("readxl")
install.packages("processanimateR")

library("bupaverse") #Process mining library for multiple packages https://cran.r-project.org/web/packages/bupaverse/index.html
library(readxl) #Reads a excel file to get data
library(processanimateR) # Used to animate process maps

##--Load Data-----------------------------------------------------------------

##Read a excel file to import data into R

##Note my data contains the following if you wanted to match the format:
##Event_ID, Local_Referral_ID, RTT_ID, Waiting_List_Type, Treatment_Function_Code, Referral_Source, Org_Code, RTT_Status, Event, Event_Date_Time

##The Event_ID is the unique identifier which is the same for 1 patients pathway.

data <- read_excel("C:/Users/RubyNicholls/Downloads/ArtificialPatientTreatment_Data.xlsx",
                                          col_types = c("numeric", "text", "text",
                                                         "numeric", "numeric", "text",
                                                     "text", "date"))

##View data that's been imported
View(data)

##--Prepare Data and Create Event Log---------------------------------------

## https://bupaverse.github.io/docs/create_logs.html

##Add a row number to data
data$row_num <- seq.int(nrow(data))

##Add column called lifecycle_id with text 'Start' against each row
data$lifecycle_id <- "Start"

##Create Event Log from data by selecting columns against the fields needed in event log
event_log <- data %>%
  eventlog(case_id = "Event_ID",
           activity_id = "Event",
           resource_id = "Organisation",
           activity_instance_id = "row_num",
           lifecycle_id = "lifecycle_id",
           timestamp = "Event_Date_Time")

##--Create different variations of static process maps-------------------------

## https://bupaverse.github.io/docs/frequency_maps.html

##Output a absolute frequency map (ie how many times each event has happened)
event_log %>%
  process_map(frequency("absolute"))

##Output a relative map (ie the % each pathway follows a set of events.)
event_log %>%
  process_map(frequency("relative"))

##Output a relative consequent map (ie what happens before each event. The % in the event itself will represent the % of activity out of all activity.)
event_log %>%
  process_map(frequency("relative-consequent"))

##Output a process map that shows average days between each event
event_log %>% process_map(performance(mean,"days"))

##Output a process map that shows maximum days between each event
event_log  %>% process_map(performance(FUN = max))


event_log %>% processing_time("activity") %>% plot()

##--Adjust to show percentile of static process maps and adjust visuals-------

# Create process map (top 70% traces) changing direction of output from top to bottom
## Codes - Instead of a left-right (LR) layout, the rankdir can be set to TB (top-bottom), BT (bottom-top) or RL (right-left).
event_log %>% filter_trace_frequency(percentage = 0.70) %>%
  process_map(type_nodes = frequency("absolute_case"),
              type_edges = performance(median, "hours", "inter_start_time"),
              sec_edges = frequency("relative"),
              rankdir="TB")


# Create process map (top 80% traces) and adjust the colours against  frequency and performance
event_log %>% filter_trace_frequency(percentage = 0.80) %>%
  process_map(type_nodes = frequency("absolute_case", color_scale = "PuBu"),
              type_edges = performance(median, "days", "inter_start_time", color_edges = "dodgerblue4"),
              sec_edges = frequency("relative"))

## Create a process map with % of cases & total cases for 80th percentile

event_log %>% filter_trace_frequency(percentage = 0.80) %>%
  process_map(type = frequency("relative_case"),
              sec = frequency("absolute"))

##--Combine measures on static process maps------------------------------------

## Both primary and secondary layers can be differentiated between nodes and edges.
event_log %>% filter_trace_frequency(percentage = 0.80) %>%
process_map(type_nodes =  frequency("relative_case"),
            type_edges = performance(units = "days"),
            sec_nodes = frequency("absolute"),
            sec_edges = performance(FUN = max, units = "days"))

##--Create animated process maps that visualise flow--------------------------

##Create data limited to 80th percentile
NHS_Process_Map <- event_log %>% filter_trace_frequency(percentage = 0.80)

##Create a process map to use for animation (using data limited to 80th percentile)
animate_process(NHS_Process_Map, mapping = token_aes(color = token_scale("red")))

##--Create a process matrix --------------------------------------------------
## shows a grid by event and how often they're found in your event data

## https://bupaverse.github.io/docs/process_matrix.html

event_log %>%
  process_matrix(frequency("absolute")) %>%
  plot()

##--Create dotted charts -----------------------------------------------------
## A dotted chart is a graph in which each activity instance is displayed by a dot. The x-axis refers to the time aspect, while the y-axis refers to cases

## https://bupaverse.github.io/docs/dotted_chart.html

##If you don't have time present in your dataset, then everything will default to your default date eg midnight
##----------------------------------------------------------------------------

event_log %>%
  dotted_chart(x = "absolute")

##-- Create a trace explorer

event_log%>%
trace_explorer(n_traces = 10,
               coverage_labels = c("cumulative", "relative"))