Some variable name and plot size adjustments
This commit is contained in:
parent
b08955b2c4
commit
26f90a7fec
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue