tests/testthat/test-prep_card.R

test_that("prep_...() pipe with demographic data", {

  # data prep -------------------------------------------------------------
  adsl <- pharmaverseadam::adsl |>
    dplyr::filter(SAFFL == "Y") |>
    dplyr::select(USUBJID, ARM, SEX, AGE, AGEGR1, ETHNIC, RACE) |>
    dplyr::mutate(
      SEX = factor(
        SEX,
        levels = c("F", "M")
      ),
      AGEGR1 = factor(
        AGEGR1,
        levels = c("<18", "18-64", ">64"),
        labels = c("<=18 years", "Between 18 and 65 years", ">=65 years")
      ),
      ETHNIC = factor(
        ETHNIC,
        levels = c(
          "HISPANIC OR LATINO",
          "NOT HISPANIC OR LATINO",
          "NOT REPORTED"
        )
      ),
      RACE = factor(
        RACE,
        levels = c(
          "AMERICAN INDIAN OR ALASKA NATIVE",
          "ASIAN",
          "BLACK OR AFRICAN AMERICAN",
          "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER",
          "WHITE"
        )
      )
    )

  # create card -----------------------------------------------------------
  ard <- cards::ard_stack(
    data = adsl,
    .by = ARM,
    cards::ard_continuous(
      variables = AGE,
      statistic = ~ cards::continuous_summary_fns(
        c("N", "mean", "sd", "min", "max")
      )
    ),
    cards::ard_categorical(
      variables = c(AGEGR1, SEX, ETHNIC, RACE)
    ),
    .overall = TRUE,
    .total_n = TRUE
  )


  # manual tidy -------------------------------------------------------------
  ard_tbl <- ard |>
    # rename cols, coalesce variable levels/stat_labels, unnest
    cards::rename_ard_columns(columns = c("group1")) |>
    cards::unlist_ard_columns() |>
    dplyr::mutate(
      label = purrr::map_chr(
        variable_level,
        ~ {
          # Assign NA if the element is empty
          if (length(.x) == 0) {
            return(NA_character_)
          }

          as.character(.x[[1]]) # Convert to character
        }
      )
    ) |>
    # set missing labels to stat_lavel
    dplyr::mutate(
      label = dplyr::if_else(is.na(label), stat_label, label),
      # Add big N labels
      ARM = dplyr::if_else(
        variable == "ARM",
        label,
        ARM
      ),
      # ID total trt
      ARM = dplyr::if_else(
        is.na(ARM) | variable == "..ard_total_n..",
        "Overall ARM",
        ARM
      ),
      # unique stat names for big N's
      stat_name = dplyr::if_else(
        (variable == "ARM" & stat_name == "n") | variable == "..ard_total_n..",
        "bigN",
        stat_name
      ),
      # relabel the label for n's
      label = dplyr::if_else(
        stat_name == "N",
        "n",
        label
      )
    ) |>
    # remove unneeded stats
    dplyr::filter(
      !(variable == "ARM" & stat_name != "bigN")
    ) |>
    # sorting (mostly handled by factors, above)
    dplyr::mutate(
      ord1 = forcats::fct_inorder(variable) |>
        forcats::fct_relevel("SEX", after = 0) |>
        as.numeric(),
      ord2 = dplyr::if_else(label == "n", 1, 2)
    ) |>
    # drop variables not needed
    dplyr::select(ARM, variable, label, stat_name, stat, ord1, ord2) |>
    # remove dups (extra denoms per variable level)
    unique()

  # the tfrmt table -------------------------------------------------------
  dm_t01 <- tfrmt(
    title = "Summary of Demographic Characteristics",
    group = variable,
    label = label,
    param = stat_name,
    value = stat,
    column = ARM,
    sorting_cols = c(ord1, ord2),
    body_plan = body_plan(
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt("xxx")
      ),
      frmt_structure(
        group_val = ".default",
        label_val = ".default",
        frmt_combine(
          "{n} ({p}%)",
          n = frmt("xxx"),
          p = frmt("xx", transform = ~ . * 100)
        )
      )
    ),
    big_n = big_n_structure(
      param_val = "bigN",
      n_frmt = frmt("\n(N=xx)")
    ),
    col_plan = col_plan(
      -starts_with("ord")
    ),
    col_style_plan = col_style_plan(
      col_style_structure(
        col = everything(),
        align = "left"
      )
    ),
    row_grp_plan = row_grp_plan(
      row_grp_structure(
        group_val = ".default",
        element_block(
          post_space = " "
        )
      )
    )
  )

  a <- print_to_gt(dm_t01, ard_tbl)
  a_html <- a |>
    gt::as_raw_html() |>
    # the id is randomly generated
    strip_id()


  # tidy with `prep_...()` functions ----------------------------------------
  prepped_ard <- ard |>
    shuffle_card(
      by = "ARM"
    ) |>
    prep_combine_vars(
      c("AGE", "AGEGR1", "SEX", "ETHNIC", "RACE")
    ) |>
    prep_big_n(
      vars = "ARM"
    ) |>
    prep_label() |>
    dplyr::mutate(
      label = dplyr::if_else(
        .data$stat_name == "N",
        "n",
        .data$label
      ),
      variable_level = dplyr::if_else(
        .data$stat_name == "N",
        NA,
        .data$variable_level
      )
    ) |>
    unique() |>
    dplyr::mutate(
      # we need these additional steps for compatibility with the manual
      # processing
      label = dplyr::if_else(
        .data$stat_name == "bigN" &
          .data$context %in% c("categorical", "tabulate"),
        ARM,
        .data$label
      ),
      ord1 = forcats::fct_inorder(stat_variable) |>
        forcats::fct_relevel("SEX", after = 0) |>
        as.numeric(),
      ord2 = dplyr::if_else(label == "n", 1, 2)
    ) |>
    dplyr::select(
      ARM,
      variable = stat_variable,
      label,
      stat_name,
      stat,
      ord1,
      ord2
    )

  expect_identical(
    dplyr::arrange(ard_tbl, ord1, ord2),
    dplyr::arrange(prepped_ard, ord1, ord2)
  )

  expect_no_error(
    b <- print_to_gt(dm_t01, prepped_ard)
  )

  b_html <- b |>
    gt::as_raw_html() |>
    # the id is randomly generated so we strip it
    strip_id()

  expect_identical(
    a_html,
    b_html
  )

  expect_identical(
    gt::extract_body(a),
    gt::extract_body(b)
  )

  expect_snapshot(
    gt::as_raw_html(b),
    transform = strip_id
  )
})

