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

Compare commits

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

No commits in common. "ec45877229cf5f404ae9032c79d1ddf1f9377dfc" and "1d31527a3f8def6118b349d713d808d49ee2f63c" have entirely different histories.
ec45877229 ... 1d31527a3f

10 changed files with 128 additions and 126 deletions
Show Stats Expand all files Collapse all files

108
R/add_trace.R
View File

@ -1,26 +1,26 @@
########################################################################### ###########################################################################
add_path_items <- function(subdata) { add_trace_artworks <- function(subdata) {
last_event <- subdata$event[1] last_event <- subdata$event[1]
items <- unique(subdata$item)[unique(subdata$item) != "glossar"] artworks <- unique(subdata$artwork)[unique(subdata$artwork) != "glossar"]
n <- 1 # count items for progress n <- 1 # count artworks 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 (item in items) { for (artwork in artworks) {
cat("\n\nAdding path variable for item", item, cat("\n\nAdding trace variable for artwork", artwork,
paste0("(", n, "/", length(items), ")"), "\n") paste0("(", n, "/", length(artworks), ")"), "\n")
for (i in 1:nrow(subdata)) { for (i in 1:nrow(subdata)) {
if (last_event == "Show Info" & subdata$item[i] == item) { if (last_event == "Show Info" & subdata$artwork[i] == artwork) {
subdata$path[i] <- i subdata$trace[i] <- i
j <- i j <- i
} else if (last_event == "Show Front" & subdata$item[i] == item) { } else if (last_event == "Show Front" & subdata$artwork[i] == artwork) {
subdata$path[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$item[i] == item) { subdata$artwork[i] == artwork) {
subdata$path[i] <- j subdata$trace[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_path_items <- function(subdata) {
} }
########################################################################### ###########################################################################
add_path_glossar <- function(subdata, xmlpath) { add_trace_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")
items <- unique(subdata$item[subdata$item != "glossar"]) artworks <- unique(subdata$artwork[subdata$artwork != "glossar"])
glossar_files <- unique(subdata[subdata$item == "glossar", "popup"]) glossar_files <- unique(subdata[subdata$artwork == "glossar", "popup"])
lut <- create_glossardict(items, glossar_files, xmlpath = xmlpath) lut <- create_glossardict(artworks, 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_path_glossar <- function(subdata, xmlpath) {
for (file in names(lut)) { for (file in names(lut)) {
cat("\n\nAdding path variable for glossar entry", file, cat("\n\nAdding trace variable for glossar entry", file,
paste0("(", m, "/", length(lut), ")"), "\n") paste0("(", m, "/", length(lut), ")"), "\n")
item_list <- unlist(lut[names(lut) == file]) artwork_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$item[i] %in% single_art)) { subdata$artwork[i] %in% single_art)) {
current_item <- subdata[i, "item"] current_artwork <- subdata[i, "artwork"]
j <- i j <- i
k <- i k <- i
} else { } else {
current_item <- current_item current_artwork <- current_artwork
} }
if (subdata$event[i] == "Show Front" & subdata$item[i] == current_item) { if (subdata$event[i] == "Show Front" & subdata$artwork[i] == current_artwork) {
# make sure item has not been closed, yet! # make sure artwork has not been closed, yet!
k <- i k <- i
} }
if (subdata$item[i] == "glossar" & if (subdata$artwork[i] == "glossar" &
(current_item %in% item_list) & (current_artwork %in% artwork_list) &
subdata$popup[i] == file & (j - k == 0)) { subdata$popup[i] == file & (j - k == 0)) {
subdata[i, "path"] <- subdata[j, "path"] subdata[i, "trace"] <- subdata[j, "trace"]
subdata[i, "item"] <- current_item subdata[i, "artwork"] <- current_artwork
} }
utils::setTxtProgressBar(pb, i) utils::setTxtProgressBar(pb, i)
} }
@ -82,22 +82,22 @@ add_path_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, "path"])), "entries", sum(is.na(subdata[subdata$glossar == 1, "trace"])), "entries",
fill = TRUE) fill = TRUE)
subset(subdata, !is.na(subdata$path)) subset(subdata, !is.na(subdata$trace))
} }
########################################################################### ###########################################################################
add_path <- function(data, xmlpath, glossar) { add_trace <- function(data, xmlpath, glossar) {
data$path <- NA data$trace <- 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_path_items(subdata2) subdata2 <- add_trace_artworks(subdata2)
if (glossar) { if (glossar) {
subdata2 <- add_path_glossar(subdata2, xmlpath) subdata2 <- add_trace_glossar(subdata2, xmlpath)
} else { } else {
subdata2 <- subdata2[subdata2$glossar != 1, ] subdata2 <- subdata2[subdata2$glossar != 1, ]
} }
@ -109,60 +109,60 @@ add_path <- function(data, xmlpath, glossar) {
########################################################################### ###########################################################################
# Add path for moves # Add trace for moves
add_path_moves <- function(data) { add_trace_moves <- function(data) {
pbapply::pboptions(style = 3, char = "=") pbapply::pboptions(style = 3, char = "=")
path_max <- max(data$path, na.rm = TRUE) trace_max <- max(data$trace, na.rm = TRUE)
#subdata_art <- split(data, ~ item) #subdata_art <- split(data, ~ artwork)
subdata_case <- split(data, ~ case) subdata_case <- split(data, ~ case)
#subdata_list <- split(data, ~ item + case) #subdata_list <- split(data, ~ artwork + 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 = ~item) subdata_list <- pbapply::pblapply(subdata_case, split, f = ~artwork)
subdata_list <- unlist(subdata_list, recursive = FALSE) subdata_list <- unlist(subdata_list, recursive = FALSE)
cat("Adding path...", "\n") cat("Adding trace...", "\n")
subdata_path <- pbapply::pblapply(subdata_list, subdata_trace <- pbapply::pblapply(subdata_list,
function(x) { function(x) {
path_max <<- path_max + 1 trace_max <<- trace_max + 1
add_path_subdata(x, max_path = path_max) add_trace_subdata(x, max_trace = trace_max)
} }
) )
out <- dplyr::bind_rows(subdata_path) out <- dplyr::bind_rows(subdata_trace)
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 path a consecutive number # Make trace a consecutive number
out$path <- as.numeric(factor(out$path, levels = unique(out$path))) out$trace <- as.numeric(factor(out$trace, levels = unique(out$trace)))
out out
} }
add_path_subdata <- function(subdata, max_path) { add_trace_subdata <- function(subdata, max_trace) {
if (nrow(subdata) != 0) { if (nrow(subdata) != 0) {
if (length(stats::na.omit(unique(subdata$path))) == 1) { if (length(stats::na.omit(unique(subdata$trace))) == 1) {
subdata[subdata$event == "move", "path"] <- stats::na.omit(unique(subdata$path)) subdata[subdata$event == "move", "trace"] <- stats::na.omit(unique(subdata$trace))
} else if (length(stats::na.omit(unique(subdata$path))) > 1) { } else if (length(stats::na.omit(unique(subdata$trace))) > 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$path[i] <- stats::na.omit(unique(subdata$path))[1] subdata$trace[i] <- stats::na.omit(unique(subdata$trace))[1]
} else { } else {
subdata$path[i] <- subdata$path[i - 1] subdata$trace[i] <- subdata$trace[i - 1]
} }
} }
} }
} else if (all(is.na(subdata$path))) { } else if (all(is.na(subdata$trace))) {
for (i in 1:nrow(subdata)) { for (i in 1:nrow(subdata)) {
subdata$path[i] <- max_path subdata$trace[i] <- max_trace
} }
} }

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", "item", "glossar") idvar <- c("folder", "eventId", "artwork", "glossar")
drop <- c("popup", "topic", "path", "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", "path", "eventId", "item", "glossar") idvar <- c("folder", "trace", "eventId", "artwork", "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", "path", "glossar", idvar <- c("folder", "eventId", "trace", "glossar",
"item", "topic") "artwork", "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", "path", "glossar", idvar <- c("folder", "eventId", "trace", "glossar",
"item", "popup") "artwork", "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$item, subdata$popup, subdata$date, subdata <- subdata[order(subdata$artwork, 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 path, usually logging # Remove eventIds associated with more than one trace, 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 + path, # corrupt_eventIds <- names(which(rowSums(stats::xtabs( ~ eventId + trace,
# 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( ~ path, x))) tmp <- sapply(subdata_eid, function(x) length(stats::xtabs( ~ trace, 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$path # subdata$eventId <- subdata$trace
# } # }
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",
"item", "path", "glossar", "date.start", "artwork", "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", "item", data_split_wide <- data_split_wide[, c("folder", "artwork",
"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", "item", data_split_wide <- data_split_wide[, c("folder", "artwork",
"glossar", "path", "glossar", "trace",
"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", "item", data_split_wide <- data_split_wide[, c("folder", "artwork",
"topic", "topic",
"glossar", "path", "glossar", "trace",
"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", "item", data_split_wide <- data_split_wide[, c("folder", "artwork",
"popup", "glossar", "popup", "glossar",
"path", "eventId", "trace", "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 items live. #' @param xmlpath Path to folder where XML definitions of artworks 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 items live.") stop("xmlpath is not specified and glossar = TRUE. Please enter the path to folder where XML definitions of artworks 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$item == "glossar", 1, 0) dat$glossar <- ifelse(dat$artwork == "glossar", 1, 0)
# Add path variable ##################################################### # Add trace variable #####################################################
cat("\n########## Adding path variable... ##########", "\n") cat("\n########## Adding trace variable... ##########", "\n")
dat1 <- add_path(dat, xmlpath = xmlpath, glossar = glossar) dat1 <- add_trace(dat, xmlpath = xmlpath, glossar = glossar)
# Close events # Close events
cat("\n\n########## Closing events... ##########", "\n") cat("\n\n########## Closing events... ##########", "\n")
@ -57,17 +57,20 @@ 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 path for move events ############################################## # Add event ID ###########################################################
cat("\n\n########## Adding path variable for move events... ##########", "\n") dat3$eventId <- seq_len(nrow(dat3))
dat4 <- add_path_moves(dat3) dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar",
"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 #########################
@ -91,8 +94,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 paths ############################################### # Remove fragmented traces ###############################################
tab <- stats::xtabs( ~ path + event, dat4) tab <- stats::xtabs( ~ trace + event, dat4)
fragments <- NULL fragments <- NULL
@ -105,11 +108,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$path %in% fragments, ] dat5 <- dat4[!dat4$trace %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", ], ~ path) dat5_split <- split(dat5[dat5$event != "move", ], ~ trace)
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
@ -117,9 +120,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$path %in% rownames(event_dat)[frag_ids], ] dat6 <- dat5[dat5$trace %in% rownames(event_dat)[frag_ids], ]
dat6b <- dat6[!dat6$glossar == 1, ] dat6b <- dat6[!dat6$glossar == 1, ]
dat7 <- rbind(dat5[!dat5$path %in% rownames(event_dat)[frag_ids], ], dat7 <- rbind(dat5[!dat5$trace %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(items, glossar_files, xmlpath) { create_glossardict <- function(artworks, glossar_files, xmlpath) {
x <- NULL x <- NULL
for (glossar_file in glossar_files) { for (glossar_file in glossar_files) {
for (item in items) { for (artwork in artworks) {
fnames <- dir(pattern = paste0(item, "_"), path = paste0(xmlpath, item)) fnames <- dir(pattern = paste0(artwork, "_"), path = paste0(xmlpath, artwork))
for (fname in fnames) { for (fname in fnames) {
suppressWarnings( suppressWarnings(
lines <- readLines(paste0(xmlpath, item, "/", fname)) lines <- readLines(paste0(xmlpath, artwork, "/", fname))
) )
if (any(grepl(glossar_file, lines))) { if (any(grepl(glossar_file, lines))) {
x <- rbind(x, data.frame(glossar_file, item)) x <- rbind(x, data.frame(glossar_file, artwork))
break # if one match is found, we are done break # if one match is found, we are done
} }
} }
} }
} }
tapply(x$item, x$glossar_file, FUN = c) tapply(x$artwork, 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 artworks are extracted from XML files and written to a #' Information about artowrks 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,7 +49,6 @@ extract_artworks <- function(artworks, xmlfiles, xmlpath) {
out out
} }
# TODO: Check if all artworks have a folder, catch it and throw warning # TODO: Check if artworks all artworks have a folder, catch it and throw
# TODO: Is this function generic for most projects? If yes, adjust variable # warning
# names, if no: Maybe remove it from package?

22
R/extract_topics.R
View File

@ -1,25 +1,25 @@
#' Creating data frame with items and topics #' Creating data frame with artworks 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 items belong to which topics. #' shows which artworks belong to which topics.
#' #'
#' @param items A character vector with names of the items. Needs to #' @param artworks A character vector with names of the artworks. 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
#' `<item>.xml`. Need to be in the same order as items! #' `<artwork>.xml`. Need to be in the same order as artworks!
#' @param xmlpath Path to folder where XML definitions of items live. #' @param xmlpath Path to folder where XML definitions of artworks live.
#' @return Data frame. #' @return Data frame.
#' @export #' @export
#' @examples #' @examples
#' # tbd #' # tbd
extract_topics <- function(items, xmlfiles, xmlpath) { extract_topics <- function(artworks, xmlfiles, xmlpath) {
out <- NULL out <- NULL
i <- 1 i <- 1
for (item in items) { for (artwork in artworks) {
index_file <- paste0(xmlpath, item, "/", xmlfiles[i]) index_file <- paste0(xmlpath, artwork, "/", 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(items, 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, item, fname, sep = "/"))), trimws(readLines(paste(xmlpath, artwork, fname, sep = "/"))),
value = TRUE))) value = TRUE)))
) )
} }
out <- rbind(out, data.frame(item, file_name = fnames, topic)) out <- rbind(out, data.frame(artwork, file_name = fnames, topic))
i <- i + 1 i <- i + 1
} }
out <- out[order(out$item), ] out <- out[order(out$artwork), ]
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$item <- 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$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 items live.} \item{xmlpath}{Path to folder where XML definitions of artworks 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 artworks are extracted from XML files and written to a Information about artowrks 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 items and topics} \title{Creating data frame with artworks and topics}
\usage{ \usage{
extract_topics(items, xmlfiles, xmlpath) extract_topics(artworks, xmlfiles, xmlpath)
} }
\arguments{ \arguments{
\item{items}{A character vector with names of the items. Needs to \item{artworks}{A character vector with names of the artworks. 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{<item>.xml}. Need to be in the same order as items!} \verb{<artwork>.xml}. Need to be in the same order as artworks!}
\item{xmlpath}{Path to folder where XML definitions of items live.} \item{xmlpath}{Path to folder where XML definitions of artworks 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 items belong to which topics. shows which artworks belong to which topics.
} }
\examples{ \examples{
# tbd # tbd