R/events.R

In ajaypillarisetti/sumr: Ingest, Clean, and Interpret Stove Use Monitoring Data

#' Number Events
#' 
#' Generate unique identifiers for each event, based on indicator of being in an event.
#' Nonevent periods are labelled NA
#' @param label A binary vector, where TRUE indicates an event
#' @export
number_events <- function(label){
  runs <- rle(label)
  runs$values[is.na(runs$values)] <- FALSE
  runs$values = ifelse(runs$values == TRUE, cumsum(runs$values), NA)
  event_nums = inverse.rle(runs)
  return(event_nums)
}


#' Smooth Events
#' 
#' Reduce "blipiness" in event indicators by eliminating small cooking events and gaps
#' @param label A binary vector, where TRUE indicates an event
#' @param sample_interval the sample interval in seconds
#' @param min_event_sec minmum number of seconds in a real event
#' @param min_break_sec minmum number of seconds in a real non-event
#' @export
smooth_events <- function(label, sample_interval, min_event_sec = 5*60, min_break_sec = 30 * 60){
  
  # use first entry if sample interval is vector
  sample_interval <- sample_interval[1]
  rl_obj <- rle(label)
  
  #remove short breaks between cooking
  rl_obj$values[(rl_obj$lengths * sample_interval) < min_break_sec & rl_obj$values == F] = T
  label <- inverse.rle(rl_obj)
  
  #remove short cooking events
  rl_obj2 <- rle(label)
  rl_obj2$values[(rl_obj2$lengths * sample_interval) < min_event_sec & rl_obj2$values == T] = F
  label <- inverse.rle(rl_obj2)
  
  return(label)
}



list_events_file <- function(data, event=NULL){
  if(is.null(event)){
    event <- data$label
  }
  
  sample_interval <- get_sample_interval(data)
  labeled_data <- copy(data)
  labeled_data$event_num <- number_events(event)
  events <- labeled_data[!is.na(event_num),
                         list(start_time = min(timestamp, na.rm = T),
                              stop_time = max((timestamp + sample_interval), na.rm = T),
                              min_temp = min(value, na.rm = T),
                              max_temp = max(value, na.rm = T)
                               ),
                         by=list(event_num)]
  events[,duration_mins := (as.numeric(difftime(stop_time, start_time, unit='secs')))/60]
  
  
  return(events)
}
    
#' List Events
#' 
#' Generate a list of events
#' @param data a sumsarizer formatted data table for one or more sensor missions
#' @export
list_events <- function(data){
  events <- data[,list_events_file(.SD),by=list(filename)]
  
  return(events)  
}

#' Summarize Events
#' 
#' Generate basic event summaries
#' @param events a table of events as generated by \code{\link{list_events}}
#' @export
event_summaries <- function(events){
  summaries <- events[,list(total_duration_mins=sum(duration_mins), nevents=.N),by=list(filename)]
  
  return(summaries)
}