tests/testthat/test-big_n.R

test_that("Defining the big Ns", {
  bn1 <- big_n_structure(
    param_val = "bigN",
    n_frmt = frmt("Hello World")
  )
  bn2 <- big_n_structure(
    param_val = c("bigN", "N")
  )

  expect_s3_class(bn1, "big_n_structure")
  expect_s3_class(bn2, "big_n_structure")

  expect_equal(
    bn1[["param_val"]],
    c("bigN"),
    ignore_attr = ".Environment"
  )

  expect_equal(
    bn1[["n_frmt"]],
    frmt("Hello World"),
    ignore_attr = ".Environment"
  )

  expect_equal(
    bn2[["param_val"]],
    c("bigN", "N"),
    ignore_attr = ".Environment"
  )

  expect_equal(
    bn2[["n_frmt"]],
    frmt("\nN = xx"),
    ignore_attr = ".Environment"
  )

  expect_error(
    big_n_structure(
      param_val = "bigN",
      n_frmt = "Hello World"
    )
  )

  expect_error(
    big_n_structure(
      param_val = "bigN",
      n_frmt = frmt_when(
        ">3" ~ frmt("(X.X%)"),
        "<=3" ~ frmt("Undetectable")
      )
    )
  )
})

test_that("Simple Case big_n", {

  data <- tibble::tibble(
    Group = rep(
      c("Age (y)", "Sex", "Age (y)", "Sex"),
      c(3, 3, 6, 12)
    ),
    Label = rep(
      c("n", "Mean (SD)", "Male", "Female"),
      c(6, 6, 6, 6)
    ),
    Column = rep(
      c("Placebo", "Treatment", "Total"),
      times = 8
    ),
    Param = rep(
      c("n", "mean", "sd", "n", "pct", "n", "pct"),
      c(6, 3, 3, 3, 3, 3, 3)
    ),
    Value = c(
      15, 13, 28, 14, 13, 27, 73.56, 74.231, 71.84, 9.347, 7.234, 8.293, 8, 7,
      15, 8 / 14, 7 / 13, 15 / 27, 6, 6, 12, 6 / 14, 6 / 13, 12 / 27
    )
  ) |>
    # Note because tfrmt only does rounding we will need to have the percents
    # multiplied by 100
    dplyr::mutate(
      Value = dplyr::case_when(
        Param == "pct" ~ Value * 100,
        TRUE ~ Value
      ),
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      ),
      ord2 = dplyr::if_else(
        Label == "n",
        1,
        2
      )
    )

  big_ns <- tibble::tibble(
    Column = c("Placebo", "Treatment", "Total"),
    Param = "bigN",
    Value = c(30, 30, 60)
  )


  data <- dplyr::bind_rows(data, big_ns)

  tfrmt_sans_colplan <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = c(ord1, ord2),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt_combine(
          "{n} {pct}",
          n = frmt("X"),
          pct = frmt(
            "(xx.x%)",
            missing = " "
          )
        )
      ),
      frmt_structure(
        group_val = "Age (y)",
        label_val = "Mean (SD)",
        frmt_combine(
          "{mean} ({sd})",
          mean = frmt("XX.X"),
          sd = frmt("x.xx")
        )
      ),
      frmt_structure(
        group_val = ".default",
        label_val = "n",
        frmt("xx")
      )
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(
          post_space = " "
        )
      )
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    )
  )

  tfrmt_wit_colplan <- tfrmt_sans_colplan |>
    tfrmt(
      col_plan = col_plan(
        everything(),
        -starts_with("ord"),
        "Total"
      )
    )

  auto_sans_colplan <- tfrmt_sans_colplan |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    ) |>
    names()

  expect_identical(
    auto_sans_colplan,
    c(
      "Label",
      "ord1",
      "ord2",
      "Placebo\nN = 30",
      "Treatment\nN = 30",
      "Total\nN = 60",
      "..tfrmt_row_grp_lbl"
    )
  )

  auto_wit_colplan <- tfrmt_wit_colplan |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    ) |>
    names()

  expect_identical(
    auto_wit_colplan,
    c(
      "Label",
      "Placebo\nN = 30",
      "Treatment\nN = 30",
      "Total\nN = 60",
      "..tfrmt_row_grp_lbl"
    )
  )

  auto_mock <- apply_tfrmt(
    .data = select(data, -Value),
    tfrmt = tfrmt_wit_colplan,
    mock = TRUE
  ) |>
    names()

  expect_identical(
    auto_mock,
    c(
      "Label",
      "Placebo\nN = xx",
      "Treatment\nN = xx",
      "Total\nN = xx",
      "..tfrmt_row_grp_lbl"
    )
  )
})

