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))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.