tests/testthat/test-stitch_on.R

In behavr: Canonical Data Structure for Behavioural Data

context("stitch")

test_that("stitch works", {
  set.seed(1)
  met1 <- data.table::data.table(uid = 1:5,id = 1:5,
                                condition = letters[1:5],
                                sex=c("M","M","M","F", "F"),
                                key="id")

  met2 <- data.table::data.table(uid = 1:4,id = 6:9,
                                condition = letters[1:4],
                                sex=c("M","M","M","F"),
                                key="id")

  met1[, datetime := as.POSIXct("2015-01-02")]
  met2[, datetime := as.POSIXct("2015-01-03")]
  met <- rbind(met1, met2)
  data.table::setkeyv(met, "id")
  t <- 1L:100L
  data <- met[,list(t=t, x=rnorm(100),y=rnorm(100), eating=runif(100) > .5 ),by="id"]

  d <- behavr(data,met)
  d2 <- stitch_on(d, on ="uid")


  expect_equal(nrow(unique(d2, by =data.table::key(d2))), 5)
  expect_identical(d2[t > 100 & id == 1, x],  d[ id == 6, x])
  expect_identical(d2[t > 100 & id == 1, t],  d[ id == 6, t] + days(1))
  expect_equal(nrow(d2[t > 100 & id == 5]), 0)

  expect_identical(meta(d2), unique(met[order(datetime)], by="uid"))


  ## now, last part of the query is BEFORE the first part

  met1[, datetime := as.POSIXct("2015-01-02")]
  met2[, datetime := as.POSIXct("2015-01-01")]
  met <- rbind(met1, met2)
  data.table::setkeyv(met, "id")
  t <- 1L:100L
  data <- met[,list(t=t, x=rnorm(100),y=rnorm(100), eating=runif(100) > .5 ),by="id"]

  d <- behavr(data,met)
  d2 <- stitch_on(d, on ="uid")

  expect_equal(nrow(unique(d2, by =data.table::key(d2))), 5)
  expect_identical(d2[t > 100 & id == 6, x],  d[ id == 1, x])
  expect_identical(d2[t > 100 & id == 6, t],  d[ id == 1, t] + days(1))
  expect_identical(d2[t > 100 & id == 6, t],  d[ id == 1, t] + days(1))
  expect_equal(nrow(d2[t > 100 & id == 5]), 0)
})


test_that("stitch fails when overlap", {
  set.seed(1)
  met <- data.table::data.table(uid = 1:5,id = 1:5,
                                condition = letters[1:5],
                                sex=c("M","M","M","F", "F"),
                                key="id")

  met2 <- data.table::data.table(uid = 1:4,id = 6:9,
                                 condition = letters[1:4],
                                 sex=c("M","M","M","F"),
                                 key="id")

  met[, datetime := as.POSIXct("2015-01-02")]
  met2[, datetime := as.POSIXct("2015-01-02")]
  met <- rbind(met, met2)
  data.table::setkeyv(met, "id")
  t <- 1L:100L
  data <- met[,list(t=t, x=rnorm(100),y=rnorm(100), eating=runif(100) > .5 ),by="id"]

  d <- behavr(data,met)
  expect_error(stitch_on(d, on ="uid"), "overlap")

})