test_that("Test with spanning headers", {

  dat <- tibble::tribble(
    ~group,     ~label,        ~span2,  ~span1,     ~my_col,    ~parm,  ~val,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col1",  "value",    1,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col2",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol3",  "value",    1,
    "g1", "rowlabel1",  "column cols",    "col 4",   "col4",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol5",  "value",    1,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col1",  "value",    2,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col2",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol3",  "value",    2,
    "g1", "rowlabel2",  "column cols",    "col 4",   "col4",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol5",  "value",    2,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col1",  "value",    3,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col2",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol3",  "value",    3,
    "g2", "rowlabel3",  "column cols",    "col 4",   "col4",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol5",  "value",    3,
    # big n's
    NA, NA,  "column cols",         NA,       NA,  "bigN",    18,
    NA, NA,  "column cols", "cols 1,2",       NA,  "bigN",    12,
    NA, NA,  "column cols",    "col 4",   "col4",  "bigN",     6,
    NA, NA,             NA,         NA, "mycol3",  "bigN",     6,
  )

  auto_tfrmt <- tfrmt(
    group = group,
    label = label,
    param = parm,
    value = val,
    column = c(span2, span1, my_col),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("x")
      )
    ),
    col_plan = col_plan(
      group,
      label,
      starts_with("col"),
      new_col_3 = mycol3,
      -mycol5
    ),
    row_grp_plan = row_grp_plan(
      label_loc = element_row_grp_loc(
        location = "spanning"
      )
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    )
  )

  auto <- apply_tfrmt(
    .data = dat,
    tfrmt = auto_tfrmt
  ) |>
    names()

  man <- c(
    "group",
    "label",
    "column cols\nN = 18___tlang_delim___cols 1,2\nN = 12___tlang_delim___col1",
    "column cols\nN = 18___tlang_delim___cols 1,2\nN = 12___tlang_delim___col2",
    "column cols\nN = 18___tlang_delim___col 4___tlang_delim___col4\nN =  6",
    "new_col_3\nN =  6",
    "..tfrmt_row_grp_lbl"
  )

  expect_identical(auto, man)

  # try with empty strings rather than NA
  dat_blank <- dat |>
    dplyr::mutate(
      dplyr::across(
        dplyr::where(is.character),
        ~ tidyr::replace_na(.x, "")
      )
    )

  auto_blank <- apply_tfrmt(
    .data = dat_blank,
    tfrmt = auto_tfrmt
  ) |>
    names()

  expect_identical(auto_blank, man)
})

