tests/testthat/test-91-pxjob-micromake.R

In pxmake: Make PX-Files in R

test_that("px_micro creates PX-files correctly", {
  skip_if_not_installed("pxjob64Win", minimum_version = "1.1.0")

  expect_that_micro_files_are_correct <- function(x) {
    n_microvars <- length(names(x$data)) - length(px_heading(x))

    out_dir <- temp_dir()

    px_micro(x, out_dir = out_dir)

    px_paths <- list.files(out_dir, full.names = TRUE)

    expect_identical(n_microvars, length(px_paths))

    for (px_path in px_paths) {
      x_micro <- px(px_path)
      micro_var <- px_stub(x_micro)

      expect_true(stringr::str_detect(px_path, micro_var))

      expect_identical(px_heading(x), px_heading(x_micro))

      expect_identical(px_figures(x_micro), "n")

      expect_identical(
        px_note(x_micro),
        list(
          "Table note",
          dplyr::tibble(
            `variable-code` = micro_var,
            note = paste0("note for ", micro_var)
          )
        )
      )
    }
  }

  get_data_path("micro") |>
    readRDS() |>
    dplyr::as_tibble() |>
    dplyr::select(taar, sex, civst, alder) |>
    dplyr::mutate(alder = cut(alder,
      breaks = c(0, 20, 40, 60, 80, 100),
      labels = c("0-19", "20-39", "40-59", "60-79", "80+")
    )) |>
    px() |>
    px_stub("civst") |>
    px_timeval("taar") |>
    px_heading(c("taar", "sex")) |>
    px_note("Table note") |>
    px_note(dplyr::tibble(
      `variable-code` = c("civst", "alder"),
      note = paste0("note for ", `variable-code`)
    )) |>
    expect_that_micro_files_are_correct()
})

test_that("px_micro creates valid PX-files", {
  skip_if_not_installed("pxjob64Win", minimum_version = "1.1.0")

  expect_that_pxjob_runs_without_errors <- function(px) {
    out_dir <- temp_dir()

    px_micro(px, out_dir = out_dir)

    px_paths <- list.files(out_dir, full.names = TRUE)

    for (px_path in px_paths) {
      output <- temp_px_file()
      pxjob_exit_code <- pxjob64Win::pxjob(px_path, output)

      expect_equal(0, pxjob_exit_code, info = px_path)
    }
  }

  get_data_path("micro") |>
    readRDS() |>
    dplyr::as_tibble() |>
    dplyr::mutate(
      sidedoer = stringr::str_trim(sidedoer),
      sidedoer = dplyr::na_if(sidedoer, ""),
      pnr = NA
    ) |>
    px() |>
    px_timeval("taar") |>
    expect_that_pxjob_runs_without_errors()
})

test_that("px_micro can control data for individual tables", {
  set.seed(1)

  df <-
    get_data_path("micro") |>
    readRDS() |>
    dplyr::as_tibble() |>
    dplyr::select(taar, civst) |>
    dplyr::mutate(
      study = sample(c("A", "B"), size = dplyr::n(), replace = TRUE)
    )


  table_level <-
    dplyr::tribble(
      ~variable, ~px_description,
      "taar", "Year",
      "civst", "Civil status"
    ) |>
    dplyr::mutate(px_matrix = variable)

  out_dir <- temp_dir()

  px(df) |>
    px_stub(names(df)) |>
    px_heading("study") |>
    px_micro(
      out_dir = out_dir,
      keyword_values = table_level
    )

  px_paths <- list.files(out_dir, full.names = TRUE)

  for (px_path in px_paths) {
    x_micro <- px(px_path)
    micro_var <- px_stub(x_micro)

    micro_table_level <-
      table_level |>
      dplyr::filter(variable == micro_var)

    expect_equal(px_description(x_micro), micro_table_level$px_description)
    expect_equal(px_matrix(x_micro), micro_table_level$px_matrix)
  }
})

test_that("keyword_values are multilingual", {
  x <-
    greenlanders |>
    px() |>
    px_language("en") |>
    px_languages(c("en", "kl")) |>
    px_stub(names(greenlanders)) |>
    px_heading("cohort")

  keyword_values <-
    dplyr::tribble(
      ~variable, ~language, ~px_description, ~px_matrix,
      "age", "en", "Age", "gl",
      "age", "kl", "Ukiut", NA,
      "gender", "en", "Gender", "ge",
      "gender", "kl", "Suiaassuseq", "ge"
    )

  out_dir <- temp_dir()

  px_micro(x, out_dir = out_dir, keyword_values = keyword_values)

  px_age <- px(file.path(out_dir, "age.px"))
  keyword_values_age <- dplyr::filter(keyword_values, variable == "age")

  expect_identical(
    px_description(px_age),
    keyword_values_age |>
      dplyr::select(language, value = px_description)
  )

  expect_identical(
    px_matrix(px_age),
    keyword_values_age |>
      tidyr::drop_na(px_matrix) |>
      dplyr::pull(px_matrix)
  )

  px_gender <- px(file.path(out_dir, "gender.px"))
  keyword_values_gender <- dplyr::filter(keyword_values, variable == "gender")

  expect_identical(
    px_description(px_gender),
    keyword_values_gender |>
      dplyr::select(language, value = px_description)
  )

  expect_identical(
    px_matrix(px_gender),
    keyword_values_gender |>
      tidyr::drop_na(px_matrix) |>
      dplyr::distinct(px_matrix) |>
      dplyr::pull(px_matrix)
  )
})

test_that("px_micro can control filenames", {
  df <-
    get_data_path("micro") |>
    readRDS() |>
    dplyr::as_tibble() |>
    dplyr::select(1:4)

  out_dir <- temp_dir()

  filename_df <-
    dplyr::tibble(
      variable = names(df),
      filename = paste0("micro_", variable, ".px")
    ) |>
    dplyr::arrange(variable) |>
    head(2)

  px(df) |>
    px_stub(names(df)) |>
    px_micro(out_dir = out_dir, keyword_values = filename_df)

  expect_equal(
    list.files(out_dir),
    c(filename_df$filename, "pnrmor.px", "taar.px")
  )
})

test_that("px_micro removes headings where all values are NA", {
  df <-
    get_data_path("micro") |>
    readRDS() |>
    dplyr::as_tibble() |>
    dplyr::select(1:2) |>
    dplyr::mutate(pnr = ifelse(taar == 1994, NA, pnr)) |>
    dplyr::arrange_all()

  out_dir <- temp_dir()

  px(df) |>
    px_stub("pnr") |>
    px_heading("taar") |>
    px_micro(out_dir = out_dir)

  micro_df <-
    px(list.files(out_dir, full.names = TRUE))$data

  target <-
    df |>
    dplyr::count(taar, pnr) |>
    tidyr::drop_na(pnr) |>
    dplyr::select(pnr, taar, n) |>
    dplyr::mutate(n = as.double(n))

  expect_identical(micro_df, target)
})