Worked on talk for next meeting with AK

code/00_current-anaylsis.R

@@ -19,9 +19,37 @@ library(bupaverse)
 # Overall Research Question: How do museum visitors interact with the
 # artworks presented on the MTT?
 
+#---------------------------------------------------------------------------
+# https://billster45.github.io/rapid_r_data_vis_book/process-mining.html
+# TODO: checkout different specifications for process maps:
+
+# edeaR::filter_trace_frequency(percentage = 0.9)
+
+# processmapR::process_map(type_nodes = processmapR::frequency("absolute"),
+#                            sec_nodes = processmapR::frequency("relative"),
+#                            type_edges = processmapR::frequency("absolute"),
+#                            sec_edges = processmapR::frequency("relative"),
+#                            rankdir = "TB")
+
+# processmapR::trace_explorer(coverage = 1,
+#                               type = "frequent",
+#                               .abbreviate = T)
+
+# edeaR::resource_frequency("resource-activity") %>%
+#   plot()
+
+# edeaR::resource_frequency(level = "case") %>%
+#   plot()
+
+# edeaR::resource_specialisation(level = "activity") %>%
+#   plot()
+
+# Functions for conformance checking:
+#   https://bupaverse.github.io/processcheckR/
+
+#---------------------------------------------------------------------------
 
 
-# What about popups?
 
 
 # Distribution of bursts
@@ -93,8 +121,11 @@ sum(dat$fileId.start != dat$fileId.stop, na.rm = TRUE) / nrow(dat)
 
 #--------------- (3.1) Check data quality ---------------
 
+dat$trace2 <- dat$trace
+dat$trace <- NULL
+
 alog <- activitylog(dat,
-                    case_id = "trace",
+                    case_id = "trace2",
                     activity_id = "event",
                     #resource_id = "case",
                     resource_id = "artwork",
@@ -103,6 +134,37 @@ alog <- activitylog(dat,
 # process_map(alog, frequency("relative"))
 map_as_pdf(alog, file = "../figures/pm_trace-event.pdf")
 
+alogf <- edeaR::filter_trace_frequency(alog, percentage = 0.9)
+
+processmapR::process_map(alogf,   # alog,
+                         type_nodes = processmapR::frequency("absolute"),
+                         sec_nodes  = processmapR::frequency("relative"),
+                         type_edges = processmapR::frequency("absolute"),
+                         sec_edges  = processmapR::frequency("relative"),
+                         rankdir    = "TB")
+
+alog_no_move <- alog[alog$event != "move", ]
+set.seed(1447)
+processmapR::trace_explorer(alog_no_move[alog_no_move$trace2 %in%
+                            sample(unique(alog_no_move$trace2), 400),],
+                            coverage = 1, type = "frequent",
+                            abbreviate = T)
+
+ra_no_move <- edeaR::resource_frequency(alog_no_move, "resource-activity")
+levels(ra_no_move$event) <- c("flipCard", "flipCard", "openTopic", "openPopup")
+plot(ra_no_move)
+
+ra <- edeaR::resource_frequency(alog, "resource-activity")
+plot(ra)
+
+heatmap(xtabs(relative_activity ~ artwork + event, ra))
+heatmap(xtabs(relative_resource ~ artwork + event, ra_no_move))
+heatmap(xtabs(relative_activity ~ artwork + event, ra_no_move))
+
+aggregate(relative_activity ~ event, ra, sum)
+aggregate(relative_resource ~ artwork, ra, sum)
+
+
 #--------------- (3.2) Interactions for different artworks ---------------
 # Do interaction patterns for events per trace look different for different
 # artworks?
@@ -412,14 +474,28 @@ tmp <- dat[dat$date == "2017-02-12", ]
 rowSums(xtabs( ~ case + trace, tmp) != 0)
 
 range(tmp$start)
-startcut <- cut(tmp$start, 7)
+hours <- lubridate::hour(tmp$start)
-xtabs( ~ case + startcut, tmp)
+xtabs( ~ case + hours, tmp)
 
 # distribution of cases over the day
-colSums(xtabs( ~ case + startcut, tmp) != 0)
+colSums(xtabs( ~ case + hours, tmp) != 0)
-barplot(colSums(xtabs( ~ case + startcut, tmp) != 0))
+barplot(colSums(xtabs( ~ case + hours, tmp) != 0))
+
+aggregate(trace ~ case + hours, tmp, length)
+
+
+
+
+tmp <- aggregate(trace2 ~ case, dat, length)
+tmp$date <- as.Date(dat[!duplicated(dat$case), "start"])
+tmp$time <- lubridate::hour(dat[!duplicated(dat$case), "start"])
+
+tmp[tmp$trace2 > 200, ]
+
+plot(trace2 ~ time, tmp, cex = 2, col = rgb(0,0,0,.3))
+
+lattice::barchart(trace2 ~ time, tmp, horizontal=F)
 
-aggregate(trace ~ case + startcut, tmp, length)
 
 
 ###########################################################################

code/03_plots_haum.R

@@ -210,8 +210,8 @@ pdf("../figures/fun_depend_mtt.pdf", width = 8, height = 4, pointsize = 10)
 foodweb(where = "package:mtt",
         prune = c("parse_logfiles", "create_eventlogs", "extract_artworks",
                   "extract_topics", "add_topic"),
-        expand.ybox = 1.8, #cex = .6,
+        #expand.ybox = 1.8, #cex = .6,
-        border = TRUE,
+        #border = TRUE,
         #boxcolor = "gray",
         lwd = 2, mai = c(0, 0, 0, 0))
 dev.off()