mtt_haum/code/09_user-navigation.R
2024-02-13 09:03:35 +01:00

206 lines
7.1 KiB
R

# 09_user_navigation.R
#
# content: (1) Read data
# (1.1) Read log event data
# (1.2) Extract additional infos for clustering
# (2) Clustering
# (3) Investigate variants
#
# input: results/haum/event_logfiles_2024-01-18_09-58-52.csv
# output: results/haum/event_logfiles_pre-corona_with-clusters_cases.csv
#
# last mod: 2024-02-07
# setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/analysis/code")
library(bupaverse)
library(factoextra)
#--------------- (1) Read data ---------------
#--------------- (1.1) Read log event data ---------------
dat0 <- read.table("results/haum/event_logfiles_2024-01-18_09-58-52.csv",
colClasses = c("character", "character", "POSIXct",
"POSIXct", "character", "integer",
"numeric", "character", "character",
rep("numeric", 3), "character",
"character", rep("numeric", 11),
"character", "character"),
sep = ";", header = TRUE)
dat0$event <- factor(dat0$event, levels = c("move", "flipCard", "openTopic",
"openPopup"))
dat0$weekdays <- factor(weekdays(dat0$date.start),
levels = c("Montag", "Dienstag", "Mittwoch",
"Donnerstag", "Freitag", "Samstag",
"Sonntag"),
labels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday",
"Sunday"))
# Select data pre Corona
dat <- dat0[as.Date(dat0$date.start) < "2020-03-13", ]
dat <- dat[dat$path != 106098, ]
#--------------- (1.2) Extract additional infos for clustering ---------------
datcase <- aggregate(cbind(duration, distance, scaleSize, rotationDegree) ~
case, dat, function(x) mean(x, na.rm = TRUE), na.action = NULL)
datcase$length <- aggregate(item ~ case, dat, length)$item
datcase$nitems <- aggregate(item ~ case, dat, function(x)
length(unique(x)), na.action = NULL)$item
datcase$npaths <- aggregate(path ~ case, dat, function(x)
length(unique(x)), na.action = NULL)$path
# datcase$ntopics <- aggregate(topic ~ case, dat,
# function(x) ifelse(all(is.na(x)), NA,
# length(unique(na.omit(x)))), na.action =
# NULL)$topic
datcase$vacation <- aggregate(vacation ~ case, dat,
function(x) ifelse(all(is.na(x)), 0, 1),
na.action = NULL)$vacation
datcase$holiday <- aggregate(holiday ~ case, dat,
function(x) ifelse(all(is.na(x)), 0, 1),
na.action = NULL)$holiday
datcase$weekend <- aggregate(weekdays ~ case, dat,
function(x) ifelse(any(x %in% c("Saturday", "Sunday")), 1, 0),
na.action = NULL)$weekdays
datcase$morning <- aggregate(date.start ~ case, dat,
function(x) ifelse(lubridate::hour(x[1]) > 13, 0, 1),
na.action = NULL)$date.start
datcase <- na.omit(datcase)
#--------------- (2) Clustering ---------------
df <- datcase[, c("duration", "distance", "scaleSize", "rotationDegree",
"length", "nitems", "npaths")] |>
scale()
#df <- cbind(df, datcase[, c("vacation", "holiday", "weekend", "morning")])
mat <- dist(df)
hc <- hclust(mat, method = "ward.D2")
grp <- cutree(hc, k = 6)
datcase$grp <- grp
table(grp)
fviz_cluster(list(data = df, cluster = grp),
palette = c("#78004B", "#000000", "#3CB4DC", "#91C86E",
"#FF6900", "#434F4F"),
ellipse.type = "convex",
show.clust.cent = FALSE, ggtheme = theme_bw())
aggregate(cbind(duration, distance, scaleSize , rotationDegree, length,
nitems, npaths) ~ grp, datcase, mean)
aggregate(cbind(duration, distance, scaleSize , rotationDegree, length,
nitems, npaths) ~ grp, datcase, median)
aggregate(cbind(duration, distance, scaleSize , rotationDegree, length,
nitems, npaths) ~ grp, datcase, max)
res <- merge(dat, datcase[, c("case", "grp")], by = "case", all.x = TRUE)
res <- res[order(res$fileId.start, res$date.start, res$timeMs.start), ]
xtabs( ~ item + grp, res)
# Look at clusters
vioplot::vioplot(duration ~ grp, res)
vioplot::vioplot(distance ~ grp, res)
vioplot::vioplot(scaleSize ~ grp, res)
vioplot::vioplot(rotationDegree ~ grp, res)
write.table(res,
file = "results/haum/event_logfiles_pre-corona_with-clusters_cases.csv",
sep = ";",
quote = FALSE,
row.names = FALSE)
#--------------- (3) Investigate variants ---------------
res$start <- res$date.start
res$complete <- res$date.stop
alog <- activitylog(res,
case_id = "case",
activity_id = "item",
resource_id = "path",
timestamps = c("start", "complete"))
trace_explorer(alog, n_traces = 25)
# --> sequences of artworks are just too rare
tr <- traces(alog)
trace_length <- sapply(strsplit(tr$trace, ","), length)
tr[trace_length > 10, ]
trace_varied <- sapply(strsplit(tr$trace, ","), function(x) length(unique(x)))
tr[trace_varied > 1, ]
table(tr[trace_varied > 2, "absolute_frequency"])
table(tr[trace_varied > 3, "absolute_frequency"])
summary(tr$absolute_frequency)
vioplot::vioplot(tr$absolute_frequency)
# Power law for frequencies of traces
tab <- table(tr$absolute_frequency)
x <- as.numeric(tab)
y <- as.numeric(names(tab))
plot(x, y, log = "xy")
p1 <- lm(log(y) ~ log(x))
pre <- exp(coef(p1)[1]) * x^coef(p1)[2]
lines(x, pre)
# Look at individual traces as examples
tr[trace_varied == 5 & trace_length > 50, ]
# --> every variant exists only once, of course
datcase[datcase$nitems == 5 & datcase$length > 50,]
sapply(datcase[, -c(1, 9)], median)
#ex <- datcase[datcase$nitems == 4 & datcase$length == 15,]
ex <- datcase[datcase$nitems == 5,]
ex <- ex[sample(1:nrow(ex), 20), ]
# --> pretty randomly chosen... TODO:
case_ids <- NULL
for (case in ex$case) {
if ("080" %in% res$item[res$case == case] | "503" %in% res$item[res$case == case]) {
case_ids <- c(case_ids, TRUE)
} else {
case_ids <- c(case_ids, FALSE)
}
}
cases <- ex$case[case_ids]
for (case in cases) {
alog <- activitylog(res[res$case == case, ],
case_id = "case",
activity_id = "item",
resource_id = "path",
timestamps = c("start", "complete"))
dfg <- process_map(alog,
type_nodes = frequency("absolute", color_scale = "Greys"),
type_edges = frequency("absolute", color_edges = "#FF6900"),
rankdir = "LR",
render = FALSE)
export_map(dfg,
file_name = paste0("results/processmaps/dfg_example_cases_", case, "_R.pdf"),
file_type = "pdf",
title = paste("Case", case))
}