tests/testthat/test-30-add_totals.R

In pxmake: Make PX-Files in R

test_that("Total is added to one variable", {
  input <- tibble::tribble(
    ~cohort, ~sex, ~value,
    "a", "m", NA,
    "a", "f", 3,
    "b", "m", 2,
    "b", "f", 4
  )

  expect <- tibble::tribble(
    ~cohort, ~sex, ~value,
    "a", "m", NA,
    "a", "f", 3,
    "b", "m", 2,
    "b", "f", 4,
    "Total", "m", 2,
    "Total", "f", 7
  )

  expect_equal(
    add_total_level_to_var(input, "cohort") |> dplyr::arrange_all(),
    expect |> dplyr::arrange_all()
  )
})


test_that("Totals are added to two variables", {
  read_data <- function(table_name) {
    table_name |>
      get_data_path() |>
      readRDS() |>
      dplyr::as_tibble()
  }

  bexsta <- read_data("BEXSTA")
  bexsta_without_totals <- read_data("BEXSTA_WITHOUT_TOTALS")

  output <-
    add_totals_to_df(
      df = bexsta_without_totals,
      variables = c("place of birth", "gender"),
      level_name = "T",
      sum_var = "persons"
    ) |>
    dplyr::arrange_all()

  expect_equal(dplyr::arrange_all(output), dplyr::arrange_all(bexsta))

  # Test having multiple level_names
  bexsta2 <-
    bexsta |>
    dplyr::mutate(gender = ifelse(gender == "T", "Total", gender))

  output2 <-
    add_totals_to_df(
      df = bexsta_without_totals,
      variables = c("place of birth", "gender"),
      level_names = c("T", "Total"),
      sum_var = "persons"
    ) |>
    dplyr::arrange_all()

  expect_equal(dplyr::arrange_all(output2), dplyr::arrange_all(bexsta2))
})


test_that("adds total levels to data without them", {
  metadata_path <- get_metadata_path("BEXSTA")
  px1 <- temp_px_file()
  px2 <- temp_px_file()

  px(input = metadata_path, data = get_data_path("BEXSTA")) |>
    px_save(path = px1)

  px(input = metadata_path, data = get_data_path("BEXSTA_WITHOUT_TOTALS")) |>
    px_add_totals(c("place of birth", "gender")) |>
    px_save(path = px2)

  expect_equal_lines(px1, px2)
})

test_that("metadata without elimination values use default value", {
  levels <-
    px(
      input = get_metadata_path("BEXSTA"),
      data = get_data_path("BEXSTA_WITHOUT_TOTALS")
    ) |>
    px_elimination(NULL) |>
    px_add_totals(value = "gender") |>
    magrittr::extract2("data") |>
    dplyr::pull(gender) |>
    unique()

  expect_equal(levels, c("Total", "K", "M"))
})

test_that("do not ignore NA when summing", {
  df <- tibble::tribble(
    ~category, ~n,
    "a", 10,
    "b", 20,
    "c", NA
  )

  result <-
    px(df) |>
    px_add_totals("category", na_rm = FALSE) |>
    magrittr::extract2("data") |>
    dplyr::pull(n)

  expect_identical(result, c(NA, 10, 20, NA))
})

test_that("Add totals work for multiple languages", {
  # Create px object with multilingual add_totals
  x <-
    population_gl |>
    px() |>
    px_languages(c("en", "da")) |>
    px_elimination(dplyr::tribble(
      ~`variable-code`, ~elimination,
      "gender", "Total"
    )) |>
    px_add_totals("gender")

  # px_add_totals adds both 'en' and 'da' level in data. This is a mistake.
  gender_levels <-
    x |>
    px_data() |>
    dplyr::distinct(gender) |>
    dplyr::pull(gender)

  expect_identical(gender_levels, c("Total", "male", "female"))
})

test_that("Add totals adds elimination", {
  default_elimination <-
    population_gl |>
    px() |>
    px_add_totals("gender") |>
    px_elimination()

  expect_identical(
    default_elimination,
    dplyr::tibble(
      "variable-code" = "gender",
      "elimination" = "Total"
    )
  )
})

test_that("Elimination and values are preserved when changing data frame", {
  tmp_px_file <- temp_px_file()

  population_gl |>
    px() |>
    px_add_totals("gender") |>
    px_save(tmp_px_file)

  x <-
    px(tmp_px_file) |>
    px_data(population_gl)

  expect_identical(
    px_elimination(x),
    dplyr::tibble(
      "variable-code" = "gender",
      "elimination" = "Total"
    )
  )

  elimination_values <-
    x |>
    px_values() |>
    dplyr::semi_join(px_elimination(x),
      by = c(
        "variable-code" = "variable-code",
        "code" = "elimination"
      )
    ) |>
    dplyr::select("variable-code", "elimination" = "code")

  expect_identical(elimination_values, px_elimination(x))
})