#' --- #' title: "Preprocessing log files" #' author: "Nora Wickelmaier" #' date: "`r Sys.Date()`" #' output: #' html_document: #' toc: true #' toc_float: true #' pdf_document: #' toc: true #' number_sections: true #' geometry: margin = 2.5cm #' --- # setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/code") # LogEntry classes: # TRANSFORM_START: "Transform start" --> "Transformation Start" in Tool # TRANSFORM_STOP: "Transform stop" # START_APPLICATION: "Start Application" # SHOW_APPLICATION: "Show Application" # SHOW_INFO: "Show Info" --> "Flip Card" in Tool # SHOW_FRONT: "Show Front" # SHOW_POPUP: "ShowPopup" --> "Show Popup" in Tool # HIDE_POPUP: "HidePopup" # ARTWORK: "Artwork" --> "Show Topic" in Tool #' # Read data dat0 <- read.table("../data/rawdata_logfiles_small.csv", sep = ";", header = TRUE) dat0$date <- as.POSIXct(dat0$date) # create date object # TODO: Add a case identifier based on timestamps -- needs to be done on # "raw data". Is it possible? Something seems seriously wrong with # `time_ms` #' # Remove irrelevant events #' ## Remove Start Application and Show Application dat <- subset(dat0, !(dat0$event %in% c("Start Application", "Show Application"))) #' # Close events # TODO: # Should every "Show front" be the beginning of a new trace? # Should Transform events be handled separately and then be "added" again # by timestamp? ######## #' Do it for Transform events first tmp <- dat[dat$event %in% c("Transform start", "Transform stop"), ] tmp <- tmp[order(tmp$artwork, tmp$date), ] rownames(tmp) <- NULL # Create event ID for closing events num_start <- diff(c(0, which(tmp$event == "Transform stop"))) tmp$eventid <- rep(seq_along(num_start), num_start) head(tmp[, c("event", "eventid")], 25) table(table(tmp$eventid)) # 1 2 3 4 5 6 7 8 10 11 # 73 78429 5156 842 222 66 18 14 3 1 # --> compare to table(num_start)! # Find out how often "Transform stop" follows each other num_stop <- c(diff(c(0, which(tmp$event == "Transform start")))) table(num_stop) tmp$eventrep <- rep(num_start, num_start) tmp$dupl <- duplicated(tmp[, c("event", "eventid")]) # keep first tmp$dupl <- duplicated(tmp[, c("event", "eventid")], fromLast = TRUE) # keep last tmp[tmp$eventrep == 10, ] tmp$dupl <- NULL tmp$eventrep <- NULL # remove duplicated "Transform start" events tmp <- tmp[!duplicated(tmp[, c("event", "eventid")]), ] # remove duplicated "Transform stop" events id_stop <- which(tmp$event == "Transform stop") id_rm_stop <- id_stop[diff(id_stop) == 1] tmp <- tmp[-(id_rm_stop + 1), ] # transform to wide data format tmp$event <- ifelse(tmp$event == "Transform start", "start", "stop") trans_wide <- reshape(tmp, direction = "wide", idvar = c("eventid", "artwork"), timevar = "event", drop = c("fileid", "popup", "card") ) # --> when fileid is part of the reshape, it does not work correctly, since # we sometimes have a start - stop event that is recorded in two separate # log files # TODO: This runs for quite some time. Is this more efficient with dplyr? # which(is.na(trans_wide$date.start)) trans_wide$event <- "move" trans_wide$eventid <- NULL rownames(trans_wide) <- NULL trans_wide$duration <- trans_wide$time_ms.stop - trans_wide$time_ms.start #trans_wide$duration2 <- trans_wide$date.stop - trans_wide$date.start # only seconds - not fine grained enough trans_wide$distance <- apply( trans_wide[, c("x.start", "y.start", "x.stop", "y.stop")], 1, function(x) dist(matrix(x, 2, 2, byrow = TRUE))) trans_wide$rotationDegree <- trans_wide$rotation.stop - trans_wide$rotation.start trans_wide$scaleSize <- trans_wide$scale.stop - trans_wide$scale.start dat_trans <- trans_wide[trans_wide$distance != 0 & trans_wide$rotationDegree != 0 & trans_wide$scaleSize != 0, ] # removes almost 2/3 of the data (for small data set) dat_trans <- dat_trans[, c("event", "artwork", "date.start", "date.stop", "time_ms.start", "time_ms.stop", "duration", "x.start", "y.start", "x.stop", "y.stop", "distance", "scale.start", "scale.stop", "scaleSize", "rotation.start", "rotation.stop", "rotationDegree")] summary(dat_trans) # TODO: Phillip fragen was mit `time_ms` schief läuft... Hat er eine # Erklärung dafür? #plot(time_ms.stop ~ time_ms.start, dat_trans, type = "b") plot(time_ms.stop ~ time_ms.start, dat_trans, col = rgb(red = 0, green = 0, blue = 0, alpha = 0.2)) plot(date.stop ~ date.start, dat_trans[1:1000,], type = "b") # TODO: Wie mit duration < 0 umgehen? Einfach auf NA setzen? For now... dat_trans[dat_trans$duration < 0, "duration"] <- NA #' # Close other events tmp <- dat[!dat$event %in% c("Transform start", "Transform stop"), ] tmp$x <- NULL tmp$y <- NULL tmp$scale <- NULL tmp$rotation <- NULL rownames(tmp) <- NULL # Create event ID for closing events # num_start <- diff(c(0, which(tmp$event == "Show Front"))) # tmp$trace <- rep(seq_along(num_start), num_start) # head(tmp[, c("artwork", "event", "trace")], 50) # TODO: How do I handle popups from glossar??? # --> does not work because of glossar entries... can't sort by artwork tmp$trace <- NA last_event <- tmp$event[1] aws <- unique(tmp$artwork)[unique(tmp$artwork) != "glossar"] # for (art in aws) { # select artwork for (i in 1:nrow(tmp)) { # go through rows if (last_event == "Show Info" & tmp$artwork[i] == art) { tmp$trace[i] <- i j <- i } else if (last_event == "Show Front" & tmp$artwork[i] == art) { tmp$trace[i] <- j } else if (!(last_event %in% c("Show Info", "Show Front")) & tmp$artwork[i] == art) { tmp$trace[i] <- j } if (i <= nrow(tmp)) { last_event <- tmp$event[i + 1] } } } head(tmp[, c("artwork", "event", "trace")], 50) tail(tmp[, c("artwork", "event", "trace")], 50) ## Fix glossar entries ### Find artwork for glossar entry tmp2 <- tmp[tmp$artwork == "glossar", ] glossar_files <- unique(tmp2$popup) # load lookup table for artworks and glossar files load("../data/glossar_dict.RData") lut <- glossar_dict[glossar_dict$glossar_file %in% glossar_files, ] # TODO: Find last "Artwork/OpenCard" that matches possible artwork head(tmp[, c("artwork", "event", "popup", "trace")], 20) #df <- NULL for (file in lut$glossar_file) { artwork_list <- unlist(lut[lut$glossar_file == file, "artwork"]) for (i in seq_len(nrow(tmp))) { if (tmp$event[i] == "Show Info") { current_artwork <- tmp[i, "artwork"] j <- i k <- i } else { current_artwork <- current_artwork } if (tmp$event[i] == "Show Front" & tmp$artwork[i] == current_artwork) { # make sure artwork has not been closed, yet! k <- i } if (tmp$artwork[i] == "glossar" & (current_artwork %in% artwork_list) & tmp$popup[i] == file & (j-k == 0)) { #df <- rbind(df, data.frame(file, current_artwork, i, j)) tmp[i, "trace"] <- tmp[j, "trace"] } } } # dim(tmp[is.na(tmp$trace), ]) # --> finds about half of the glossar entries for the small data set... # tmp[apply(df[, c("j", "i")], 1, c), c("artwork", "event", "popup", "trace")] # REMEMBER: It can never bo 100% correct, since it is always possible that # several cards are open and that they link at the same glossar entry # Fill in the glossar_files that are only associated with one artwork # How many glossar_files are only associated with one artwork? lut[sapply(lut$artwork, length) == 1, "glossar_file"] # TODO: Can I fill in the ones that are only associated with one artwork # easily? I can't come up with something --> maybe ask AK??? # TODO: How can I check if one of the former "Show Infos" is the correct # one? I can't come up with something --> maybe ask AK??? # for (file in lut$glossar_file) { # # artwork_list <- unlist(lut[lut$glossar_file == file, "artwork"]) # # for (i in seq_len(nrow(tmp))) { # # if (tmp$event[i] == "Show Info") { # # artworks <- NULL # current_artwork <- tmp[i, "artwork"] # j <- i # # } else { # # print(current_artwork) # artworks <- c(artworks, tmp[i, "artwork"]) # print(artworks) # # } # # # if (tmp$artwork[i] == "glossar" & # # (current_artwork %in% artwork_list) & # # tmp$popup[i] == file) { # # # # #df <- rbind(df, data.frame(file, current_artwork, i, j)) # # tmp[i, "trace"] <- tmp[j, "trace"] # # # } # } # } # correct: 17940 # incorrect: 17963 # TODO: For now: Exclude not matched glossar entries df <- subset(tmp, !is.na(tmp$trace)) df <- df[order(df$trace), ] rownames(df) <- NULL #' ## Close flipCard tmp <- subset(df, df$event %in% c("Show Info", "Show Front")) tmp$event <- ifelse(tmp$event == "Show Info", "start", "stop") dat_flipCard <- reshape(tmp, direction = "wide", idvar = c("trace", "artwork"), timevar = "event", drop = c("fileid", "popup", "card")) dat_flipCard$event <- "flipCard" dat_flipCard$duration <- dat_flipCard$time_ms.stop - dat_flipCard$time_ms.start dat_flipCard$duration <- ifelse(dat_flipCard$duration < 0, NA, dat_flipCard$duration) # TODO: Wie mit duration < 0 umgehen? Einfach auf NA setzen? For now... dat_flipCard <- dat_flipCard[, c("event", "artwork", "trace", "date.start", "date.stop", "time_ms.start", "time_ms.stop", "duration")] #' ## Close openTopic tmp <- subset(df, df$event %in% c("Artwork/OpenCard", "Artwork/CloseCard")) tmp <- tmp[order(tmp$artwork, tmp$date), ] rownames(tmp) <- NULL num_start <- diff(c(0, which(tmp$event == "Artwork/CloseCard"))) tmp$eventid <- rep(seq_along(num_start), num_start) tmp$event <- ifelse(tmp$event == "Artwork/OpenCard", "start", "stop") dat_openTopic <- reshape(tmp, direction = "wide", idvar = c("eventid", "trace", "artwork", "card"), timevar = "event", drop = c("fileid", "popup")) dat_openTopic$event <- "openTopic" dat_openTopic$duration <- dat_openTopic$time_ms.stop - dat_openTopic$time_ms.start dat_openTopic$duration <- ifelse(dat_openTopic$duration < 0, NA, dat_openTopic$duration) # TODO: Wie mit duration < 0 umgehen? Einfach auf NA setzen? For now... dat_openTopic <- dat_openTopic[, c("event", "artwork", "card", "trace", "date.start", "date.stop", "time_ms.start", "time_ms.stop", "duration")] # TODO: card should have a unique identifier for each artwork! #' ## close openPopup tmp <- subset(df, df$event %in% c("ShowPopup", "HidePopup")) tmp <- tmp[order(tmp$artwork, tmp$date), ] rownames(tmp) <- NULL num_start <- diff(c(0, which(tmp$event == "HidePopup"))) # last event is "ShowPopup"! Needs to be fixed TODO: Needs to be cought in # a function! num_start <- c(num_start, 1) tmp$eventid <- rep(seq_along(num_start), num_start) tmp$event <- ifelse(tmp$event == "ShowPopup", "start", "stop") dat_openPopup <- reshape(tmp, direction = "wide", idvar = c("eventid", "trace", "artwork", "popup"), timevar = "event", drop = c("fileid", "card")) # there is a pathological entry which gets deleted... # df[df$trace == 4595, ] # TODO: Some correct entries are not closed: df[df$trace == 1843, ] # WHY??? dat_openPopup$event <- "openPopup" dat_openPopup$duration <- dat_openPopup$time_ms.stop - dat_openPopup$time_ms.start dat_openPopup$duration <- ifelse(dat_openPopup$duration < 0, NA, dat_openPopup$duration) # TODO: Wie mit duration < 0 umgehen? Einfach auf NA setzen? For now... dat_openPopup <- dat_openPopup[, c("event", "artwork", "popup", "trace", "date.start", "date.stop", "time_ms.start", "time_ms.stop", "duration")] # Merge all dat_all <- merge(dat_trans, dat_flipCard, all = TRUE) dat_all <- merge(dat_all, dat_openTopic, all = TRUE) dat_all <- merge(dat_all, dat_openPopup, all = TRUE) # check nrow(dat_all) == (nrow(dat_trans) + nrow(dat_flipCard) + nrow(dat_openTopic) + nrow(dat_openPopup)) dat_all <- dat_all[order(dat_all$date.start), ] rownames(dat_all) <- NULL # TODO: Should card maybe also be filled in for "openPopup"? #' ## Remove "button presses" # Sort data frame by artwork and date dat <- dat[order(dat$artwork, dat$date), ] # remove "Transform start" and "Transform stop" following directly each # other, since I do not know how to interpret them as events id_start <- which(dat$event == "Transform start") id_stop <- which(dat$event == "Transform stop") id_rm_start <- id_start[diff(id_start) == 1] id_rm_stop <- id_stop[diff(id_stop) == 1] dat <- dat[-c(id_rm_start, id_rm_stop), ] rownames(dat) <- NULL id_start2 <- which(dat$event == "Transform start") id_stop2 <- which(dat$event == "Transform stop") length(id_start2) - length(id_stop2) # 340 --> "starts too many" # remove "Transform start" and "Transform stop" following directly each # other (but with events in between!) id_start_new <- id_start2 id_stop_new <- id_stop2 for (i in 2:length(id_start_new)) { if (id_start_new[i-1] < id_stop_new[i-1] & id_start_new[i] < id_stop_new[i-1]) { id_start_new <- id_start_new[-(i-1)] } else if (id_start_new[i-1] > id_stop_new[i-1] & id_start_new[i] > id_stop_new[i-1]) { id_stop_new <- id_stop_new[-(i-1)] } } length(id_start2) - length(id_start_new) length(id_stop2) - length(id_stop_new) ids <- data.frame(start = id_start_new, stop = id_stop_new) ids$diff <- ids$stop - ids$start table(ids$diff) # remove "Transform start" and "Transform stop" around other events id_rm_start2 <- id_start2[!(id_start2 %in% id_start_new)] id_rm_stop2 <- id_stop2[!(id_stop2 %in% id_stop_new)] # TODO: It still does not work correctly: dat[64764:64769,] # time_ms event artwork popup x y scale rotation # 64764 473081 Transform start 052 052.xml 1958.65 1505.75 0.8234455 -0.1351998 # 64765 474226 Show Info 052 052.xml NA NA NA NA # 64766 475735 Transform start 052 052.xml 1988.25 1625.25 0.9927645 2.4527958 # 64767 475739 Transform stop 052 052.xml 1988.25 1625.25 0.9927645 2.4527958 # 64768 479326 Artwork 052 052.xml NA NA NA NA # 64769 479751 Transform stop 052 052.xml 1660.90 1883.20 0.8074586 29.0875534 # --> but no idea how to find these cases in an automated way... dat <- dat[-c(id_rm_start2, id_rm_stop2), ] # --> Every start ends with a stop now (but not necessarily the correct one!) dat1 <- dat[order(dat$date, dat$time_ms), ] dat1$time_diff <- c(NA, diff(dat1$time_ms)) boxplot(time_diff ~ as.Date(date), dat1[dat1$time_diff > 1000 & dat1$time_diff < 4000, ]) boxplot(time_ms ~ event, dat1) #' ## Plots counts <- table(as.Date(dat$date), dat$event) lattice::barchart(counts, auto.key = TRUE) start_events <- c("Transform start", "Show Info", "ShowPopup", "Artwork/OpenCard") counts <- table(as.Date(dat$date[dat$event %in% start_events]), dat$event[dat$event %in% start_events]) lattice::barchart(counts, auto.key = TRUE) # TODO: Do I want to "collapse" the data frame in a way, that I only have # one event for each "set", meaning # # * Transform start + Transform stop --> Transform # * Artwork/OpenCard + Artwork/CloseCard --> Show Subcard # * ShowPopup + HidePopup --> Show Popup # * Show Info + Show Front --> Flip Card # (s.o. ;)) # # Then I would have meaningful variables like duration, distance, degree of # rotation, size of scaling, selection of Subcard etc. # This means that I would have to delete all "unclosed" events. # Create a data frame with # case event attributes (can differ for different events) # ?? # Is `artwork` my case? Or `artwork` per day? Or `artwork` per some other # unit??? Maybe look at differences between timestamps separately for # `artwork`? And identify "new observational unit" this way? # # Definition: (???) # 1. Touching a new `artwork` corresponds to "observational unit change" # 2. Time interval of XX min within one `artwork` on the same day # corresponds to "observational unit change" # id activity timestamp # Split data frame in list of data frame which all correspond to one # artwork # dat_art <- split(dat, dat$artwork) ## --> Maybe need it at some point? #' # Problems #' * Opening and closing of events cannot be identified unambiguously; it #' can happen that the wrong tags have been put together (e.g., Transform #' start and Transform stop); therefore, durations etc. are only heuristic