test_that("Multiple big N params", {

  data <- tibble::tibble(
    Group = rep(
      c("Age (y)", "Sex", "Age (y)", "Sex"),
      c(3, 3, 6, 12)
    ),
    Label = rep(
      c("n", "Mean (SD)", "Male", "Female"),
      c(6, 6, 6, 6)
    ),
    Column = rep(
      c("Placebo", "Treatment", "Total"),
      times = 8
    ),
    Param = rep(
      c("n", "mean", "sd", "n", "pct", "n", "pct"),
      c(6, 3, 3, 3, 3, 3, 3)
    ),
    Value = c(
      15, 13, 28, 14, 13, 27, 73.56, 74.231, 71.84, 9.347, 7.234, 8.293, 8, 7,
      15, 8 / 14, 7 / 13, 15 / 27, 6, 6, 12, 6 / 14, 6 / 13, 12 / 27
    )
  ) |>
    # Note because tfrmt only does rounding we will need to have the percents
    # multiplied by 100
    dplyr::mutate(
      Value = dplyr::case_when(
        Param == "pct" ~ Value * 100,
        TRUE ~ Value
      ),
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      ),
      ord2 = dplyr::if_else(
        Label == "n",
        1,
        2
      )
    )

  big_ns <- tibble::tibble(
    Column = c("Placebo", "Treatment", "Total"),
    Param = c("bigN", "big_n", "big_n"),
    Value = c(30, 30, 60)
  )


  data <- dplyr::bind_rows(data, big_ns)

  auto <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = c(ord1, ord2),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt_combine(
          "{n} {pct}",
          n = frmt("X"),
          pct = frmt(
            "(xx.x%)",
            missing = " "
          )
        )
      ),
      frmt_structure(
        group_val = "Age (y)",
        label_val = "Mean (SD)",
        frmt_combine(
          "{mean} ({sd})",
          mean = frmt("XX.X"),
          sd = frmt("x.xx")
        )
      ),
      frmt_structure(
        group_val = ".default",
        label_val = "n",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(
          post_space = " "
        )
      )
    ),
    big_n = big_n_structure(
      param_val = c("bigN", "big_n")
    )
  ) |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    ) |>
    names()

  expect_identical(
    auto,
    c(
      "Label",
      "Placebo\nN = 30",
      "Treatment\nN = 30",
      "Total\nN = 60",
      "..tfrmt_row_grp_lbl"
    )
  )
})

test_that("Overlapping Big N's", {

  data <- tibble::tibble(
    Group = rep(
      c("Age (y)", "Sex", "Age (y)", "Sex"),
      c(3, 3, 6, 12)
    ),
    Label = rep(
      c("n", "Mean (SD)", "Male", "Female"),
      c(6, 6, 6, 6)
    ),
    Column = rep(
      c("Placebo", "Treatment", "Total"),
      times = 8
    ),
    Param = rep(
      c("n", "mean", "sd", "n", "pct", "n", "pct"),
      c(6, 3, 3, 3, 3, 3, 3)
    ),
    Value = c(
      15, 13, 28, 14, 13, 27, 73.56, 74.231, 71.84, 9.347, 7.234, 8.293, 8, 7,
      15, 8 / 14, 7 / 13, 15 / 27, 6, 6, 12, 6 / 14, 6 / 13, 12 / 27
    )
  ) |>
    # Note because tfrmt only does rounding we will need to have the percents
    # multiplied by 100
    dplyr::mutate(
      Value = dplyr::case_when(
        Param == "pct" ~ Value * 100,
        TRUE ~ Value
      ),
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      ),
      ord2 = dplyr::if_else(
        Label == "n",
        1,
        2
      )
    )

  big_ns <- tibble::tibble(
    Column = c("Placebo", "Treatment", "Total", "Total"),
    Param = "bigN",
    Value = c(30, 30, 60, 65)
  )

  data <- dplyr::bind_rows(data, big_ns)

  tfrmt_test <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = c(ord1, ord2),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt_combine(
          "{n} {pct}",
          n = frmt("X"),
          pct = frmt(
            "(xx.x%)",
            missing = " "
          )
        )
      ),
      frmt_structure(
        group_val = "Age (y)",
        label_val = "Mean (SD)",
        frmt_combine(
          "{mean} ({sd})",
          mean = frmt("XX.X"),
          sd = frmt("x.xx")
        )
      ),
      frmt_structure(
        group_val = ".default",
        label_val = "n",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    )
  )

  expect_warning(
    apply_tfrmt(
      .data = data,
      tfrmt = tfrmt_test,
      mock = FALSE
    ) |>
      names()
  )
})

test_that("Missing Big N in dataset", {
  dat <- tibble::tribble(
    ~group,     ~label,        ~span2,  ~span1,     ~my_col,    ~parm,   ~val,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col1",  "value",    1,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col2",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol3",  "value",    1,
    "g1", "rowlabel1",  "column cols",    "col 4",   "col4",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol5",  "value",    1,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col1",  "value",    2,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col2",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol3",  "value",    2,
    "g1", "rowlabel2",  "column cols",    "col 4",   "col4",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol5",  "value",    2,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col1",  "value",    3,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col2",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol3",  "value",    3,
    "g2", "rowlabel3",  "column cols",    "col 4",   "col4",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol5",  "value",    3,
  )

  tfrmt_test <- tfrmt(
    group = group,
    label = label,
    param = parm,
    value = val,
    column = c(span2, span1, my_col),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("x")
      )
    ),
    col_plan = col_plan(
      group,
      label,
      starts_with("col")
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    )
  )

  expect_warning(
    apply_tfrmt(
      .data = dat,
      tfrmt = tfrmt_test,
      mock = FALSE
    )
  )
})

