tests/testthat/test-wrappers.R

In infer: Tidy Statistical Inference

test_that("t_test works", {
  # Two Sample
  expect_snapshot(res_ <- gss_tbl %>% t_test(hours ~ sex))

  expect_snapshot(error = TRUE,
    gss_tbl %>% t_test(response = "hours", explanatory = "sex")
  )

  new_way <- t_test(gss_tbl,
                    hours ~ sex,
                    order = c("male", "female"))
  new_way_alt <- t_test(gss_tbl,
                    response = hours,
                    explanatory = sex,
                    order = c("male", "female"))
  old_way <- t.test(hours ~ sex, data = gss_tbl) %>%
    broom::glance() %>%
    dplyr::select(statistic, t_df = parameter, p_value = p.value,
                  alternative, estimate,
                  lower_ci = conf.low, upper_ci = conf.high)

  expect_equal(new_way, new_way_alt, tolerance = 1e-5)
  expect_equal(new_way, old_way, tolerance = 1e-5)

  # check that the order argument changes output
  new_way2 <- t_test(gss_tbl,
                    hours ~ sex,
                    order = c("female", "male"))
  expect_equal(new_way[["lower_ci"]], -new_way2[["upper_ci"]])
  expect_equal(new_way[["statistic"]], -new_way2[["statistic"]])

  # One Sample
  new_way <- gss_tbl %>%
    t_test(hours ~ NULL, mu = 0)
  new_way_alt <- gss_tbl %>%
    t_test(response = hours, mu = 0)
  old_way <- t.test(x = gss_tbl$hours, mu = 0) %>%
    broom::glance() %>%
    dplyr::select(statistic, t_df = parameter, p_value = p.value,
                  alternative, estimate,
                  lower_ci = conf.low, upper_ci = conf.high)

  expect_equal(new_way, new_way_alt, tolerance = 1e-5)
  expect_equal(new_way, old_way, tolerance = 1e-5)
})

test_that("chisq_test works", {
  # maleependence
  expect_silent(gss_tbl %>%
                  chisq_test(college ~ partyid))
  new_way <- gss_tbl %>%
    chisq_test(college ~ partyid)
  new_way_alt <- gss_tbl %>%
    chisq_test(response = college, explanatory = partyid)
  old_way <- chisq.test(x = table(gss_tbl$partyid, gss_tbl$college)) %>%
    broom::glance() %>%
    dplyr::select(statistic, chisq_df = parameter, p_value = p.value)

  expect_equal(new_way, new_way_alt, tolerance = eps)
  expect_equal(new_way, old_way, tolerance = eps)

  # Goodness of Fit
  expect_silent(gss_tbl %>%
                  chisq_test(response = partyid, p = c(.3, .4, .3)))
  new_way <- gss_tbl %>%
    chisq_test(partyid ~ NULL, p = c(.3, .4, .3))
  new_way_alt <- gss_tbl %>%
    chisq_test(response = partyid, p = c(.3, .4, .3))
  old_way <- chisq.test(x = table(gss_tbl$partyid), p = c(.3, .4, .3)) %>%
    broom::glance() %>%
    dplyr::select(statistic, chisq_df = parameter, p_value = p.value)

  expect_equal(new_way, new_way_alt, tolerance = 1e-5)
  expect_equal(new_way, old_way, tolerance = 1e-5)

  # check that function errors out when response is numeric
  expect_snapshot(error = TRUE, chisq_test(x = gss_tbl, response = age, explanatory = partyid))

  # check that function errors out when explanatory is numeric
  expect_snapshot(error = TRUE, chisq_test(x = gss_tbl, response = partyid, explanatory = age))

})

