#' 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 artworks 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 of glossar folder is present and if it #' should be taken into account when preprocessing raw log files. Default #' is FALSE. #' @return Data frame. #' @export #' @examples #' # tbd create_eventlogs <- function(data, xmlpath, case_cutoff = 20, rm_nochange_moves = TRUE, glossar = FALSE) { if (!lubridate::is.POSIXt(data$date)){ cat("########## Converting variable `date` to POSIXct ##########", "\n") data$date <- as.POSIXct(data$date) } # Remove irrelevant events dat <- subset(data, !(data$event %in% c("Start Application", "Show Application"))) artworks <- unique(stats::na.omit(dat$artwork)) # Create glossar dictionary ############################################## if (glossar) { dat$glossar <- ifelse(dat$artwork == "glossar", 1, 0) cat("\n########## Creating glossar dictionary ##########", "\n") artworks <- artworks[artworks != "glossar"] glossar_files <- unique(subset(dat, dat$artwork == "glossar")$popup) glossar_dict <- create_glossardict(artworks, glossar_files, xmlpath = xmlpath) } else { glossar_dict <- NULL } # Add trace variable ##################################################### cat("\n########## Adding trace variable... ##########", "\n") dat1 <- add_trace(dat, glossar_dict) # 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), ] # Remove all events that do not have a `date.start` # d1 <- nrow(dat2) # dat2 <- dat2[!is.na(dat2$date.start), ] # d2 <- nrow(dat2) # if(d1 > d2) { # warning(paste0(d1-d2, " lines that do not contain a start event have been removed. This can happen when events span over more than one log file.\n")) # } # rownames(dat2) <- NULL # Add case variable ###################################################### cat("\n########## Adding case and eventId variables... ##########", "\n\n") dat3 <- add_case(dat2, cutoff = case_cutoff) # Add event ID ########################################################### dat3$eventId <- seq_len(nrow(dat3)) dat3 <- dat3[, c("folder", "eventId", "case", "trace", "glossar", "event", "artwork", "fileId.start", "fileId.stop", "date.start", "date.stop", "timeMs.start", "timeMs.stop", "duration", "topicNumber", "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 ######################### 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 dat4 <- dat4[which(dat4$fIdDiff > 0), ] dat4$duration[dat4$fIdDiff > 0] <- dat4$fIdDiff * 600000 - dat4$timeMs.start + dat4$timeMs.stop # Remove fragmented traces ############################################### tab <- stats::xtabs( ~ trace + 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$trace %in% fragments, ] if (!glossar) dat5$glossar <- NULL dat5 }