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) })