R/aoristic.df.R

In aoristic: Generates Aoristic Probability Distributions

#' Calculate aoristic weights
#'
#' Calculates aoristic proportional weights across 168 units representing each
#' hour of the week (24 hours x 7 days). It is designed for situations when an
#' event time is not known but could be spread across numerous hours or days,
#' represented by Start/From and End/To date-times.
#'
#' If an observation is missing the End/To date-time, or its End/To precedes
#' its Start/From, the entire weight is assigned to the hour containing the
#' Start/From date-time. Durations of at least one week receive a uniform
#' probability of `1/168` in every hour.
#'
#' @param data1 Data frame containing coordinates and date-time columns.
#' @param Xcoord Name of the numeric X coordinate or latitude column.
#' @param Ycoord Name of the numeric Y coordinate or longitude column.
#' @param DateTimeFrom Name of the Start/From POSIXct column.
#' @param DateTimeTo Name of the End/To POSIXct column.
#' @return A data frame with source fields, duration in whole elapsed minutes,
#'   and aoristic probabilities for every hour of the week.
#' @examples
#' df <- aoristic.df(dcburglaries, "X", "Y", "StartDateTime", "EndDateTime")
#' @export
#' @references Ratcliffe, J. H. (2002). Aoristic signatures and the
#' spatio-temporal analysis of high volume crime patterns. Journal of
#' Quantitative Criminology, 18(1), 23-43.
aoristic.df <- function(data1, Xcoord, Ycoord, DateTimeFrom, DateTimeTo) {
  .validate_aoristic_inputs(data1, Xcoord, Ycoord, DateTimeFrom, DateTimeTo)

  df1 <- data.frame(
    x_lon = data1[[Xcoord]],
    y_lat = data1[[Ycoord]],
    datetime_from = data1[[DateTimeFrom]],
    datetime_to = data1[[DateTimeTo]]
  )

  # Direct POSIXct subtraction measures elapsed time correctly across DST.
  # Partial minutes are rounded down to preserve the established method.
  df1$duration <- floor(as.numeric(difftime(
    df1$datetime_to, df1$datetime_from, units = "mins"
  )))
  errors.missing <- sum(is.na(df1$datetime_to))
  errors.logic <- sum(df1$duration < 0, na.rm = TRUE)

  hour.names <- paste0("hour", seq_len(168))
  df1[hour.names] <- 0

  for (i in seq_len(nrow(df1))) {
    from <- df1$datetime_from[i]
    if (is.na(from)) {
      message("Warning message: No START date-time found in row ", i, ". Row will be ignored.")
      next
    }

    from.day <- lubridate::wday(from)
    from.hour <- lubridate::hour(from)
    hour.position <- 24 * (from.day - 1) + from.hour + 1
    current.hour <- paste0("hour", hour.position)
    time.span <- df1$duration[i]

    # An unknown end is not represented as an observed one-minute duration.
    if (is.na(df1$datetime_to[i])) {
      df1[i, current.hour] <- 1
      next
    }

    # Preserve compatibility for reversed and precisely known intervals.
    if (time.span < 0 || time.span <= 1) {
      df1[i, current.hour] <- 1
      next
    }

    if (time.span >= 7 * 24 * 60) {
      df1[i, hour.names] <- 1 / 168
      next
    }

    # Allocate elapsed minutes to successive hours, wrapping after Saturday.
    remaining <- time.span
    left.in.hour <- 60 - lubridate::minute(from)
    probability.per.minute <- 1 / time.span
    while (remaining > 0) {
      allocated <- min(remaining, left.in.hour)
      df1[i, current.hour] <- df1[i, current.hour] + allocated * probability.per.minute
      remaining <- remaining - allocated
      if (remaining > 0) {
        hour.position <- if (hour.position == 168) 1 else hour.position + 1
        current.hour <- paste0("hour", hour.position)
        left.in.hour <- 60
      }
    }
  }

  message("\nAoristic data frame created.")
  if (errors.missing > 0) {
    message("  ", errors.missing, " row(s) were missing END/TO datetime values.")
  }
  if (errors.logic > 0) {
    message("  ", errors.logic, " row(s) had END/TO datetimes before START/FROM datetimes.")
  }
  if (errors.missing > 0 || errors.logic > 0) {
    message(
      "  Use 'aoristic.datacheck()' to identify these rows.\n",
      "  '?aoristic.datacheck' explains how aoristic.df handles these data."
    )
  }

  df1
}