test_that("prep_...() pipe with adverse effects data", {

  # data prep -------------------------------------------------------------
  # Filter to include only subjects marked as part of the safety population
  adsl <- pharmaverseadam::adsl |>
    dplyr::filter(SAFFL == "Y")

  #subset data to limit printed rows for demo purposes
  adae <- pharmaverseadam::adae |>
    dplyr::filter(AESOC %in% unique(AESOC)[1:3]) |>
    dplyr::group_by(AESOC) |>
    dplyr::filter(AEDECOD %in% unique(AEDECOD)[1:3]) |>
    dplyr::ungroup()

  # create card -----------------------------------------------------------
  suppressMessages(
    ae_ard <- cards::ard_stack_hierarchical(
      data = adae,
      by = c(TRT01A, AESEV),
      variables = c(AEBODSYS, AETERM),
      statistic = ~ c("n", "p"), # Calculate count and percentage
      denominator = adsl,
      id = USUBJID,
      over_variables = TRUE,
      total_n = TRUE
    )
  )


  # manual tidy -------------------------------------------------------------
  ae2_ard_tbl <- ae_ard |>
    cards::rename_ard_columns() |>
    cards::unlist_ard_columns() |>
    dplyr::mutate(
      # label any event rows for top level any event and each aesoc any event
      # rows
      AETERM = dplyr::if_else(
        !is.na(..ard_hierarchical_overall..) &
          ..ard_hierarchical_overall.. == TRUE |
          is.na(AETERM) & !is.na(AEBODSYS),
        "ANY EVENT",
        AETERM
      ),
      # update na rows in aebodsys to be ANY EVENT so labels appear correctly
      # in tfrmt
      AEBODSYS = dplyr::if_else(
        AETERM == "ANY EVENT" &
          is.na(AEBODSYS),
        "ANY EVENT",
        AEBODSYS
      ),
      #create bigN values
      stat_name = dplyr::if_else(
        is.na(AETERM) & stat_name == "n" | context == "total_n",
        "bigN",
        stat_name
      )
    ) |>
    #filter to just the needed stats
    dplyr::filter(
      !(is.na(AETERM) & stat_name %in% c("N", "p"))
    ) |>
    dplyr::select(
      TRT01A,
      AESEV,
      AEBODSYS,
      AETERM,
      stat,
      stat_name
    )

  # the tfrmt table -------------------------------------------------------
  ae_t02 <- tfrmt_n_pct(
    n = "n",
    pct = "p",
    pct_frmt_when = frmt_when(
      "==1" ~ frmt("100"),
      ">.99" ~ frmt("(>99%)"),
      "==0" ~ "",
      "<.01" ~ frmt("(<1%)"),
      "TRUE" ~ frmt("(xx%)", transform = ~ . * 100)
    )
  ) |>
    tfrmt(
      group = AEBODSYS,
      label = AETERM,
      param = stat_name,
      value = stat,
      column = c(TRT01A, AESEV),
      row_grp_plan = row_grp_plan(
        row_grp_structure(
          group_val = ".default",
          element_block(
            post_space = " "
          )
        )
      ),
      big_n = big_n_structure(
        param_val = "bigN",
        n_frmt = frmt(" (N=xx)")
      )
    )

  a <- print_to_gt(ae_t02, ae2_ard_tbl)
  a

  # tidy with `prep_...()` functions ----------------------------------------
  prepped_ard <- ae_ard |>
    shuffle_card(
      by = c("TRT01A", "AESEV"),
      fill_overall = NA,
      fill_hierarchical_overall = "ANY EVENT"
    ) |>
    prep_big_n(
      vars = c("TRT01A", "AESEV")
    ) |>
    prep_hierarchical_fill(
      vars = c("AEBODSYS", "AETERM"),
      fill = "ANY EVENT"
    ) |>
    dplyr::select(-context, -stat_variable, -stat_label) |>
    dplyr::relocate(stat_name, .after = stat)

  expect_equal(
    arrange(ae2_ard_tbl, TRT01A, AESEV, AEBODSYS, AETERM),
    arrange(prepped_ard, TRT01A, AESEV, AEBODSYS, AETERM),
    ignore_attr = TRUE
  )

  expect_no_error(
    b <- print_to_gt(ae_t02, prepped_ard)
  )

  expect_identical(
    gt::extract_body(a),
    gt::extract_body(b),
    ignore_attr = ".col_plan_vars"
  )

  # check messaging around combining vars in a hierarchical ard stack df
  expect_message(
    ae_ard |>
      shuffle_card(
        by = c("TRT01A", "AESEV"),
        fill_overall = NA,
        fill_hierarchical_overall = "ANY EVENT"
      ) |>
      prep_combine_vars(
        vars = c("AEBODSYS", "AETERM")
      ),
    regexp = "The `context` column indicates data comes from a hierarchical `ard` stack.",
    fixed = TRUE
  )

  # check messaging around prep_label() needing `variable_level`
  expect_message(
    ae_ard |>
      shuffle_card(
        by = c("TRT01A", "AESEV"),
        fill_overall = NA,
        fill_hierarchical_overall = "ANY EVENT"
      ) |>
      prep_big_n(
        vars = c("TRT01A", "AESEV")
      ) |>
      prep_label(),
    regexp = "Required column (`variable_level`) not present in the input data.",
    fixed = TRUE
  )
})

