mtt/R/add_trace.R

###########################################################################
add_trace_artworks <- function(subdata) {
  last_event <- subdata$event[1]
  artworks <- unique(subdata$artwork)[unique(subdata$artwork) != "glossar"]
  n <- 1    # count artworks for progress

  pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA,
                       style = 3)

  for (artwork in artworks) {

    cat("\n\nAdding trace variable for artwork", artwork,
               paste0("(", n, "/", length(artworks), ")"), "\n")

    for (i in 1:nrow(subdata)) {
      if (last_event == "Show Info" & subdata$artwork[i] == artwork) {
        subdata$trace[i] <- i
        j <- i
      } else if (last_event == "Show Front" & subdata$artwork[i] == artwork) {
        subdata$trace[i] <- j
      } else if (!(last_event %in% c("Show Info", "Show Front")) &
                 subdata$artwork[i] == artwork) {
        subdata$trace[i] <- j
      }
      if (i <= nrow(subdata)) {
        last_event <- subdata$event[i + 1]
      }
      utils::setTxtProgressBar(pb, i)
    }
    n <- n + 1
  }
  subdata
}

###########################################################################
add_trace_glossar <- function(subdata, xmlpath) {

  pb <- utils::txtProgressBar(min = 0, max = nrow(subdata), initial = NA,
                       style = 3)

  cat("\n\n########## Creating glossar dictionary ##########", "\n")
  artworks      <- unique(subdata$artwork[subdata$artwork != "glossar"])
  glossar_files <- unique(subdata[subdata$artwork == "glossar", "popup"])
  lut           <- create_glossardict(artworks, glossar_files, xmlpath = xmlpath)
  inside        <- glossar_files[glossar_files %in%
                                 names(lut[sapply(lut, length) == 1])]
  single_art    <- unlist(lut[names(lut) %in% inside])

  m <- 1

  for (file in names(lut)) {

    cat("\n\nAdding trace variable for glossar entry", file,
               paste0("(", m, "/", length(lut), ")"), "\n")

    artwork_list <- unlist(lut[names(lut) == file])

    for (i in seq_len(nrow(subdata))) {
      if (subdata$event[i] == "Show Info" |
          (subdata$event[i] == "Artwork/OpenCard" &
           subdata$artwork[i] %in% single_art)) {
        current_artwork <- subdata[i, "artwork"]
        j <- i
        k <- i
      } else {
        current_artwork <- current_artwork
      }
      if (subdata$event[i] == "Show Front" & subdata$artwork[i] == current_artwork) {
      # make sure artwork has not been closed, yet!
        k <- i
      }
      if (subdata$artwork[i] == "glossar" &
          (current_artwork %in% artwork_list) &
          subdata$popup[i] == file & (j - k == 0)) {
        subdata[i, "trace"]   <- subdata[j, "trace"]
        subdata[i, "artwork"] <- current_artwork
      }
      utils::setTxtProgressBar(pb, i)
    }
    m <- m + 1
  }

  # Exclude not matched glossar entries
  cat("\n\nINFORMATION: glossar entries that are not matched will be removed:",
      sum(is.na(subdata[subdata$glossar == 1, "trace"])), "entries",
      fill = TRUE)
  subset(subdata, !is.na(subdata$trace))
}

###########################################################################
add_trace <- function(data, xmlpath, glossar) {

  data$trace <- NA
  subdata1 <- data[data$event %in% c("Transform start", "Transform stop"), ]
  subdata2 <- data[!data$event %in% c("Transform start", "Transform stop"), ]

  subdata2 <- add_trace_artworks(subdata2)

  if (glossar) {
    subdata2 <- add_trace_glossar(subdata2, xmlpath)
  } else {
    subdata2 <- subdata2[subdata2$glossar != 1, ]
  }

  out <- rbind(subdata1, subdata2)
  out <- out[order(out$fileId, out$date, out$timeMs), ]
  out
}

###########################################################################

# Add trace for moves

add_trace_moves <- function(data) {

  pbapply::pboptions(style = 3, char = "=")

  trace_max <- max(data$trace, na.rm = TRUE)

  #subdata_art <- split(data, ~ artwork)
  subdata_case <- split(data, ~ case)

  #subdata_list <- split(data, ~ artwork + case)
  # --> does not work with complete data set
  cat("Splitting data...", "\n")
  subdata_list <- pbapply::pblapply(subdata_case, split, f = ~artwork)
  subdata_list <- unlist(subdata_list, recursive = FALSE)

  cat("Adding trace...", "\n")
  subdata_trace <- pbapply::pblapply(subdata_list,
        function(x) {
          trace_max <<- trace_max + 1
          add_trace_subdata(x, max_trace = trace_max)
        }
      )

  out <- dplyr::bind_rows(subdata_trace)
  out <- out[order(out$fileId.start, out$date.start, out$timeMs.start), ]
  rownames(out) <- NULL

  # Make trace a consecutive number
  out$trace <- as.numeric(factor(out$trace, levels = unique(out$trace)))
  out
}


add_trace_subdata <- function(subdata, max_trace) {

  if (nrow(subdata) != 0) {

    if (length(stats::na.omit(unique(subdata$trace))) == 1) {
      subdata[subdata$event == "move", "trace"] <- stats::na.omit(unique(subdata$trace))
    } else if (length(stats::na.omit(unique(subdata$trace))) > 1) {
      for (i in 1:nrow(subdata)) {
        if (subdata$event[i] == "move") {
          if (i == 1) {
            subdata$trace[i] <- stats::na.omit(unique(subdata$trace))[1]
          } else {
            subdata$trace[i] <- subdata$trace[i - 1]
          }
        }
      }
    } else if (all(is.na(subdata$trace))) {
      for (i in 1:nrow(subdata)) {
        subdata$trace[i] <- max_trace
      }
    }

  } else {
    warning("subdata has nrow = 0")
  }
  subdata
}