test_that("using 'value' for values column where there may be conflict in big_n", {

  dat <- tibble::tribble(
    ~group,     ~label,     ~span2,      ~span1,    ~my_col,  ~parm,   ~value,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col1",  "value",    1,
    "g1", "rowlabel1",  "column cols", "cols 1,2",   "col2",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol3",  "value",    1,
    "g1", "rowlabel1",  "column cols",    "col 4",   "col4",  "value",    1,
    "g1", "rowlabel1",             NA,         NA, "mycol5",  "value",    1,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col1",  "value",    2,
    "g1", "rowlabel2",  "column cols", "cols 1,2",   "col2",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol3",  "value",    2,
    "g1", "rowlabel2",  "column cols",    "col 4",   "col4",  "value",    2,
    "g1", "rowlabel2",             NA,         NA, "mycol5",  "value",    2,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col1",  "value",    3,
    "g2", "rowlabel3",  "column cols", "cols 1,2",   "col2",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol3",  "value",    3,
    "g2", "rowlabel3",  "column cols",    "col 4",   "col4",  "value",    3,
    "g2", "rowlabel3",             NA,         NA, "mycol5",  "value",    3,
    #big n's
    NA, NA,  "column cols",         NA,       NA, "bigN", 18,
    NA, NA,  "column cols", "cols 1,2",       NA, "bigN", 12,
    NA, NA,  "column cols",    "col 4",   "col4", "bigN",  6,
    NA, NA,             NA,         NA, "mycol3", "bigN",  6,
  )

  auto <- tfrmt(
    group = group,
    label = label,
    param = parm,
    value = value,
    column = c(span2, span1, my_col),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("x")
      )
    ),
    col_plan = col_plan(
      group,
      label,
      starts_with("col"),
      new_col_3 = mycol3,
      -mycol5
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    ),
    row_grp_plan = row_grp_plan(
      label_loc = element_row_grp_loc(
        location = "spanning"
      )
    )
  ) |>
    apply_tfrmt(
      .data = dat,
      tfrmt = _
    ) |>
    names()

  man <- c(
    "group",
    "label",
    "column cols\nN = 18___tlang_delim___cols 1,2\nN = 12___tlang_delim___col1",
    "column cols\nN = 18___tlang_delim___cols 1,2\nN = 12___tlang_delim___col2",
    "column cols\nN = 18___tlang_delim___col 4___tlang_delim___col4\nN =  6",
    "new_col_3\nN =  6",
    "..tfrmt_row_grp_lbl"
  )

  expect_identical(auto, man)
})

