tests/testthat/test-count.R

In Tplyr: A Traceability Focused Grammar of Clinical Data Summary

# Count Layers
# set seed to get consistant sample
set.seed(1)
# This is used for nesting counts
mtcars2 <- mtcars
mtcars$grp <- paste0("grp.", mtcars$cyl + sample(c(0, 0.5), 32, replace = TRUE))
mtcars$amn <- unclass(as.factor(mtcars$am))
mtcars <- mutate_all(mtcars, as.character)
t1 <- tplyr_table(mtcars, gear)
t2 <- tplyr_table(mtcars, gear)
t3 <- tplyr_table(mtcars, gear)
t4 <- tplyr_table(mtcars, gear)
t5 <- tplyr_table(mtcars, gear)
t6 <- tplyr_table(mtcars, gear)
t7 <- tplyr_table(mtcars, gear)
t8 <- tplyr_table(mtcars, gear)
t9 <- tplyr_table(mtcars, gear)
t10 <- tplyr_table(mtcars, gear)
t11 <- tplyr_table(mtcars, gear)
t12 <- tplyr_table(mtcars, gear)
t13 <- tplyr_table(mtcars, gear)
t14 <- tplyr_table(mtcars, gear)
t15 <- tplyr_table(mtcars, gear)
t16 <- tplyr_table(mtcars, gear) %>%
  add_total_group()
t17 <- tplyr_table(mtcars, gear)
t18 <- tplyr_table(mtcars, gear)
t19 <- tplyr_table(mtcars, gear)
t20 <- tplyr_table(mtcars, gear)

c1 <- group_count(t1, cyl)
# Add in by
c2 <- group_count(t2, cyl, by = am)
# Add in multiple bys
c3 <- group_count(t3, cyl, by = vars(am, vs))
# Multiple bys and different f_str
c4 <- group_count(t4, cyl, by = vars(am, vs)) %>%
  set_format_strings(f_str("xxx", n))
# Multiple bys and total row
c5 <- group_count(t5, cyl, by = vars(am, vs)) %>%
  add_total_row() %>%
  set_denoms_by(gear)
# Add distinct by
c6 <- group_count(t6, cyl) %>%
  set_distinct_by(cyl)
# Multiple target_vars
c7 <- group_count(t7, vars(cyl, grp))
# Distinct count and Event count
c8 <- group_count(t8, cyl) %>%
  set_format_strings(f_str("xx (xx.x%) [xx]", n, pct, distinct_n)) %>%
  set_distinct_by(am)
# Change indentation
c9 <- group_count(t9, vars(cyl, grp)) %>%
  set_indentation("")
# Change row prefix
c10 <- group_count(t10, cyl) %>%
  set_count_row_prefix("abc")
# Change ordering cols
c11 <- group_count(t11, cyl) %>%
  set_ordering_cols(5)
# Change numeric extraction value
c12 <- group_count(t12, cyl) %>%
  set_format_strings(f_str("xx (xx.x%) [xx]", n, pct, distinct_n)) %>%
  set_result_order_var(distinct_n) %>%
  set_distinct_by(am)
c13 <- group_count(t13, vars(cyl, grp), by = "Test")
c14 <- group_count(t14, vars(cyl, grp)) %>%
  set_outer_sort_position("asc")
c15 <- group_count(t15, cyl) %>%
  set_distinct_by(vars(am, vs))
c16 <- group_count(t16, cyl) %>%
  set_distinct_by(vars(am,vs))
#Check for warning with by, total row and no denom_by
c17 <- group_count(t17, cyl, by = vars(am, vs)) %>%
  add_total_row()
# Warning shouldn't raise here because they are both strings
c18 <- group_count(t18, cyl, by = vars("am", "vs")) %>%
  add_total_row()
c19 <- group_count(t19, cyl, by = am) %>%
  set_denoms_by(am) %>%
  add_total_row()
c20 <- group_count(t20, cyl) %>%
  set_missing_count(f_str("xx", n), Missing = "4", denom_ignore = TRUE) %>%
  add_total_row()


t1 <- add_layers(t1, c1)
t2 <- add_layers(t2, c2)
t3 <- add_layers(t3, c3)
t4 <- add_layers(t4, c4)
t5 <- add_layers(t5, c5)
t6 <- add_layers(t6, c6)
t7 <- add_layers(t7, c7)
t8 <- add_layers(t8, c8)
t9 <- add_layers(t9, c9)
t10 <- add_layers(t10, c10)
t11 <- add_layers(t11, c11)
t12 <- add_layers(t12, c12)
t13 <- add_layers(t13, c13)
t14 <- add_layers(t14, c14)
t15 <- add_layers(t15, c15)
t16 <- add_layers(t16, c16)
t17 <- add_layers(t17, c17)
t18 <- add_layers(t18, c18)
t19 <- add_layers(t19, c19)
t20 <- add_layers(t20, c20)