test_that("prep_combine_vars() works", {
  df <- tibble::tibble(
    a = 1:6,
    context = rep("categorical", 6),
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, NA, "c", rep(NA, 3)),
    e = c(NA, NA, NA, "d", rep(NA, 2)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_identical(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f", "g")
    ),
    tibble::tibble(
      a = 1:6,
      context = rep("categorical", 6),
      variable_level = c("a", "b", "c", "d", "e", "f")
    )
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f", "g")
    )
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f"),
      remove = FALSE
    )
  )
})

test_that("prep_combine_vars() returns the input when context hierarchical", {

  df <- tibble::tibble(
    a = 1:6,
    context = rep("hierarchical", 6),
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, NA, "c", rep(NA, 3)),
    e = c(NA, NA, NA, "d", rep(NA, 2)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_identical(
    suppressMessages(
      prep_combine_vars(
        df,
        vars = c("b", "c", "d", "e", "f", "g")
      )
    ),
    df
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f", "g")
    )
  )
})

test_that("prep_combine_vars() return input unchanged when length(vars)=1", {

  df <- tibble::tibble(
    a = 1:6,
    context = rep("categorical", 6),
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, NA, "c", rep(NA, 3)),
    e = c(NA, NA, NA, "d", rep(NA, 2)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_identical(
    suppressMessages(
      prep_combine_vars(
        df,
        vars = "b"
      )
    ),
    df
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = "b"
    )
  )
})

