tests/testthat/test-geneabout_functions.R

In GENEAcore: Pre-Processing of 'GENEActiv' Data

library(testthat)
local({
  ## Nonwear rest coverage

  bouts <- data.frame(
    TimeUTC = c(1, 16, 30, 43, 55, 66, 76),
    Duration = c(15, 14, 13, 12, 11, 10, 9),
    AGSAMean = c(0.0062, 0.5, 0.18, 0.15, 0.0822, 0.0078, 0.0023)
  )

  nonwear_day <- data.frame(
    nonwear_start = c(33, 75),
    nonwear_end = c(58, 87),
    MPI_nonwear_duration = c(25, 12)
  )

  TEMPMPI <- list()
  TEMPMPI$non_movement$rest_intervals <- data.frame(
    start_time = 1,
    duration = 20
  )

  TEMPMPI$non_movement$still_bouts <- data.frame(
    start_time = c(3, 45, 72),
    duration = c(32, 10, 3)
  )

  expected_nonwearseconds <- c(0, 0, 10, 12, 3, 1, 9)
  expected_restseconds <- c(15, 5, 0, 0, 0, 0, 0)
  expected_stillseconds <- c(13, 14, 5, 10, 0, 3, 0)

  bouts <- nonwear_rest_coverage(MPI = TEMPMPI, aggregated_data = bouts, nonwear_day = nonwear_day)

  test_that("Nonwear rest coverage calculates the correct non-wear duration per event.", {
    expect_equal(bouts$NonWearSeconds, expected_nonwearseconds)
  })
  test_that("Nonwear rest coverage calculates the correct rest duration per event.", {
    expect_equal(bouts$RestSeconds, expected_restseconds)
  })
  test_that("Nonwear rest coverage calculates the correct still duration per event.", {
    expect_equal(bouts$StillSeconds, expected_stillseconds)
  })

  nonwear_day <- data.frame(
    nonwear_start = NULL,
    nonwear_end = NULL,
    MPI_nonwear_duration = NULL
  )

  TEMPMPI$non_movement$rest_intervals <- data.frame(
    start_time = NULL,
    duration = NULL
  )

  TEMPMPI$non_movement$still_bouts <- data.frame(
    start_time = numeric(),
    duration = numeric(),
    number_events = numeric()
  )

  expected_nonwearseconds <- c(0, 0, 0, 0, 0, 0, 0)
  expected_restseconds <- c(0, 0, 0, 0, 0, 0, 0)
  expected_stillseconds <- c(0, 0, 0, 0, 0, 0, 0)

  bouts <- nonwear_rest_coverage(MPI = TEMPMPI, aggregated_data = bouts, nonwear_day = nonwear_day)

  test_that("Nonwear rest coverage calculates no non-wear duration per event.", {
    expect_equal(bouts$NonWearSeconds, expected_nonwearseconds)
  })
  test_that("Nonwear rest coverage calculates no rest duration per event.", {
    expect_equal(bouts$RestSeconds, expected_restseconds)
  })
  test_that("Nonwear rest coverage calculates no still duration per event.", {
    expect_equal(bouts$StillSeconds, expected_stillseconds)
  })

  ## Find rest intervals

  TEMPMPI <- list()
  TEMPMPI$non_movement$non_wear <- data.frame(start_time = 194, duration = 5)
  TEMPMPI$non_movement$still_bouts <- data.frame(
    start_time = c(1, 6, 16, 31, 81, 86, 111, 146, 191),
    duration = c(5, 10, 15, 20, 5, 25, 35, 45, 2),
    number_events = rep(1, 9)
  )

  TEMPMPI$file_data[["MeasurementStartTimeUTC"]] <- 1
  TEMPMPI$file_data[["MeasurementEndTimeUTC"]] <- 200
  TEMPMPI$file_data[["FirstLocalMidnightTimeUTC"]] <- 80

  TEMPMPI <- find_rest_intervals(10, 5, "00:00", TEMPMPI)

  expected_rest_intervals <- data.frame(
    start_time = c(1, 81),
    duration = c(50, 112),
    day_number = c(1, 2)
  )

  test_that("MPI stores the correct rest interval recommendations for each day.", {
    expect_equal(TEMPMPI$non_movement$rest_intervals, expected_rest_intervals)
  })

  TEMPMPI$non_movement$non_wear <- data.frame(start_time = 193, duration = 5)

  TEMPMPI <- find_rest_intervals(10, 100, "00:00", TEMPMPI)

  expected_rest_intervals <- data.frame(
    start_time = c(1, 81),
    duration = c(50, 110),
    day_number = c(1, 2)
  )

  test_that("Rest interval disregards still bout that overlaps a non-wear period.", {
    expect_equal(TEMPMPI$non_movement$rest_intervals, expected_rest_intervals)
  })

  TEMPMPI <- list()
  TEMPMPI$non_movement$still_bouts <- data.frame(
    start_time = as.POSIXct(
      c(
        "2026-01-01 10:00:00",
        "2026-01-01 17:00:00",
        "2026-01-01 22:30:00"
      ),
      tz = "GMT"
    ),
    duration = c(8 * 60 * 60, 3 * 60 * 60, 8 * 60 * 60)
  )
  TEMPMPI$non_movement$non_wear <- data.frame(
    start_time = as.POSIXct("2026-01-01 20:00:00", tz = "GMT"),
    duration = 2 * 60 * 60
  )
  TEMPMPI$file_data[["MeasurementStartTimeUTC"]] <- as.POSIXct("2026-01-01 08:00:00", tz = "GMT")
  TEMPMPI$file_data[["MeasurementEndTimeUTC"]] <- as.POSIXct("2026-01-02 08:00:00", tz = "GMT")
  TEMPMPI$file_data[["FirstLocalMidnightTimeUTC"]] <- as.POSIXct("2026-01-02 00:00:00", tz = "GMT")

  TEMPMPI <- find_rest_intervals(0, 0, "15:00", TEMPMPI)

  expected_rest_intervals <- data.frame(
    start_time = c(as.POSIXct("2026-01-01 10:00:00", tz = "GMT"), as.POSIXct("2026-01-01 22:30:00", tz = "GMT")),
    duration = c(28800, 28800),
    day_number = c(1,2)
  )

  test_that("Rest interval disregards still bout that overlaps a non-wear period.", {
    expect_equal(TEMPMPI$non_movement$rest_intervals, expected_rest_intervals)
  })

  ## Bouts decision tree

  bouts <- data.frame(
    TimeUTC = c(1, 16, 30, 43, 55, 66, 76),
    Duration = c(15, 14, 13, 12, 11, 10, 9),
    xSD = c(0.0001, 0.2, 0.002, 0.002, 0.4, 0.008, 0.0001),
    ySD = c(0.0001, 0.2, 0.002, 0.002, 0.272, 0.01, 0.0001),
    zSD = c(0.0001, 0.2, 0.002, 0.002, 0.413, 0.014, 0.0001),
    AGSAMean = c(0.0062, 0.5, 0.18, 0.15, 0.0822, 0.0078, 0.0023),
    StepMean = c(0, 80, 72, 46, 10, 2, 0),
    NonWearSeconds = c(0, 0, 0, 0, 0, 3, 5),
    RestSeconds = c(10, 0, 0, 0, 0, 0, 0),
    StillSeconds = c(10, 3, 0, 1, 1, 0, 0)
  )

  expected_bouts <- data.frame(
    NonWear = c(rep(FALSE, 6), TRUE),
    Rest = c(TRUE, rep(FALSE, 6)),
    Active = c(FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE),
    Ambulatory = c(FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
    Vigorous = c(FALSE, TRUE, rep(FALSE, 5)),
    FastWalk = c(FALSE, TRUE, FALSE, rep(FALSE, 4)),
    Sleep = c(TRUE, rep(FALSE, 5), TRUE),
    Classification = c("sleep", "run", "slow_walk", "slow_walk", "active", "sedentary", "non_wear")
  )

  bouts <- bouts_decision_tree(bouts)

  test_that("Bouts decision tree assigns the correct classifications.", {
    expect_equal(bouts[, 11:18], expected_bouts)
  })

  bouts <- data.frame(
    TimeUTC = c(1, 16, 31, 44, 56, 67, 77),
    Duration = c(15, 15, 13, 12, 11, 10, 9),
    xSD = c(0.2, 0.0001, 0.002, 0.002, 0.0001, 0.5, 0.0001),
    ySD = c(0.1, 0.0001, 0.002, 0.002, 0.0001, 0.1, 0.0001),
    zSD = c(0.1, 0.0001, 0.002, 0.002, 0.0001, 0.1, 0.0001),
    AGSAMean = c(0.0062, 0.005, 0.18, 0.0015, 0.00822, 0.078, 0.0023),
    StepMean = c(0, 80, 72, 46, 10, 2, 0),
    NonWearSeconds = c(0, 0, 13, 12, 1, 3, 5),
    RestSeconds = c(10, 0, 0, 0, 0, 0, 0),
    StillSeconds = c(10, 3, 0, 1, 1, 0, 0)
  )

  actual_bouts <- bouts_decision_tree(bouts)

  expected_bouts_classifications <- c("sedentary", "sleep", "sleep", "sleep", "sleep", "active", "non_wear")

  test_that("Non-wear events between sleep events are reclassified as sleep.", {
    expect_equal(actual_bouts$Classification, expected_bouts_classifications)
  })
})