R/add_trace.R

@@ -1,55 +1,37 @@
 ###########################################################################
 add_path_items <- function(subdata) {
-  subdata_glossar <- subdata[subdata$item == "glossar", ]
+  last_event <- subdata$event[1]
-  subdata_glossar$path <- NA
-
   items <- unique(subdata$item)[unique(subdata$item) != "glossar"]
+  n <- 1    # count items for progress
 
-  path_per_item <- function(subdata, item) {
+  pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA,
+                       style = 3)
 
-    subsubdata <- subdata[subdata$item == item, ]
+  for (item in items) {
-    last_event <- subsubdata$event[1]
+
-    subsubdata$path <- NA
+    cat("\n\nAdding path variable for item", item,
-    for (i in 1:nrow(subsubdata)) {
+               paste0("(", n, "/", length(items), ")"), "\n")
-      if (last_event == "Show Info") {
+
-        subsubdata$path[i] <- i
+    for (i in 1:nrow(subdata)) {
+      if (last_event == "Show Info" & subdata$item[i] == item) {
+        subdata$path[i] <- i
         j <- i
-        status <- "path_started"
+      } else if (last_event == "Show Front" & subdata$item[i] == item) {
-      } else if (last_event == "Show Front") {
+        subdata$path[i] <- j
-        subsubdata$path[i] <- j
-        status <- "path_ended"
       } else if (!(last_event %in% c("Show Info", "Show Front")) &
-                 status == "path_started") {
+                 subdata$item[i] == item) {
-        subsubdata$path[i] <- j
+        subdata$path[i] <- j
       }
-      if (i <= nrow(subsubdata)) {
+      if (i <= nrow(subdata)) {
-        last_event <- subsubdata$event[i + 1]
+        last_event <- subdata$event[i + 1]
       }
+      utils::setTxtProgressBar(pb, i)
     }
-    subsubdata$path <- ifelse(is.na(subsubdata$path), NA,
+    n <- n + 1
-                              paste0(item, "_", subsubdata$path))
-    subsubdata
   }
-
-  subdata_list <- pbapply::pblapply(items, path_per_item, subdata = subdata)
-  subdata <- dplyr::bind_rows(subdata_list)
-
-  # Remove popup events that occur after item has been closed
-  subdata <- subdata[!is.na(subdata$path), ]
-
-  # Add glossar events back in
-  subdata <- rbind(subdata, subdata_glossar)
-
-  # Bring back in time order
-  subdata <- subdata[order(subdata$fileId, subdata$date), ]
-
-  # Make path a consecutive number
-  subdata$path <- as.numeric(factor(subdata$path, levels = unique(subdata$path)))
-  rownames(subdata) <- NULL
   subdata
 }
 
-
 ###########################################################################
 add_path_glossar <- function(subdata, xmlpath) {
 
@@ -156,6 +138,8 @@ add_path_moves <- function(data) {
   out <- out[order(out$fileId.start, out$date.start, out$timeMs.start), ]
   rownames(out) <- NULL
 
+  # Make path a consecutive number
+  out$path <- as.numeric(factor(out$path, levels = unique(out$path)))
   out
 }