Worked on case clustering; becomes user navigation again ;)
This commit is contained in:
parent
98e62da5b8
commit
358d962f1e
@ -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)
|
|
||||||
|
|
||||||
221
code/09_user-navigation.R
Normal file
221
code/09_user-navigation.R
Normal file
@ -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))
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user