134 lines
5.6 KiB
R
134 lines
5.6 KiB
R
#' Creating log events from raw log files.
|
|
#'
|
|
#' Creating event logs from a data frame of raw log files from a
|
|
#' Multi-Touch-Table at the IWM.
|
|
#'
|
|
#' @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 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
|
|
#' change, meaning distance and rotationDegree are 0 and scaleSize is 1, be
|
|
#' removed. Default is TRUE.
|
|
#' @param glossar Logical indicating if glossar folder is present and if it
|
|
#' should be taken into account when preprocessing raw log files. Default
|
|
#' is FALSE.
|
|
#' @param save Temporary argument to save intermediate data frames for debugging.
|
|
#' @return Data frame.
|
|
#' @export
|
|
#' @examples
|
|
#' # tbd
|
|
create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
|
|
rm_nochange_moves = TRUE, glossar = FALSE, save = FALSE) {
|
|
|
|
if (!lubridate::is.POSIXt(data$date)){
|
|
cat("########## Converting variable `date` to POSIXct ##########", "\n")
|
|
data$date <- as.POSIXct(data$date)
|
|
}
|
|
|
|
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.")
|
|
}
|
|
|
|
# Remove irrelevant events
|
|
dat <- subset(data, !(data$event %in% c("Start Application",
|
|
"Show Application")))
|
|
dat$glossar <- ifelse(dat$item == "glossar", 1, 0)
|
|
|
|
# Add path variable #####################################################
|
|
cat("\n########## Adding path variable... ##########", "\n")
|
|
dat1 <- add_path(dat, xmlpath = xmlpath, glossar = glossar)
|
|
|
|
# Close events
|
|
cat("\n\n########## Closing events... ##########", "\n")
|
|
c1 <- close_events(dat1, "move", rm_nochange_moves = rm_nochange_moves)
|
|
cat("## --> move events closed.", "\n")
|
|
c2 <- close_events(dat1, "flipCard", rm_nochange_moves = rm_nochange_moves)
|
|
cat("## --> flipCard events closed.", "\n")
|
|
c3 <- close_events(dat1, "openTopic", rm_nochange_moves = rm_nochange_moves)
|
|
cat("## --> openTopic events closed.", "\n")
|
|
c4 <- close_events(dat1, "openPopup", rm_nochange_moves = rm_nochange_moves)
|
|
cat("## --> openPopup events closed.", "\n")
|
|
dat2 <- rbind(c1, c2, c3, c4)
|
|
|
|
dat2 <- dat2[order(dat2$fileId.start, dat2$date.start, dat2$timeMs.start), ]
|
|
|
|
# Add path for move events ##############################################
|
|
cat("\n\n########## Adding path variable for move events... ##########", "\n")
|
|
dat3 <- add_path_moves(dat2, cutoff = case_cutoff)
|
|
|
|
# Add case variable ######################################################
|
|
cat("\n########## Adding case variable... ##########", "\n\n")
|
|
dat4 <- add_case(dat3, cutoff = case_cutoff)
|
|
dat4 <- dat4[, 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")]
|
|
|
|
# Fix durations that span more than one log file #########################
|
|
levels_fId <- sort(unique(c(dat4$fileId.start, dat4$fileId.stop)))
|
|
dat4$fIdNum.start <- factor(dat4$fileId.start, levels = levels_fId)
|
|
dat4$fIdNum.stop <- factor(dat4$fileId.stop, levels = levels_fId)
|
|
dat4$fIdNum.start <- as.numeric(dat4$fIdNum.start)
|
|
dat4$fIdNum.stop <- as.numeric(dat4$fIdNum.stop)
|
|
|
|
dat4$fIdDiff <- dat4$fIdNum.stop - dat4$fIdNum.start
|
|
|
|
# Remove moves where stop is before start (3)
|
|
dat4 <- dat4[dat4$fIdDiff >= 0 | is.na(dat4$fIdDiff), ]
|
|
|
|
dat4$duration[which(dat4$fIdDiff > 0)] <-
|
|
dat4$fIdDiff[which(dat4$fIdDiff > 0)] * 600000 -
|
|
dat4$timeMs.start[which(dat4$fIdDiff > 0)] +
|
|
dat4$timeMs.stop[which(dat4$fIdDiff > 0)]
|
|
|
|
dat4$fIdNum.start <- NULL
|
|
dat4$fIdNum.stop <- NULL
|
|
dat4$fIdDiff <- NULL
|
|
|
|
# Remove fragmented paths ###############################################
|
|
# tab <- stats::xtabs( ~ path + event, dat4)
|
|
|
|
# fragments <- NULL
|
|
|
|
# for (i in seq_len(nrow(tab))) {
|
|
# if (tab[i, "openPopup"] != 0 & tab[i, "flipCard"] == 0) {
|
|
# fragments <- c(fragments, rownames(tab)[i])
|
|
# } else if (tab[i, "openTopic"] != 0 & tab[i, "flipCard"] == 0) {
|
|
# fragments <- c(fragments, rownames(tab)[i])
|
|
# } else if (tab[i, "openPopup"] != 0 & tab[i, "openTopic"] == 0) {
|
|
# fragments <- c(fragments, rownames(tab)[i])
|
|
# }
|
|
# }
|
|
# dat5 <- dat4[!dat4$path %in% fragments, ]
|
|
# TODO: Decide if I want this or not - are all these log errors?
|
|
dat5 <- dat4
|
|
|
|
if (glossar) {
|
|
# Check for wrong order of events: flipCard -> openPopup -> openTopic
|
|
dat5_split <- split(dat5[dat5$event != "move", ], ~ path)
|
|
event_list <- lapply(dat5_split, function(x) unique(x$event))
|
|
|
|
ids <- sapply(event_list, length) == 3
|
|
event_dat <- as.data.frame(do.call(rbind, event_list[ids]))
|
|
names(event_dat) <- c("flipCard", "openTopic", "openPopup")
|
|
|
|
frag_ids <- which(event_dat$openTopic == "openPopup")
|
|
dat6 <- dat5[dat5$path %in% rownames(event_dat)[frag_ids], ]
|
|
dat6b <- dat6[!dat6$glossar == 1, ]
|
|
dat7 <- rbind(dat5[!dat5$path %in% rownames(event_dat)[frag_ids], ],
|
|
dat6b)
|
|
} else {
|
|
dat7 <- dat5
|
|
dat7$glossar <- NULL
|
|
}
|
|
|
|
if (save) save(dat, dat1, dat2, dat3, dat4, dat5, dat7, file = "results/tmp_intermediate-df.RData")
|
|
dat7
|
|
}
|
|
|