tests/testthat/test-indent-mod.R

In rtables: Reporting Tables

context("Indent modifiers")

test_that("indent modifiers propogated from analyze calls properly", {
  lyt <- basic_table() %>%
    analyze("Sepal.Width", afun = mean, show_labels = "visible") %>%
    analyze("Sepal.Width",
      afun = median, show_labels = "hidden", indent_mod = 2L,
      table_names = "SecondAge"
    )
  tab <- build_table(lyt, iris)
  expect_equal(rtables:::indent_mod(tree_children(tab)[[2]]), 2L)

  expect_equal(make_row_df(tab)$indent, c(0, 1, 2))
})


test_that("indents are correct in make_row_df", {
  l1 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)") %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label"
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx"
    )

  t1 <- build_table(l1, rawdat)
  pgdf1 <- make_row_df(t1)
  expect_identical(
    rep(c(0, 1, 2, 2, 1, 2, 2), 2),
    pgdf1$indent
  )

  l2 <- l1 %>% analyze("AGE",
    var_labels = "Age Analysis Redux", table_names = "AgeRedux",
    afun = range, format = "xx - xx"
  )

  t2 <- build_table(l2, rawdat)
  pgdf2 <- make_row_df(t2)
  expect_identical(
    rep(c(0, 1, 2, 3, 3, 2, 3, 1, 2, 3, 3, 2, 3), 2),
    pgdf2$indent
  )


  l3 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)") %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label",
      indent_mod = 0
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx",
      indent_mod = -1
    )

  t3 <- build_table(l3, rawdat)
  pgdf3 <- make_row_df(t3)
  expect_identical(
    rep(c(0, 1, 1, 1, 1, 1, 1), 2),
    pgdf3$indent
  )

  l4 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)") %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label",
      indent_mod = -1
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx",
      indent_mod = 1
    )
  t4 <- build_table(l4, rawdat)
  pagdf4 <- make_row_df(t4)
  expect_identical(
    rep(c(0, 0, 2, 2, 0, 2, 2), 2),
    pagdf4$indent
  )

  l5 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", indent_mod = 2) %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)") %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label",
      indent_mod = -2
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx",
      indent_mod = 1
    )
  t5 <- build_table(l5, rawdat)
  pgdf5 <- make_row_df(t5)
  expect_identical(
    rep(c(2, 1, 3, 3, 1, 3, 3), 2),
    pgdf5$indent
  )

  l6 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity",
      labels_var = "ethn_label", indent_mod = 0,
      label_pos = "visible"
    ) %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)") %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label",
      indent_mod = 0
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx",
      indent_mod = 0
    )
  t6 <- build_table(l6, rawdat)
  pgdf6 <- make_row_df(t6)
  expect_identical(
    c(0, rep(c(1, 2, 3, 3, 2, 3, 3), 2)),
    pgdf6$indent
  )




  ## children inherit table idnent mod, NOT content indent_mod, when thsoe two
  ## values are different.

  l7 <- basic_table() %>%
    split_rows_by("RACE", "Ethnicity",
      labels_var = "ethn_label", indent_mod = 2,
      label_pos = "visible"
    ) %>%
    summarize_row_groups("RACE", label_fstr = "%s (n)", indent_mod = -1) %>%
    split_rows_by("FACTOR2", "Factor2",
      split_fun = remove_split_levels("C"),
      labels_var = "fac2_label",
      indent_mod = 0
    ) %>%
    analyze(
      "AGE", "Age Analysis",
      afun = function(x) list(mean = mean(x), median = median(x)),
      format = "xx.xx",
      indent_mod = 0
    )
  t7 <- build_table(l7, rawdat)
  pgdf7 <- make_row_df(t7)
  expect_identical(
    c(2, rep(c(1, 3, 4, 4, 3, 4, 4), 2)),
    pgdf7$indent
  )
})

test_that("getters and setters work", {
  t0 <- basic_table() %>%
    summarize_row_groups("STUDYID", label_fstr = "overall summary") %>%
    split_rows_by("AEBODSYS", child_labels = "visible") %>%
    summarize_row_groups("STUDYID", label_fstr = "subgroup summary") %>%
    analyze("AGE") %>%
    build_table(ex_adae)

  expect_equal(indent_mod(t0), 0)
  tm3 <- t0

  indent_mod(tm3) <- 3L

  expect_identical(indent_mod(tm3), 3L)

  cv <- CellValue(15)
  expect_equal(indent_mod(cv), 0)
  indent_mod(cv) <- 3L
  expect_equal(indent_mod(cv), 3)

  origimods <- c(hi = 0L, lo = 0L, med = 1L)
  rvs <- in_rows(hi = 5, lo = 2, med = 17.5, .indent_mods = origimods)
  expect_identical(indent_mod(rvs), origimods)
  indent_mod(rvs) <- c(2, 3, -1)

  sink(textConnection("outputstr2", open = "w"))
  print(rvs)
  sink(NULL)

  expect_equal(
    c(2, 3, -1),
    as.numeric(substr(outputstr2[4:6], 35, 36))
  )

  expect_equal(
    indent_mod(rvs),
    c(hi = 2, lo = 3, med = -1)
  )

  spl <- VarLevelSplit("age", "myagesplit")
  expect_equal(indent_mod(spl), 0)
  indent_mod(spl) <- 3
  expect_identical(indent_mod(spl), 3L) ## this tests implicit conversion
})



test_that("clear_indent_mods works as desired", {
  lytm <- basic_table() %>%
    summarize_row_groups("STUDYID", label_fstr = "overall summary", indent_mod = 1L) %>%
    split_rows_by("AEBODSYS", child_labels = "visible") %>%
    summarize_row_groups("STUDYID", label_fstr = "subgroup summary") %>%
    analyze("AGE", indent_mod = -1L)
  tm <- build_table(lytm, ex_adae)

  t0 <- basic_table() %>%
    summarize_row_groups("STUDYID", label_fstr = "overall summary") %>%
    split_rows_by("AEBODSYS", child_labels = "visible") %>%
    summarize_row_groups("STUDYID", label_fstr = "subgroup summary") %>%
    analyze("AGE") %>%
    build_table(ex_adae)

  expect_identical(
    matrix_form(clear_indent_mods(tm)),
    matrix_form(t0)
  )
})