tests/testthat/test-server_utils.R

In epicmodel: Causal Modeling in Epidemiology

source(system.file("shiny","steplist_creator","R","server_utils.R", package = "epicmodel"), local = TRUE)

test_that("fun_get_id works", {
  expect_equal(fun_get_id(c("a1","a2"),"what"), "a3")
  expect_equal(fun_get_id(c("i1","i2"),"what"), "i3")
  expect_equal(fun_get_id(c("e1","e2"),"what"), "e3")
  expect_equal(fun_get_id(c("d1","d2"),"what"), "d3")
  expect_equal(fun_get_id(c("m1","m2"),"what"), "m3")
})

test_that("fun_get_id works for empty data.frames", {
  # create character(0) for x$what$id_what
  x <- empty_steplist()
  x$what %<>% dplyr::filter(.data$id_what != "a0")

  expect_equal(fun_get_id(x$what$id_what, "what"), "a1")
  expect_equal(fun_get_id(x$what$id_what, "does"), "d1")
  expect_equal(fun_get_id(x$what$id_what, "where"), "e1")
  expect_equal(fun_get_id(x$what$id_what, "module"), "m1")
  expect_equal(fun_get_id(x$what$id_what, "icc"), "i1")
})

test_that("fun_get_id works for NULL, NA, non-character inputs, and ''", {
  expect_equal(fun_get_id(NULL,"what"),"a1")
  expect_equal(fun_get_id(NA,"what"),"a1")
  expect_equal(fun_get_id(1,"what"),"a1")
  expect_equal(fun_get_id(TRUE,"what"),"a1")
  expect_equal(fun_get_id("","what"),"a1")
})


test_that("THEN IDs normal behavior works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_then_step_id(subject_key = "Laura",
                                       does_key = "bring",
                                       object_key = "cake",
                                       where_key = "beach",
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"a6d2a1e6")
  expect_equal(fun_create_then_step_id(subject_key = "Laura",
                                       does_key = "happy",
                                       object_key = "food is fine",
                                       where_key = "beach",
                                       check_object = "1",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"a6d4(a9d6)e6")
})

test_that("THEN IDs creation can handle NA and NULL", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_then_step_id(subject_key = NULL,
                                       does_key = NULL,
                                       object_key = NULL,
                                       where_key = NULL,
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
  expect_equal(fun_create_then_step_id(subject_key = "NA",
                                       does_key = "NA",
                                       object_key = "NA",
                                       where_key = "NA",
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
  expect_equal(fun_create_then_step_id(subject_key = NA,
                                       does_key = NA,
                                       object_key = NA,
                                       where_key = NA,
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
})

test_that("THEN descriptions normal behavior works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_then_step_desc(subject_key = "Laura",
                                       does_key = "bring",
                                       object_key = "cake",
                                       where_key = "beach",
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"Laura brings birthday cake at the beach")
  expect_equal(fun_create_then_step_desc(subject_key = "Laura",
                                       does_key = "happy",
                                       object_key = "food is fine",
                                       where_key = "beach",
                                       check_object = "1",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"Laura is happy that food is fine at the beach")
})

test_that("THEN descriptions creation can handle NA and NULL", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_then_step_desc(subject_key = NULL,
                                       does_key = NULL,
                                       object_key = NULL,
                                       where_key = NULL,
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
  expect_equal(fun_create_then_step_desc(subject_key = "NA",
                                       does_key = "NA",
                                       object_key = "NA",
                                       where_key = "NA",
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
  expect_equal(fun_create_then_step_desc(subject_key = NA,
                                       does_key = NA,
                                       object_key = NA,
                                       where_key = NA,
                                       check_object = "",
                                       what_data = steplist_party_test$what,
                                       does_data = steplist_party_test$does,
                                       where_data = steplist_party_test$where,
                                       then_data = steplist_party_test$then),"")
})

test_that("normal IFNOT IDs work", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_step_ifnot_id(input_select = list("birthday party takes place inside","birthday party takes place outside","no rain"),
                                        input_numeric = list("1","2","2"),
                                        then_data = steplist_party_test$then),list("(a7d3e2)or(a7d3e1+a3)",FALSE,FALSE))
})

test_that("error indicators in IFNOT ID work", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_true(fun_create_step_ifnot_id(input_select = list("Ana is invited","Ana is invited","Emma is invited"),
                           input_numeric = list("1","1","1"),
                           then_data = steplist_party_test$then)[[2]])
  expect_true(fun_create_step_ifnot_id(input_select = list("Ana is invited","Ana is invited","Emma is invited"),
                                       input_numeric = list("1","2","3"),
                                       then_data = steplist_party_test$then)[[3]])
})

test_that("normal IFNOT descriptions work", {
  expect_equal(fun_create_step_ifnot_desc(input_select = list("birthday party takes place inside","birthday party takes place outside","no rain"),
                                        input_numeric = list("1","2","2")),
               "birthday party takes place inside or (birthday party takes place outside and no rain)")
})



test_that("normal IF IDs work", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_create_step_if_id(input_select = list("birthday party takes place inside","birthday party takes place outside","no rain"),
                                        input_numeric = list("1","2","2"),
                                        then_data = steplist_party_test$then),list("(a7d3e2)or(a7d3e1+a3)",FALSE,FALSE))
})