test_that("Count layers are built as expected", {

  expect_equal(unname(map_chr(c1$by, as_name)), character())
  expect_equal(unname(map_chr(c2$by, as_name)), "am")
  expect_equal(unname(map_chr(c3$by, as_name)), c("am", "vs"))
  expect_equal(unname(map_chr(c4$by, as_name)), c("am", "vs"))
  expect_equal(unname(map_chr(c5$by, as_name)), c("am", "vs"))
  expect_equal(unname(map_chr(c6$by, as_name)), character())
  expect_equal(unname(map_chr(c7$by, as_name)), character())
  expect_equal(unname(map_chr(c8$by, as_name)), character())
  expect_equal(unname(map_chr(c9$by, as_name)), character())
  expect_equal(unname(map_chr(c10$by, as_name)), character())

  expect_equal(unname(map_chr(c1$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c2$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c3$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c4$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c5$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c6$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c7$target_var, as_name)), c("cyl", "grp"))
  expect_equal(unname(map_chr(c8$target_var, as_name)), "cyl")
  expect_equal(unname(map_chr(c9$target_var, as_name)), c("cyl", "grp"))
  expect_equal(unname(map_chr(c10$target_var, as_name)), "cyl")

  expect_equal(c4$format_strings$n_counts, f_str("xxx", n))
  expect_equal(c5$include_total_row, TRUE)
  expect_equal(unname(map_chr(c6$distinct_by, as_name)), "cyl")
  expect_equal(unname(map_chr(c8$distinct_by, as_name)), "am")
  expect_equal(c9$indentation, "")
  expect_equal(c10$count_row_prefix, "abc")
  expect_equal(unname(map_chr(c15$distinct_by, as_name)), c("am", "vs"))
})

test_that("Count layers are summarized without errors and warnings", {
  expect_silent(build(t1))
  expect_silent(build(t2))
  expect_silent(build(t3))
  expect_silent(build(t4))
  expect_silent(build(t5))
  expect_silent(build(t6))
  # Just building this due to some weird error. It produces no output in an
  # expect output, but produces output in an expect silent. Any warnings raised
  # will raise when this is rebuilt for consistancy.
  build(t7)
  expect_silent(build(t8))
  expect_silent(build(t9))
  expect_silent(build(t10))
  expect_silent(build(t11))
  expect_silent(build(t12))
  expect_silent(build(t13))
  expect_silent(build(t14))
  expect_silent(build(t15))
  expect_silent(build(t16))
  expect_warning(build(t17), "A total row was added in addition")
  expect_silent(build(t18))
  expect_silent(build(t19))
  expect_warning(build(t20), "Your total row is ignoring certain values.")
})

test_that("Count layers are processed as expected", {

  expect_equal(dim(c1$numeric_data), c(9, 6))
  expect_equal(dim(c2$numeric_data), c(18, 7))
  expect_equal(dim(c3$numeric_data), c(36, 8))
  expect_equal(dim(c4$numeric_data), c(36, 8))
  expect_equal(dim(c5$numeric_data), c(39, 8))
  expect_equal(dim(c6$numeric_data), c(9, 6))
  expect_equal(dim(c7$numeric_data), c(27, 7))
  expect_equal(dim(c8$numeric_data), c(9, 6))
  expect_equal(dim(c9$numeric_data), c(27, 7))
  expect_equal(dim(c10$numeric_data), c(9, 6))

  expect_type(c1$numeric_data$n, "double")
  expect_type(c2$numeric_data$n, "double")
  expect_type(c3$numeric_data$n, "double")
  expect_type(c4$numeric_data$n, "double")
  expect_type(c5$numeric_data$n, "double")
  expect_type(c6$numeric_data$n, "double")
  expect_type(c7$numeric_data$n, "double")
  expect_type(c8$numeric_data$n, "double")
  expect_type(c9$numeric_data$n, "double")
  expect_type(c10$numeric_data$n, "double")

  expect_true(all(nchar(unlist(c1$formatted_data[, 2:4])) == 11))
  expect_true(all(nchar(unlist(c2$formatted_data[, 3:5])) == 11))
  expect_true(all(nchar(unlist(c3$formatted_data[, 4:6])) == 11))
  expect_true(all(nchar(unlist(c4$formatted_data[, 5:6])) == 3))
  expect_true(all(nchar(unlist(c5$formatted_data[, 4:6])) == 11))
  expect_true(all(nchar(unlist(c6$formatted_data[, 3:4])) == 11))
  expect_true(all(nchar(unlist(c7$formatted_data[, 3:5])) == 11))

  # Check all start with abc
  expect_true(all(map_chr(unlist(c10$formatted_data[, 1]), str_sub, 1, 3) == "abc"))

  # Check denoms can be properly formed when there are custom groups and
  # distinct variables
  expect_true(all(t16$layers[[1]]$numeric_data$distinct_total != 0))

  # Check denoms_by calculates pcts correctly
  expect_equal(t19$layers[[1]]$numeric_data$total,
               c(19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L,
                 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L))
})

