tests/testthat/test-set_scenario.R

In cath-parkinson/mm.reoptimise: Run and Compare Budget Optimisation in Different Scenarios

# work around to ensure the package can read in the data
# needs to be saved in the inst folder
path <- system.file("testdata", "three1", "scenario_0", package = "mm.reoptimise") # not ran
path2 <- system.file("testdata", "three2", "scenario_0", package = "mm.reoptimise") # not ran
path3 <- system.file("testdata", "three1", "scenario_1", package = "mm.reoptimise") # already ran

path <- c(path, path2, path3)
scenario_multiple <- purrr::map(path, create_scenario)

# NOTE: update this to test all scenarios in the folder via map / map2
scenario <- scenario_multiple[[1]]

period <- get_scenario_period(scenario, type = "all")
kpi1 <- get_scenario_kpi1(scenario, period[1])
kpi2 <- get_scenario_kpi2(scenario, period[1], kpi1[2])
kpi3 <- get_scenario_kpi3(scenario, period[1], kpi1[2], kpi2[1])

val <- NA
period <- period[1]
kpi1 <- kpi1[2]
kpi2 <- kpi2[1]
kpi3 <- kpi3[1]
scenario <- set_scenario(scenario, period = period, budget = val, kpi1, kpi2, kpi3)

test_that("function returns correctly", {

      expect_equal(class(scenario), "list")
      expect_equal(class(scenario$curves_filtered)[1], "tbl_df")
      expect_equal(scenario$curves_filtered %>% dplyr::pull(period_level1) %>% unique(), get_scenario_period(scenario)[1])
      expect_true(scenario$curves_filtered %>% nrow() %>% sum() > 0)
      expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level1_name) %>% unique(), kpi1)
      expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level2_name) %>% unique(), kpi2)
      expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level3_name) %>% unique(), kpi3)

})

# NOTE: add a test to check we can pass this to a scenario and run an optimisation
# check we can pass this scenario and run a optimisation
scenario <- scenario_multiple[[2]]
scenario <- set_scenario(scenario, period[1], budget = val, kpi1[2], kpi2[1], kpi3[1], get_constraints_input_tables(scenario, period[1]))

test_that("function returns correctly", {

      expect_equal(class(scenario), "list")
      expect_equal(class(scenario$curves_filtered)[1], "tbl_df")
      expect_equal(scenario$curves_filtered %>% dplyr::pull(period_level1) %>% unique(), get_scenario_period(scenario)[1])
      expect_true(scenario$curves_filtered %>% nrow() %>% sum() > 0)

})

# checking can deal with scenario with NA in kpi2 and kpi3 ---------------
# version where we pass NA
path5 <- system.file("testdata", "three5", "scenario_0", package = "mm.reoptimise") # already ran

scenario_multiple <- purrr::map(path5, create_scenario)
scenario <- scenario_multiple[[1]]

val <- NA
period <- get_scenario_period(scenario)
kpi1 <- get_scenario_kpi1(scenario, period = "month")[1]
kpi2 <- NA
kpi3 <- NA

scenario <- set_scenario(scenario, period = period, budget = val, kpi1, kpi2, kpi3)

test_that("function returns correctly", {

   expect_equal(class(scenario), "list")
   expect_equal(class(scenario$curves_filtered)[1], "tbl_df")
   expect_equal(scenario$curves_filtered %>% dplyr::pull(period_level1) %>% unique(), get_scenario_period(scenario)[1])
   expect_true(scenario$curves_filtered %>% nrow() %>% sum() > 0)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level1_name) %>% unique(), kpi1)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level2_name) %>% unique(), kpi2)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level3_name) %>% unique(), kpi3)

})

# checking can deal with scenario with NA in kpi2 and kpi3 ---------------
# version where we just do not pass
path5 <- system.file("testdata", "three5", "scenario_0", package = "mm.reoptimise") # already ran

scenario_multiple <- purrr::map(path5, create_scenario)
scenario <- scenario_multiple[[1]]

val <- NA
period <- get_scenario_period(scenario)
kpi1 <- get_scenario_kpi1(scenario, period = "month")[1]
kpi2 <- NA
kpi3 <- NA

scenario <- set_scenario(scenario, period = period, budget = val, kpi1) # not passed here!

test_that("function returns correctly", {

   expect_equal(class(scenario), "list")
   expect_equal(class(scenario$curves_filtered)[1], "tbl_df")
   expect_equal(scenario$curves_filtered %>% dplyr::pull(period_level1) %>% unique(), get_scenario_period(scenario)[1])
   expect_true(scenario$curves_filtered %>% nrow() %>% sum() > 0)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level1_name) %>% unique(), kpi1)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level2_name) %>% unique(), kpi2)
   expect_equal(scenario$curves_filtered %>% dplyr::pull(kpi.level3_name) %>% unique(), kpi3)

})