tests/testthat/test-data_helpers.R

In mapbayr: MAP-Bayesian Estimation of PK Parameters

dh1 <- as.POSIXct("2022/01/01 10:00:00", tz = "UTC")
dh2 <- as.POSIXct("2022/01/02 10:00:00", tz = "UTC")
dh3 <- as.POSIXct("2022/01/03 10:00:00", tz = "UTC")

init_data <- tibble::tibble(ID = 1L, time = 0, evid = 1L, cmt = 1L, amt = 100, mdv = 1L)
init_data24 <- tibble::tibble(ID = 1L, time = 24, evid = 1L, cmt = 1L, amt = 100, mdv = 1L)
init_data48 <- tibble::tibble(ID = 1L, time = 48, evid = 1L, cmt = 1L, amt = 100, mdv = 1L)

init_data_dh <- tibble::tibble(ID = 1L, time = 0, evid = 1L, cmt = 1L, amt = 100, mdv = 1L, .datehour = dh1)
init_data_dh3 <- tibble::tibble(ID = 1L, time = 48, evid = 1L, cmt = 1L, amt = 100, mdv = 1L, .datehour = dh3)
init_data_dh3_t0 <- tibble::tibble(ID = 1L, time = 0, evid = 1L, cmt = 1L, amt = 100, mdv = 1L, .datehour = dh3)

