tests/testthat/test-ui.R

In shinymrp: Interface for Multilevel Regression and Poststratification

test_that(".waiter_ui works", {
  # Valid types return tagList with 2 element
  for (type in .const()$ui$loading_types) {
    golem::expect_shinytaglist(.waiter_ui(type))
  }

  expect_error(
    .waiter_ui("invalid"),
    "Assertion on 'loading_type' failed"
  )
})

test_that(".create_guide works", {
  for (section in .const()$ui$guide_sections) {
    golem::expect_shinytag(.create_guide(section))
  }

  expect_error(
    .create_guide("invalid"),
    "Assertion on 'open' failed"
  )
})

test_that(".create_model_tab works", {
  skip_on_cran()

  golem::expect_shinytag(
    .create_model_tab(
      ns = function(id) id,
      model = example_model(),
      last_tab_id = NULL
    )
  )
})

test_that(".est_map_ui works", {
  skip_on_cran()
  
  # County map with slider
  golem::expect_shinytaglist(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = TRUE),
      geo_scale = "county",
      geo_view = "map"
    )
  )

  # County map without slider
  golem::expect_shinytaglist(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = FALSE),
      geo_scale = "county",
      geo_view = "map"
    )
  )

  # State map with slider
  golem::expect_shinytaglist(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = TRUE),
      geo_scale = "state",
      geo_view = "map"
    )
  )

  # State map without slider
  golem::expect_shinytaglist(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = FALSE),
      geo_scale = "state",
      geo_view = "map"
    )
  )

  # Error for invalid geo_scale
  expect_error(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = FALSE),
      geo_scale = "invalid",
      geo_view = "map"
    ),
    "Assertion on 'geo_scale' failed"
  )

  # Error for invalid geo_view
  expect_error(
    .est_map_ui(
      ns = function(id) id,
      model = example_model(is_timevar = FALSE),
      geo_scale = "state",
      geo_view = "invalid"
    ),
    "Assertion on 'geo_view' failed"
  )
})

test_that(".plot_height works", {
  expect_equal(.plot_height(n = 3, is_timevar = TRUE), 900)
  expect_equal(.plot_height(n = 3, is_timevar = FALSE), 550)
  expect_equal(.plot_height(n = 1, is_timevar = TRUE), 550)
  expect_equal(.plot_height(n = 1, is_timevar = FALSE), 550)
})


test_that(".vis_cat_select works", {
  # Test general case with linking geography
  expect_setequal(
    .vis_cat_select(
      metadata = list(
        special_case = NULL,
        is_timevar = TRUE,
        family = "binomial"
      ),
      linkdata = list(link_geo = "zip")
    ),
    c("indiv", "geo", "outcome")
  )

  # Test time-varying data w/out linking geography
  expect_setequal(
    .vis_cat_select(
      metadata = list(
        special_case = NULL,
        is_timevar = TRUE,
        family = "binomial"
      ),
      linkdata = list(link_geo = NULL)
    ),
    c("indiv", "outcome")
  )

  # Test cross-sectional data w/ linking geography
  expect_setequal(
    .vis_cat_select(
      metadata = list(
        special_case = NULL,
        is_timevar = FALSE,
        family = "binomial"
      ),
      linkdata = list(link_geo = NULL)
    ),
    c("indiv")
  )

})

