tests/testthat/test-effects.R

In crosstable: Crosstables for Descriptive Analyses

#snapshot_review('effects')


# Categorical variables ---------------------------------------------------

test_that("Effects: categorical variables", {
  set.seed(0)
  e_args = crosstable_effect_args()

  # e_args$effect_tabular = effect_odds_ratio (default)
  x=crosstable(mtcars3, am, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "0.19 [0.02 to 1.11]", fixed=TRUE)

  e_args$effect_tabular = effect_relative_risk
  x = crosstable(mtcars3, am~vs, effect=T, effect_args=e_args) %>%
    expect_warning2(class="crosstable_effect_error_warning")
  expect_match(attr(x, "obj")$effect[1], "0.56 [CI error]", fixed=TRUE)
  x = crosstable(mtcars3, am~fct_rev(vs), effect=T, effect_args=e_args)
  expect_match(x$effect[1], "2.96 [0.94 to 17.27]", fixed=TRUE)

  e_args$effect_tabular = effect_risk_difference
  x=crosstable(mtcars3, am, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "-1.66 [-3.79 to 0.11]", fixed=TRUE)
})


# Numeric variables -------------------------------------------------------

test_that("Effects: numeric variables", {
  e_args = crosstable_effect_args()

  #e_args$effect_summarize = diff_mean_auto (default)
  set.seed(1234)
  x=crosstable(mtcars3, disp, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "Difference in means (bootstrap CI)", fixed=TRUE)
  expect_match(x$effect[1], "190.34 [119.89 to 260.78]", fixed=TRUE)

  e_args$effect_summarize = diff_mean_student
  x=crosstable(mtcars3, disp, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "Difference in means (t-test CI)", fixed=TRUE)
  expect_match(x$effect[1], "190.34 [104.14 to 276.54]", fixed=TRUE)

  # mtcars3 %>% map(~if(is.numeric(.x)) try(test_normality(.x, mtcars2$vs)))
  x=crosstable(mtcars3, hp, by=vs, effect=T)
  expect_match(x$effect[1], "Difference in means (Welch CI)", fixed=TRUE)
  expect_match(x$effect[1], "102.00 [63.49 to 140.51]", fixed=TRUE)

  set.seed(1234)
  e_args$effect_summarize = diff_mean_boot
  x=crosstable(mtcars3, disp, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "Difference in means (bootstrap CI)", fixed=TRUE)
  expect_match(x$effect[1], "190.34 [119.89 to 260.78]", fixed=TRUE)

  set.seed(1234)
  e_args$effect_summarize = diff_median_boot
  x=crosstable(mtcars3, disp, by=vs, effect=T, effect_args=e_args)
  expect_match(x$effect[1], "Difference in medians (bootstrap CI)", fixed=TRUE)
  expect_match(x$effect[1], "208.90 [89.06 to 283.31]", fixed=TRUE)
})


# Survival variables ------------------------------------------------------

test_that("Effects: survival variables", {
  set.seed(1234)
  x=crosstable(mtcars3, surv, by=cyl6, effect=T)
  expect_match(x$effect[1], "Hazard ratio (Wald CI)", fixed=TRUE)
  expect_match(x$effect[1], "0.66 [0.08 to 5.41]", fixed=TRUE)

  crosstable(mtcars3, surv, by=am, effect=T) %>%
    expect_warning(class="crosstable_effect_warning")
})


# Survival variables ------------------------------------------------------

test_that("Effects: missing variables", {
  set.seed(1234)
  mtcars3$x = ifelse(is.na(mtcars3$vs), "missing", paste0("cyl", mtcars3$cyl))

  x = crosstable(mtcars3, x, by=vs, effect=T) %>%
    expect_warning2(class="crosstable_effect_warning")

  expect_match(attr(x, "object")$effect[1], "Odds ratio [95% Wald CI]", fixed=TRUE)
  expect_match(attr(x, "object")$effect[1], "missing vs cyl4", fixed=TRUE)
})


# Warnings/Errors ---------------------------------------------------------


test_that("Effects Warnings", {
  set.seed(1234)

  crosstable(mtcars3, cyl, by=c(am, vs), effect=T) %>%
    expect_warning(class="crosstable_multiby_effect_warning")

  crosstable(mtcars3, c(am, vs), by=cyl, effect=T) %>%
    expect_warning(class="crosstable_effect_2groups_warning") #3 groups
  crosstable(mtcars3, c(am, vs), by=dummy, effect=T) %>%
    expect_warning(class="crosstable_effect_2groups_warning") #1 group

  crosstable(mtcars3, by=vs, times=c(0,100,200,400), effect=T) %>%
    expect_warning("fitted probabilities numerically 0 or 1 occurred") %>%
    expect_warning("fitted probabilities numerically 0 or 1 occurred") %>%
    expect_warning("fitted probabilities numerically 0 or 1 occurred") %>%
    expect_warning(class="crosstable_effect_other_warning") %>%
    expect_warning(class="crosstable_all_na_warning")
})