test_that(".datehour works", {
  #1) time=NULL, no initial data
  expect_equal(
    datehour_manager(
      old_data = tibble::tibble(),
      time = NULL,
      .datehour = dh1),
    list(
      old_data = tibble::tibble(),
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )

  #2) time=NULL, initial data without .datehour
  # ok if all time = 0
  expect_equal(
    datehour_manager(
      old_data = init_data,
      time = NULL,
      .datehour = dh1
    ),
    list(
      old_data = init_data,
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )

  expect_equal(
    datehour_manager(
      old_data = init_data,
      time = NULL,
      .datehour = c(dh1, dh2)
    ),
    list(
      old_data = init_data,
      time = c(0, 24),
      .datehour = c(dh1, dh2),
      dh0 = dh1
    )
  )

  # error otherwise
  expect_error(
    datehour_manager(
      old_data = init_data24,
      time = NULL,
      .datehour = dh1),
    "Cannot assign when `.datehour` is in the timeline already defined by `time`."
  )

  #3) time=NULL, initial data with .datehour
  expect_equal(
    datehour_manager(
      old_data = init_data_dh,
      time = NULL,
      .datehour = dh2
    ),
    list(
      old_data = init_data_dh,
      time = 24,
      .datehour = dh2,
      dh0 = dh1
    )
  )

  expect_equal(
    datehour_manager(
      old_data = init_data_dh3_t0,
      time = NULL,
      .datehour = dh1
    ),
    list(
      old_data = mutate(init_data_dh3_t0, time = 48),
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )

  #4) time non-NULL, no initial data
  expect_equal(
    datehour_manager(
      old_data = tibble::tibble(),
      time = 0,
      .datehour = dh1
    ),
    list(
      old_data = tibble::tibble(),
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )

  expect_equal(
    datehour_manager(
      old_data = tibble::tibble(),
      time = 24,
      .datehour = dh2
    ),
    list(
      old_data = tibble::tibble(),
      time = 24,
      .datehour = dh2,
      dh0 = dh1
    )
  )

  expect_equal(
    datehour_manager(
      old_data = tibble::tibble(),
      time = c(0,24),
      .datehour = c(dh1, dh2)
    ),
    list(
      old_data = tibble::tibble(),
      time = c(0, 24),
      .datehour = c(dh1, dh2),
      dh0 = dh1
    )
  )

  expect_error(
    datehour_manager(
      old_data = tibble::tibble(),
      time = 0,
      .datehour = c(dh1, dh2)
    ),
    "`.time` and `.datehour` are of different length."
  )

  #5) time non-NULL, initial data without .datehour
  #>  if all times = 0
  expect_equal(
    datehour_manager(
      old_data = init_data,
      time = 0,
      .datehour = dh1
    ),
    list(
      old_data = init_data,
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )

  #>  if initial time = 0, time > 0
  expect_equal(
    datehour_manager(
      old_data = init_data,
      time = 24,
      .datehour = dh2
    ),
    list(
      old_data = init_data,
      time = 24,
      .datehour = dh2,
      dh0 = dh1
    )
  )

  #>  if initial time > 0, time > 0
  expect_equal(
    datehour_manager(
      old_data = init_data48,
      time = 24,
      .datehour = dh2
    ),
    list(
      old_data = init_data48,
      time = 24,
      .datehour = dh2,
      dh0 = dh1
    )
  )

  #>  if initial time > 0, time = 0
  expect_equal(
    datehour_manager(
      old_data = init_data48,
      time = 0,
      .datehour = dh1
    ),
    list(
      old_data = init_data48,
      time = 0,
      .datehour = dh1,
      dh0 = dh1
    )
  )


  #6) time non-NULL, initial data with .datehour
  #> new time/datehour matching defined, but consistent so ok
  expect_equal(
    datehour_manager(
      old_data = init_data_dh,
      time = 24,
      .datehour = dh2
    ),
    list(
      old_data = init_data_dh,
      time = 24,
      .datehour = dh2,
      dh0 = NULL # do not need to define a new one, so NULL is returned
    )
  )

  expect_equal(
    datehour_manager(
      old_data = init_data_dh3,
      time = 24,
      .datehour = dh2
    ),
    list(
      old_data = init_data_dh3,
      time = 24,
      .datehour = dh2,
      dh0 = NULL
    )
  )

  #> new time/datehour matching and inconsistent
  expect_error(
    datehour_manager(
      old_data = init_data_dh,
      time = 9999,
      .datehour = dh2
    ),
    "`time` and `.datehour` are inconsistent with values already in the initial dataset."
  )
})

test_that(".datehour works jointly with AOLA/TOLA", {
  mod_datehour <- mrgsolve::mcode("modTOLA",
                                  "$PARAM @annotated @covariates
                                  TOLA : 0 : time last adm", compile = FALSE)

  data_datehour <-mod_datehour %>%
    adm_rows(amt = 100, cmt = 1, addl = 3, ii = 24, .datehour = "12/12/2012 12:12") %>%
    add_covariates() %>%
    get_data()

  expect_equal(data_datehour[[".datehour"]], parse_datehour(paste0("2012/12/", 12:15, " 12:12:00")))
})

test_that("AOLA/TOLA works", {
  dat <- tibble::tibble(ID = c(1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L),
                 time = c(0, 12, 24, 36, 48, 0, 24, 48, 60),
                 evid = c(1L, 0L, 1L, 0L, 1L, 1L, 1L, 1L, 0L),
                 cmt = 1L,
                 amt = c(100, 0, 200, 0, 300, 1000, 2000, 3000, 0))

  expect_equal(AOLA(dat)$AOLA, c(100, 100, 200, 200, 300, 1000, 2000, 3000, 3000))
  expect_equal(TOLA(dat)$TOLA, c(0, 0, 24, 24, 48, 0, 24, 48, 48))

  dataddl <- tibble::tibble(ID = 1L, amt = c(100, 0), time = c(0, 96), evid = c(1L, 0L), cmt = 1L, addl = c(3L, 0), ii = c(24, 0))

  expect_equal(AOLA(dataddl)$AOLA, c(100, 100))
  expect_equal(TOLA(dataddl)$TOLA, c(0, 24, 48, 72, 72))
})

test_that("NULL_remove works", {
  expect_equal(NULL_remove(list(A = NULL, B = NULL, C = "foo", D = "foo", "bar", NULL)), list(C = "foo", D = "foo", "bar"))
})

test_that("rearrange_nmdata works", {
  dat <- tibble::tibble(
    ID = c(3, 3, 3, 3, 3, 3, 1, 1),
    time = c(24, 0, 48, 0, 72, 0, 96, 0),
    evid = c(1, 1, 1, 0, 1, 0, 1, 0),
    cmt = c(2, 1, 3, 1, 2, 4, 2, 1)
  )

  # Sorts well
  expect_equal(
    rearrange_nmdata(dat),
    tibble::tibble(
      ID = c(1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L),
      time = c(0, 96, 0, 0, 0, 24, 48, 72),
      evid = c(0L, 1L, 1L, 0L, 0L, 1L, 1L, 1L),
      cmt = c(1L, 2L, 1L, 1L, 4L, 2L, 3L, 2L)
    ))

  # .datehour increment works
  expect_equal(rearrange_nmdata(init_data, dh0 = NULL), init_data)
  expect_equal(rearrange_nmdata(init_data, dh0 = dh1), mutate(init_data, .datehour = dh1))
  dat2 <- bind_rows(init_data_dh, init_data24)
  expect_true(any(is.na(dat2$.datehour))) # Test if NA will be filled
  expect_equal(rearrange_nmdata(dat2), mutate(dat2, .datehour = c(dh1, dh2)))

  # nocb fill is correct
  dat3 <- tibble::tibble(ID = 1L, evid = 1L, time = c(0, 24, 48, 72, 96), cmt = 1L, amt = 1000,
                 BW = c(100, NA, NA, 200, NA))
  expect_equal(rearrange_nmdata(dat3)$BW, c(100, 200, 200, 200, 200))
})

test_that("cur_dh0 works", {
  expect_null(cur_dh0(data.frame(A = "foo")))
  expect_equal(cur_dh0(data.frame(time = c(0, 24), .datehour = c(dh1, dh2))), dh1)
  expect_equal(cur_dh0(data.frame(time = c(24, 48), .datehour = c(dh2, dh3))), dh1)
  expect_equal(cur_dh0(data.frame(time = c(24, 48, 72), .datehour = c(dh2, dh3, NA))), as.POSIXct(NA, "UTC"))
  expect_equal(cur_dh0(data.frame(time = c(24, 48, 72), .datehour = c(dh2, dh3, NA)), na.rm = TRUE), dh1)
})

test_that("forbidden covariate works", {
  expect_error(forbidden_covariate(list(A = "foo", B = "bar", C = "car", D = "dad"), cov = c("A", "B")),
               "Cannot have a covariate named: A B")
})

test_that("filter.mrgmod works", {
  mod <- mrgsolve::mcode("mod", "$CMT FOO", compile = FALSE)
  dat <- mod %>%
    adm_rows(amt = c(100, 200, 300), cmt = 1) %>%
    filter(amt != 200) %>%
    get_data()
  expect_equal(dat$amt, c(100, 300))
})