test_that("nested count layers can be rebuilt without changes", {
  tmp1 <- build(t7)
  tmp2 <- build(t7)

  expect_equal(tmp1, tmp2)

})

test_that("missing counts can be displayed as expected", {
  mtcars[mtcars$cyl == 6, "cyl"] <- NA
  t1 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx ", n), Missing = NA)
    ) %>%
    build()
  expect_equal(t1[3, 1], tibble(row_label1 = "Missing"))
  expect_equal(t1[3, 2:4], tibble(var1_3 = " 2 ", var1_4 = " 4 ", var1_5 = " 1 "))

  mtcars[is.na(mtcars$cyl), "cyl"] <- "Not here"
  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx ", n), Missing = "Not here")
    ) %>%
    build()
  expect_equal(t2[3, 1], tibble(row_label1 = "Missing"))
  expect_equal(t2[3, 2:4], tibble(var1_3 = " 2 ", var1_4 = " 4 ", var1_5 = " 1 "))

  mtcars[mtcars$cyl == "Not here", "cyl"] <- "Unknown"
  t3 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx ", n), UNK = "Unknown")
    ) %>%
    build()
  expect_equal(t3[3, 1], tibble(row_label1 = "UNK"))
  expect_equal(t3[3, 2:4], tibble(var1_3 = " 2 ", var1_4 = " 4 ", var1_5 = " 1 "))

  mtcars[mtcars$cyl == 8, "cyl"] <- NA
  t4 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx ", n), denom_ignore = TRUE, Missing = NA, Unknown = "Unknown")
    ) %>%
    build() %>%
    arrange(ord_layer_1)
  expect_equal(t4$row_label1, c("4", "Unknown", "Missing"))
  expect_equal(t4$var1_3, c(" 1 (100.0%)", " 2 ", "12 "))
  expect_equal(t4$var1_4, c(" 8 (100.0%)", " 4 ", " 0 "))
  expect_equal(t4$var1_5, c(" 2 (100.0%)", " 1 ", " 2 "))
  expect_equal(t4$ord_layer_index, c(1L, 1L, 1L))
  # Added unname for compatibility between tibble versions
  expect_equal(unname(t4$ord_layer_1), c(1, 2, 3))

  t5 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        add_total_row(f_str("xx (xx.x%)", n, pct), count_missings = FALSE) %>%
        set_missing_count(f_str("xx", n), Missing = c("Unknown", NA))
    ) %>%
    build()

  expect_equal(t5$var1_3, c(" 1 (  6.7%)", "14", " 1 ( 6.7%)"))
})

test_that("Count layer clauses with invalid syntax give informative error", {
  t <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(am, where = bad == code)
    )

  expect_snapshot_error(build(t))
})


test_that("Nested count layers can be built with text by variables", {
  expect_equal(c13$formatted_data$ord_layer_2, rep(2, 9))
})

test_that("set_outer_sort_position works as expected", {
  expect_equal(c14$formatted_data$ord_layer_2, rep(c(-Inf, 1, 2), 3))
})