test_that("_stat functions work", {
  # Test of maleependence
  expect_snapshot(
    res_ <- gss_tbl %>% chisq_stat(college ~ partyid)
  )

  another_way <- gss_tbl %>%
    chisq_test(college ~ partyid) %>%
    dplyr::select(statistic)

  expect_snapshot(
    obs_stat_way <- gss_tbl %>% chisq_stat(college ~ partyid)
  )
  one_more <- chisq.test(
    table(gss_tbl$partyid, gss_tbl$college)
  )$statistic

  expect_equal(dplyr::pull(another_way), obs_stat_way, ignore_attr = TRUE)
  expect_equal(one_more, obs_stat_way, ignore_attr = TRUE)

  # Goodness of Fit
  new_way <- gss_tbl %>%
    chisq_test(partyid ~ NULL) %>%
    dplyr::select(statistic)

  expect_snapshot(
    obs_stat_way <- gss_tbl %>%
      chisq_stat(partyid ~ NULL)
  )
  expect_snapshot(
   obs_stat_way_alt <- gss_tbl %>%
     chisq_stat(response = partyid)
  )

 expect_equal(dplyr::pull(new_way), obs_stat_way, ignore_attr = TRUE)
 expect_equal(dplyr::pull(new_way), obs_stat_way_alt, ignore_attr = TRUE)

 # robust to the named vector
 unordered_p <- gss_tbl %>%
   chisq_test(response = partyid, p = c(.2, .3, .5))
 ordered_p <- gss_tbl %>%
   chisq_test(response = partyid, p = c(ind = .2, rep = .3, dem = .5))

 expect_equal(unordered_p, ordered_p, ignore_attr = TRUE)

  # Two sample t
  expect_snapshot(
    res_ <- gss_tbl %>% t_stat(
      hours ~ sex, order = c("male", "female")
    )
  )
  another_way <- gss_tbl %>%
    t_test(hours ~ sex, order = c("male", "female")) %>%
    dplyr::select(statistic) %>%
    pull()

  expect_snapshot(
    obs_stat_way <- gss_tbl %>%
      t_stat(hours ~ sex, order = c("male", "female"))
  )

  expect_snapshot(
    obs_stat_way_alt <- gss_tbl %>%
      t_stat(response = hours,
             explanatory = sex,
             order = c("male", "female"))
  )

  expect_equal(another_way, obs_stat_way, ignore_attr = TRUE)
  expect_equal(another_way, obs_stat_way_alt, ignore_attr = TRUE)

  # One sample t
  expect_snapshot(
    res_ <- gss_tbl %>% t_stat(hours ~ NULL)
  )

  another_way <- gss_tbl %>%
    t_test(hours ~ NULL) %>%
    dplyr::select(statistic) %>%
    pull()

  expect_snapshot(
    obs_stat_way <- gss_tbl %>%
      t_stat(hours ~ NULL)
  )
  expect_snapshot(
    obs_stat_way_alt <- gss_tbl %>%
      t_stat(response = hours)
  )

  expect_equal(another_way, obs_stat_way, ignore_attr = TRUE)
  expect_equal(another_way, obs_stat_way_alt, ignore_attr = TRUE)

  expect_snapshot(error = TRUE,
    res_ <- chisq_stat(x = gss_tbl, response = age, explanatory = sex)
  )

  expect_snapshot(error = TRUE,
    res_ <- chisq_stat(x = gss_tbl, response = sex, explanatory = age)
  )
})

