tests/testthat/test_data_helpers.R

In CausalQueries: Make, Update, and Query Binary Causal Models

context(desc = "Testing data helperse")

testthat::skip_on_cran()
testthat::test_that(desc = "collapse_data works if variables not in the model",

                    code = {
                      model <- make_model('X->Y')
                      long_data <- make_data(model, n = 6)
                      data <- collapse_data(long_data, model)
                      expect_true(class(data) == "data.frame")
                      expect_true(unique(data$strategy) == "XY")

                      model <- make_model('X->Y')
                      data <- make_data(model, n = 3)
                      Z <- c(0, 0, 0)
                      data <- cbind(data, Z)
                      nodes <- model$nodes
                      data <- collapse_data(data, model)
                      expect_equal(nrow(data), 4)

                    })




testthat::test_that(desc = "collapse_data works when all NA",

                    code = {
                      model <- make_model('X->Y')
                      X <- c(NA, NA, NA)
                      Y <- c(NA, NA, NA)
                      data <- as.data.frame(cbind(X, Y))
                      data <- collapse_data(data, model)
                      expect_equal(nrow(data), 4)
                    })

testthat::test_that(desc = "collapse_data works when node not in data",

                    code = {
                      model <- make_model('X->Y')
                      data <- data.frame(Y = c(1, 0, 1, 0))
                      data <- collapse_data(data, model)
                      expect_true(!c("X") %in% data$strategy)
                    })

testthat::test_that(desc = "collapse data inconsistent with model and ignored",

                    code = {
                      model <- make_model('X -> Y') |>
                        set_restrictions('X[]==1')
                      data <- data.frame(X = 0:1)
                      expect_message(collapse_data(data, model))
                    })


testthat::test_that(desc = "collapse_data conditions work",

                    code = {
                      model <- make_model('X -> Y')
                      data <- make_data(model, n = 4) %>%
                        collapse_data(model, drop_family = TRUE)
                      expect_true(!"strategy" %in% colnames(data))
                      data <- make_data(model, n = 4) %>%
                        collapse_data(model, summary = TRUE)
                      expect_true(class(data) == "list")
                      expect_equal(names(data),
                                   c("data_events",
                                     "observed_events",
                                     "unobserved_events"))
                    })


testthat::test_that(desc = "expand_data works",

                    code = {
                      model <-  make_model('X -> Y')
                      events <- make_events(model, n = 4)
                      data <- expand_data(events, model)
                      expect_equal(nrow(data), 4)
                      expect_equal(names(data), c("X", "Y"))
                      data <- expand_data(model = model)
                    })

testthat::test_that(desc = "expand_data errors",

                    code = {
                      model <-  make_model('X -> Y')
                      events <- make_events(model, n = 5)
                      expect_error(expand_data(events, model = 'X -> Y'))
                      expect_error(expand_data(c(events = c("X0YO", "X1Y1")),
                                               model))
                      colnames(events) <- NULL
                      expect_error(expand_data(events, model))
                    })

testthat::test_that(desc = "get_all_data_types errors",

                    code = {
                      model <- make_model("X -> Y")
                      expect_error(get_all_data_types(model, given = "Z == 0"))
                      model <- make_model('X -> Y') %>%
                        set_restrictions(labels = list(Y = '00'), keep = TRUE)
                      out <- get_all_data_types(model, given = "Y == 0")
                      expect_true(is.na(out$X[3]))
                    })



testthat::test_that(desc = "get_data_families works",

                    code = {
                      model <- make_model("X -> Y")
                      expect_equal(nrow(get_data_families(model)),  8)

                      model <- make_model('X->Y') |>
                        set_restrictions(statement =  '(Y[X = .] == 1)',
                                         join_by = '&',
                                         keep = TRUE)
                      data_fam <- get_data_families(model)
                      expect_true(!"Y0" %in% data_fam$event)

                      model <- model |>
                        set_restrictions(statement =  'X[] == 1', keep = TRUE)
                      data_fam <- get_data_families(model)
                      expect_equal(ncol(data_fam), 3)
                      expect_equal(data_fam$event, c("X1Y1", "Y1", "X1"))
                    })