test_that("Total rows and missing counts are displayed correctly(0.1.5 Updates)", {
  mtcars2$cyl2 <- mtcars2$cyl + 10
  mtcars2[mtcars2$cyl == "4", "cyl"] <- NA
  mtcars2$grp <- paste0("grp.", mtcars2$cyl + rep(c(0, 0.5), 16))
  mtcars2$amN <- unclass(as.factor(mtcars2$am))
  mtcars2[mtcars2$am == 1, "am"] <- NA

  t1 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), Missing = NA) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct)) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing Count + Total Row
  t2 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), Missing = NA, `Not Found` = NaN) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct)) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing Counts + Total Row
  t3 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(am) %>%
        set_missing_count(f_str("xx", n), sort_value = 5689, Missing = NA, `Not Found` = NaN) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct), sort_value = 9999, count_missings = TRUE) %>%
        set_order_count_method("byvarn") %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing Counts + Total Row + byvarn
  t4 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), sort_value = 999, Missing = NA, `Not Found` = NaN) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct), sort_value = 9999) %>%
        set_order_count_method("bycount") %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing Counts + Total Row + bycount
  t5 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), Missing = NA) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct), sort_value = 7862) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing COunts + Total Row(bottom)
  t6 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(am) %>%
        set_missing_count(f_str("xx", n), Missing = NA) %>%
        set_order_count_method("byvarn") %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct), sort_value = -Inf, count_missings = TRUE) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  # Missing COunts + Total Row(bottom) + byVarn
  t7 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), Missing = NA) %>%
        set_order_count_method("bycount") %>%
      add_total_row(f_str("xxxxx [xx.x]", n, pct), sort_value = -6795, count_missings = TRUE) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    # Suppressing warnring for pct in total
    build()
  # Missing COunts + Total Row(bottom) + by count
  t8 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_distinct_by(am) %>%
        add_total_row() %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  mtcars3 <- mtcars2
  mtcars3$cyl <- factor(mtcars3$cyl, c(2,3,4,6,8))
  t9 <- tplyr_table(mtcars3, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xxxx", n), Missing_ = NA) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()


  expect_snapshot_output(dput(t1))
  expect_snapshot_output(dput(t2))
  expect_snapshot_output(dput(t3))
  expect_snapshot_output(dput(t4))
  expect_snapshot_output(dput(t5))
  expect_snapshot_output(dput(t6))
  expect_snapshot_output(dput(t7))
  expect_snapshot_output(dput(t8))
  expect_snapshot_output(dput(t9))
})

test_that("set_denom_where works as expected", {
  # Just make a different object for pop_data. Just used to check for warning
  pop_mtcars <- mtcars
  pop_mtcars$grp <- seq_along(mtcars$am)
  t10 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl, where = cyl != 6) %>%
        set_denom_where(TRUE) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  expect_snapshot_output(dput(t10))
  t11 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl, where = cyl != 6) %>%
        set_denom_where(cyl != 4) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()
  expect_snapshot_output(dput(t11))

  t12 <- tplyr_table(mtcars, gear) %>%
    set_pop_data(pop_mtcars) %>%
    add_layer(
      group_count(cyl) %>%
        set_denom_where(cyl != 6) %>%
        set_distinct_by(am)
    )
  expect_snapshot_warning(build(t12))

  t13 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl, where = cyl != 6) %>%
        set_distinct_by(am) %>%
        set_format_strings(f_str("xx (xx.x)", distinct_n, distinct_pct)) %>%
        set_format_strings(f_str("xx (xx.x)", n, pct))
    ) %>%
    build()

  expect_snapshot_output(dput(t13))
})

test_that("set_denom_where errors for incompatible object type", {
  t1 <- tplyr_table(mtcars, gear)

  # Modify the object type to make it incompatible
  class(t1) <- "environment"

  # Function errors
  t1 <- set_denom_where(t1, mpg != 21) %>%
    expect_error("Object type should be")
})

test_that("missing counts can be set without a format and it inherits the layer format", {
  t1 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(Missing = "4")
    ) %>%
    build()
  expect_equal(t1$row_label1, c("Missing", "6", "8"))
  expect_equal(t1$var1_3, c(" 1 (  6.7%)", " 2 ( 13.3%)", "12 ( 80.0%)"))

  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(Missing = "4") %>%
        set_format_strings(f_str("xxx  [xx.x%]", n, pct))
    ) %>%
    build()
  expect_equal(t2$row_label1, c("Missing", "6", "8"))
  expect_equal(t2$var1_3, c("  1  [ 6.7%]", "  2  [13.3%]", " 12  [80.0%]"))
})

test_that("distinct is changed to distinct_n with a warning", {

  expect_warning({
    t <- tplyr_table(mtcars, gear) %>%
      add_layer(
        group_count(cyl) %>%
          set_distinct_by(am) %>%
          set_format_strings(f_str("xx", distinct))
      )
  }, "The use of 'distinct' in count f_strs is discouraged. It was replaced with 'distinct_n' for consistancy.")

  expect_equal(t$layers[[1]]$format_strings$n_counts$vars[[1]], "distinct_n")

})

