forks: Formula Spells

test_that("formulas can be made with appropriate roles and complexity", {

  # Zeroeth order
  t <- distill_rune(~x)
  expect_equal(decipher(t), 0)

  # First order
  t <- distill_rune(y ~ x)
  expect_equal(decipher(t), 1)

  # Second order
  t <- distill_rune(y ~ X(x) + c)
  expect_equal(decipher(t), 2)

  # Third order/mediation
  t <- distill_rune(y ~ X(x) + M(m) + c)
  expect_equal(decipher(t), 3)

  # Fourth order/script
  t <- distill_rune(y1 + y2 ~ X(x) + M(m) + C(c))
  expect_equal(decipher(t), 4)



})

test_that("scripts can be decomposed appropriately", {

  # Fourth order scripts into third order
  t <- distill_rune(y1 + y2 ~ X(x1) + X(x2) + C(c1) + C(c2))
  s4 <- cast_spell(t)
  expect_equal(field(s4, "order"), 4)
  s3 <- recompose_roles(s4)
  expect_length(s3, 3) # Third order decomposition
  expect_equal(format(s3[1]), "y1 + y2 ~ x1 + x2 + c1 + c2")

  # Third order/mediation
  t <- distill_rune(y ~ X(x) + M(m) + c)
  s3 <- cast_spell(t)
  s2 <- recompose_roles(s3)
  expect_length(s2, 4) # Second order decomposition
  expect_equal(format(s2[2]), "y ~ x + c")

  # Second order recomposition (into first order)
  t <- distill_rune(y ~ X(x) + c)
  expect_equal(decipher(t), 2)
  s <- cast_spell(t, pattern = "fundamental")
  sl <- recompose_roles(s)
  expect_length(sl, 3)
  expect_equal(field(sl, "formula")[2], "y ~ x")

  # Multiple order decompositions
  f <- mpg + wt ~ X(hp) + X(cyl) + gear + drat + log(qsec)
  t <- distill_rune(f)
  x <- cast_spell(t)
  s1 <- recompose_roles(x)
  expect_length(s1, 3)
  s2 <- recompose_roles(s1)
  expect_length(s2, 7)

  # Complex break down with mediation
  s <- cast_spell(mpg + wt ~ X(hp) + M(cyl) + am)
  s1 <- recompose_roles(x)
  expect_equal(min(field(s1, "order")), 3)
  s2 <- recompose_roles(s1)
  s3 <- recompose_roles(s2[6])


})

test_that("scripts can be re-expanded into formulas", {

  # Direct
  f <- mpg + wt ~ X(hp) + X(cyl) + gear
  t <- distill_rune(f)
  x <- cast_spell(t, pattern = "direct")
  lof <- decompose_patterns(x)
  expect_length(lof, 3)

  # Sequential
  f <- mpg + wt ~ X(hp) + X(cyl) + drat + qsec
  t <- distill_rune(f, tier = list(drat + qsec ~ "secondary"))
  x <- cast_spell(t, pattern = "sequential")
  lof <- decompose_patterns(x)
  expect_length(lof, 5)

  # Parallel
  f <- mpg + wt ~ X(hp) + X(cyl) + drat + qsec
  t <- distill_rune(f, tier = list(qsec ~ "measurement"))
  x <- cast_spell(t, pattern = "parallel")
  lof <- decompose_patterns(x)
  expect_length(lof, 5)
})

test_that("mediation creates appropriate lists", {

  # Simple mediation
  f <- Surv(stop, status) ~ X(primary) + X(secondary) + M(mediator)
  t <- distill_rune(f)
  x <- cast_spell(t)
  sl <- recompose_roles(x)
  expect_length(sl, 5)

  # Mediation with covariates
  f <- Surv(stop, status) + Surv(stop, censor) ~ X(exposure) + M(mediator) + confounder + covariate + predictor
  t <- distill_rune(f)
  x <- cast_spell(t, pattern = "direct")
  sl <- recompose_roles(x)
  fl <- decompose_patterns(sl)
  expect_length(sl, 3)
  expect_length(fl, 4) # Since includes parent structure of order = 4

  x <- cast_spell(t, pattern = "parallel")
  fl <- decompose_patterns(x)
  expect_length(fl, 4)

  x <- cast_spell(t, pattern = "sequential")
  fl <- decompose_patterns(x)
  expect_length(fl, 5)

  # Mediation complexity
  s <- cast_spell(mpg ~ X(wt) + M(cyl) + hp)
  sl <- recompose_roles(s)
  fl <- decompose_patterns(sl)
  f <- summon_formulas(s) # Not appropriately adding hte mediation class here
  expect_equal(field(f, "formulas")[4], "cyl ~ wt + hp")

})

test_that("strata can be made appropriately", {

  f <- mpg ~ X(wt) + hp + qsec + S(cyl)
  labels <- list(mpg ~ "Mileage", hp ~  "Horsepower", cyl ~ "Cylinders")
  tiers <- list(qsec ~ "speed", wt ~ "hardware")
  t <- distill_rune(f, label = labels, tier = tiers)
  s <- cast_spell(t, pattern = "sequential")
  sl <- recompose_roles(s)
  expect_length(sl, 4)
  # Check the label positions
  expect_equal(labels(distill_rune(sl))$cyl, "Cylinders")
  expect_equal(vec_data(distill_rune(sl))[5, "label"], "Cylinders")
})


test_that("interaction terms can be used appropriately", {

  ## Straightforward interaction terms
  # Would expect "formula" to be ... mpg ~ hp + gear + am + hp:am
  t <- distill_rune(mpg ~ X(hp) + gear + In(am))
  expect_equal(decipher(t), 2)
  s <- recompose_roles(cast_spell(t, pattern = "direct"))
  expect_equal(cast_spell(t), s) # Would expect equality since order is 2
  sl <- recompose_roles(cast_spell(t, pattern = "sequential"))
  expect_length(sl, 4)
  sp <- decompose_patterns(sl)
  expect_length(sp, 4)

  # No exposure
  t <- suppressWarnings(distill_rune(mpg ~ gear + In(am)))
  expect_equal(decipher(t), 2)
  s <- recompose_roles(cast_spell(t))
  expect_equal(cast_spell(t), s) # Would expect equality since order is 2

  # Order = 1
  t <- suppressWarnings(distill_rune(mpg ~ In(am)))
  expect_equal(decipher(t), 1)
  s <- recompose_roles(cast_spell(t))
  expect_equal(cast_spell(t), s)

  ## Complex interactions (higher order)
  # Multiple exposures
  f <- mpg ~ X(hp) + X(cyl) + In(am)
  t <- distill_rune(f)
  s <- cast_spell(t)
  expect_equal(as.formula(t), as.formula(s), ignore_attr = TRUE)
  expect_equal(decipher(t), 3) # For multiple exposures
  l <- recompose_roles(s)
  expect_length(l, 3)

  # Multiple interactions
  f <- mpg ~ X(hp) + In(am) + In(vs)
  t <- distill_rune(f)
  expect_equal(decipher(t), 2)
  s <- cast_spell(t)
  l <- recompose_roles(s)
  expect_length(l, 1)
  expect_equal(s, l)



})