test_that("Test big n with footnotes", {

  # Create mock data
  df <- tidyr::crossing(
    group = c("group 1", "group 2"),
    label = c("label 1", "label 2"),
    column = c("PL", "T1", "T2", "T1&T2"),
    param = c("count", "percent")
  )

  # This one is used for examples 5 and 6
  span_df <- df |>
    dplyr::mutate(
      span = dplyr::case_when(
        column == "PL" ~ "Placebo",
        column %in% c("T1", "T2", "T1&T2") == TRUE ~ "Treatment"
      )
    )

  span_df_big_n <- dplyr::bind_rows(
    span_df,
    tibble::tibble(
      group = NA,
      label = NA,
      column = c("T1", "T2", "T1&T2"),
      param = "big_n",
      span = NA
    )
  )

  # Add specification
  big_n_footnote_plan_gt <- tfrmt(
    value = fake_value,
    group = group,
    label = label,
    column = c("span", "column"),
    param = param,
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = "   ")
      )
    ),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt_combine(
          "{count} ({percent})",
          count = frmt("xx"),
          percent = frmt("xx.x")
        )
      )
    ),
    col_plan = col_plan(
      group,
      label,
      span_structure(
        span = c("Placebo"),
        column = c("PL")
      ),
      span_structure(
        span = c("Treatment"),
        column = c("T1", "T2", "T1&T2")
      )
    ),

    # Add footnote here
    footnote_plan = footnote_plan(
      footnote_structure(
        footnote_text = "Footnote goes here",
        column_val = list(
          span = "Treatment",
          column = "T1&T2"
        )
      ),
      footnote_structure(
        footnote_text = "Footnote goes here 2",
        group_val = list(group = "group 1"),
        label_val = list(label = "label 1"),
        column_val = list(
          span = "Treatment",
          column = "T1"
        )
      ),
      footnote_structure(
        footnote_text = "Footnote goes here 3",
        label_val = list(label = "label 1"),
        column_val = list(
          span = "Treatment",
          column = "T1"
        )
      ),
      footnote_structure(
        footnote_text = "Footnote goes here 4",
        label_val = list(label = "label 1"),
      ),
      footnote_structure(
        footnote_text = "Footnote goes here 5",
        group_val = list(group = "group 1")
      ),
      footnote_structure(
        footnote_text = "Footnote goes here 6",
        label_val = list(label = "label 1"),
        column_val = list(
          span = "Treatment",
          column = c("T2")
        )
      )
    ),
    big_n = big_n_structure(
      param_val = "big_n"
    )
  ) |>
    print_mock_gt(span_df_big_n)


  ## ensure big_n got applied
  expect_identical(
    names(big_n_footnote_plan_gt$`_data`),
    c(
      "label",
      "Placebo___tlang_delim___PL",
      "Treatment___tlang_delim___T1\nN = xx",
      "Treatment___tlang_delim___T2\nN = xx",
      "Treatment___tlang_delim___T1&T2\nN = xx",
      "..tfrmt_row_grp_lbl"
    )
  )

  ## confirm location of footnotes gets recorded correctly
  expect_identical(
    big_n_footnote_plan_gt$`_footnotes` |>
      select(
        locname,
        colname,
        locnum,
        rownum,
        footnotes
      ) |>
      as_tibble(),
    tibble::tibble(
      locname = c(
        "columns_columns",
        "data",
        "data",
        "data",
        "stub",
        "stub",
        "stub",
        "data",
        "data"
      ),
      colname = c(
        "Treatment___tlang_delim___T1&T2\nN = xx",
        "Treatment___tlang_delim___T1\nN = xx",
        "Treatment___tlang_delim___T1\nN = xx",
        "Treatment___tlang_delim___T1\nN = xx",
        NA,
        NA,
        NA,
        "Treatment___tlang_delim___T2\nN = xx",
        "Treatment___tlang_delim___T2\nN = xx"
      ),
      locnum = c(4, 5, 5, 5, 5, 5, 5, 5, 5),
      rownum = c(NA, 2L, 2L, 6L, 2L, 6L, 1L, 2L, 6L),
      footnotes = list(
        "Footnote goes here",
        "Footnote goes here 2",
        "Footnote goes here 3",
        "Footnote goes here 3",
        "Footnote goes here 4",
        "Footnote goes here 4",
        "Footnote goes here 5",
        "Footnote goes here 6",
        "Footnote goes here 6"
      )
    )
  )
})

test_that("big Ns vary by page", {

  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  big_ns <- data |>
    dplyr::summarise(
      .by = c(Group, Column),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    )

  data <- bind_rows(data, big_ns)

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = ord1,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = ".default"
      )
    ),
    big_n = big_n_structure(
      param_val = c("big_N"),
      by_page = TRUE
    )
  )

  auto <- mytfrmt |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    )

  auto_names <- map(auto, names)
  man_names <- list(
    c(
      "Label",
      "Placebo\nN = 12",
      "Treatment\nN = 14",
      "Total\nN = 31",
      "..tfrmt_row_grp_lbl"
    ),
    c(
      "Label",
      "Placebo\nN = 20",
      "Treatment\nN = 32",
      "Total\nN = 18",
      "..tfrmt_row_grp_lbl"
    )
  )
  expect_identical(auto_names, man_names)
})