test_that("Nested count layers can accept text values in the first variable", {
  t <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars("All Cyl", cyl))
    )

  expect_silent(build(t))

  expect_equal(t$layers[[1]]$formatted_data$row_label1,
               c("All Cyl", "All Cyl", "All Cyl", "All Cyl"))
  expect_equal(t$layers[[1]]$formatted_data$row_label2,
               c("All Cyl", "   4", "   6", "   8"))
  expect_equal(t$layers[[1]]$formatted_data$var1_3,
               c("15 (100.0%)", " 1 (  6.7%)", " 2 ( 13.3%)", "12 ( 80.0%)"))
  expect_equal(t$layers[[1]]$formatted_data$var1_4,
               c("12 (100.0%)", " 8 ( 66.7%)", " 4 ( 33.3%)", " 0 (  0.0%)"))
  expect_equal(t$layers[[1]]$formatted_data$var1_5,
               c(" 5 (100.0%)", " 2 ( 40.0%)", " 1 ( 20.0%)", " 2 ( 40.0%)"))

  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars(cyl, "Txt"))
    )
  expect_snapshot_error(build(t2))

  mtcars$cyl <- factor(as.character(mtcars$cyl), c("4", "6", "8", "25"))
  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars("all cyl", cyl))
    ) %>%
    build()

  expect_equal(t2$var1_3,
               c("15 (100.0%)", " 1 (  6.7%)", " 2 ( 13.3%)", "12 ( 80.0%)",
                 " 0 (  0.0%)"))
})

test_that("Variable names will be coersed into symbols", {
  t1 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count("cyl")
    )
  expect_snapshot_warning(build(t1))

  t2 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(vars("all cyl", "cyl"))
    )
  expect_snapshot_warning(build(t2))
})

test_that("nested count layers can be built with character value in first position and risk difference", {
  suppressWarnings({
    t1 <- tplyr_table(mtcars, gear) %>%
      add_layer(
        group_count(vars("all_cyl", cyl)) %>%
          add_risk_diff(
            c("4", "5"),
            c("3", "5")
            )
      ) %>%
      build()
  })


  expect_equal(t1$rdiff_4_5, c(" 0.000 ( 0.000,  0.000)",
                               " 0.267 (-0.380,  0.914)",
                               " 0.133 (-0.441,  0.707)",
                               "-0.400 (-0.971,  0.171)"))
})

test_that("keep_levels works as expeceted", {
  t1 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        keep_levels("4", "6") %>%
        set_format_strings(f_str("xxx (xxx%)", n, pct))
    ) %>%
    build()
  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars("all cyl", cyl)) %>%
        keep_levels("8") %>%
        set_format_strings(f_str("xxx (xxx%)", n, pct))
    ) %>%
    build()

  expect_equal(t1$var1_3, c("  1 (  7%)", "  2 ( 13%)"))
  expect_equal(dim(t1), c(2, 6))
  expect_equal(t2$var1_3, c(" 12 ( 80%)", " 12 ( 80%)"))
  expect_equal(dim(t2), c(2, 8))

  expect_snapshot_error({
    t3 <- tplyr_table(mtcars, gear) %>%
      add_layer(
        group_count(cyl) %>%
          keep_levels("10", "20")
      ) %>%
      build()
  })

  mtcars$grp <- paste0("grp.", as.numeric(mtcars$cyl) + rep(c(0, 0.5), 16))
  t4 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars(cyl, grp)) %>%
        keep_levels("nothere")
    )
  expect_snapshot_error(build(t4))
})

test_that("nested count layers can be built with restrictive where logic", {
  mtcars <- mtcars2
  mtcars$grp <- paste0("grp.", mtcars$cyl + sample(c(0, 0.5), 32, replace = TRUE))

  t <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars(cyl, grp), where = grp == "grp.8.5") %>%
        set_nest_count(TRUE) %>%
        set_order_count_method('bycount') %>%
        set_ordering_cols("3")
    ) %>%
    build()

  expect_equal(dim(t), c(2, 7))

})