test_that("conf_int argument works", {
  expect_equal(
    names(
      gss_tbl %>%
        t_test(hours ~ sex,
               order = c("male", "female"), conf_int = FALSE)
    ),
    c("statistic", "t_df", "p_value", "alternative", "estimate"),
    tolerance = 1e-5
  )
  expect_equal(
    names(
      gss_tbl %>%
        t_test(
          hours ~ sex, order = c("male", "female"),
          conf_int = TRUE
        )
    ),
    c("statistic", "t_df", "p_value", "alternative",
      "estimate", "lower_ci", "upper_ci"),
    tolerance = 1e-5
  )

  ci_test <- gss_tbl %>%
    t_test(
      hours ~ sex, order = c("male", "female"),
      conf_int = TRUE, conf_level = 0.9
    )
  old_way <- t.test(
    formula = hours ~ sex, data = gss_tbl, conf.level = 0.9
  )[["conf.int"]]
  expect_equal(ci_test$lower_ci[1], old_way[1], tolerance = 1e-5)
  expect_equal(ci_test$upper_ci[1], old_way[2], tolerance = 1e-5)

  expect_snapshot(error = TRUE,
    res_ <- gss_tbl %>%
      t_test(
        hours ~ sex, order = c("female", "male"),
        conf_int = TRUE, conf_level = 1.1
      )
  )

  # Check that var.equal produces different results
  # Thanks for fmaleing this @EllaKaye!
  gss_tbl_small <- gss_tbl %>% dplyr::slice(1:6, 90:100)

  expect_snapshot(
    no_var_equal <- gss_tbl_small %>%
      t_stat(hours ~ sex, order = c("female", "male"))
  )

  expect_snapshot(
    var_equal <- gss_tbl_small %>%
      t_stat(
        hours ~ sex, order = c("female", "male"),
        var.equal = TRUE
      )
  )

  expect_false(no_var_equal == var_equal)

  shortcut_no_var_equal <- gss_tbl_small %>%
    specify(hours ~ sex) %>%
    calculate(stat = "t", order = c("female", "male"))

  shortcut_var_equal <- gss_tbl_small %>%
    specify(hours ~ sex) %>%
    calculate(
      stat = "t", order = c("female", "male"),
      var.equal = TRUE
    )
  expect_false(shortcut_no_var_equal == shortcut_var_equal)
})

# generate some data to test the prop.test wrapper
df <- data.frame(exp = rep(c("a", "b"), each = 500),
                 resp = c(rep("c", 450),
                          rep("d", 50),
                          rep("c", 400),
                          rep("d", 100)),
                 stringsAsFactors = FALSE)

sum_df <- table(df)

bad_df <- data.frame(resp = 1:5,
                     exp = letters[1:5])

bad_df2 <- data.frame(resp = letters[1:5],
                     exp = 1:5)

df_l <- df %>%
   dplyr::mutate(resp = dplyr::if_else(resp == "c", TRUE, FALSE))

test_that("two sample prop_test works", {

  # run the tests with default args
  base <- prop.test(sum_df)
  infer <- prop_test(df, resp ~ exp, order = c("a", "b"))

  # check that results are same
  expect_equal(base[["statistic"]],
               infer[["statistic"]],
               tolerance = .001)
  expect_equal(base[["parameter"]],
               infer[["chisq_df"]])
  expect_equal(base[["p.value"]],
               infer[["p_value"]],
               tolerance = .001)

  # expect warning for unspecified order
  expect_snapshot(res_ <- prop_test(df, resp ~ exp))

  # check that the functions respond to "p" in the same way
  base2 <- prop.test(sum_df, p = c(.1, .1))
  infer2 <- prop_test(df, resp ~ exp, order = c("a", "b"), p = c(.1, .1))
  expect_equal(base2[["statistic"]],
               infer2[["statistic"]],
               tolerance = .001)
  expect_equal(base2[["parameter"]],
               infer2[["chisq_df"]])
  expect_equal(base2[["p.value"]],
               infer2[["p_value"]],
               tolerance = .001)

  # check confidence interval argument
  infer3 <- prop_test(df, resp ~ exp, order = c("a", "b"), conf_int = TRUE)
  expect_length(infer3, 6)
  expect_length(infer2, 4)

  # check that the order argument changes output
  infer4 <- prop_test(df, resp ~ exp, order = c("b", "a"), conf_int = TRUE)
  expect_equal(infer4[["lower_ci"]], -infer3[["upper_ci"]], tolerance = .001)

  expect_snapshot(error = TRUE, res_ <- prop_test(bad_df, resp ~ exp))
  expect_snapshot(error = TRUE, res_ <- prop_test(bad_df2, resp ~ exp))

  # check that the success argument changes output
  infer5 <- prop_test(df, resp ~ exp, order = c("a", "b"), success = "d", conf_int = TRUE)
  expect_equal(infer3[["upper_ci"]], -infer5[["lower_ci"]], tolerance = .001)

  # check that logical variables are leveled intuitively
  infer1_l <- prop_test(df_l, resp ~ exp, order = c("b", "a"))
  infer2_l <- prop_test(df_l, resp ~ exp, order = c("b", "a"), success = "TRUE")
  infer3_l <- prop_test(df_l, resp ~ exp, order = c("b", "a"), success = "FALSE")

  expect_equal(infer1_l$lower_ci, infer2_l$lower_ci)
  expect_equal(infer1_l$lower_ci, -infer3_l$upper_ci)
})

