From 26f90a7fec963dacad34aced8c7f6e93ef22caa6 Mon Sep 17 00:00:00 2001 From: nwickel Date: Mon, 18 Mar 2024 15:32:09 +0100 Subject: [PATCH] Some variable name and plot size adjustments --- code/07_item-clustering.R | 9 +++-- code/11_validation.R | 82 +++++++++++++++++++-------------------- 2 files changed, 46 insertions(+), 45 deletions(-) diff --git a/code/07_item-clustering.R b/code/07_item-clustering.R index 717c134..ddbea13 100644 --- a/code/07_item-clustering.R +++ b/code/07_item-clustering.R @@ -97,6 +97,7 @@ mycols <- c("#434F4F", "#78004B", "#FF6900", "#3CB4DC", "#91C86E", "Black") cluster <- cutree(hc, k = k) pdf("results/figures/dendrogram_items.pdf", width = 6.5, height = 5.5, pointsize = 10) +# TODO: Move code for plots to /thesis/ factoextra::fviz_dend(hc, k = k, cex = 0.5, @@ -182,10 +183,10 @@ coor_2d <- cmdscale(dist_mat, k = 2) items <- sprintf("%03d", as.numeric(rownames(datitem))) -#pdf("results/figures/clustering_artworks.pdf", height = 8, width = 8, pointsize = 10) -png("results/figures/clustering_artworks.png", units = "in", height = 8, width = 8, pointsize = 10, res = 300) +pdf("results/figures/clustering_artworks.pdf", height = 8, width = 8, pointsize = 16) +#png("results/figures/clustering_artworks.png", units = "in", height = 8, width = 8, pointsize = 16, res = 300) -par(mai = c(.4,.4,.1,.1), mgp = c(2.4, 1, 0)) +par(mai = c(.6,.6,.1,.1), mgp = c(2.4, 1, 0)) plot(coor_2d, type = "n", ylim = c(-3.7, 2.6), xlim = c(-5, 10.5), xlab = "", ylab = "") @@ -208,7 +209,7 @@ for (item in items) { points(x, y, col = mycols[cluster[items == item]], - cex = 9, + cex = 6, pch = 15) rasterImage(img, diff --git a/code/11_validation.R b/code/11_validation.R index 8561ec4..1623f1f 100644 --- a/code/11_validation.R +++ b/code/11_validation.R @@ -25,10 +25,10 @@ dat <- dat[as.Date(dat$date.start) > "2017-12-31" & #--------------- (2) Extract characteristics for cases --------------- -datcase <- aggregate(cbind(distance, scaleSize, rotationDegree) ~ +datcase18 <- aggregate(cbind(distance, scaleSize, rotationDegree) ~ case, dat, function(x) mean(x, na.rm = TRUE), na.action = NULL) -datcase$length <- aggregate(item ~ case, dat, length)$item +datcase18$length <- aggregate(item ~ case, dat, length)$item eventtab <- aggregate(event ~ case, dat, table)["case"] eventtab$nmove <- aggregate(event ~ case, dat, table)$event[, "move"] @@ -36,44 +36,44 @@ eventtab$nflipCard <- aggregate(event ~ case, dat, table)$event[, "flipCard"] eventtab$nopenTopic <- aggregate(event ~ case, dat, table)$event[, "openTopic"] eventtab$nopenPopup <- aggregate(event ~ case, dat, table)$event[, "openPopup"] -datcase <- datcase |> +datcase18 <- datcase18 |> merge(eventtab, by = "case", all = TRUE) rm(eventtab) -datcase$nitems <- aggregate(item ~ case, dat, function(x) +datcase18$nitems <- aggregate(item ~ case, dat, function(x) length(unique(x)), na.action = NULL)$item -datcase$npaths <- aggregate(path ~ case, dat, function(x) +datcase18$npaths <- aggregate(path ~ case, dat, function(x) length(unique(x)), na.action = NULL)$path dat_split <- split(dat, ~ case) dat_list <- pbapply::pblapply(dat_split, time_minmax_ms) dat_minmax <- dplyr::bind_rows(dat_list) -datcase$min_time <- aggregate(min_time ~ case, dat_minmax, unique)$min_time -datcase$max_time <- aggregate(max_time ~ case, dat_minmax, unique)$max_time +datcase18$min_time <- aggregate(min_time ~ case, dat_minmax, unique)$min_time +datcase18$max_time <- aggregate(max_time ~ case, dat_minmax, unique)$max_time -datcase$duration <- datcase$max_time - datcase$min_time -datcase$min_time <- NULL -datcase$max_time <- NULL +datcase18$duration <- datcase18$max_time - datcase18$min_time +datcase18$min_time <- NULL +datcase18$max_time <- NULL artworks <- unique(dat$item)[!unique(dat$item) %in% c("501", "502", "503")] -datcase$infocardOnly <- pbapply::pbsapply(dat_split, check_infocards, artworks = artworks) +datcase18$infocardOnly <- pbapply::pbsapply(dat_split, check_infocards, artworks = artworks) # Clean up NAs -datcase$distance <- ifelse(is.na(datcase$distance), 0, datcase$distance) -datcase$scaleSize <- ifelse(is.na(datcase$scaleSize), 1, datcase$scaleSize) -datcase$rotationDegree <- ifelse(is.na(datcase$rotationDegree), 0, datcase$rotationDegree) +datcase18$distance <- ifelse(is.na(datcase18$distance), 0, datcase18$distance) +datcase18$scaleSize <- ifelse(is.na(datcase18$scaleSize), 1, datcase18$scaleSize) +datcase18$rotationDegree <- ifelse(is.na(datcase18$rotationDegree), 0, datcase18$rotationDegree) #--------------- (3) Select features for navigation behavior --------------- -dattree18 <- data.frame(case = datcase$case, - PropItems = datcase$nitems / length(unique(dat$item)), - SearchInfo = (datcase$nopenTopic + - datcase$nopenPopup) / datcase$length, - PropMoves = datcase$nmove / datcase$length, - PathLinearity = datcase$nitems / datcase$npaths, - Singularity = datcase$npaths / datcase$length +dattree18 <- data.frame(case = datcase18$case, + PropItems = datcase18$nitems / length(unique(dat$item)), + SearchInfo = (datcase18$nopenTopic + + datcase18$nopenPopup) / datcase18$length, + PropMoves = datcase18$nmove / datcase18$length, + PathLinearity = datcase18$nitems / datcase18$npaths, + Singularity = datcase18$npaths / datcase18$length ) # centrality <- pbapply::pbsapply(dattree18$case, get_centrality, data = dat) @@ -97,10 +97,10 @@ dattree18$AvDurItem <- aggregate(duration ~ case, tmp, mean)$duration rm(tmp) # Indicator variable if table was used as info terminal only -dattree18$InfocardOnly <- factor(datcase$infocardOnly, levels = 0:1, +dattree18$InfocardOnly <- factor(datcase18$infocardOnly, levels = 0:1, labels = c("no", "yes")) -# Add pattern to datcase; loosely based on Bousbia et al. (2009) +# Add pattern dattree18$Pattern <- "Dispersion" dattree18$Pattern <- ifelse(dattree18$PathLinearity > 0.8, "Scholar", dattree18$Pattern) @@ -118,13 +118,13 @@ df <- dattree18[, c("PropItems", "SearchInfo", "PropMoves", "AvDurItemNorm", dist_mat18 <- cluster::daisy(df, metric = "gower") -coor_3d <- smacof::mds(dist_mat, ndim = 3, type = "ordinal")$conf -coor_2d <- coor_3d[, 1:2] +coor_3d_18 <- smacof::mds(dist_mat18, ndim = 3, type = "ordinal")$conf +coor_2d_18 <- coor_3d_18[, 1:2] -plot(coor_2d) -rgl::plot3d(coor_3d) +plot(coor_2d_18) +rgl::plot3d(coor_3d_18) -hc18 <- cluster::agnes(dist_mat, method = "ward") +hc18 <- cluster::agnes(dist_mat18, method = "ward") k <- 5 @@ -134,27 +134,27 @@ cluster18 <- cutree(as.hclust(hc18), k = k) table(cluster18) -plot(coor_2d, col = mycols[cluster18], pch = 16) +plot(coor_2d_18, col = mycols[cluster18], pch = 16) legend("topleft", c("Searching", "Exploring", "Scanning", "Flitting", "Info"), col = mycols, bty = "n", pch = 16) -rgl::plot3d(coor_3d, col = mycols[cluster18]) +rgl::plot3d(coor_3d_18, col = mycols[cluster18]) print(ftable(xtabs( ~ InfocardOnly + Pattern + cluster18, dattree18)), zero = "-") aggregate(. ~ cluster18, df, mean) aggregate(. ~ cluster18, dattree18[, -1], mean) -save(coor_2d, coor_3d, cluster18, dattree18, dist_mat18, hc18, +save(coor_2d_18, coor_3d_18, cluster18, dattree18, dist_mat18, hc18, file = "../../thesis/figures/data/clustering_cases_2018.RData") #--------------- (5) Fit tree --------------- c1 <- rpart::rpart(as.factor(cluster18) ~ ., data = dattree18[, c("PropMoves", - "PropItems", - "SearchInfo", - "AvDurItem", - "Pattern", - "InfocardOnly")], + "PropItems", + "SearchInfo", + "AvDurItem", + "Pattern", + "InfocardOnly")], method = "class") plot(partykit::as.party(c1), tp_args = list(fill = mycols, col = mycols)) @@ -164,11 +164,11 @@ plot(partykit::as.party(c1), tp_args = list(fill = mycols, col = mycols)) load("../../thesis/figures/data/clustering_cases.RData") c19 <- rpart::rpart(as.factor(cluster) ~ ., data = dattree[, c("PropMoves", - "PropItems", - "SearchInfo", - "AvDurItem", - "Pattern", - "InfocardOnly")], + "PropItems", + "SearchInfo", + "AvDurItem", + "Pattern", + "InfocardOnly")], method = "class") cl18 <- rpart:::predict.rpart(c1, type = "class", newdata = dattree18)