test_that("nested count layers handle `set_denoms_by` as expected", {
  mtcars <- mtcars2
  mtcars$grp <- paste0("grp.", mtcars$cyl + rep(c(0, 0.5), 16))

  expect_snapshot_error({
    t1 <- tplyr_table(mtcars, gear) %>%
      add_layer(
        group_count(vars(cyl,grp)) %>%
          set_denoms_by(grp)
      )
  })

  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars(cyl,grp)) %>%
        set_denoms_by(cyl)
    ) %>%
    build()

  expect_equal(t2$var1_3,
               c(" 1 (  9.1%)", " 1 (  9.1%)", " 0 (  0.0%)", " 2 ( 28.6%)",
                 " 0 (  0.0%)", " 2 ( 28.6%)", "12 ( 85.7%)", " 7 ( 50.0%)",
                 " 5 ( 35.7%)"))

  t3 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(vars(cyl,grp)) %>%
        set_denoms_by(cyl, gear)
    ) %>%
    build()

  expect_equal(t3$var1_3,
               c(" 1 (100.0%)", " 1 (100.0%)", " 0 (  0.0%)", " 2 (100.0%)",
                 " 0 (  0.0%)", " 2 (100.0%)", "12 (100.0%)", " 7 ( 58.3%)",
                 " 5 ( 41.7%)"))

  # Tests added to capture #136
  expect_snapshot(
    # Results have been manually verified
    # Denom for cyl == 4 is 11
    tplyr_table(mtcars, gear, cols=vs) %>%
      add_layer(
        group_count(vars(cyl,grp)) %>%
          set_denoms_by(cyl)
      ) %>%
      build() %>%
      as.data.frame()
  )

  expect_snapshot(
    # Results have been manually verified
    # Denom for gear == 3, vs = 0 is 12
    tplyr_table(mtcars, gear, cols=vs) %>%
      add_layer(
        group_count(vars(cyl,grp))
      ) %>%
      build() %>%
      as.data.frame()
  )

})

test_that("test IBM rounding option", {
  row_num <- seq(1:2000)
  trta = ifelse(row_num <= 1000, "Placebo", "ThisDrg")
  gender = ifelse(between(row_num, 1, 485), "F",
                  ifelse(between(row_num, 1001, 1525), "F", "M"))
  adsl <- tibble(trta, gender)

  tabl <- tplyr_table(adsl, trta) %>%
    add_total_group(group_name = "Total") %>%
    add_layer(
      group_count(gender, by = "Gender")   %>%
        set_format_strings(f_str("xxx (xxx%)", n, pct))
    ) %>%
    build()

  expect_equal(tabl$var1_Placebo, c("485 ( 48%)", "515 ( 52%)"))

  options(tplyr.IBMRounding = TRUE)

  tabl2 <- tplyr_table(adsl, trta) %>%
    add_total_group(group_name = "Total") %>%
    add_layer(
      group_count(gender, by = "Gender")  %>%
        set_format_strings(f_str("xxx (xxx%)", n, pct))
    )

  expect_warning({tabl2 <- build(tabl2)}, "You have enabled IBM Rounding.")

  expect_equal(tabl2$var1_Placebo, c("485 ( 49%)", "515 ( 52%)"))

  options(tplyr.IBMRounding = FALSE)
})

test_that("test specific rounding proplem #124", {
  vec <- c(2.64, -3.20, -2.88, 2.95)
  mvec <- mean(vec)

  options(tplyr.IBMRounding = TRUE)

  rounded <- ut_round(mvec, 3)

  expect_equal(rounded, -0.123)

  options(tplyr.IBMRounding = FALSE)
})

test_that("nested count can accept data if second variable is bigger than the first", {
  test_adcm <- data.frame(
    SUBJID = c("1", "2", "3"),
    ATC2 = c("Antiemetics and antinauseants", "Psycholeptics", "Psycholeptics"),
    CMDECOD = c("Promethazine hydrochloride", "Promethazine hydrochloride", "Promethazine hydrochloride"),
    TRT101A = c("TRT1", "TRT2", "TRT1")
  )

  x <- test_adcm %>%
    tplyr_table(TRT101A) %>%
    add_layer(
      group_count(vars(ATC2, CMDECOD))
    ) %>%
    build() %>%
    as.data.frame()

  expect_snapshot(x)
})

test_that("Posix columns don't cause the build to error out.", {
#

  load(test_path("adae.Rdata"))
  load(test_path("adsl.Rdata"))

  adsl <- adsl %>%
    mutate(fake_dttm = as.POSIXct("2019-01-01 10:10:10"), origin = "1970-01-01") %>%
    rename(TRTA = TRT01A)

  tp_obj <- tplyr_table(adae, TRTA) %>%
    set_pop_data(adsl) %>%
    add_layer(
      group_count('Number of subjects with any event') %>%
        set_distinct_by(USUBJID) %>%
        set_denoms_by(TRTA)
    )

  expect_silent(build(tp_obj))
})