test_that("prep_combine_vars() does not over unite", {

  # c, d and e are identical, the are not pasted together in the output
  # the input is returned unchanged
  df <- tibble::tibble(
    a = 1:6,
    context = rep("categorical", 6),
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, "b", rep(NA, 4)),
    e = c(NA, "b", rep(NA, 4)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_identical(
    suppressMessages(
      prep_combine_vars(
        df,
        vars = c("b", "c", "d", "e", "f", "g")
      )
    ),
    df
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f", "g")
    )
  )
})

test_that("prep_combine_vars() informs when the context col is missing", {
  df <- tibble::tibble(
    a = 1:6,
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, "b", rep(NA, 4)),
    e = c(NA, "b", rep(NA, 4)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_snapshot(
    prep_combine_vars(
      df,
      vars = c("b", "c", "d", "e", "f", "g")
    )
  )
})

test_that("prep_combine_vars() errors when `vars` is not character", {
  df <- tibble::tibble(
    a = 1:6,
    b = c("a", rep(NA, 5)),
    c = c(NA, "b", rep(NA, 4)),
    d = c(NA, "b", rep(NA, 4)),
    e = c(NA, "b", rep(NA, 4)),
    f = c(NA, NA, NA, NA, "e", NA),
    g = c(rep(NA, 5), "f")
  )

  expect_snapshot(
    error = TRUE,
    prep_combine_vars(
      df,
      vars = 1:3
    )
  )

  expect_snapshot(
    error = TRUE,
    prep_combine_vars(
      df,
      vars = c(TRUE, FALSE)
    )
  )
})

test_that("prep_big_n() works", {
  df <- tibble::tibble(
    stat_name = c("n", "max", "min", rep(c("n", "N", "p"), times = 2)),
    context = rep(c("continuous", "hierarchical", "categorical"), each = 3),
    stat_variable = rep(c("a", "b", "c"), each = 3)
  ) |>
    bind_rows(
      tibble::tibble(
        stat_name = "n",
        context = "total_n",
        stat_variable = "d"
      )
    )

  expect_identical(
    prep_big_n(
      df,
      vars = c("b", "c")
    ),
    tibble::tibble(
      stat_name = c("n", "max", "min", rep("bigN", 3)),
      context = c(
        rep("continuous", 3),
        "hierarchical",
        "categorical",
        "total_n"
      ),
      stat_variable = c(rep("a", 3), "b", "c", "d")
    )
  )

  expect_snapshot(
    prep_big_n(
      df,
      vars = c("b", "c")
    )
  )

  expect_snapshot(
    prep_big_n(
      df,
      vars = "b"
    )
  )
})

test_that("prep_big_n() informs when required columns are missing", {
  df <- tibble::tibble(
    a = c("n", "max", "min", rep(c("n", "N", "p"), times = 2)),
    context = rep(c("continuous", "hierarchical", "categorical"), each = 3),
    stat_variable = rep(c("a", "b", "c"), each = 3)
  )

  expect_identical(
    suppressMessages(
      prep_big_n(
        df,
        vars = "a"
      )
    ),
    df
  )

  expect_snapshot(
    prep_big_n(
      df,
      vars = "a"
    )
  )
})

test_that("prep_big_n() errors when `vars` is not character", {
  df <- tibble::tibble(
    a = c("n", "max", "min", rep(c("n", "N", "p"), times = 2)),
    context = rep(c("continuous", "hierarchical", "categorical"), each = 3),
    stat_variable = rep(c("a", "b", "c"), each = 3)
  )

  expect_snapshot(
    error = TRUE,
    prep_big_n(
      df,
      vars = 1
    )
  )

  expect_snapshot(
    error = TRUE,
    prep_big_n(
      df,
      vars = TRUE
    )
  )
})

test_that("prep_label() works", {
  df <- tibble::tibble(
    variable_level = rep(c("a", "b", "c"), each = 3),
    stat_label = c("n", "N", "%", "N", "Mean", "SD", "n", "N", "%"),
    stat_name = c("n", "N", "p", "N", "mean", "sd", "n", "N", "p"),
    context = rep(c("categorical", "continuous", "hierarchical"), each = 3)
  )

  expect_identical(
    prep_label(df),
    tibble::tibble(
      variable_level = rep(c("a", "b", "c"), each = 3),
      stat_label = c("n", "N", "%", "N", "Mean", "SD", "n", "N", "%"),
      stat_name = c("n", "N", "p", "N", "mean", "sd", "n", "N", "p"),
      context = rep(c("categorical", "continuous", "hierarchical"), each = 3),
      label = c("a", "a", "a", "N", "Mean", "SD", "c", "c", "c")
    )
  )

  expect_snapshot(
    prep_label(df)
  )
})

test_that("prep_label() returns the input when the required cols are missing", {
  # `variable_level` col is not present
  df <- tibble::tibble(
    x = c("d", "e", "f"),
    stat_label = c("a", "b", "c"),
    context = c("categorical", "continuous", "hierarchical")
  )

  expect_identical(
    suppressMessages(prep_label(df)),
    df
  )

  expect_snapshot(
    prep_label(df)
  )

  # `stat_label` col is not present
  df2 <- tibble::tibble(
    variable_level = c("d", "e", "f"),
    y = c("a", "b", "c"),
    context = c("categorical", "continuous", "hierarchical")
  )

  expect_snapshot(
    prep_label(df2)
  )

  expect_identical(
    suppressMessages(prep_label(df2)),
    df2
  )
})

test_that("prep_hierarchical_fill() returns input when `length(vars) < 2`", {
  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, 3)
  )

  expect_identical(
    suppressMessages(
      prep_hierarchical_fill(
        df,
        vars = "y"
      )
    ),
    df
  )

  expect_snapshot(
    prep_hierarchical_fill(
      df,
      vars = "y"
    ),
  )
})

