reconstruct.x <- "consider reconstructing 'x'" test_that("input is validated before fixing state names", { errchr <- "'x' is not a character vector" warn0 <- "'x' has length 0L or only missing values" expect_error(fix_region(99), errchr) expect_error(fix_region(NA), errchr) expect_error(fix_region(c(NA, NA, NA)), errchr) expect_error(fix_region(NULL), errchr) expect_error(fix_region(TRUE), errchr) expect_error(fix_region(""), "'x' only has empty strings") expect_warning(try(fix_region(c("Ogin", "", "Abia")), silent = TRUE), "Tried to fix empty strings - may produce errors") expect_warning(fix_region(NA_character_), warn0) expect_warning(fix_region(character()), warn0) expect_warning(fix_region(factor()), warn0) expect_error(fix_region(lgas(), 9)) expect_error(fix_region(lgas(), quietly = 9)) expect_error(fix_region(lgas(), graphic = 9)) expect_type(fix_region(matrix(states())), "character") ## preserve class?? }) test_that("Messaging clear when fixing via character vectors or factors", { # Function for creating regular expressions for matching messages .msgfunc <- function(x) { stopifnot(grepl("^(.+)(\\s=>\\s)(.+)$", x)) sprintf("Successful fix\\(es\\)\\:\\n\\-+\\n\\*\\s%s", x) } # ^ # Note place-holder # data --- multi.lga <- readRDS("data/mispelt-lga.rds") # messages --- change1 <- "Fufure => Fufore" msg1 <- .msgfunc(change1) morethanone <- "approximately matched more than one region" # character vectors --- ad <- c("Fufure", "Demsa", "Fufure", "Machika", "Ganye", "Noman", "Fufure") correctLga <- ad[2] misspeltLga <- ad[3] bothLga <- c(correctLga, misspeltLga) expect_no_warning(fix_region(lgas(correctLga))) expect_message(fix_region(lgas(misspeltLga))) expect_message(fix_region(lgas(bothLga)), msg1) expect_message(fix_region(lgas(c(bothLga, "Fufore"))), msg1) expect_message(fix_region(lgas(c(bothLga, "Fafure"))), "not applied.+Fafure") expect_error(fix_region(misspeltLga), reconstruct.x) expect_message(fix_region(lgas(ad), quietly = TRUE), morethanone) # expect_message(fix_region(lgas(ad)), # sprintf("%s.+Noman => Numan", change1)) expect_message(fix_region(lgas(multi.lga)), change1) # factors --- lg.fac <- factor(ad) correctLga.fac <- droplevels(lg.fac[2]) misspeltLga.fac <- droplevels(lg.fac[3]) bothlga.fac <- c(correctLga.fac, misspeltLga.fac) expect_silent(fix_region(lgas(correctLga.fac))) expect_message(fix_region(lgas(misspeltLga.fac))) expect_message(fix_region(lgas(bothlga.fac)), msg1) expect_message(fix_region(lgas( c(bothlga.fac, factor("Fufore")), warn = FALSE)), msg1) expect_error(fix_region(misspeltLga.fac), reconstruct.x, fixed = TRUE) expect_message(fix_region(lgas(lg.fac), quietly = TRUE), morethanone) # expect_message(suppressWarnings(fix_region(lgas(lg.fac))), # sprintf("%s.+Noman => Numan", change1)) expect_message(fix_region(lgas(multi.lga)), change1) }) test_that("various cases for fixing state names", { ss <- states() ss2 <- states(c("Oyo", "Legos"), warn = FALSE) ssx <- states(c("xxx", "Benue"), warn = FALSE) ss.us <- c("kentucky", "Bornu", "Abia") fctup <- "Federal Capital Territory" fctlw <- "FCT" expect_equal(fix_region(ss), ss, ignore_attr = TRUE) expect_error(fix_region('Fct'), reconstruct.x, fixed = TRUE) expect_error(fix_region('Kane'), reconstruct.x, fixed = TRUE) expect_error(fix_region('plateau'), reconstruct.x, fixed = TRUE) expect_identical(fix_region(c(fctup, fctlw)), rep(fctup, 2)) expect_identical(fix_region(states(c(fctup, fctlw)))[2], states(fctup)) expect_identical(fix_region(states(fctlw, "Kano"))[1], states(fctlw)) # expect_identical(fix_region('FCT'), fedcap) # expect_identical(fix_region(states('Fct')), states(fedcap)) expect_identical(fix_region(states('Kane')), states("Kano")) expect_identical(fix_region(states('plateau')), states('Plateau')) expect_error(fix_region(states(c("Owerri north", "Owerri West")))) fixed2 <- suppressMessages(fix_region(ss2)) expect_identical(fixed2, states(c("Oyo", "Lagos"))) expect_length(fixed2, 2L) expect_error(fix_region(ssx)) expect_error(fix_region(ss.us)) }) test_that("Misspelt LGAs can be fixed (limited)", { dt <- readRDS("data/taraba-lga.rds") tar.lgas <- lgas(dt, warn = FALSE) fixed <- suppressMessages(fix_region(tar.lgas)) expect_length(attr(fixed, "misspelt"), 0L) expect_equal( fix_region(lgas(c("Amuwo Odofin", "Lagos Island")), quietly = TRUE), c("Amuwo-Odofin", "Lagos Island"), ignore_attr = TRUE ) }) test_that("outputs", { lgs <- c("Fufore", "Demsa") expect_invisible(fix_region(lgs)) expect_warning(fix_region(lgs, interactive = FALSE, graphic = TRUE), "'graphic' was reset to FALSE in non-interactive mode") expect_silent(fix_region(lgs, quietly = TRUE)) }) test_that("regions can be fixed manually", { bs <- states(c("Oyo", "Lagos", "Abya"), warn = FALSE) bl <- lgas(c("Damboo", "Biu", "Hawl", "Shank", "Damboe"), warn = FALSE) lag <- "Lagos" errTyp <- "The operation cannot be done on objects of type" output2 <- lgas(c("Damboo", "Biu", "Hawul", "Shani", "Damboe"), warn = FALSE) wrong2 <- c("Hawl", "Shank") expect_error(fix_region_manual(bs, lag, "Legos"), "'Legos' is not a valid region") for (elem in list(999L, NULL, NA, TRUE, pi)) expect_error(fix_region_manual(elem, lag, "Lagos"), errTyp) # expect_error(fix_region_manual("TRUE", lag, "Lagos")) expect_identical(fix_region_manual(bs, "Abya", "Abia"), states(c("Oyo", "Lagos", "Abia"))) expect_identical(fix_region_manual(bl, c("Damboo", "Damboe"), "Damboa"), lgas(c("Damboa", "Biu", "Hawl", "Shank", "Damboa"), warn = FALSE)) expect_identical(fix_region_manual(bl, wrong2, c("Hawul", "Shani")), output2) expect_warning(fix_region_manual(bl, wrong2, c("Hawul", "FakeLG")), "'FakeLG' is not a valid region") expect_error( fix_region_manual( bl, c("Hawl", "shank"), # used the wrong case in element #2 c("Hawul", "FakeLG")), regexp = "'shank' is not an element of 'bl'" ) expect_error( fix_region_manual(bl, "Hawl", c("Hawul", "FakeLG")), "Substitutions must be single or the same number as targetted fixes" ) }) test_that("No warning when constructors are nested with fix_* functions", { lgavec <- c("Legos Island", "Amuwo-Odofin") fct <- "Fct" expect_error(fix_region(states(fct))) expect_warning(states(fct)) expect_no_warning(fix_region(lgas(lgavec), quietly = TRUE)) expect_warning(lgas(lgavec)) })