From 46a2ec6e793286ddb8a5497277b942e53ea778b2 Mon Sep 17 00:00:00 2001 From: nwickel Date: Tue, 2 Jan 2024 13:49:30 +0100 Subject: [PATCH] Renamed artwork to item --- R/add_trace.R | 50 +++++++++++++++++++++--------------------- R/close_events.R | 20 ++++++++--------- R/create_eventlogs.R | 8 +++---- R/create_glossardict.R | 12 +++++----- R/extract_artworks.R | 7 +++--- R/extract_topics.R | 22 +++++++++---------- R/parse_logfiles.R | 2 +- 7 files changed, 61 insertions(+), 60 deletions(-) diff --git a/R/add_trace.R b/R/add_trace.R index d59d942..52b43be 100644 --- a/R/add_trace.R +++ b/R/add_trace.R @@ -1,25 +1,25 @@ ########################################################################### -add_trace_artworks <- function(subdata) { +add_trace_items <- function(subdata) { last_event <- subdata$event[1] - artworks <- unique(subdata$artwork)[unique(subdata$artwork) != "glossar"] - n <- 1 # count artworks for progress + items <- unique(subdata$item)[unique(subdata$item) != "glossar"] + n <- 1 # count items for progress pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA, style = 3) - for (artwork in artworks) { + for (item in items) { - cat("\n\nAdding trace variable for artwork", artwork, - paste0("(", n, "/", length(artworks), ")"), "\n") + cat("\n\nAdding trace variable for item", item, + paste0("(", n, "/", length(items), ")"), "\n") 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 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 } else if (!(last_event %in% c("Show Info", "Show Front")) & - subdata$artwork[i] == artwork) { + subdata$item[i] == item) { subdata$trace[i] <- j } if (i <= nrow(subdata)) { @@ -39,9 +39,9 @@ add_trace_glossar <- function(subdata, xmlpath) { style = 3) cat("\n\n########## Creating glossar dictionary ##########", "\n") - artworks <- unique(subdata$artwork[subdata$artwork != "glossar"]) - glossar_files <- unique(subdata[subdata$artwork == "glossar", "popup"]) - lut <- create_glossardict(artworks, glossar_files, xmlpath = xmlpath) + items <- unique(subdata$item[subdata$item != "glossar"]) + glossar_files <- unique(subdata[subdata$item == "glossar", "popup"]) + lut <- create_glossardict(items, glossar_files, xmlpath = xmlpath) inside <- glossar_files[glossar_files %in% names(lut[sapply(lut, length) == 1])] 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, 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))) { if (subdata$event[i] == "Show Info" | (subdata$event[i] == "Artwork/OpenCard" & - subdata$artwork[i] %in% single_art)) { - current_artwork <- subdata[i, "artwork"] + subdata$item[i] %in% single_art)) { + current_item <- subdata[i, "item"] j <- i k <- i } else { - current_artwork <- current_artwork + current_item <- current_item } - if (subdata$event[i] == "Show Front" & subdata$artwork[i] == current_artwork) { - # make sure artwork has not been closed, yet! + if (subdata$event[i] == "Show Front" & subdata$item[i] == current_item) { + # make sure item has not been closed, yet! k <- i } - if (subdata$artwork[i] == "glossar" & - (current_artwork %in% artwork_list) & + if (subdata$item[i] == "glossar" & + (current_item %in% item_list) & subdata$popup[i] == file & (j - k == 0)) { subdata[i, "trace"] <- subdata[j, "trace"] - subdata[i, "artwork"] <- current_artwork + subdata[i, "item"] <- current_item } utils::setTxtProgressBar(pb, i) } @@ -94,7 +94,7 @@ add_trace <- function(data, xmlpath, glossar) { subdata1 <- 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) { subdata2 <- add_trace_glossar(subdata2, xmlpath) @@ -117,13 +117,13 @@ add_trace_moves <- function(data) { trace_max <- max(data$trace, na.rm = TRUE) - #subdata_art <- split(data, ~ artwork) + #subdata_art <- split(data, ~ item) subdata_case <- split(data, ~ case) - #subdata_list <- split(data, ~ artwork + case) + #subdata_list <- split(data, ~ item + case) # --> does not work with complete data set 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) cat("Adding trace...", "\n") diff --git a/R/close_events.R b/R/close_events.R index 479b55c..da87bab 100644 --- a/R/close_events.R +++ b/R/close_events.R @@ -8,14 +8,14 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP switch(event, "move" = { actions <- c("Transform start", "Transform stop") - idvar <- c("folder", "eventId", "artwork", "glossar") + idvar <- c("folder", "eventId", "item", "glossar") drop <- c("popup", "topic", "trace", "event") ncol <- 18 }, "flipCard" = { 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") ncol <- 19 @@ -23,7 +23,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP "openTopic" = { actions <- c("Artwork/OpenCard", "Artwork/CloseCard") idvar <- c("folder", "eventId", "trace", "glossar", - "artwork", "topic") + "item", "topic") drop <- c("popup", "event") ncol <- 20 @@ -31,7 +31,7 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP "openPopup" = { actions <- c("ShowPopup", "HidePopup") idvar <- c("folder", "eventId", "trace", "glossar", - "artwork", "popup") + "item", "popup") drop <- c("topic", "event") ncol <- 20 # 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 <- subdata[order(subdata$artwork, subdata$popup, subdata$date, + subdata <- subdata[order(subdata$item, subdata$popup, subdata$date, subdata$timeMs), ] subdata$time <- ifelse(subdata$event == actions[1], "start", "stop") 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$timeMs.start), c("fileId.start", "fileId.stop", "folder", "event", - "artwork", "trace", "glossar", "date.start", + "item", "trace", "glossar", "date.start", "date.stop", "timeMs.start", "timeMs.stop", "duration", "topic", "popup", "x.start", "y.start", "x.stop", "y.stop", "distance", @@ -205,7 +205,7 @@ add_variables <- function(data_split_wide, ncol, switch(event, "move" = { - data_split_wide <- data_split_wide[, c("folder", "artwork", + data_split_wide <- data_split_wide[, c("folder", "item", "glossar", "eventId", "fileId.start", "date.start", @@ -220,7 +220,7 @@ add_variables <- function(data_split_wide, ncol, "rotation.stop")] }, "flipCard" = { - data_split_wide <- data_split_wide[, c("folder", "artwork", + data_split_wide <- data_split_wide[, c("folder", "item", "glossar", "trace", "eventId", "fileId.start", @@ -236,7 +236,7 @@ add_variables <- function(data_split_wide, ncol, "rotation.stop")] }, "openTopic" = { - data_split_wide <- data_split_wide[, c("folder", "artwork", + data_split_wide <- data_split_wide[, c("folder", "item", "topic", "glossar", "trace", "eventId", @@ -254,7 +254,7 @@ add_variables <- function(data_split_wide, ncol, "rotation.stop")] }, "openPopup" = { - data_split_wide <- data_split_wide[, c("folder", "artwork", + data_split_wide <- data_split_wide[, c("folder", "item", "popup", "glossar", "trace", "eventId", "fileId.start", diff --git a/R/create_eventlogs.R b/R/create_eventlogs.R index 38dbdea..77cdc44 100644 --- a/R/create_eventlogs.R +++ b/R/create_eventlogs.R @@ -5,7 +5,7 @@ #' #' @param data Data frame of raw log files created with `parse_logfiles()`. #' 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 #' different cases should be. #' @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)) { - 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 dat <- subset(data, !(data$event %in% c("Start Application", "Show Application"))) - dat$glossar <- ifelse(dat$artwork == "glossar", 1, 0) + dat$glossar <- ifelse(dat$item == "glossar", 1, 0) # Add trace variable ##################################################### cat("\n########## Adding trace variable... ##########", "\n") @@ -61,7 +61,7 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20, # Add event ID ########################################################### dat3$eventId <- seq_len(nrow(dat3)) 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", "timeMs.stop", "duration", "topic", "popup", "x.start", "y.start", "x.stop", "y.stop", "distance", diff --git a/R/create_glossardict.R b/R/create_glossardict.R index e6f2383..f0db82f 100644 --- a/R/create_glossardict.R +++ b/R/create_glossardict.R @@ -1,22 +1,22 @@ -create_glossardict <- function(artworks, glossar_files, xmlpath) { +create_glossardict <- function(items, glossar_files, xmlpath) { x <- NULL for (glossar_file in glossar_files) { - for (artwork in artworks) { - fnames <- dir(pattern = paste0(artwork, "_"), path = paste0(xmlpath, artwork)) + for (item in items) { + fnames <- dir(pattern = paste0(item, "_"), path = paste0(xmlpath, item)) for (fname in fnames) { suppressWarnings( - lines <- readLines(paste0(xmlpath, artwork, "/", fname)) + lines <- readLines(paste0(xmlpath, item, "/", fname)) ) 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 } } } } - 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: Add progress bars diff --git a/R/extract_artworks.R b/R/extract_artworks.R index 1500af8..0a4b3cd 100644 --- a/R/extract_artworks.R +++ b/R/extract_artworks.R @@ -1,6 +1,6 @@ #' 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`. #' #' @param artworks A character vector with names of the artworks. Needs to @@ -49,6 +49,7 @@ extract_artworks <- function(artworks, xmlfiles, xmlpath) { out } -# TODO: Check if artworks all artworks have a folder, catch it and throw -# warning +# TODO: Check if all artworks have a folder, catch it and throw warning +# TODO: Is this function generic for most projects? If yes, adjust variable +# names, if no: Maybe remove it from package? diff --git a/R/extract_topics.R b/R/extract_topics.R index c78903f..f6c3bac 100644 --- a/R/extract_topics.R +++ b/R/extract_topics.R @@ -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 -#' 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. #' @param xmlfiles Vector of names of index files, often something like -#' `.xml`. Need to be in the same order as artworks! -#' @param xmlpath Path to folder where XML definitions of artworks live. +#' `.xml`. Need to be in the same order as items! +#' @param xmlpath Path to folder where XML definitions of items live. #' @return Data frame. #' @export #' @examples #' # tbd -extract_topics <- function(artworks, xmlfiles, xmlpath) { +extract_topics <- function(items, xmlfiles, xmlpath) { out <- NULL 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( fnames <- gsub("^$", "\\1", grep("^$", "\\1", grep("^