Added some slides with plots after meeting with BB

This commit is contained in:
Nora Wickelmaier 2023-11-02 14:24:06 +01:00
parent fb448f01a9
commit f6983f4412

View File

@ -60,7 +60,17 @@ addmargins(tab)
proportions(tab, margin = "artwork") proportions(tab, margin = "artwork")
proportions(tab, margin = "event") 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 # Proportion of events
proportions(xtabs( ~ event, dat)) 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[is.na(dat$complete), ]) / nrow(dat) 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 --------------- #--------------- (3) Process Mining ---------------
@ -174,6 +188,16 @@ alog <- activitylog(dat[dat$tod == "afternoon",],
map_as_pdf(alog, file = "../figures/pm_case-event_afternoon.pdf") 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 ### Weekdays and weekends
dat$wd <- ifelse(dat$weekdays %in% c("Saturday", "Sunday"), "weekend", "weekday") 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") 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 ### Weekdays vs. school vacation weekdays
dat$wds <- ifelse(!is.na(dat$vacation), "vacation", "school") 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") 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 ### Pre and post Corona
dat$corona <- ifelse(dat$date < "2020-03-14", "pre", "post") 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") 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 --------------- #--------------- (3.4) Artwork sequences ---------------
# Order in which artworks are looked at # 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? # Are there certain topics that people are interested in more than others?
# Do these topic distributions differ for comparable artworks? # 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 # Order of topics for Vermeer
# alog080 <- activitylog(dat[dat$artwork == "080",], # alog080 <- activitylog(dat[dat$artwork == "080",],
# case_id = "case", # 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")) { 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", case_id = "case",
activity_id = "topic", activity_id = "topic",
resource_id = "trace", resource_id = "trace",