# ...and some data for the one sample wrapper
df_1 <- df %>%
  select(resp)

sum_df_1 <- table(df_1)

test_that("one sample prop_test works", {

  # check that results with default args are the same
  base <- prop.test(sum_df_1)
  infer <- prop_test(df_1, resp ~ NULL, p = .5)
  expect_equal(base[["statistic"]],
               infer[["statistic"]],
               tolerance = .001)
  expect_equal(base[["parameter"]],
               infer[["chisq_df"]])
  expect_equal(base[["p.value"]],
               infer[["p_value"]],
               tolerance = .001)

  # check that the functions respond to "p" in the same way
  base2 <- prop.test(sum_df_1, p = .86)
  infer2 <- prop_test(df_1, resp ~ NULL, p = .86)
  expect_equal(base2[["statistic"]],
               infer2[["statistic"]],
               tolerance = .001)
  expect_equal(base2[["parameter"]],
               infer2[["chisq_df"]])
  expect_equal(base2[["p.value"]],
               infer2[["p_value"]],
               tolerance = .001)

  # expect message for unspecified p
  expect_snapshot(res_ <- prop_test(df_1, resp ~ NULL))

  # check that the success argument changes output
  infer3 <- prop_test(df_1, resp ~ NULL, p = .2, success = "c")
  infer4 <- prop_test(df_1, resp ~ NULL, p = .8, success = "d")
  expect_equal(infer3[["chisq_df"]], infer4[["chisq_df"]], tolerance = .001)
  expect_snapshot(error = TRUE,
    res_ <- prop_test(df_1, resp ~ NULL, p = .2, success = "b")
  )
})

test_that("prop_test output dimensionality is correct", {
  infer_1_sample <- prop_test(df, resp ~ NULL, p = .5)
  infer_1_sample_z <- prop_test(df, resp ~ NULL, p = .5, z = TRUE)
  infer_2_sample <- prop_test(df, resp ~ exp, order = c("a", "b"))
  infer_2_sample_no_int <- prop_test(df, resp ~ exp, order = c("a", "b"),
                                     conf_int = FALSE)
  infer_2_sample_z <- prop_test(df, resp ~ exp, order = c("a", "b"), z = TRUE)

  expect_length(infer_1_sample, 4)
  expect_length(infer_1_sample, length(infer_1_sample_z) + 1)
  expect_length(infer_2_sample, 6)
  expect_length(infer_2_sample_no_int, 4)
  expect_length(infer_2_sample_z, length(infer_2_sample) - 1)
})

test_that("prop_test handles >2 explanatory levels gracefully", {
   set.seed(1)
   dfr <-
      tibble::tibble(
         exp = sample(c("a", "b", "c"), 100, replace = TRUE),
         resp = sample(c("d", "e"), 100, replace = TRUE)
      )

   res_old <- prop.test(table(dfr))

   # don't pass order
   expect_silent(
      res_1 <- prop_test(dfr, resp ~ exp)
   )

   # pass 2-length order
   expect_snapshot(
      res_2 <- prop_test(dfr, resp ~ exp, order = c("a", "b"))
   )

   # pass 3-length order
   expect_snapshot(
      res_3 <- prop_test(dfr, resp ~ exp, order = c("a", "b", "c"))
   )

   expect_equal(res_1, res_2)
   expect_equal(res_2, res_3)

   expect_named(res_1, c("statistic", "chisq_df", "p_value"))
   expect_equal(res_1$statistic, res_old$statistic)
   expect_equal(res_1$chisq_df, res_old$parameter)
   expect_equal(res_1$p_value, res_old$p.value)
})

