From 358d962f1e3c4424fd68c764254fa3eae95e5a87 Mon Sep 17 00:00:00 2001 From: nwickel Date: Mon, 5 Feb 2024 18:00:33 +0100 Subject: [PATCH] Worked on case clustering; becomes user navigation again ;) --- code/09_case-clustering.R | 113 ------------------- code/09_user-navigation.R | 221 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 221 insertions(+), 113 deletions(-) delete mode 100644 code/09_case-clustering.R create mode 100644 code/09_user-navigation.R diff --git a/code/09_case-clustering.R b/code/09_case-clustering.R deleted file mode 100644 index ac5c802..0000000 --- a/code/09_case-clustering.R +++ /dev/null @@ -1,113 +0,0 @@ -# 09_case-clustering.R -# -# content: (1) Read data -# (1.1) Read log event data -# (1.2) Extract additional infos for clustering -# (2) Clustering -# -# 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-04 - - -# 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")) - -# 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() -mat <- dist(df) - -hc <- hclust(mat, method = "ward.D2") - -grp <- cutree(hc, k = 6) -datcase$grp <- grp - -table(grp) - -# k1 <- kmeans(mat, 4) -# datcase$kcluster <- k1$cluster - -set.seed(1658) -ids <- sample(rownames(df), 5000) - -fviz_cluster(list(data = df[ids, ], cluster = grp[ids]), - 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, 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), ] - -# 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) - diff --git a/code/09_user-navigation.R b/code/09_user-navigation.R new file mode 100644 index 0000000..1c5f0e5 --- /dev/null +++ b/code/09_user-navigation.R @@ -0,0 +1,221 @@ +# 09_case-clustering.R +# +# content: (1) Read data +# (1.1) Read log event data +# (1.2) Extract additional infos for clustering +# (2) Clustering +# +# 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-04 + + +# 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") +hc <- hclust(mat) + +grp <- cutree(hc, k = 3) +datcase$grp <- grp + +table(grp) + +# k1 <- kmeans(mat, 4) +# datcase$kcluster <- k1$cluster + +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) + +# Look at 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 = 30) +# --> 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"]) + +longest_case <- datcase[datcase$length == max(datcase$length), "case"] + +alog_often <- activitylog(res[res$case == longest_case, ], + case_id = "case", + activity_id = "item", + resource_id = "path", + timestamps = c("start", "complete")) + +process_map(alog_often) + +# Power law for frequencies of traces +tab <- table(tr$absolute_frequency) +x <- as.numeric(tab) +y <- as.numeric(names(tab)) +plot(log(y) ~ log(x)) +abline(lm(log(y) ~ log(x))) + +# 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 == 10 & datcase$length == 30,] +# --> pretty randomly chosen... TODO: + +for (case in ex$case) { + + 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)) + + +} + +## --> not interesting! +# Just "flipCard" +res_case <- res[!duplicated(res[, c("case", "path")]), ] + +for (case in ex$case) { + + alog <- activitylog(res_case[res_case$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, "_fc_R.pdf"), + file_type = "pdf", + title = paste("Single case", case)) + + +} + +