library(dplyr, warn.conflicts = FALSE) library(r2dii.data) test_that("w/ full demo datasets throws no error", { expect_no_error( loanbook_demo %>% slice(4:5) %>% match_name(abcd_demo) %>% prioritize(priority = "ultimate_parent") ) }) test_that("errors gracefully if data lacks crucial columns", { expect_error(prioritize(fake_matched()), NA) expect_error( prioritize(select(fake_matched(), -id_loan)), class = "missing_names" ) expect_error( prioritize(select(fake_matched(), -level)), class = "missing_names" ) expect_error( prioritize(select(fake_matched(), -score)), class = "missing_names" ) expect_error( prioritize(select(fake_matched(), -sector_abcd)), class = "missing_names" ) expect_error( prioritize(select(fake_matched(), -sector)), class = "missing_names" ) }) test_that("errors gracefully with bad `priority`", { expect_warning( prioritize(fake_matched(), priority = c("bad1", "bad2")), "[Ii]gnoring.*levels.*bad1.*bad2" ) }) test_that("picks score equal to 1", { matched <- fake_matched(score = c(1, 0.9)) expect_equal(min(prioritize(matched)$score), 1) }) test_that("picks the highest level per id_loan", { # styler: off id_level <- tibble::tribble( ~id_loan, ~level, "aa", "ultimate_parent", "aa", "direct_loantaker", # pick this ** "bb", "intermediate_parent", # pick this ** "bb", "ultimate_parent", ) # styler: on matched <- fake_matched(id_loan = id_level$id_loan, level = id_level$level) expect_equal( prioritize(matched)$level, c("direct_loantaker", "intermediate_parent") # ** ) }) test_that("takes a `priority` function or lambda", { matched <- fake_matched(level = c("direct_loantaker", "ultimate_parent")) out <- prioritize(matched, priority = NULL) expect_equal(out$level, "direct_loantaker") # Reverse with function out <- prioritize(matched, priority = rev) expect_equal(out$level, "ultimate_parent") # Reverse with lambda out <- prioritize(matched, priority = ~ rev(.x)) expect_equal(out$level, "ultimate_parent") }) test_that("is sensitive to `priority`", { expect_equal( prioritize(fake_matched(level = c("z", "a")), priority = "z")$level, "z" ) }) test_that("ignores existing groups", { # styler: off matched <- tibble::tribble( ~id_loan, ~other_id, ~level, "a", 1, "z", # pick ** "a", 2, "a", "b", 3, "z", # pick ** "b", 4, "a", ) %>% # Crucial columns with toy values mutate(sector = "coal", sector_abcd = "coal", score = 1) %>% group_by(other_id) # styler: on expect_equal( prioritize(matched, priority = "z")$level, c("z", "z") # ** ) }) test_that("when ignoring existing groups, does not throw a message", { matched <- group_by(fake_matched(other = 1), other) capture_msg <- function(expr) { tryCatch(expr, message = function(m) conditionMessage(m)) } unwanted_msg <- "missing grouping" has_unwanted_msg <- any(grepl(unwanted_msg, capture_msg(prioritize(matched)))) expect_false(has_unwanted_msg) }) test_that("previous preserves groups", { matched <- fake_matched(other_id = 1:4) %>% group_by(other_id, score) expect_equal( dplyr::group_vars(prioritize(matched)), c("other_id", "score") ) }) test_that("prioritize_level otputs expected vector", { matched <- tibble( level = c( "intermediate_parent_1", "direct_loantaker", "direct_loantaker", "direct_loantaker", "ultimate_parent", "intermediate_parent_2" ) ) expect_equal( prioritize_level(matched), c( "direct_loantaker", "intermediate_parent_1", "intermediate_parent_2", "ultimate_parent" ) ) }) test_that("prioritize_at with ungrouped data picks the highest priority row", { out <- tibble(x = c("a", "z")) %>% prioritize_at(.at = "x", priority = c("z", "a")) expect_equal(out$x, "z") }) test_that("prioritize_at with grouped data picks one row per group", { out <- tibble( x = c(1, 2, 2), y = c("a", "a", "z") ) %>% group_by(x) %>% prioritize_at(.at = "y", priority = c("z", "a")) %>% arrange(x) expect_equal(out$y, c("a", "z")) }) test_that("does not warn if a group has not all priority items", { expect_no_warning( fake_matched(level = c("a", "z"), new = level) %>% group_by(new) %>% prioritize(priority = c("z", "a")) ) }) test_that("w/ id_loan at level direct* & ultimate* picks only direct* (#106)", { matched <- fake_matched(level = c("ultimate_parent", "direct_loantaker")) expect_identical(prioritize(matched)$level, "direct_loantaker") }) test_that("output is independent from the row-order of the input (#113)", { # styler: off # Could use fake_matched() but the data is clearer this way matched_direct <- tibble::tribble( ~id_loan, ~id_2dii, ~level, ~score, ~sector, ~sector_abcd, "A", "D", "direct_loantaker", 1, "automotive", "automotive", "A", "U", "ultimate_parent", 1, "automotive", "automotive", "B", "U", "ultimate_parent", 1, "automotive", "automotive", ) # styler: on matched_invert <- dplyr::arrange(matched_direct, desc(id_loan)) testthat::expect_equal( prioritize(matched_direct)$id_loan, prioritize(matched_invert)$id_loan ) }) test_that("error if score=1 & values by id_loan+level are duplicated (#114)", { valid <- fake_matched(score = 0:1) expect_no_error(prioritize(valid)) invalid <- fake_matched(score = c(1, 1)) expect_error( class = "duplicated_score1_by_id_loan_by_level", prioritize(invalid) ) }) test_that("passes if score=1 & values by id_loan are duplicated for distinct levels (#122)", { valid <- fake_matched( score = 1, id_loan = "L1", level = c("direct_loantaker", "intermediate_parent", "ultimate_parent"), id_2dii = c("dl", "ip", "up") ) expect_no_error(prioritize(valid)) }) test_that("with 0-row input returns 0-row input", { lbk <- fake_lbk() abcd <- fake_abcd(name_company = "won't match") zero_row <- suppressWarnings(match_name(lbk, abcd)) has_zero_row <- identical(nrow(zero_row), 0L) stopifnot(has_zero_row) expect_no_error(prioritize(zero_row)) })