test_that("prop_test errors with >2 response levels", {
   set.seed(1)
   dfr <-
      tibble::tibble(
         exp = sample(c("a", "b"), 100, replace = TRUE),
         resp = sample(c("c", "d", "e"), 100, replace = TRUE)
      )

   expect_snapshot(
      error = TRUE,
      res_1 <- prop_test(dfr, resp ~ exp)
   )
})

test_that("prop_test z argument works as expected", {
  chi_res <- prop_test(df, resp ~ NULL, p = .5, correct = FALSE)

  z_res <- prop_test(df, resp ~ NULL, p = .5, z = TRUE)

  expect_equal(unname(chi_res$statistic), z_res$statistic^2, tolerance = eps)
})

test_that("wrappers can handled ordered factors", {
  expect_equal(
    gss_tbl %>%
      dplyr::mutate(sex = factor(sex, ordered = FALSE)) %>%
      t_test(hours ~ sex, order = c("male", "female")),
    gss_tbl %>%
      dplyr::mutate(sex = factor(sex, ordered = TRUE)) %>%
      t_test(hours ~ sex, order = c("male", "female"))
  )

  expect_snapshot(
     ordered_t_1 <- gss_tbl %>%
        dplyr::mutate(income = factor(income, ordered = TRUE)) %>%
        chisq_test(income ~ partyid)
  )

  expect_snapshot(
     ordered_f_1 <- gss_tbl %>%
        dplyr::mutate(income = factor(income, ordered = FALSE)) %>%
        chisq_test(income ~ partyid)
  )

  expect_equal(ordered_t_1, ordered_f_1)

  expect_snapshot(
     ordered_t_2 <- gss_tbl %>%
        dplyr::mutate(income = factor(income, ordered = TRUE)) %>%
        chisq_test(partyid ~ income)
  )

  expect_snapshot(
     ordered_f_2 <- gss_tbl %>%
        dplyr::mutate(income = factor(income, ordered = FALSE)) %>%
        chisq_test(partyid ~ income)
  )

  expect_equal(ordered_t_2, ordered_f_2)

  expect_equal(
    df %>%
      dplyr::mutate(resp = factor(resp, ordered = TRUE)) %>%
      prop_test(resp ~ NULL, p = .5),
    df %>%
      dplyr::mutate(resp = factor(resp, ordered = FALSE)) %>%
      prop_test(resp ~ NULL, p = .5)
  )
})

test_that("handles spaces in variable names (t_test)", {
   gss_ <- gss %>%
      tidyr::drop_na(college) %>%
      dplyr::mutate(`h o u r s` = hours)

   expect_equal(
      t_test(gss_,
             formula = hours ~ college,
             order = c("degree", "no degree"),
             alternative = "two-sided"),
      t_test(gss_,
             formula = `h o u r s` ~ college,
             order = c("degree", "no degree"),
             alternative = "two-sided")
   )

   expect_equal(
      t_test(gss_,
             response = hours,
             explanatory = college,
             order = c("degree", "no degree"),
             alternative = "two-sided"),
      t_test(gss_,
             response = `h o u r s`,
             explanatory = college,
             order = c("degree", "no degree"),
             alternative = "two-sided")
   )
})

test_that("handles spaces in variable names (prop_test)", {
   df$`r e s p` <- df$resp

   expect_equal(
      prop_test(df, `r e s p` ~ exp, order = c("a", "b")),
      prop_test(df, resp ~ exp, order = c("a", "b"))
   )

   expect_equal(
      prop_test(df, response = `r e s p`, explanatory = exp, order = c("a", "b")),
      prop_test(df, response = resp, explanatory = exp, order = c("a", "b"))
   )
})