test_that("big Ns constant by page", {

  # big Ns are constant by page
  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  big_ns <- data |>
    dplyr::summarise(
      .by = c(Column),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    )

  data <- bind_rows(data, big_ns)

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = ord1,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = ".default"
      )
    ),
    big_n = big_n_structure(
      param_val = c("big_N"),
      by_page = FALSE
    )
  )

  auto <- mytfrmt |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    )

  expect_identical(
    map(auto, names),
    list(
      c(
        "Label",
        "Placebo\nN = 32",
        "Treatment\nN = 46",
        "Total\nN = 49",
        "..tfrmt_row_grp_lbl"
      ),
      c(
        "Label",
        "Placebo\nN = 32",
        "Treatment\nN = 46",
        "Total\nN = 49",
        "..tfrmt_row_grp_lbl"
      )
    )
  )

  # big Ns constant by page but by_page=TRUE in the big_n_structure gives
  # message
  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = ord1,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = ".default"
      )
    ),
    big_n = big_n_structure(
      param_val = c("big_N"),
      by_page = TRUE
    )
  )

  expect_snapshot(
    auto <- mytfrmt |>
      apply_tfrmt(
        .data = data,
        tfrmt = _,
        mock = FALSE
      )
  )

  expect_identical(
    map(auto, names),
    list(
      c(
        "Label",
        "Placebo\nN = 32",
        "Treatment\nN = 46",
        "Total\nN = 49",
        "..tfrmt_row_grp_lbl"
      ),
      c(
        "Label",
        "Placebo\nN = 32",
        "Treatment\nN = 46",
        "Total\nN = 49",
        "..tfrmt_row_grp_lbl"
      )
    )
  )

  # too many big Ns provided with by_page = FALSE
  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  big_ns <- data |>
    dplyr::summarise(
      .by = c(Group, Column),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    )

  data <- bind_rows(data, big_ns)

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = ord1,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = ".default"
      )
    ),
    big_n = big_n_structure(
      param_val = c("big_N"),
      by_page = FALSE
    )
  )

  expect_snapshot_warning(
    mytfrmt |>
      apply_tfrmt(
        .data = data,
        tfrmt = _,
        mock = FALSE
      )
  )
})


test_that("not enough big Ns by page", {

  # big Ns are constant by page
  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  #remove sex bigNs so we have a mismatch of big ns
  big_ns <- data |>
    dplyr::filter(
      Group == "Age (y)"
    ) |>
    dplyr::summarise(
      .by = c(Column, Group),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    )

  data <- bind_rows(data, big_ns)

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    sorting_cols = ord1,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = ".default"
      )
    ),
    big_n = big_n_structure(
      param_val = c("big_N"),
      by_page = TRUE
    )
  )

  expect_snapshot(
    mytfrmt |>
      apply_tfrmt(
        .data = data,
        tfrmt = _,
        mock = FALSE
      )
  )
})


test_that("Paging (group) variable is sorted non-alphabetically", {

  # same sorting of data and big Ns
  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  big_ns <- data |>
    dplyr::summarise(
      .by = c(Column, Group),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    )

  data <- bind_rows(data, big_ns) |>
    dplyr::arrange(
      dplyr::desc(Group)
    )

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = list(
          Group = ".default"
        )
      )
    ),
    big_n = big_n_structure(
      param_val = "big_N",
      by_page = TRUE
    )
  )

  auto <- mytfrmt |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    )

  # check that the labels have printed in the changed order
  expect_identical(
    # This extracts the first value of the "Label" column from each element
    map(auto, ~ .x[["Label"]][1]),
    list(
      "Sex",
      "Age (y)"
    )
  )

  # check big Ns have been correctly applied
  expect_identical(
    map(auto, names),
    list(
      c(
        "Label",
        "Placebo\nN = 20",
        "Treatment\nN = 32",
        "Total\nN = 18",
        "..tfrmt_row_grp_lbl"
      ),
      c(
        "Label",
        "Placebo\nN = 12",
        "Treatment\nN = 14",
        "Total\nN = 31",
        "..tfrmt_row_grp_lbl"
      )
    )
  )

  # different sorting of data and big Ns
  data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    ) |>
    dplyr::arrange(
      dplyr::desc(Group)
    )

  big_ns <- data |>
    dplyr::summarise(
      .by = c(Column, Group),
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "big_N"
    ) |>
    dplyr::arrange(
      Group
    )

  data <- bind_rows(data, big_ns)

  mytfrmt <- tfrmt(
    group = Group,
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xx")
      )
    ),
    col_plan = col_plan(
      everything(),
      -starts_with("ord"),
      "Total"
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(post_space = " ")
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = list(
          Group = ".default"
        )
      )
    ),
    big_n = big_n_structure(
      param_val = "big_N",
      by_page = TRUE
    )
  )

  expect_snapshot(
    mytfrmt |>
      apply_tfrmt(
        .data = data,
        tfrmt = _,
        mock = FALSE
      )
  )
})


