tests/testthat/test-policy_learn_earl.R

In polle: Policy Learning

test_that("get_policy.earl returns a policy", {
  library("DynTxRegime")

  d <- sim_single_stage(200, seed=1)
  pd <- policy_data(d,
                    action="A",
                    covariates = list("Z", "B", "L"),
                    utility="U")

  moPropen1 <- buildModelObj(model = ~B+Z+L,
                             solver.method = 'glm',
                             solver.args = list('family'='binomial'),
                             predict.method = 'predict.glm',
                             predict.args = list(type='response'))

  pl <- policy_learn(type = "earl",
                     control = control_earl(moPropen = moPropen1,
                                            regime = ~B+Z+L,))
  expect_error({
    p <- get_policy(pl(pd, q_models = q_glm(), g_models = g_glm()))
  },
  NA
  )

  expect_true(
    inherits(p, what = "policy")
  )

  expect_error(
    p(pd),
    NA
  )
})

test_that("the polle implementation of earl agrees with direct application of DynTxRegime::earl in the single stage case.",{
  library("DynTxRegime")

  d1 <- sim_single_stage(200, seed=1)
  pd1 <- policy_data(d1,
                     action="A",
                     covariates = list("Z", "B", "L"),
                     utility="U")

  # direct application:
  moPropen1 <- buildModelObj(model = ~B+Z+L,
                             solver.method = 'glm',
                             solver.args = list('family'='binomial'),
                             predict.method = 'predict.glm',
                             predict.args = list(type='response'))

  moMain1 <- buildModelObj(model = ~B+Z+L,
                           solver.method = 'lm')

  moCont1 <- buildModelObj(model = ~B+Z+L,
                           solver.method = 'lm')

  set.seed(1)
  dir <- DynTxRegime::earl(moPropen = moPropen1,
                           moMain = moMain1,
                           moCont = moCont1,
                           response = d1$U,
                           data = d1,
                           txName = "A",
                           lambdas = c(0.5, 1, 2),
                           regime = ~B+Z+L,
                           cvFolds = 3,
                           verbose = 0)

  # polle application:
  pl <- policy_learn(type = "earl",
                     control = control_earl(moPropen = moPropen1,
                                            moMain = moMain1,
                                            moCont = moCont1,
                                            regime = ~B+Z+L,
                                            verbose = 0,
                                            lambdas = c(0.5, 1, 2),
                                            cvFolds = 3))
  set.seed(1)
  po <- pl(policy_data = pd1)

  # comparison
  expect_equal(
    dir@analysis@optimal@estimatedValue,
    po$earl_object@analysis@optimal@estimatedValue
  )
})

test_that("the polle implementation is robust in respect to the action set.",{
  d1 <- sim_single_stage(200, seed=1)
  d2 <- d1

  d2$A[d1$A == 0] <- "B"
  d2$A[d1$A == 1] <- "A"

  pd1 <- policy_data(d1,
                     action="A",
                     covariates = list("Z", "B", "L"),
                     utility="U")
  pd2 <- policy_data(d2,
                     action="A",
                     covariates = list("Z", "B", "L"),
                     utility="U")

  # earl specification
  moPropen1 <- buildModelObj(model = ~B+Z+L,
                             solver.method = 'glm',
                             solver.args = list('family'='binomial'),
                             predict.method = 'predict.glm',
                             predict.args = list(type='response'))

  moMain1 <- buildModelObj(model = ~B+Z+L,
                           solver.method = 'lm')

  moCont1 <- buildModelObj(model = ~B+Z+L,
                           solver.method = 'lm')

  pl <- policy_learn(type = "earl",
                     control = control_earl(moPropen = moPropen1,
                                            moMain = moMain1,
                                            moCont = moCont1,
                                            regime = ~B+Z+L,
                                            verbose = 0,
                                            lambdas = c(0.5, 1, 2),
                                            cvFolds = 3))
  set.seed(1)
  po1 <- pl(policy_data = pd1)
  set.seed(1)
  po2 <- pl(policy_data = pd1)

  expect_equal(
    po1$earl_object@analysis@optimal@estimatedValue,
    po2$earl_object@analysis@optimal@estimatedValue
  )

  expect_equal(
    po1$earl_object@analysis@optimal@optimalTx,
    po2$earl_object@analysis@optimal@optimalTx
  )

})

test_that("earl handles missing arguments", {
  library("DynTxRegime")

  d1 <- sim_single_stage(200, seed=1)
  pd1 <- policy_data(d1,
                     action="A",
                     covariates = list("Z", "B", "L"),
                     utility="U")

  pl <- policy_learn(type = "earl",
                     control = control_earl(regime = ~B+Z+L,
                                            verbose = 0,
                                            lambdas = c(0.5, 1, 2),
                                            cvFolds = 3))
  set.seed(1)
  # moPropen is required:
  expect_error(pl(policy_data = pd1))
})