test_that(".vis_subcat_select works", {
  ### COVID data
  md_covid <- list(special_case = "covid", is_timevar = TRUE)
  ld_covid <- list(link_geo = "zip")

  # Test individual characteristics
  out <- .vis_subcat_select("indiv", md_covid, ld_covid)
  expect_equal(out$label, "2. Select characteristic")
  expect_setequal(out$choices, c("sex", "race", "age"))  

  # Test geographic characteristics (covariates
  # available for zip-level data)
  out <- .vis_subcat_select("geo", md_covid, ld_covid)
  expect_equal(out$label, "2. Select characteristic")
  expect_setequal(
    out$choices,
    c("sample", "college", "poverty",
      "employment", "income", "urbanicity", "adi")
  )

  # Test outcome
  out <- .vis_subcat_select("outcome", md_covid, ld_covid)
  expect_equal(out$label, "2. Select plot type")
  expect_setequal(out$choices, c("overall", "by_geo"))

  ### Polling data
  md_poll <- list(special_case = "poll", is_timevar = FALSE)
  ld_poll <- list(link_geo = "state")

  # Test individual characteristics
  out <- .vis_subcat_select("indiv", md_poll, ld_poll)
  expect_setequal(out$choices, c("sex", "race", "age", "edu"))  

  # Test geographic characteristics
  out <- .vis_subcat_select("geo", md_poll, ld_poll)
  expect_setequal(out$choices, c("sample"))

  # Test outcome (only by_geo available for cross-sectional data)
  out <- .vis_subcat_select("outcome", md_poll, ld_poll)
  expect_setequal(out$choices, c("by_geo"))

  ### Test without linking geography
  ld_no_geo <- list(link_geo = NULL)

  # Test time-varying data
  md_no_geo <- list(special_case = NULL, is_timevar = TRUE)

  out <- .vis_subcat_select("geo", md_no_geo, ld_no_geo)
  expect_setequal(out$choices, character(0))

  out <- .vis_subcat_select("outcome", md_no_geo, ld_no_geo)
  expect_setequal(out$choices, c("overall"))

  # Test cross-sectional data
  md_no_geo <- list(special_case = NULL, is_timevar = FALSE)

  out <- .vis_subcat_select("outcome", md_no_geo, ld_no_geo)
  expect_setequal(out$choices, character(0))

  # Test invalid category
  out <- .vis_subcat_select("invalid", md_covid, ld_covid)
  expect_equal(out$label, character(0))
  expect_null(out$choices)

})

test_that(".vis_ui works", {
  ns <- function(id) id

  # Individual characteristics
  for (demo in .const()$vars$demo) {
    golem::expect_shinytag(
      .vis_ui(ns, "indiv", demo)
    )
  }

  # Geographic characteristics
  for (covar in c("sample", .const()$vars$covar)) {
    golem::expect_shinytag(
      .vis_ui(ns, "geo", covar)
    )
  }

  # Outcome measure
  golem::expect_shinytag(
    .vis_ui(ns, "outcome", "overall")
  )
  golem::expect_shinytaglist(
    .vis_ui(ns, "outcome", "by_geo")
  )

  # Invalid category
  expect_error(
    .vis_ui(ns, "invalid", "overall"),
    "Assertion on 'category' failed"
  )

  # Invalid subcategory
  expect_error(
    .vis_ui(ns, "indiv", "invalid"),
    "Assertion on 'subcategory' failed"
  ) 
})

test_that(".preview_table works", {
  df <- data.frame(
    a = rnorm(10),
    b = runif(10),
    outcome = rbinom(10, 1, 0.5),
    positive = rbinom(10, 10, 0.5)
  )

  tbl <- .preview_table(df)
  expect_s3_class(tbl, "datatables")
  expect_equal(
    nrow(tbl$x$data),
    min(nrow(df), .const()$ui$preview_size)
  )
})


test_that(".link_select works", {
  # Test if options for linking geography reflect data

  data <- data.frame(
    zip = character(0),
    county = character(0),
    state = character(0)
  )
  period_regex <- "^[0-9]{4}-[0-9]{4}$"

  # COVID data
  choices_covid <- .link_select(data, "covid")
  expect_setequal(
    choices_covid$link_geos,
    c("zip")
  )
  expect_true(all(grepl(period_regex, choices_covid$acs_years)))

  # Poll data
  choices_poll <- .link_select(data, "poll")
  expect_setequal(
    choices_poll$link_geos,
    c("state")
  )
  expect_true(all(grepl(period_regex, choices_poll$acs_years)))

  # General data
  choices_gnr <- .link_select(data)
  expect_setequal(
    choices_gnr$link_geos,
    c("zip", "county", "state", "Do not include geography")
  )
  expect_true(all(grepl(period_regex, choices_gnr$acs_years)))

})