tests/testthat/test-aoristic-df.R

In aoristic: Generates Aoristic Probability Distributions

test_that("all 168 hourly probability columns are created", {
  result <- run_aoristic(make_events("2024-01-07 10:15:00", "2024-01-07 10:15:00"))
  expect_identical(names(result)[6:173], paste0("hour", seq_len(168)))
})

test_that("precisely known and one-minute events stay in the start hour", {
  precise <- run_aoristic(make_events("2024-01-07 10:15:00", "2024-01-07 10:15:00"))
  one_minute <- run_aoristic(make_events("2024-01-07 10:15:00", "2024-01-07 10:16:00"))

  expect_equal(hour_values(precise)[11], 1)
  expect_equal(hour_values(one_minute)[11], 1)
  expect_equal(sum(hour_values(precise)), 1)
  expect_equal(sum(hour_values(one_minute)), 1)
})

test_that("intervals within and across hours use minute-level allocation", {
  within <- run_aoristic(make_events("2024-01-07 10:10:00", "2024-01-07 10:40:00"))
  across <- run_aoristic(make_events("2024-01-07 10:30:00", "2024-01-07 12:00:00"))

  expect_equal(hour_values(within)[11], 1)
  expect_equal(hour_values(across)[11:12], c(1 / 3, 2 / 3))
  expect_equal(sum(hour_values(across)), 1, tolerance = 1e-12)
})

test_that("exact hour boundaries do not spill into the ending hour", {
  result <- run_aoristic(make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00"))
  expect_equal(hour_values(result)[11], 1)
  expect_equal(hour_values(result)[12], 0)
})

test_that("midnight and week boundaries wrap correctly", {
  midnight <- run_aoristic(make_events("2024-01-07 23:30:00", "2024-01-08 00:30:00"))
  week_wrap <- run_aoristic(make_events("2024-01-06 23:30:00", "2024-01-07 00:30:00"))

  expect_equal(hour_values(midnight)[24:25], c(0.5, 0.5))
  expect_equal(hour_values(week_wrap)[c(168, 1)], c(0.5, 0.5))
})

test_that("missing end and reversed intervals use the start hour", {
  missing_end <- make_events("2024-01-07 10:15:00", NA_character_)
  reversed <- make_events("2024-01-07 10:15:00", "2024-01-07 09:15:00")

  missing_result <- run_aoristic(missing_end)
  reversed_result <- run_aoristic(reversed)

  expect_equal(hour_values(missing_result)[11], 1)
  expect_equal(hour_values(reversed_result)[11], 1)
  expect_true(is.na(missing_result$duration))
  expect_equal(reversed_result$duration, -60)
  expect_equal(sum(hour_values(missing_result)), 1)
  expect_equal(sum(hour_values(reversed_result)), 1)
})

test_that("missing starts are ignored without affecting other rows", {
  data <- make_events(
    c(NA_character_, "2024-01-07 10:00:00"),
    c("2024-01-07 11:00:00", "2024-01-07 10:30:00")
  )
  expect_message(result <- aoristic.df(data, "x", "y", "from", "to"), "No START date-time found in row 1")
  expect_equal(sum(as.numeric(result[1, paste0("hour", 1:168)])), 0)
  expect_equal(sum(as.numeric(result[2, paste0("hour", 1:168)])), 1)
})

test_that("week-long and longer intervals are uniform", {
  one_week <- run_aoristic(make_events("2024-01-07 00:00:00", "2024-01-14 00:00:00"))
  longer <- run_aoristic(make_events("2024-01-07 00:00:00", "2024-01-15 00:00:00"))

  expect_equal(hour_values(one_week), rep(1 / 168, 168))
  expect_equal(hour_values(longer), rep(1 / 168, 168))
  expect_equal(sum(hour_values(one_week)), 1, tolerance = 1e-12)
})

test_that("valid analyzed observations are normalized", {
  data <- make_events(
    c("2024-01-07 10:00:00", "2024-01-07 10:17:00", "2024-01-06 23:45:00"),
    c("2024-01-07 10:00:00", "2024-01-07 14:53:00", "2024-01-07 01:13:00")
  )
  result <- run_aoristic(data)
  totals <- rowSums(result[paste0("hour", seq_len(168))])
  expect_equal(totals, rep(1, 3), tolerance = 1e-12)
})

test_that("column arguments are validated", {
  data <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  expect_error(aoristic.df(data, "missing", "y", "from", "to"), "missing")
  expect_error(aoristic.df(data, character(), "y", "from", "to"), "Xcoord")
  expect_error(aoristic.df(data, c("x", "y"), "y", "from", "to"), "Xcoord")
})

test_that("datetime columns must inherit from POSIXct", {
  data <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  data$from <- format(data$from)
  expect_error(aoristic.df(data, "x", "y", "from", "to"), "DateTimeFrom.*POSIXct")
  data <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  data$to <- as.POSIXlt(data$to)
  expect_error(aoristic.df(data, "x", "y", "from", "to"), "DateTimeTo.*POSIXct")
})

test_that("coordinate columns must be numeric", {
  data <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  data$x <- "east"
  expect_error(aoristic.df(data, "x", "y", "from", "to"), "X coordinate.*numeric")
  data <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  data$y <- "north"
  expect_error(aoristic.df(data, "x", "y", "from", "to"), "Y coordinate.*numeric")
})

test_that("timezone is retained and controls weekly hour placement", {
  data <- make_events("2024-01-07 23:30:00", "2024-01-08 00:30:00", tz = "America/New_York")
  original_from <- data$from
  original_to <- data$to
  result <- run_aoristic(data)
  expect_identical(attr(result$datetime_from, "tzone"), "America/New_York")
  expect_identical(result$datetime_from, original_from)
  expect_identical(result$datetime_to, original_to)
  expect_equal(hour_values(result)[24:25], c(0.5, 0.5))
})

test_that("DST transitions use elapsed minutes and remain normalized", {
  spring <- run_aoristic(make_events(
    "2024-03-10 01:30:00", "2024-03-10 03:30:00", tz = "America/New_York"
  ))
  fall <- run_aoristic(make_events(
    "2024-11-03 00:30:00", "2024-11-03 02:30:00", tz = "America/New_York"
  ))

  expect_equal(spring$duration, 60)
  expect_equal(hour_values(spring)[2:3], c(0.5, 0.5))
  expect_equal(fall$duration, 180)
  expect_equal(sum(hour_values(fall)), 1, tolerance = 1e-12)
})

test_that("diagnostics are initialized and not duplicated", {
  valid <- make_events("2024-01-07 10:00:00", "2024-01-07 11:00:00")
  expect_message(result <- aoristic.df(valid, "x", "y", "from", "to"), "Aoristic data frame created")
  expect_s3_class(result, "data.frame")

  reversed <- make_events("2024-01-07 11:00:00", "2024-01-07 10:00:00")
  messages <- capture.output(
    invisible(aoristic.df(reversed, "x", "y", "from", "to")),
    type = "message"
  )
  expect_equal(sum(grepl("before START/FROM", messages, fixed = TRUE)), 1)
})