R/eventMerge.R

In KWB-R/kwb.event: Generate Events from Time Series and Work with Events

# getParallelEventsInfo --------------------------------------------------------

#' Information on Events in parallel
#' 
#' @param eventLists list of data frames, each of which represents a list of
#'   events as e.g. generated by \code{\link{hsEvents}}
#'
#' @return data frame with timestamps in the first column indicating any begin
#'   or end of any event within \emph{eventLists} and columns for each element
#'   of \emph{eventLists}, containing event numbers. If you go along one row you
#'   can find the events that occur in parallel.
#' 
getParallelEventsInfo <- function(eventLists)
{
  n <- length(eventLists)
  
  eventLimits <- kwb.utils::rbindAll(lapply(seq_len(n), function(i) {
    kwb.utils::selectColumns(eventLists[[i]], c("tBeg", "tEnd"))
  }))

  x <- data.frame(eventLimit = sort(kwb.datetime::toUTC(
    unique(c(eventLimits$tBeg, eventLimits$tEnd))
  )))
  
  for (i in seq_len(n)) {
    
    x <- cbind(x, hsEventNumber(x$eventLimit, eventLists[[i]]))
  }  
  
  colnames(x)[-1] <- names(eventLists)
  
  x
}

# mergeAllEvents ---------------------------------------------------------------

#' Merge all Events
#' 
#' 'merge' all events in a list of event lists
#' 
#' @param eventList list of data frames, each of which represents a list of
#'   events as e.g. generated by \code{\link{hsEvents}}
#' @param dbg if TRUE, debug messages are shown
#' 
mergeAllEvents <- function(eventList, dbg = TRUE) 
{
  n <- length(eventList)
  
  stopifnot(n > 0)
  
  events <- eventList[[1]]
  
  if (n > 1) {
    
    for (i in 2:n) {
      
      eventsToMerge <- eventList[[i]]
      
      kwb.utils::catIf("merging events:", names(eventList)[i], "...\n")

      events <- hsMergeEvents(events, eventsToMerge)
    }      
  }
  
  events
}

# hsMergeEvents ----------------------------------------------------------------

#' Merge two Event Lists
#' 
#' Events in data frames \emph{events1} and \emph{events2} are merged in such a 
#' way that overlapping events are combined to one event and events that are 
#' fully contained in other events are discarded.
#' 
#' @param events1 data frame containing events as provided by e.g. hsEvents
#' @param events2 data frame containing events as provided by e.g. hsEvents
#' @param renumber if TRUE, rows in result data frame are renumbered from one to
#'   number of rows.
#' @param dbg if \code{TRUE}, debug messages are shown.
#' 
#' @return data frame with fields \emph{tBeg}, \emph{tEnd}, \emph{dur}
#'   containing the times of event begin and event end and the event duration in
#'   seconds, respectively. The event duration is the difference between end and
#'   begin of the event plus the time period that one timestamp represents 
#'   (signal width).
#' 
hsMergeEvents <- function(events1, events2, renumber = TRUE, dbg = FALSE) 
{  
  ## Return events1 if events2 is empty or events2 if events1 is empty
  if (length(events2) == 0) return(events1)
  if (length(events1) == 0) return(events2)
  
  ## Save current time unit; leading time unit is time unit of events1
  timeUnit1 <- attr(events1, "tUnit")
  timeUnit2 <- attr(events2, "tUnit")
  
  if ((! is.null(timeUnit1) || ! is.null(timeUnit2)) && (timeUnit1 != timeUnit2)) {
    
    cat(
      "Warning: event lists are in different time units. ", 
      "Result time unit will be time unit of first event list: ", 
      timeUnit1, "\n"
    )
  }
  
  ## Convert durations and pauses to seconds
  events1 <- hsEventsToUnit(events1, "s")
  events2 <- hsEventsToUnit(events2, "s")
  
  kwb.utils::catIf(
    dbg, 
    sprintf(" events in event list 1: %d\n", nrow(events1)),
    sprintf( "events in event list 2: %d\n", nrow(events2))
  )
  
  ## Define result columns. We do not use begin and end index of the events 
  ## as the indices loose their context.
  resCols <- c("tBeg", "tEnd", "dur", "pBefore", "pAfter") 
  
  # Guarantee that both data frames contain all possible "event" columns  
  cols <- c("iBeg", "iEnd", resCols)
  
  events1 <- kwb.utils::hsAddMissingCols(events1, cols)
  events2 <- kwb.utils::hsAddMissingCols(events2, cols)
  
  ## append events2 to events1 and reorder all events by their start time  
  evts <- rbind(events1[resCols], events2[resCols])
  evts <- evts[order(evts$tBeg), ]
  
  ## number of events
  ne <- nrow(evts)
  
  kwb.utils::catIf(dbg, "total number of events:", ne, "\n")
  
  ## Set the time unit attribute in the event list to "s" 
  attr(evts, "tUnit") <- "s"
  
  ## Calculate signal width from events in evts
  sigWidth <- hsSigWidth(evts, dbg = dbg)
  
  kwb.utils::catIf(dbg, "Encountered signal width:", sigWidth, "\n")
  
  ## sub function for adding an event to the result event list
  evt.add <- function(evt) {
    kwb.utils::catIf(dbg, "  Writing current event\n")      
    evt$dur <- as.integer(evt$tEnd) - as.integer(evt$tBeg) + sigWidth
    rbind(res, evt)      
  }
  
  ## sub function for making event i to current event
  evt.new <- function(i) {
    kwb.utils::catIf(dbg, "New current event:", i, "\n")
    evts[i, ]
  }
  
  ## Prepare result data frame
  res <- data.frame()
  
  ## Get first event
  evt <- evt.new(1)
  
  ## Loop through following events  
  for (i in 2:ne) {
    
    ## Does current event fit in last event?
    if (evts$tBeg[i] <= evt$tEnd) {
      
      kwb.utils::catIf(dbg, "  Joining event", i, "with current event\n")
      
      evt$tEnd <- max(evt$tEnd, evts$tEnd[i])
      
    } else {
      
      ## Write last event and get this event
      ## Calculate duration of evt and add evt to result data frame
      res <- evt.add(evt)
      evt <- evt.new(i)
    }
  }
  
  ## Write last event
  res <- evt.add(evt)
  
  ## Return result list of events with renumbered rows
  if (renumber) {
    
    res <- kwb.utils::resetRowNames(res)
  }
  
  ## delete empty columns before returning the result data frame
  res <- kwb.utils::hsDelEmptyCols(res)
  
  ## Set the time unit attribute in the result event list to "s" 
  ## Calculate duration and pauses back to original time unit
  hsEventsToUnit(structure(res, tUnit = "s"), timeUnit1)
}