test_that("set_numeric_threshold works as expected", {

  t1 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(10, "n") %>%
        add_total_row() %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t1)))

  t2 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(5.1, "n") %>%
        add_total_row() %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t2)))

  t3 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(13, "n") %>%
        add_total_row() %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t3)))

  t4 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(16, "n") %>%
        add_total_row() %>%
       set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t4)))

  t5 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(0.5, "pct") %>%
        add_total_row() %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t5)))

  t6 <- mtcars %>%
    tplyr_table(gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_numeric_threshold(4, "n", "3") %>%
        add_total_row() %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t6)))

  load(test_path("adae.Rdata"))

  t7 <- adae %>%
    tplyr_table(TRTA) %>%
    add_layer(
      group_count(vars(AEBODSYS, AEDECOD)) %>%
        set_numeric_threshold(3, "n", "Placebo")
    )

  expect_snapshot(as.data.frame(build(t7)))

  t8 <- adae %>%
    tplyr_table(TRTA) %>%
    add_layer(
      group_count(vars(AEBODSYS, AEDECOD)) %>%
        set_numeric_threshold(3, "n", "Placebo") %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t8)))
})

test_that("denom and distinct_denom values work as expected", {


  t1 <- tplyr_table(mtcars2, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_missing_count(f_str("xx", n), Missing = NA) %>%
        add_total_row(f_str("xxxxx [xx.x]", n, pct)) %>%
        set_format_strings(f_str("xx/xxx (xx.x)", n, total, pct)) %>%
        set_order_count_method("bycount")
    )

  expect_snapshot(as.data.frame(build(t1)))

  t2 <- tplyr_table(mtcars, gear) %>%
    add_layer(
      group_count(cyl) %>%
        set_distinct_by(am) %>%
        set_format_strings(f_str("xxx xxx xxx xxx", distinct_n, distinct_total, n, total))
    )

  expect_snapshot(as.data.frame(build(t2)))
})

test_that("denoms with distinct population data populates as expected", {
  load(test_path("adae.Rdata"))
  load(test_path("adsl.Rdata"))

  tab <- tplyr_table(adae, TRTA) %>%
    set_pop_data(adsl) %>%
    set_pop_treat_var(TRT01A) %>%
    add_total_group %>%
    add_treat_grps(Dosed = c("Xanomeline High Dose", "Xanomeline Low Dose")) %>%
    add_layer(
      group_count("Any Body System") %>%
        set_distinct_by(USUBJID) %>%
        set_format_strings(f_str("xx (xx.x%)", distinct_n, distinct_pct))
    ) %>%
    build()

  expect_snapshot(as.data.frame(tab))
})

test_that("nested count layers error out when you try to add a total row", {

  # GH issue 92
  tab <- tplyr_table(mtcars, am) %>%
    add_layer(
      group_count(vars(cyl, grp)) %>%
        add_total_row()
    )

    expect_snapshot_error(build(tab))

  # The weird use of mtcars2 makes us have to overwrite this again
  mtcars <- mtcars2
})

test_that("Tables with pop_data can accept a layer level where", {

  load(test_path('adsl.Rdata'))
  load(test_path('adae.Rdata'))
  t <- tplyr_table(adae, TRTA) %>%
    set_pop_data(adsl) %>%
    set_pop_treat_var(TRT01A) %>%
    set_pop_where(TRUE) %>%
    add_layer(
      group_count(AEDECOD, where = AEREL != "NONE") %>%
        set_distinct_by(USUBJID) %>%
        set_format_strings(f_str("xxx, [xxx] (xxx.x%) [xxx.x%]", distinct_n, n, distinct_pct, pct))
    )

  expect_snapshot(as.data.frame(build(t)))

})

test_that("Regression test to make sure cols produce correct denom", {
  load(test_path('adsl.Rdata'))
  load(test_path('adae.Rdata'))
  t <- tplyr_table(adae,TRTAN, cols=SEX) %>%
    set_pop_data(adsl) %>%
    set_pop_treat_var(TRT01AN) %>%
    add_layer(
      group_count("Subjects with at least one event") %>%
        set_distinct_by(USUBJID) %>%
        set_format_strings(f_str("xxx (xx.x) [xx]", distinct_n, distinct_pct, distinct_total))
    ) %>%
    build() %>%
    select(-starts_with('ord')) %>%
    as.data.frame()

  expect_snapshot(t)
})

