Removed add_topic function and changed topicNumber to topic

This commit is contained in:
Nora Wickelmaier 2024-01-02 13:29:25 +01:00
parent a61d56b9cb
commit 1d31527a3f
4 changed files with 10 additions and 56 deletions

View File

@ -9,21 +9,21 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
"move" = { "move" = {
actions <- c("Transform start", "Transform stop") actions <- c("Transform start", "Transform stop")
idvar <- c("folder", "eventId", "artwork", "glossar") idvar <- c("folder", "eventId", "artwork", "glossar")
drop <- c("popup", "topicNumber", "trace", "event") drop <- c("popup", "topic", "trace", "event")
ncol <- 18 ncol <- 18
}, },
"flipCard" = { "flipCard" = {
actions <- c("Show Info", "Show Front") actions <- c("Show Info", "Show Front")
idvar <- c("folder", "trace", "eventId", "artwork", "glossar") idvar <- c("folder", "trace", "eventId", "artwork", "glossar")
drop <- c("popup", "topicNumber", "event") drop <- c("popup", "topic", "event")
ncol <- 19 ncol <- 19
}, },
"openTopic" = { "openTopic" = {
actions <- c("Artwork/OpenCard", "Artwork/CloseCard") actions <- c("Artwork/OpenCard", "Artwork/CloseCard")
idvar <- c("folder", "eventId", "trace", "glossar", idvar <- c("folder", "eventId", "trace", "glossar",
"artwork", "topicNumber") "artwork", "topic")
drop <- c("popup", "event") drop <- c("popup", "event")
ncol <- 20 ncol <- 20
@ -32,9 +32,9 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
actions <- c("ShowPopup", "HidePopup") actions <- c("ShowPopup", "HidePopup")
idvar <- c("folder", "eventId", "trace", "glossar", idvar <- c("folder", "eventId", "trace", "glossar",
"artwork", "popup") "artwork", "popup")
drop <- c("topicNumber", "event") drop <- c("topic", "event")
ncol <- 20 ncol <- 20
# TODO: Should topicNumber maybe also be filled in for "openPopup"? # TODO: Should topic maybe also be filled in for "openPopup"?
} }
) )
@ -158,7 +158,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
c("fileId.start", "fileId.stop", "folder", "event", c("fileId.start", "fileId.stop", "folder", "event",
"artwork", "trace", "glossar", "date.start", "artwork", "trace", "glossar", "date.start",
"date.stop", "timeMs.start", "timeMs.stop", "date.stop", "timeMs.start", "timeMs.stop",
"duration", "topicNumber", "popup", "x.start", "duration", "topic", "popup", "x.start",
"y.start", "x.stop", "y.stop", "distance", "y.start", "x.stop", "y.stop", "distance",
"scale.start", "scale.stop", "scaleSize", "scale.start", "scale.stop", "scaleSize",
"rotation.start", "rotation.stop", "rotationDegree")] "rotation.start", "rotation.stop", "rotationDegree")]
@ -237,7 +237,7 @@ add_variables <- function(data_split_wide, ncol,
}, },
"openTopic" = { "openTopic" = {
data_split_wide <- data_split_wide[, c("folder", "artwork", data_split_wide <- data_split_wide[, c("folder", "artwork",
"topicNumber", "topic",
"glossar", "trace", "glossar", "trace",
"eventId", "eventId",
"fileId.start", "fileId.start",

View File

@ -63,7 +63,7 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar", dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar",
"event", "artwork", "fileId.start", "fileId.stop", "event", "artwork", "fileId.start", "fileId.stop",
"date.start", "date.stop", "timeMs.start", "date.start", "date.stop", "timeMs.start",
"timeMs.stop", "duration", "topicNumber", "popup", "timeMs.stop", "duration", "topic", "popup",
"x.start", "y.start", "x.stop", "y.stop", "distance", "x.start", "y.start", "x.stop", "y.stop", "distance",
"scale.start", "scale.stop", "scaleSize", "scale.start", "scale.stop", "scaleSize",
"rotation.start", "rotation.stop", "rotationDegree")] "rotation.start", "rotation.stop", "rotationDegree")]

View File

@ -32,7 +32,7 @@ extract_topics <- function(artworks, xmlfiles, xmlpath) {
topic <- c(topic, gsub("^<card type=.(.*).>$", "\\1", topic <- c(topic, gsub("^<card type=.(.*).>$", "\\1",
grep("^<card type=", grep("^<card type=",
trimws(readLines(paste(xmlpath, artwork, fname, sep = "/"))), trimws(readLines(paste(xmlpath, artwork, fname, sep = "/"))),
value = T))) value = TRUE)))
) )
} }
out <- rbind(out, data.frame(artwork, file_name = fnames, topic)) out <- rbind(out, data.frame(artwork, file_name = fnames, topic))
@ -41,52 +41,6 @@ extract_topics <- function(artworks, xmlfiles, xmlpath) {
out <- out[order(out$artwork), ] out <- out[order(out$artwork), ]
rownames(out) <- NULL rownames(out) <- NULL
out$index <- unlist(lapply(table(out$artwork), seq_len))
out
}
###########################################################################
# Add topics: file names and topics
add_topic <- function(data, topics) {
artworks <- unique(data$artwork)
tab_art <- lapply(artworks,
function(x) names(table(data$topicNumber[data$artwork == x])))
names(tab_art) <- artworks
tab_index <- lapply(tab_art, seq_along)
dat_split <- split(data, ~ artwork)
set_label <- function(x) {
artwork <- unique(x$artwork)
x$topicIndex <- factor(x$topicNumber, labels = tab_index[[artwork]])
x
}
dat_label <- lapply(dat_split, set_label)
set_topic <- function(x) {
artwork <- unique(x$artwork)
labels_file <- topics[topics$artwork == artwork,
"file_name"][as.numeric(levels(x$topicIndex))]
x$topicFile <- as.character(factor(x$topicIndex, labels = labels_file))
labels_topic <- topics[topics$artwork == artwork,
"topic"][as.numeric(levels(x$topicIndex))]
x$topic <- as.character(factor(x$topicIndex, labels = labels_topic))
x
}
dat_topic <- lapply(dat_label, set_topic)
#out <- do.call(rbind, dat_topic)
out <- dplyr::bind_rows(dat_topic)
out$topicIndex <- as.numeric(out$topicIndex)
out <- out[order(out$fileId.start, out$date.start, out$timeMs.start), ]
rownames(out) <- NULL
out out
} }

View File

@ -98,7 +98,7 @@ parse_logfiles <- function(folders, path, file = "rawdata_logfiles.csv",
dat$event <- events dat$event <- events
dat$artwork <- trimws(sapply(strsplit(topics, "/"), function(x) x[1])) dat$artwork <- trimws(sapply(strsplit(topics, "/"), function(x) x[1]))
dat$popup <- sapply(strsplit(topics, "/"), function(x) x[2]) dat$popup <- sapply(strsplit(topics, "/"), function(x) x[2])
dat$topicNumber <- card dat$topic <- card
dat$x <- moves[,1] dat$x <- moves[,1]
dat$y <- moves[,2] dat$y <- moves[,2]
dat$scale <- moves[,3] dat$scale <- moves[,3]