From f6983f44122939b3026c25095fae5865f95e2886 Mon Sep 17 00:00:00 2001
From: nwickel <n.wickelmaier@iwm-tuebingen.de>
Date: Thu, 2 Nov 2023 14:24:06 +0100
Subject: [PATCH] Added some slides with plots after meeting with BB

---
 code/00_current-anaylsis.R | 67 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 65 insertions(+), 2 deletions(-)

diff --git a/code/00_current-anaylsis.R b/code/00_current-anaylsis.R
index 36f0b20..2db5af9 100644
--- a/code/00_current-anaylsis.R
+++ b/code/00_current-anaylsis.R
@@ -60,7 +60,17 @@ addmargins(tab)
 proportions(tab, margin = "artwork")
 proportions(tab, margin = "event")
 
-barplot(t(proportions(tab, margin = "artwork")), las = 2)
+cc <- palette.colors(palette = "Okabe-Ito")[c(3,2,4,8)]
+
+pdf("../figures/event-dist.pdf", height = 3.375, width = 12, pointsize = 10)
+par(mai = c(.4,.4,.1,.1), mgp = c(2.4, 1, 0))
+
+barplot(t(proportions(tab, margin = "artwork")), las = 2, col = cc,
+        legend.text = levels(dat$event), args.legend = list(x = "bottomleft", bg = "white"))
+
+dev.off()
+
+#barchart(proportions(tab, margin = "artwork"), las = 2)
 
 # Proportion of events
 proportions(xtabs( ~ event, dat))
@@ -74,6 +84,10 @@ colMeans(proportions(tab, margin = "artwork"))
 nrow(dat[is.na(dat$complete), ])
 nrow(dat[is.na(dat$complete), ]) / nrow(dat)
 
+# Proportion of events spanning more than one log file
+sum(dat$fileId.start != dat$fileId.stop, na.rm = TRUE)
+sum(dat$fileId.start != dat$fileId.stop, na.rm = TRUE) / nrow(dat)
+
 
 #--------------- (3) Process Mining ---------------
 
@@ -174,6 +188,16 @@ alog <- activitylog(dat[dat$tod == "afternoon",],
 
 map_as_pdf(alog, file = "../figures/pm_case-event_afternoon.pdf")
 
+# Are the same artworks looked at?
+pdf("../figures/bp_tod.pdf", height = 3.375, width = 12, pointsize = 10)
+par(mai = c(.5,.6,.1,.1), mgp = c(2.4, 1, 0))
+
+barplot(proportions(xtabs( ~ tod + artwork, dat), margin = "tod"), #col = cc[1:2],
+        las = 2, beside = TRUE, legend = c("afternoon", "morning"),
+        args.legend = list(x = "topleft"))
+
+dev.off()
+
 ### Weekdays and weekends
 
 dat$wd <- ifelse(dat$weekdays %in% c("Saturday", "Sunday"), "weekend", "weekday")
@@ -194,6 +218,16 @@ alog <- activitylog(dat[dat$wd == "weekday",],
 
 map_as_pdf(alog, file = "../figures/pm_case-event_weekday.pdf")
 
+# Are the same artworks looked at?
+pdf("../figures/bp_wd.pdf", height = 3.375, width = 12, pointsize = 10)
+par(mai = c(.5,.6,.1,.1), mgp = c(2.4, 1, 0))
+
+barplot(proportions(xtabs( ~ wd + artwork, dat), margin = "wd"),
+        las = 2, beside = TRUE, legend = c("weekday", "weekend"),
+        args.legend = list(x = "topleft"))
+
+dev.off()
+
 ### Weekdays vs. school vacation weekdays
 
 dat$wds <- ifelse(!is.na(dat$vacation), "vacation", "school")
@@ -215,6 +249,17 @@ alog <- activitylog(dat[which(dat$wds == "vacation"),],
 
 map_as_pdf(alog, file = "../figures/pm_case-event_vacation.pdf")
 
+# Are the same artworks looked at?
+pdf("../figures/bp_wds.pdf", height = 3.375, width = 12, pointsize = 10)
+par(mai = c(.5,.6,.1,.1), mgp = c(2.4, 1, 0))
+
+#barplot(xtabs( ~ wds + artwork, dat), las = 2, beside = TRUE,
+barplot(proportions(xtabs( ~ wds + artwork, dat), margin = "wds"),
+        las = 2, beside = TRUE,
+        legend = c("school", "vacation"), args.legend = list(x = "topleft"))
+
+dev.off()
+
 ### Pre and post Corona
 
 dat$corona <- ifelse(dat$date < "2020-03-14", "pre", "post")
@@ -235,6 +280,16 @@ alog <- activitylog(dat[which(dat$corona == "post"),],
 
 map_as_pdf(alog, file = "../figures/pm_case-event_post-corona.pdf")
 
+# Are the same artworks looked at?
+pdf("../figures/bp_corona.pdf", height = 3.375, width = 12, pointsize = 10)
+par(mai = c(.5,.6,.1,.1), mgp = c(2.4, 1, 0))
+
+barplot(proportions(xtabs( ~ corona + artwork, dat), margin = "corona"),
+        las = 2, beside = TRUE,
+        legend = c("post", "pre"), args.legend = list(x = "topleft"))
+
+dev.off()
+
 #--------------- (3.4) Artwork sequences ---------------
 # Order in which artworks are looked at
 
@@ -276,6 +331,14 @@ map_as_pdf(alog, file = "../figures/pm_case-artwork_often080.pdf")
 # Are there certain topics that people are interested in more than others?
 # Do these topic distributions differ for comparable artworks?
 
+alog <- activitylog(dat[which(dat$event == "openTopic"),],
+                    case_id = "case",
+                    activity_id = "topic",
+                    resource_id = "trace",
+                    timestamps = c("start", "complete"))
+
+map_as_pdf(alog, file = "../figures/pm_case-topic.pdf")
+
 # Order of topics for Vermeer
 # alog080 <- activitylog(dat[dat$artwork == "080",],
 #                     case_id = "case",
@@ -312,7 +375,7 @@ which(rowSums(xtabs( ~ artwork + topic, dat[dat$topic %in%
 
 for (art in c("037", "046", "062", "080", "083", "109")) {
 
-  alog <- activitylog(dat[dat$artwork == art,],
+  alog <- activitylog(dat[dat$event == "openTopic" & dat$artwork == art,],
                       case_id = "case",
                       activity_id = "topic",
                       resource_id = "trace",