test_that("Error checking for add_missing_subjects_row()", {
  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_count(AEDECOD) %>%
          add_missing_subjects_row("blah")
      )
  )

  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_count(AEDECOD) %>%
          add_missing_subjects_row(f_str("xx", distinct_n), sort_value = "x")
      )
  )

  expect_error({
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_shift(vars(AEBODSYS, AEDECOD)) %>%
          add_missing_subjects_row(f_str("xx", distinct_n))
      )
    }, "`add_missing_subjects_row` for shift layers"
  )

  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_desc(RACEN) %>%
          add_missing_subjects_row(f_str("xx", distinct_n))
      )
  )

  ## ----

  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_count(AEDECOD) %>%
          set_missing_subjects_row_label(3)
      )
  )

  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_count(AEDECOD) %>%
          set_missing_subjects_row_label(c("x", "y"))
      )
  )

  expect_error({
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_shift(vars(AEBODSYS, AEDECOD)) %>%
          set_missing_subjects_row_label("x")
      )}, "`set_missing_subjects_row_label` for shift layers"
  )

  expect_snapshot_error(
    tplyr_table(tplyr_adae, TRTA) %>%
      add_layer(
        group_desc(RACEN) %>%
          set_missing_subjects_row_label("x")
      )
  )

})

test_that("Missing subjects row calculates correctly", {
  x <- tplyr_table(tplyr_adlb, TRTA, cols=SEX) %>%
    set_pop_data(tplyr_adsl) %>%
    set_pop_treat_var(TRT01A) %>%
    add_layer(
      group_count(ANRIND, by = vars(PARAM, AVISIT)) %>%
        set_distinct_by(USUBJID) %>%
        add_missing_subjects_row(f_str("xx", distinct_n))
    ) %>%
    build()

  # Check 1
  in_res1 <- x %>%
    filter(row_label3 == "Missing", row_label1 == "Blood Urea Nitrogen (mmol/L)", row_label2 == "Week 12") %>%
    pull(var1_Placebo_F) %>%
    as.numeric()

  pop1 <- tplyr_adsl %>%
    filter(TRT01A == "Placebo", SEX == "F") %>%
    nrow()

  dat1 <- tplyr_adlb %>%
    filter(PARAM == "Blood Urea Nitrogen (mmol/L)", AVISIT == "Week 12", TRTA == "Placebo", SEX == "F") %>%
    distinct(USUBJID) %>%
    nrow()

  expect_equal(pop1-dat1, in_res1)

  # Check 2
  in_res2 <- x %>%
    filter(row_label3 == "Missing", row_label1 == "Gamma Glutamyl Transferase (U/L)", row_label2 == "Week 24") %>%
    pull(`var1_Xanomeline Low Dose_M`) %>%
    as.numeric()

  pop2 <- tplyr_adsl %>%
    filter(TRT01A == "Xanomeline Low Dose", SEX == "M") %>%
    nrow()

  dat2 <- tplyr_adlb %>%
    filter(PARAM == "Gamma Glutamyl Transferase (U/L)", AVISIT == "Week 24", TRTA == "Xanomeline Low Dose", SEX == "M") %>%
    distinct(USUBJID) %>%
    nrow()

  expect_equal(pop2-dat2, in_res2)

})

test_that("Missing counts on nested count layers function correctly", {
  x <- tplyr_table(tplyr_adae, TRTA) %>%
    set_pop_data(tplyr_adsl) %>%
    set_pop_treat_var(TRT01A) %>%
    add_layer(
      group_count(vars(AEBODSYS, AEDECOD)) %>%
        set_distinct_by(USUBJID) %>%
        add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf)
    ) %>%
    build()

  expect_equal(nrow(x %>% filter(row_label2 == "   Missing")), 1)
  expect_equal(tail(x, 1)$ord_layer_2, Inf)

  # Verify that bycount works for missing values and sort value is assigned correctly
  x <- tplyr_table(tplyr_adae, TRTA) %>%
    set_pop_data(tplyr_adsl) %>%
    set_pop_treat_var(TRT01A) %>%
    add_layer(
      group_count(vars(AEBODSYS, AEDECOD)) %>%
        set_distinct_by(USUBJID) %>%
        set_order_count_method("bycount") %>%
        set_ordering_cols("Xanomeline High Dose") %>%
        set_result_order_var(distinct_n) %>%
        add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999)
    ) %>%
    build()

  expect_equal(tail(x, 1)$ord_layer_2, 99999)

  # Also test that label reassignment flows
  # The warning here is intentional
  expect_snapshot_warning({
    x <- tplyr_table(tplyr_adsl, TRT01A) %>%
      add_layer(
        group_count(vars(SEX, RACE)) %>%
          set_order_count_method(c("byfactor", "byvarn")) %>%
          add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999) %>%
          set_missing_subjects_row_label("New label")
      ) %>%
      build()
  })

  expect_equal(filter(x, row_label2 == "   New label")$ord_layer_2, c(99999, 99999))
})