test_that("prep_hierarchical_fill() fills pairwise conditionally", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, 3)
  )

  # z is not filled - still 3 NAs
  expect_identical(
    prep_hierarchical_fill(df, vars = c("x", "y")),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "Any y", "b"),
      z = rep(NA, 3)
    )
  )

  expect_identical(
    prep_hierarchical_fill(df, vars = c("x", "y", "z")),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "Any y", "b"),
      z = rep("Any z", 3)
    )
  )
})

test_that("prep_hierarchical_fill() with `fill`", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, "3")
  )

  # the second value of y is replaced with "2
  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y"),
      fill = "foo"
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "foo", "b"),
      z = rep(NA, 3)
    )
  )

  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y", "z"),
      fill = "bar"
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "bar", "b"),
      z = c("bar", "bar", "bar")
    )
  )
})

test_that("prep_hierarchical_fill() with `fill` 'Any {colname}'", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, "3")
  )

  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y"),
      fill = "Any {colname}"
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "Any y", "b"),
      z = rep(NA, 3)
    )
  )

  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y", "z"),
      fill = "Any {colname}"
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "Any y", "b"),
      z = c("Any z", "Any z", "Any z")
    )
  )
})

test_that("prep_hierarchical_fill() with `fill_from_left = TRUE' works", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, "3")
  )

  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y"),
      fill_from_left = TRUE
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "2", "b"),
      z = rep(NA, 3)
    )
  )

  expect_identical(
    prep_hierarchical_fill(
      df,
      vars = c("x", "y", "z"),
      fill_from_left = TRUE
    ),
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", "2", "b"),
      z = c("a", "2", "b")
    )
  )
})