test_that("Two grouping variables with a page_plan work as expected (renamed variables with a space)", {

  # Create the original data frame
  original_data <- tibble::tibble(
    Group = rep(c("Age (y)", "Sex"), c(3, 3)),
    Label = rep("n", 6),
    Column = rep(c("Placebo", "Treatment", "Total"), times = 2),
    Param = rep("n", 6),
    Value = c(12, 14, 31, 20, 32, 18)
  ) |>
    dplyr::mutate(
      ord1 = dplyr::if_else(
        Group == "Age (y)",
        1,
        2
      )
    )

  # Duplicate the data and add the `by group` column
  data_101 <- original_data |> dplyr::mutate(`by group` = "101")
  data_102 <- original_data |> dplyr::mutate(`by group` = "102")

  # Combine the two data frames
  data <- bind_rows(data_101, data_102)

  # Create mock big Ns
  big_ns <- data |>
    dplyr::group_by(
      `by group`,
      Column
    ) |>
    dplyr::summarise(
      Value = sum(Value)
    ) |>
    dplyr::mutate(
      Param = "bigN"
    ) |>
    dplyr::filter(
      `by group` == "101"
    ) |>
    dplyr::ungroup()

  data <- dplyr::bind_rows(data, big_ns) |>
    dplyr::arrange(
      dplyr::desc(Group)
    )

  # Define the tfrmt object with two grouping variables and a page_plan
  tfrmt_two_groups <- tfrmt(
    group = c(`by group`, Group),
    label = Label,
    column = Column,
    value = Value,
    param = Param,
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = "n",
        frmt("xx")
      )
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(
          post_space = " "
        )
      )
    ),
    page_plan = page_plan(
      page_structure(
        group_val = list(
          `by group` = ".default"
        )
      ),
      note_loc = "subtitle"
    ),
    big_n = big_n_structure(
      param_val = "bigN"
    ),
    col_plan = col_plan(
      -`by group`
    )
  )

  # Apply the tfrmt and check the output for each page
  output_list <- tfrmt_two_groups |>
    apply_tfrmt(
      .data = data,
      tfrmt = _,
      mock = FALSE
    )

  # Expect two elements in the output list, one for each `By group` value
  expect_length(output_list, 2)

  # Check the order of page notes
  expect_identical(
    purrr::map_chr(
      output_list,
      ~ attr(.x, ".page_note")
    ),
    c(
      "by group: 101",
      "by group: 102"
    )
  )

  # Check the first page (`by group` = "101")
  page_1_names <- names(output_list[[1]])
  expect_identical(
    page_1_names,
    c(
      "Label",
      "ord1",
      "Placebo\nN = 32",
      "Treatment\nN = 46",
      "Total\nN = 49",
      "..tfrmt_row_grp_lbl"
    )
  )

  # Check the second page (`by group` = "102")
  page_2_names <- names(output_list[[2]])
  expect_identical(
    page_2_names,
    c(
      "Label",
      "ord1",
      "Placebo\nN = 32",
      "Treatment\nN = 46",
      "Total\nN = 49",
      "..tfrmt_row_grp_lbl"
    )
  )
})

Try the tfrmt package in your browser

Any scripts or data that you put into this service are public.

tfrmt documentation built on Nov. 5, 2025, 6:12 p.m.