Renamed artwork to item

This commit is contained in:
Nora Wickelmaier 2024-01-02 13:49:30 +01:00
parent 1d31527a3f
commit 46a2ec6e79
7 changed files with 61 additions and 60 deletions

View File

@ -1,25 +1,25 @@
########################################################################### ###########################################################################
add_trace_artworks <- function(subdata) { add_trace_items <- function(subdata) {
last_event <- subdata$event[1] last_event <- subdata$event[1]
artworks <- unique(subdata$artwork)[unique(subdata$artwork) != "glossar"] items <- unique(subdata$item)[unique(subdata$item) != "glossar"]
n <- 1 # count artworks for progress n <- 1 # count items for progress
pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA, pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA,
style = 3) style = 3)
for (artwork in artworks) { for (item in items) {
cat("\n\nAdding trace variable for artwork", artwork, cat("\n\nAdding trace variable for item", item,
paste0("(", n, "/", length(artworks), ")"), "\n") paste0("(", n, "/", length(items), ")"), "\n")
for (i in 1:nrow(subdata)) { for (i in 1:nrow(subdata)) {
if (last_event == "Show Info" & subdata$artwork[i] == artwork) { if (last_event == "Show Info" & subdata$item[i] == item) {
subdata$trace[i] <- i subdata$trace[i] <- i
j <- i j <- i
} else if (last_event == "Show Front" & subdata$artwork[i] == artwork) { } else if (last_event == "Show Front" & subdata$item[i] == item) {
subdata$trace[i] <- j subdata$trace[i] <- j
} else if (!(last_event %in% c("Show Info", "Show Front")) & } else if (!(last_event %in% c("Show Info", "Show Front")) &
subdata$artwork[i] == artwork) { subdata$item[i] == item) {
subdata$trace[i] <- j subdata$trace[i] <- j
} }
if (i <= nrow(subdata)) { if (i <= nrow(subdata)) {
@ -39,9 +39,9 @@ add_trace_glossar <- function(subdata, xmlpath) {
style = 3) style = 3)
cat("\n\n########## Creating glossar dictionary ##########", "\n") cat("\n\n########## Creating glossar dictionary ##########", "\n")
artworks <- unique(subdata$artwork[subdata$artwork != "glossar"]) items <- unique(subdata$item[subdata$item != "glossar"])
glossar_files <- unique(subdata[subdata$artwork == "glossar", "popup"]) glossar_files <- unique(subdata[subdata$item == "glossar", "popup"])
lut <- create_glossardict(artworks, glossar_files, xmlpath = xmlpath) lut <- create_glossardict(items, glossar_files, xmlpath = xmlpath)
inside <- glossar_files[glossar_files %in% inside <- glossar_files[glossar_files %in%
names(lut[sapply(lut, length) == 1])] names(lut[sapply(lut, length) == 1])]
single_art <- unlist(lut[names(lut) %in% inside]) single_art <- unlist(lut[names(lut) %in% inside])
@ -53,27 +53,27 @@ add_trace_glossar <- function(subdata, xmlpath) {
cat("\n\nAdding trace variable for glossar entry", file, cat("\n\nAdding trace variable for glossar entry", file,
paste0("(", m, "/", length(lut), ")"), "\n") paste0("(", m, "/", length(lut), ")"), "\n")
artwork_list <- unlist(lut[names(lut) == file]) item_list <- unlist(lut[names(lut) == file])
for (i in seq_len(nrow(subdata))) { for (i in seq_len(nrow(subdata))) {
if (subdata$event[i] == "Show Info" | if (subdata$event[i] == "Show Info" |
(subdata$event[i] == "Artwork/OpenCard" & (subdata$event[i] == "Artwork/OpenCard" &
subdata$artwork[i] %in% single_art)) { subdata$item[i] %in% single_art)) {
current_artwork <- subdata[i, "artwork"] current_item <- subdata[i, "item"]
j <- i j <- i
k <- i k <- i
} else { } else {
current_artwork <- current_artwork current_item <- current_item
} }
if (subdata$event[i] == "Show Front" & subdata$artwork[i] == current_artwork) { if (subdata$event[i] == "Show Front" & subdata$item[i] == current_item) {
# make sure artwork has not been closed, yet! # make sure item has not been closed, yet!
k <- i k <- i
} }
if (subdata$artwork[i] == "glossar" & if (subdata$item[i] == "glossar" &
(current_artwork %in% artwork_list) & (current_item %in% item_list) &
subdata$popup[i] == file & (j - k == 0)) { subdata$popup[i] == file & (j - k == 0)) {
subdata[i, "trace"] <- subdata[j, "trace"] subdata[i, "trace"] <- subdata[j, "trace"]
subdata[i, "artwork"] <- current_artwork subdata[i, "item"] <- current_item
} }
utils::setTxtProgressBar(pb, i) utils::setTxtProgressBar(pb, i)
} }
@ -94,7 +94,7 @@ add_trace <- function(data, xmlpath, glossar) {
subdata1 <- data[data$event %in% c("Transform start", "Transform stop"), ] subdata1 <- data[data$event %in% c("Transform start", "Transform stop"), ]
subdata2 <- data[!data$event %in% c("Transform start", "Transform stop"), ] subdata2 <- data[!data$event %in% c("Transform start", "Transform stop"), ]
subdata2 <- add_trace_artworks(subdata2) subdata2 <- add_trace_items(subdata2)
if (glossar) { if (glossar) {
subdata2 <- add_trace_glossar(subdata2, xmlpath) subdata2 <- add_trace_glossar(subdata2, xmlpath)
@ -117,13 +117,13 @@ add_trace_moves <- function(data) {
trace_max <- max(data$trace, na.rm = TRUE) trace_max <- max(data$trace, na.rm = TRUE)
#subdata_art <- split(data, ~ artwork) #subdata_art <- split(data, ~ item)
subdata_case <- split(data, ~ case) subdata_case <- split(data, ~ case)
#subdata_list <- split(data, ~ artwork + case) #subdata_list <- split(data, ~ item + case)
# --> does not work with complete data set # --> does not work with complete data set
cat("Splitting data...", "\n") cat("Splitting data...", "\n")
subdata_list <- pbapply::pblapply(subdata_case, split, f = ~artwork) subdata_list <- pbapply::pblapply(subdata_case, split, f = ~item)
subdata_list <- unlist(subdata_list, recursive = FALSE) subdata_list <- unlist(subdata_list, recursive = FALSE)
cat("Adding trace...", "\n") cat("Adding trace...", "\n")

View File

@ -8,14 +8,14 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
switch(event, switch(event,
"move" = { "move" = {
actions <- c("Transform start", "Transform stop") actions <- c("Transform start", "Transform stop")
idvar <- c("folder", "eventId", "artwork", "glossar") idvar <- c("folder", "eventId", "item", "glossar")
drop <- c("popup", "topic", "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", "item", "glossar")
drop <- c("popup", "topic", "event") drop <- c("popup", "topic", "event")
ncol <- 19 ncol <- 19
@ -23,7 +23,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
"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", "topic") "item", "topic")
drop <- c("popup", "event") drop <- c("popup", "event")
ncol <- 20 ncol <- 20
@ -31,7 +31,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
"openPopup" = { "openPopup" = {
actions <- c("ShowPopup", "HidePopup") actions <- c("ShowPopup", "HidePopup")
idvar <- c("folder", "eventId", "trace", "glossar", idvar <- c("folder", "eventId", "trace", "glossar",
"artwork", "popup") "item", "popup")
drop <- c("topic", "event") drop <- c("topic", "event")
ncol <- 20 ncol <- 20
# TODO: Should topic maybe also be filled in for "openPopup"? # TODO: Should topic maybe also be filled in for "openPopup"?
@ -39,7 +39,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
) )
subdata <- subset(data, data$event %in% actions) subdata <- subset(data, data$event %in% actions)
subdata <- subdata[order(subdata$artwork, subdata$popup, subdata$date, subdata <- subdata[order(subdata$item, subdata$popup, subdata$date,
subdata$timeMs), ] subdata$timeMs), ]
subdata$time <- ifelse(subdata$event == actions[1], "start", "stop") subdata$time <- ifelse(subdata$event == actions[1], "start", "stop")
num_start <- diff(c(0, which(subdata$event == actions[2]))) num_start <- diff(c(0, which(subdata$event == actions[2])))
@ -156,7 +156,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
data_wide$date.start, data_wide$date.start,
data_wide$timeMs.start), data_wide$timeMs.start),
c("fileId.start", "fileId.stop", "folder", "event", c("fileId.start", "fileId.stop", "folder", "event",
"artwork", "trace", "glossar", "date.start", "item", "trace", "glossar", "date.start",
"date.stop", "timeMs.start", "timeMs.stop", "date.stop", "timeMs.start", "timeMs.stop",
"duration", "topic", "popup", "x.start", "duration", "topic", "popup", "x.start",
"y.start", "x.stop", "y.stop", "distance", "y.start", "x.stop", "y.stop", "distance",
@ -205,7 +205,7 @@ add_variables <- function(data_split_wide, ncol,
switch(event, switch(event,
"move" = { "move" = {
data_split_wide <- data_split_wide[, c("folder", "artwork", data_split_wide <- data_split_wide[, c("folder", "item",
"glossar", "eventId", "glossar", "eventId",
"fileId.start", "fileId.start",
"date.start", "date.start",
@ -220,7 +220,7 @@ add_variables <- function(data_split_wide, ncol,
"rotation.stop")] "rotation.stop")]
}, },
"flipCard" = { "flipCard" = {
data_split_wide <- data_split_wide[, c("folder", "artwork", data_split_wide <- data_split_wide[, c("folder", "item",
"glossar", "trace", "glossar", "trace",
"eventId", "eventId",
"fileId.start", "fileId.start",
@ -236,7 +236,7 @@ add_variables <- function(data_split_wide, ncol,
"rotation.stop")] "rotation.stop")]
}, },
"openTopic" = { "openTopic" = {
data_split_wide <- data_split_wide[, c("folder", "artwork", data_split_wide <- data_split_wide[, c("folder", "item",
"topic", "topic",
"glossar", "trace", "glossar", "trace",
"eventId", "eventId",
@ -254,7 +254,7 @@ add_variables <- function(data_split_wide, ncol,
"rotation.stop")] "rotation.stop")]
}, },
"openPopup" = { "openPopup" = {
data_split_wide <- data_split_wide[, c("folder", "artwork", data_split_wide <- data_split_wide[, c("folder", "item",
"popup", "glossar", "popup", "glossar",
"trace", "eventId", "trace", "eventId",
"fileId.start", "fileId.start",

View File

@ -5,7 +5,7 @@
#' #'
#' @param data Data frame of raw log files created with `parse_logfiles()`. #' @param data Data frame of raw log files created with `parse_logfiles()`.
#' See `?parse_logfiles` for more details. #' See `?parse_logfiles` for more details.
#' @param xmlpath Path to folder where XML definitions of artworks live. #' @param xmlpath Path to folder where XML definitions of items live.
#' @param case_cutoff Number in seconds how long time interval between #' @param case_cutoff Number in seconds how long time interval between
#' different cases should be. #' different cases should be.
#' @param rm_nochange_moves Logical. Should move events that record no #' @param rm_nochange_moves Logical. Should move events that record no
@ -28,13 +28,13 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
} }
if (!glossar & is.null(xmlpath)) { if (!glossar & is.null(xmlpath)) {
stop("xmlpath is not specified and glossar = TRUE. Please enter the path to folder where XML definitions of artworks live.") stop("xmlpath is not specified and glossar = TRUE. Please enter the path to folder where XML definitions of items live.")
} }
# Remove irrelevant events # Remove irrelevant events
dat <- subset(data, !(data$event %in% c("Start Application", dat <- subset(data, !(data$event %in% c("Start Application",
"Show Application"))) "Show Application")))
dat$glossar <- ifelse(dat$artwork == "glossar", 1, 0) dat$glossar <- ifelse(dat$item == "glossar", 1, 0)
# Add trace variable ##################################################### # Add trace variable #####################################################
cat("\n########## Adding trace variable... ##########", "\n") cat("\n########## Adding trace variable... ##########", "\n")
@ -61,7 +61,7 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
# Add event ID ########################################################### # Add event ID ###########################################################
dat3$eventId <- seq_len(nrow(dat3)) dat3$eventId <- seq_len(nrow(dat3))
dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar", dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar",
"event", "artwork", "fileId.start", "fileId.stop", "event", "item", "fileId.start", "fileId.stop",
"date.start", "date.stop", "timeMs.start", "date.start", "date.stop", "timeMs.start",
"timeMs.stop", "duration", "topic", "popup", "timeMs.stop", "duration", "topic", "popup",
"x.start", "y.start", "x.stop", "y.stop", "distance", "x.start", "y.start", "x.stop", "y.stop", "distance",

View File

@ -1,22 +1,22 @@
create_glossardict <- function(artworks, glossar_files, xmlpath) { create_glossardict <- function(items, glossar_files, xmlpath) {
x <- NULL x <- NULL
for (glossar_file in glossar_files) { for (glossar_file in glossar_files) {
for (artwork in artworks) { for (item in items) {
fnames <- dir(pattern = paste0(artwork, "_"), path = paste0(xmlpath, artwork)) fnames <- dir(pattern = paste0(item, "_"), path = paste0(xmlpath, item))
for (fname in fnames) { for (fname in fnames) {
suppressWarnings( suppressWarnings(
lines <- readLines(paste0(xmlpath, artwork, "/", fname)) lines <- readLines(paste0(xmlpath, item, "/", fname))
) )
if (any(grepl(glossar_file, lines))) { if (any(grepl(glossar_file, lines))) {
x <- rbind(x, data.frame(glossar_file, artwork)) x <- rbind(x, data.frame(glossar_file, item))
break # if one match is found, we are done break # if one match is found, we are done
} }
} }
} }
} }
tapply(x$artwork, x$glossar_file, FUN = c) tapply(x$item, x$glossar_file, FUN = c)
} }
# TODO: Get rid of (at least 2) loops # TODO: Get rid of (at least 2) loops
# TODO: Add progress bars # TODO: Add progress bars

View File

@ -1,6 +1,6 @@
#' Creating data frame with information about artworks #' Creating data frame with information about artworks
#' #'
#' Information about artowrks are extracted from XML files and written to a #' Information about artworks are extracted from XML files and written to a
#' data frame that contains `artist`, `title`, `misc`, and `description`. #' data frame that contains `artist`, `title`, `misc`, and `description`.
#' #'
#' @param artworks A character vector with names of the artworks. Needs to #' @param artworks A character vector with names of the artworks. Needs to
@ -49,6 +49,7 @@ extract_artworks <- function(artworks, xmlfiles, xmlpath) {
out out
} }
# TODO: Check if artworks all artworks have a folder, catch it and throw # TODO: Check if all artworks have a folder, catch it and throw warning
# warning # TODO: Is this function generic for most projects? If yes, adjust variable
# names, if no: Maybe remove it from package?

View File

@ -1,25 +1,25 @@
#' Creating data frame with artworks and topics #' Creating data frame with items and topics
#' #'
#' Topics are extracted from XML files and written to a data frame that #' Topics are extracted from XML files and written to a data frame that
#' shows which artworks belong to which topics. #' shows which items belong to which topics.
#' #'
#' @param artworks A character vector with names of the artworks. Needs to #' @param items A character vector with names of the items. Needs to
#' correspond to the folder names which contain the XML files. #' correspond to the folder names which contain the XML files.
#' @param xmlfiles Vector of names of index files, often something like #' @param xmlfiles Vector of names of index files, often something like
#' `<artwork>.xml`. Need to be in the same order as artworks! #' `<item>.xml`. Need to be in the same order as items!
#' @param xmlpath Path to folder where XML definitions of artworks live. #' @param xmlpath Path to folder where XML definitions of items live.
#' @return Data frame. #' @return Data frame.
#' @export #' @export
#' @examples #' @examples
#' # tbd #' # tbd
extract_topics <- function(artworks, xmlfiles, xmlpath) { extract_topics <- function(items, xmlfiles, xmlpath) {
out <- NULL out <- NULL
i <- 1 i <- 1
for (artwork in artworks) { for (item in items) {
index_file <- paste0(xmlpath, artwork, "/", xmlfiles[i]) index_file <- paste0(xmlpath, item, "/", xmlfiles[i])
suppressWarnings( suppressWarnings(
fnames <- gsub("^<card src=.*/(.*)./>$", "\\1", fnames <- gsub("^<card src=.*/(.*)./>$", "\\1",
grep("^<card src=", trimws(readLines(index_file)), grep("^<card src=", trimws(readLines(index_file)),
@ -31,15 +31,15 @@ extract_topics <- function(artworks, xmlfiles, xmlpath) {
suppressWarnings( suppressWarnings(
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, item, fname, sep = "/"))),
value = TRUE))) value = TRUE)))
) )
} }
out <- rbind(out, data.frame(artwork, file_name = fnames, topic)) out <- rbind(out, data.frame(item, file_name = fnames, topic))
i <- i + 1 i <- i + 1
} }
out <- out[order(out$artwork), ] out <- out[order(out$item), ]
rownames(out) <- NULL rownames(out) <- NULL
out out
} }

View File

@ -96,7 +96,7 @@ parse_logfiles <- function(folders, path, file = "rawdata_logfiles.csv",
dat$date <- lubridate::parse_date_time(date, "bdyHMSOp") dat$date <- lubridate::parse_date_time(date, "bdyHMSOp")
dat$timeMs <- time_ms dat$timeMs <- time_ms
dat$event <- events dat$event <- events
dat$artwork <- trimws(sapply(strsplit(topics, "/"), function(x) x[1])) dat$item <- 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$topic <- card dat$topic <- card
dat$x <- moves[,1] dat$x <- moves[,1]