test_that("error indicators in IF ID work", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_true(fun_create_step_if_id(input_select = list("Ana is invited","Ana is invited","Emma is invited"),
                                       input_numeric = list("1","1","1"),
                                       then_data = steplist_party_test$then)[[2]])
  expect_true(fun_create_step_if_id(input_select = list("Ana is invited","Ana is invited","Emma is invited"),
                                       input_numeric = list("1","2","3"),
                                       then_data = steplist_party_test$then)[[3]])
})

test_that("normal IF descriptions work", {
  expect_equal(fun_create_step_if_desc(input_select = list("birthday party takes place inside","birthday party takes place outside","no rain"),
                                          input_numeric = list("1","2","2")),"birthday party takes place inside or (birthday party takes place outside and no rain)")
})

test_that("Step IDs can be created", {
  expect_equal(fun_create_step_id(input_if = "a5d1",
                                  input_ifnot = "a7d3e3",
                                  input_then = "a5d5"),"IFa5d1IFNOTa7d3e3THENa5d5")
  expect_equal(fun_create_step_id(input_if = "",
                                  input_ifnot = "",
                                  input_then = "a5d5"),"THENa5d5")
})

test_that("Step descriptions can be created", {
  expect_equal(fun_create_step_desc(input_if = "birthday party takes place inside or (birthday party takes place outside and no rain)",
                                    input_ifnot = "",
                                    input_then = "weather is fine",
                                    input_end_step = "1"),
               "End: IF birthday party takes place inside or (birthday party takes place outside and no rain) THEN weather is fine")
  expect_equal(fun_create_step_desc(input_if = "",
                                    input_ifnot = "",
                                    input_then = "birthday party takes place on a weekday",
                                    input_end_step = "0"),
               "Start: birthday party takes place on a weekday")
})

test_that("gun_get_module_id works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_get_module_id(steplist_module = steplist_party_test$module,
                                 input = "food"),"m2")
})

test_that("gun_get_module_id works for NULL and ''", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(fun_get_module_id(steplist_module = steplist_party_test$module,
                                 input = NULL),"")
  expect_equal(fun_get_module_id(steplist_module = steplist_party_test$module,
                                 input = ""),"")
})

test_that("no end steps lead to empty selection in outc", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  x <- steplist_party_test$step %>% dplyr::filter(.data$end_step == "0")
  test <- steplist_party_test
  test$step <- x
  expect_equal(get_options_outc(test),"")
})

test_that("selection in outc works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(get_options_outc(steplist_party_test),
               c("Emma is coming","food is fine","Laura is coming","weather is fine"))
})

test_that("creating outc IDs works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(get_id_outc("food is fine",steplist_party_test$step),"a9d6")

})

test_that("creating outc IDs works for NULL, '', non-used values", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_equal(get_id_outc(NULL,steplist_party_test$step),"")
  expect_equal(get_id_outc("",steplist_party_test$step),"")
  expect_equal(get_id_outc("test",steplist_party_test$step),"NA")
})

test_that("create_outc_desc returns correct values", {
  expect_equal(create_outc_desc(list("","",""), coll = T),"")
  expect_equal(create_outc_desc(list("","",""), coll = F),"")
  expect_equal(create_outc_desc(list("","","test"), coll = T),"test")
  expect_equal(create_outc_desc(list("","","test"), coll = F),"test")
  expect_equal(create_outc_desc(list("","test1","test 2"), coll = T),"test1 and test 2")
  expect_equal(create_outc_desc(list("","test1","test 2"), coll = F),c("test1","test 2"))
  expect_equal(create_outc_desc(NULL, coll = T),"")
  expect_equal(create_outc_desc(NULL, coll = F),"")
  expect_equal(create_outc_desc(c(NULL,""), coll = F),"")
  expect_equal(create_outc_desc(c(NULL,"test","test 2"), coll = F),c("test","test 2"))
  expect_equal(create_outc_desc(c(NULL,"test","test 2"), coll = T),"test and test 2")
})

test_that("check_outc_duplicates works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_true(check_outc_duplicates("a4d5+a9d6+a6d5+a2d6",steplist_party_test$outc))
  expect_true(check_outc_duplicates("a4d5+a9d6+a2d6+a6d5",steplist_party_test$outc))
  expect_false(check_outc_duplicates("a4d5+a9d6+a2d6+a6d5+a12d54e4",steplist_party_test$outc))
  expect_false(check_outc_duplicates("a4d5+a9d6+a6d5",steplist_party_test$outc))
  expect_false(check_outc_duplicates("",steplist_party_test$outc))
  expect_false(check_outc_duplicates(NULL,steplist_party_test$outc))
})