R/mtt
R/mtt
0
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: R:1d31527a3f8def6118b349d713d808d49ee2f63c
Branches Tags
R:master
..
compare: R:ec45877229cf5f404ae9032c79d1ddf1f9377dfc
Branches Tags
R:master

2 Commits
1d31527a3f ... ec45877229

Author SHA1 Message Date
nwickel
ec45877229 Renamed trace into path 2024-01-02 14:17:50 +01:00
nwickel
46a2ec6e79 Renamed artwork to item 2024-01-02 13:49:30 +01:00
10 changed files with 126 additions and 128 deletions
Show Stats Expand all files Collapse all files

108
R/add_trace.R
View File

@ -1,26 +1,26 @@
########################################################################### ###########################################################################
add_trace_artworks <- function(subdata) { add_path_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 path 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$path[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$path[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$path[i] <- j
} }
if (i <= nrow(subdata)) { if (i <= nrow(subdata)) {
last_event <- subdata$event[i + 1] last_event <- subdata$event[i + 1]
@ -33,15 +33,15 @@ add_trace_artworks <- function(subdata) {
} }
########################################################################### ###########################################################################
add_trace_glossar <- function(subdata, xmlpath) { add_path_glossar <- function(subdata, xmlpath) {
pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA, pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA,
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])
@ -50,30 +50,30 @@ add_trace_glossar <- function(subdata, xmlpath) {
for (file in names(lut)) { for (file in names(lut)) {
cat("\n\nAdding trace variable for glossar entry", file, cat("\n\nAdding path 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, "path"] <- subdata[j, "path"]
subdata[i, "artwork"] <- current_artwork subdata[i, "item"] <- current_item
} }
utils::setTxtProgressBar(pb, i) utils::setTxtProgressBar(pb, i)
} }
@ -82,22 +82,22 @@ add_trace_glossar <- function(subdata, xmlpath) {
# Exclude not matched glossar entries # Exclude not matched glossar entries
cat("\n\nINFORMATION: glossar entries that are not matched will be removed:", cat("\n\nINFORMATION: glossar entries that are not matched will be removed:",
sum(is.na(subdata[subdata$glossar == 1, "trace"])), "entries", sum(is.na(subdata[subdata$glossar == 1, "path"])), "entries",
fill = TRUE) fill = TRUE)
subset(subdata, !is.na(subdata$trace)) subset(subdata, !is.na(subdata$path))
} }
########################################################################### ###########################################################################
add_trace <- function(data, xmlpath, glossar) { add_path <- function(data, xmlpath, glossar) {
data$trace <- NA data$path <- NA
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_path_items(subdata2)
if (glossar) { if (glossar) {
subdata2 <- add_trace_glossar(subdata2, xmlpath) subdata2 <- add_path_glossar(subdata2, xmlpath)
} else { } else {
subdata2 <- subdata2[subdata2$glossar != 1, ] subdata2 <- subdata2[subdata2$glossar != 1, ]
} }
@ -109,60 +109,60 @@ add_trace <- function(data, xmlpath, glossar) {
########################################################################### ###########################################################################
# Add trace for moves # Add path for moves
add_trace_moves <- function(data) { add_path_moves <- function(data) {
pbapply::pboptions(style = 3, char = "=") pbapply::pboptions(style = 3, char = "=")
trace_max <- max(data$trace, na.rm = TRUE) path_max <- max(data$path, 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 path...", "\n")
subdata_trace <- pbapply::pblapply(subdata_list, subdata_path <- pbapply::pblapply(subdata_list,
function(x) { function(x) {
trace_max <<- trace_max + 1 path_max <<- path_max + 1
add_trace_subdata(x, max_trace = trace_max) add_path_subdata(x, max_path = path_max)
} }
) )
out <- dplyr::bind_rows(subdata_trace) out <- dplyr::bind_rows(subdata_path)
out <- out[order(out$fileId.start, out$date.start, out$timeMs.start), ] out <- out[order(out$fileId.start, out$date.start, out$timeMs.start), ]
rownames(out) <- NULL rownames(out) <- NULL
# Make trace a consecutive number # Make path a consecutive number
out$trace <- as.numeric(factor(out$trace, levels = unique(out$trace))) out$path <- as.numeric(factor(out$path, levels = unique(out$path)))
out out
} }
add_trace_subdata <- function(subdata, max_trace) { add_path_subdata <- function(subdata, max_path) {
if (nrow(subdata) != 0) { if (nrow(subdata) != 0) {
if (length(stats::na.omit(unique(subdata$trace))) == 1) { if (length(stats::na.omit(unique(subdata$path))) == 1) {
subdata[subdata$event == "move", "trace"] <- stats::na.omit(unique(subdata$trace)) subdata[subdata$event == "move", "path"] <- stats::na.omit(unique(subdata$path))
} else if (length(stats::na.omit(unique(subdata$trace))) > 1) { } else if (length(stats::na.omit(unique(subdata$path))) > 1) {
for (i in 1:nrow(subdata)) { for (i in 1:nrow(subdata)) {
if (subdata$event[i] == "move") { if (subdata$event[i] == "move") {
if (i == 1) { if (i == 1) {
subdata$trace[i] <- stats::na.omit(unique(subdata$trace))[1] subdata$path[i] <- stats::na.omit(unique(subdata$path))[1]
} else { } else {
subdata$trace[i] <- subdata$trace[i - 1] subdata$path[i] <- subdata$path[i - 1]
} }
} }
} }
} else if (all(is.na(subdata$trace))) { } else if (all(is.na(subdata$path))) {
for (i in 1:nrow(subdata)) { for (i in 1:nrow(subdata)) {
subdata$trace[i] <- max_trace subdata$path[i] <- max_path
} }
} }

40
R/close_events.R
View File

@ -8,30 +8,30 @@ 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", "path", "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", "path", "eventId", "item", "glossar")
drop <- c("popup", "topic", "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", "path", "glossar",
"artwork", "topic") "item", "topic")
drop <- c("popup", "event") drop <- c("popup", "event")
ncol <- 20 ncol <- 20
}, },
"openPopup" = { "openPopup" = {
actions <- c("ShowPopup", "HidePopup") actions <- c("ShowPopup", "HidePopup")
idvar <- c("folder", "eventId", "trace", "glossar", idvar <- c("folder", "eventId", "path", "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])))
@ -72,22 +72,22 @@ close_events <- function(data, event = c("move", "flipCard", "openTopic", "openP
subdata <- dplyr::bind_rows(subdata_list) subdata <- dplyr::bind_rows(subdata_list)
} }
# Remove eventIds associated with more than one trace, usually logging # Remove eventIds associated with more than one path, usually logging
# errors that cannot be resolved for openTopic or openPopup # errors that cannot be resolved for openTopic or openPopup
if (event %in% c("openTopic", "openPopup")) { if (event %in% c("openTopic", "openPopup")) {
# corrupt_eventIds <- names(which(rowSums(stats::xtabs( ~ eventId + trace, # corrupt_eventIds <- names(which(rowSums(stats::xtabs( ~ eventId + path,
# subdata) != 0) != 1)) # subdata) != 0) != 1))
# --> does not run on complete data set # --> does not run on complete data set
subdata_eid <- split(subdata, ~ eventId) subdata_eid <- split(subdata, ~ eventId)
tmp <- sapply(subdata_eid, function(x) length(stats::xtabs( ~ trace, x))) tmp <- sapply(subdata_eid, function(x) length(stats::xtabs( ~ path, x)))
corrupt_eventIds <- names(tmp[tmp > 1]) corrupt_eventIds <- names(tmp[tmp > 1])
subdata <- subdata[!subdata$eventId %in% corrupt_eventIds, ] subdata <- subdata[!subdata$eventId %in% corrupt_eventIds, ]
} }
# if (event == "flipCard") { # if (event == "flipCard") {
# subdata$eventId <- subdata$trace # subdata$eventId <- subdata$path
# } # }
subdata_split <- split(subdata, ~ fileId) subdata_split <- split(subdata, ~ fileId)
@ -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", "path", "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,8 +220,8 @@ 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", "path",
"eventId", "eventId",
"fileId.start", "fileId.start",
"date.start", "date.start",
@ -236,9 +236,9 @@ 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", "path",
"eventId", "eventId",
"fileId.start", "fileId.start",
"date.start", "date.start",
@ -254,9 +254,9 @@ 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", "path", "eventId",
"fileId.start", "fileId.start",
"date.start", "date.start",
"timeMs.start", "timeMs.start",

47
R/create_eventlogs.R
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,17 +28,17 @@ 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 path variable #####################################################
cat("\n########## Adding trace variable... ##########", "\n") cat("\n########## Adding path variable... ##########", "\n")
dat1 <- add_trace(dat, xmlpath = xmlpath, glossar = glossar) dat1 <- add_path(dat, xmlpath = xmlpath, glossar = glossar)
# Close events # Close events
cat("\n\n########## Closing events... ##########", "\n") cat("\n\n########## Closing events... ##########", "\n")
@ -57,20 +57,17 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
# Add case variable ###################################################### # Add case variable ######################################################
cat("\n########## Adding case and eventId variables... ##########", "\n\n") cat("\n########## Adding case and eventId variables... ##########", "\n\n")
dat3 <- add_case(dat2, cutoff = case_cutoff) dat3 <- add_case(dat2, cutoff = case_cutoff)
dat3 <- dat3[, c("fileId.start", "fileId.stop", "date.start",
"date.stop", "folder", "case", "path", "glossar",
"event", "item", "timeMs.start", "timeMs.stop",
"duration", "topic", "popup", "x.start", "y.start",
"x.stop", "y.stop", "distance", "scale.start",
"scale.stop", "scaleSize", "rotation.start",
"rotation.stop", "rotationDegree")]
# Add event ID ########################################################### # Add path for move events ##############################################
dat3$eventId <- seq_len(nrow(dat3)) cat("\n\n########## Adding path variable for move events... ##########", "\n")
dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar", dat4 <- add_path_moves(dat3)
"event", "artwork", "fileId.start", "fileId.stop",
"date.start", "date.stop", "timeMs.start",
"timeMs.stop", "duration", "topic", "popup",
"x.start", "y.start", "x.stop", "y.stop", "distance",
"scale.start", "scale.stop", "scaleSize",
"rotation.start", "rotation.stop", "rotationDegree")]
# Add trace for move events ##############################################
cat("\n\n########## Adding trace variable for move events... ##########", "\n")
dat4 <- add_trace_moves(dat3)
# Fix durations that span more than one log file ######################### # Fix durations that span more than one log file #########################
@ -94,8 +91,8 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
dat4$fIdNum.stop <- NULL dat4$fIdNum.stop <- NULL
dat4$fIdDiff <- NULL dat4$fIdDiff <- NULL
# Remove fragmented traces ############################################### # Remove fragmented paths ###############################################
tab <- stats::xtabs( ~ trace + event, dat4) tab <- stats::xtabs( ~ path + event, dat4)
fragments <- NULL fragments <- NULL
@ -108,11 +105,11 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
fragments <- c(fragments, rownames(tab)[i]) fragments <- c(fragments, rownames(tab)[i])
} }
} }
dat5 <- dat4[!dat4$trace %in% fragments, ] dat5 <- dat4[!dat4$path %in% fragments, ]
if (glossar) { if (glossar) {
# Check for wrong order of events: flipCard -> openPopup -> openTopic # Check for wrong order of events: flipCard -> openPopup -> openTopic
dat5_split <- split(dat5[dat5$event != "move", ], ~ trace) dat5_split <- split(dat5[dat5$event != "move", ], ~ path)
event_list <- lapply(dat5_split, function(x) unique(x$event)) event_list <- lapply(dat5_split, function(x) unique(x$event))
ids <- sapply(event_list, length) == 3 ids <- sapply(event_list, length) == 3
@ -120,9 +117,9 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
names(event_dat) <- c("flipCard", "openTopic", "openPopup") names(event_dat) <- c("flipCard", "openTopic", "openPopup")
frag_ids <- which(event_dat$openTopic == "openPopup") frag_ids <- which(event_dat$openTopic == "openPopup")
dat6 <- dat5[dat5$trace %in% rownames(event_dat)[frag_ids], ] dat6 <- dat5[dat5$path %in% rownames(event_dat)[frag_ids], ]
dat6b <- dat6[!dat6$glossar == 1, ] dat6b <- dat6[!dat6$glossar == 1, ]
dat7 <- rbind(dat5[!dat5$trace %in% rownames(event_dat)[frag_ids], ], dat7 <- rbind(dat5[!dat5$path %in% rownames(event_dat)[frag_ids], ],
dat6b) dat6b)
} else { } else {
dat7 <- dat5 dat7 <- dat5

12
R/create_glossardict.R
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

7
R/extract_artworks.R
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?

22
R/extract_topics.R
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
} }

2
R/parse_logfiles.R
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]

2
man/create_eventlogs.Rd
View File

@ -17,7 +17,7 @@ create_eventlogs(
\item{data}{Data frame of raw log files created with \code{parse_logfiles()}. \item{data}{Data frame of raw log files created with \code{parse_logfiles()}.
See \code{?parse_logfiles} for more details.} See \code{?parse_logfiles} for more details.}
\item{xmlpath}{Path to folder where XML definitions of artworks live.} \item{xmlpath}{Path to folder where XML definitions of items live.}
\item{case_cutoff}{Number in seconds how long time interval between \item{case_cutoff}{Number in seconds how long time interval between
different cases should be.} different cases should be.}

2
man/extract_artworks.Rd
View File

@ -19,7 +19,7 @@ correspond to the folder names which contain the XML files.}
Data frame. Data frame.
} }
\description{ \description{
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 \code{artist}, \code{title}, \code{misc}, and \code{description}. data frame that contains \code{artist}, \code{title}, \code{misc}, and \code{description}.
} }
\examples{ \examples{

12
man/extract_topics.Rd
View File

@ -2,25 +2,25 @@
% Please edit documentation in R/extract_topics.R % Please edit documentation in R/extract_topics.R
\name{extract_topics} \name{extract_topics}
\alias{extract_topics} \alias{extract_topics}
\title{Creating data frame with artworks and topics} \title{Creating data frame with items and topics}
\usage{ \usage{
extract_topics(artworks, xmlfiles, xmlpath) extract_topics(items, xmlfiles, xmlpath)
} }
\arguments{ \arguments{
\item{artworks}{A character vector with names of the artworks. Needs to \item{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.}
\item{xmlfiles}{Vector of names of index files, often something like \item{xmlfiles}{Vector of names of index files, often something like
\verb{<artwork>.xml}. Need to be in the same order as artworks!} \verb{<item>.xml}. Need to be in the same order as items!}
\item{xmlpath}{Path to folder where XML definitions of artworks live.} \item{xmlpath}{Path to folder where XML definitions of items live.}
} }
\value{ \value{
Data frame. Data frame.
} }
\description{ \description{
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.
} }
\examples{ \examples{
# tbd # tbd