test_that("prep_hierarchical_fill() errors when `vars` is not character", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, "3")
  )

  expect_snapshot(
    error = TRUE,
    prep_hierarchical_fill(
      df,
      vars = 1:3
    )
  )

  expect_snapshot(
    error = TRUE,
    prep_hierarchical_fill(
      df,
      vars = c(TRUE, FALSE)
    )
  )
})

test_that("prep_hierarchical_fill() errors when `fill` is not character", {

  df <- tibble::tibble(
    x = c(1, 2, NA),
    y = c("a", NA, "b"),
    z = rep(NA, "3")
  )

  expect_snapshot(
    error = TRUE,
    prep_hierarchical_fill(
      df,
      vars = c("x", "y", "z"),
      fill = 2
    )
  )
})

test_that("generate_pairs() works", {

  expect_identical(
    generate_pairs(
      c("foo", "bar", "baz")
    ),
    list(
      c("foo", "bar"),
      c("bar", "baz")
    )
  )
})

test_that("generate_pairs() complains", {

  # with non-character input
  expect_snapshot(
    error = TRUE,
    generate_pairs(1:3)
  )

  # with an input having less than 2 elements
  expect_snapshot(
    error = TRUE,
    generate_pairs("foo")
  )

})

test_that("replace_na_pairwise() works", {

  expect_identical(
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, 3)
      ),
      pair = c("y", "z")
    ),
    # all NAs in z (when y is not NA) are replaced with `"Any z"`
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", NA, "b"),
      z = c("Any z", NA, "Any z")
    )
  )

  expect_identical(
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, 3)
      ),
      pair = c("y", "z"),
      fill = "foo"
    ),
    # all NAs in z (when y is not NA) are replaced with `"Any z"`
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", NA, "b"),
      z = c("foo", NA, "foo")
    )
  )

  expect_identical(
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, 3)
      ),
      pair = c("y", "z"),
      fill_from_left = TRUE
    ),
    # all NAs in z (when y is not NA) are replaced with `"Any z"`
    tibble::tibble(
      x = c(1, 2, NA),
      y = c("a", NA, "b"),
      z = c("a", NA, "b")
    )
  )
})

test_that("replace_na_pairwise() complains", {

  expect_snapshot(
    error = TRUE,
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, 3)
      ),
      pair = 1:2
    )
  )

  expect_snapshot(
    error = TRUE,
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, 3)
      ),
      pair = c("x", "y", "z")
    )
  )

  expect_snapshot(
    error = TRUE,
    replace_na_pairwise(
      tibble::tibble(
        x = c(1, 2, NA),
        y = c("a", NA, "b"),
        z = rep(NA, "3")
      ),
      pair = c("y", "z"),
      fill = 2
    )
  )

})

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.