diff --git a/.Rbuildignore b/.Rbuildignore index 8159dca..3fb9188 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,5 @@ ^LICENSE.md ^\.appveyor\.yml$ ^vignettes/releases$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/DESCRIPTION b/DESCRIPTION index d6d9d0d..18adc46 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,15 +1,16 @@ Package: toOrdinal -Version: 1.1-0.0 -Date: 2019-2-22 +Version: 1.1-1.0 +Date: 2019-8-05 Title: Cardinal to Ordinal Number & Date Conversion Description: Language specific cardinal to ordinal number conversion. Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="dbetebenner@nciea.org", role=c("aut", "cre")), person(given="Andrew", family="Martin", role="ctb"), - person(given="Jeff", family="Erickson", role="ctb")) + person(given="Jeff", family="Erickson", role="ctb"), + person(given="Richard", family="Cotton", role="ctb")) Maintainer: Damian W. Betebenner Depends: R (>= 3.3) Suggests: knitr, rmarkdown -Imports: crayon, testthat +Imports: assertive.numbers, crayon, rlang, stringi, testthat URL: https://CenterForAssessment.github.io/toOrdinal, https://github.com/CenterForAssessment/toOrdinal, https://cran.r-project.org/package=toOrdinal BugReports: https://github.com/CenterForAssessment/toOrdinal/issues VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 749aa15..2e55160 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,8 @@ import(testthat) export(toOrdinal) export(toOrdinalDate) +importFrom(assertive.numbers,assert_all_are_non_negative,assert_all_are_whole_numbers) importFrom(crayon,bold,green,magenta,red,yellow) +importFrom(rlang,rep_along) +importFrom(stringi,stri_sub) importFrom(utils,packageVersion) diff --git a/R/toOrdinal.R b/R/toOrdinal.R index 0058517..7a0fffc 100644 --- a/R/toOrdinal.R +++ b/R/toOrdinal.R @@ -1,123 +1,68 @@ -`toOrdinal` <- -function( - cardinal_number, - language="English", - convert_to="ordinal_number") { - - - ### Utility function - - strtail <- function(s, n=1) { - if(n < 0) substring(s, 1-n) - else substring(s, nchar(s)-n+1) - } - - - ### Argument tests - - supported_languages_ordinal_number <- c("ENGLISH", "FRENCH", "GERMAN", "GERMAN_ALT", "SPANISH", "SWEDISH") - supported_languages_ordinal_word <- "" - if (floor(cardinal_number)!=cardinal_number | cardinal_number < 0) stop("Number supplied to 'toOrdinal' must be a non-negative integer.", call.=FALSE) - - - ####################################################### - ### - ### convert_to ordinal_number - ### - ####################################################### - - if (identical(toupper(convert_to), "ORDINAL_NUMBER")) { - - if (!toupper(language) %in% supported_languages_ordinal_number) stop(paste("Language supplied (", language, ") is currently not supported by toOrdinal for conversion to an 'ordinal_number'. Currently supported languages include: ", paste(supported_languages_ordinal_number, collapse=", "), ". Please submit pull requests to https://github.com/CenterForAssessment/toOrdinal/pulls for additional language support.", sep=""), call.=FALSE) - - - ### ENGLISH - - if (toupper(language)=="ENGLISH") { - tmp <- strtail(as.character(cardinal_number), 2) - if (tmp %in% c('1', paste(c(0, 2:9), 1, sep=""))) tmp.suffix <- "st" - if (tmp %in% c('2', paste(c(0, 2:9), 2, sep=""))) tmp.suffix <- "nd" - if (tmp %in% c('3', paste(c(0, 2:9), 3, sep=""))) tmp.suffix <- "rd" - if (tmp %in% c('11', '12', '13')) tmp.suffix <- "th" - if (tmp %in% c('4', paste(0:9, 4, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('5', paste(0:9, 5, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('6', paste(0:9, 6, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('7', paste(0:9, 7, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('8', paste(0:9, 8, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('9', paste(0:9, 9, sep=""))) tmp.suffix <- "th" - if (tmp %in% c('0', paste(0:9, 0, sep=""))) tmp.suffix <- "th" - } - - - ### FRENCH - - if (toupper(language)=="FRENCH") { - if (cardinal_number==1) tmp.suffix <- "re" else tmp.suffix <- "e" - } - - - ### GERMAN (standard method of adding a suffix "." to the number) - - if (toupper(language)=="GERMAN_ALT") { - if (cardinal_number >=0) tmp.suffix <- "." - } - - - ### GERMAN (informal *te and *ste endings) - - if (toupper(language)=="GERMAN") { - if (cardinal_number >=0 & cardinal_number <= 19) tmp.suffix <- "te" - if (cardinal_number >= 20) tmp.suffix <- "ste" - } - - - ### SPANISH - - if (toupper(language)=="SPANISH") { - tmp <- strtail(as.character(cardinal_number), 1) - if (tmp %in% c('1', '3')) tmp.suffix <- ".er" - if (tmp %in% c('0', '2', '4', '5', '6', '7', '8', '9')) tmp.suffix <- ".\u00BA" - } - - - ### SWEDISH - - if (toupper(language)=="SWEDISH") { - tmp_1char <- strtail(as.character(cardinal_number), 1) - tmp_2char <- strtail(as.character(cardinal_number), 2) - if (tmp_1char %in% c('0', '3', '4', '5', '6', '7', '8', '9') | tmp_2char %in% c('11', '12')) { - tmp.suffix <- ":e" - } else if (tmp_1char %in% c('1', '2')) { - tmp.suffix <- ":a" - } - } - - - ### TURKISH - - if (toupper(language)=="TURKISH") { - } - - return(paste(cardinal_number, tmp.suffix, sep="")) - - } ### if (identical(toupper(convert_to), "ORDINAL_NUMBER")) - - - ###################################################################### - ### - ### convert_to ordinal_word - ### - ###################################################################### - - if (identical(toupper(convert_to), "ORDINAL_WORD")) { - - if (!toupper(language) %in% supported_languages_ordinal_word) stop(paste("Language supplied (", language, ") is currently not supported by toOrdinal for conversion to an 'ordinal_word'. Currently supported languages include: ", paste(supported_languages_ordinal_word, collapse=", "), ". Please submit pull requests to https://github.com/CenterForAssessment/toOrdinal/pulls for additional language support.", sep=""), call.=FALSE) - - - ### ENGLISH - - - - - } ### if (identical(toupper(convert_to), "ORDINAL_WORD")) -} ### END toOrdinal +toOrdinal <- function(cardinal_number, language = c("ENGLISH", "FRENCH", "GERMAN", "GERMAN_ALT", "SPANISH", "SWEDISH"), convert_to = "ordinal_number") { + assertive.numbers::assert_all_are_non_negative(cardinal_number, na_ignore = TRUE) + assertive.numbers::assert_all_are_whole_numbers(cardinal_number, na_ignore = TRUE) + language <- toupper(language) + language <- match.arg(language) + convert_to <- match.arg(convert_to) + suffix_fn <- get(paste0("get_suffix_", tolower(language))) + suffix <- suffix_fn(cardinal_number) + ordinal_number <- paste0(cardinal_number, suffix) + ordinal_number[is.na(cardinal_number)] <- NA_character_ + ordinal_number +} + +get_ones <- function(cardinal_number) { + stringi::stri_sub(cardinal_number, -1, -1) +} + +get_tens <- function(cardinal_number) { + ifelse( + nchar(cardinal_number) == 1, + "0", + stringi::stri_sub(cardinal_number, -2, -2) + ) +} + +get_suffix_english <- function(cardinal_number) { + ones <- get_ones(cardinal_number) + tens <- get_tens(cardinal_number) + suffix <- rlang::rep_along(cardinal_number, "th") + suffix[tens != "1" & ones == "1"] <- "st" + suffix[tens != "1" & ones == "2"] <- "nd" + suffix[tens != "1" & ones == "3"] <- "rd" + suffix +} + +get_suffix_french <- function(cardinal_number) { + ones <- get_ones(cardinal_number) + suffix <- rlang::rep_along(cardinal_number, "e") + suffix[ones == "1"] <- "re" + suffix +} + +get_suffix_german <- function(cardinal_number) { + tens <- get_tens(cardinal_number) + suffix <- rlang::rep_along(cardinal_number, "ste") + suffix[tens %in% c("0", "1")] <- "te" + suffix +} + +get_suffix_german_alt <- function(cardinal_number) { + suffix <- rlang::rep_along(cardinal_number, ".") + suffix +} + +get_suffix_spanish <- function(cardinal_number) { + ones <- get_ones(cardinal_number) + suffix <- rlang::rep_along(cardinal_number, ".\u00BA") + suffix[ones %in% c("1", "3")] <- ".er" + suffix +} + +get_suffix_swedish <- function(cardinal_number) { + ones <- get_ones(cardinal_number) + tens <- get_tens(cardinal_number) + suffix <- rlang::rep_along(cardinal_number, ":e") + suffix[tens != "1" & ones %in% c("1", "2")] <- ":a" + suffix +} diff --git a/man/toOrdinal.Rd b/man/toOrdinal.Rd index 75c6823..dd58825 100755 --- a/man/toOrdinal.Rd +++ b/man/toOrdinal.Rd @@ -4,9 +4,9 @@ \description{Function for converting cardinal to ordinal numbers by adding a language specific ordinal indicator (http://en.wikipedia.org/wiki/Ordinal_indicator) to the number. } \usage{ -toOrdinal( +toOrdinal( cardinal_number, - language="English", + language=c("ENGLISH", "FRENCH", "GERMAN", "GERMAN_ALT", "SPANISH", "SWEDISH"), convert_to="ordinal_number") } @@ -18,23 +18,25 @@ toOrdinal( \item{convert_to}{OPTIONAL. Output type that provided 'cardinal_number' is converted into. Default is 'ordinal_number' which refers to the 'cardinal_number' followed by the appropriate ordinal indicator. Additional options planned include 'ordinal_word'. } -} +} \details{Typical use of the function is to submit a positive integer for conversion to an ordinal number in the language specified. See examples. } -\value{Function returns the ordinal number or ordinal word (as a character string). +\value{Function returns the ordinal number or ordinal word (as a character string). } \author{Damian W. Betebenner \email{dbetebenner@nciea.org} } \examples{ -toOrdinal(1) ## 1st -toOrdinal(1, language="French") ## 1re - -sapply(1:20, toOrdinal) ## 1st, 2nd, 3rd, ... -sapply(1:20, toOrdinal, language="French") ## 1re, 2e, 3e, ... +x <- c(1, 2, 3, 4, 11, 12, 13, 14, 21, 22, 23, 24, 101, 102, 103, 104, NA) +toOrdinal(x) # English by default +toOrdinal(x, "fr") +toOrdinal(x, "german") +toOrdinal(x, "german_alt") +toOrdinal(x, "sp") +toOrdinal(x, "sw") } \keyword{ misc } diff --git a/tests/testthat/test_toOrdinal_english.R b/tests/testthat/test_toOrdinal_english.R index 7bae5c9..58e26d0 100644 --- a/tests/testthat/test_toOrdinal_english.R +++ b/tests/testthat/test_toOrdinal_english.R @@ -6,7 +6,7 @@ test_that("toOrdinal correctly processes integers 0-40 in English", { "18th", "19th", "20th", "21st", "22nd", "23rd", "24th", "25th", "26th", "27th", "28th", "29th", "30th", "31st", "32nd", "33rd", "34th", "35th", "36th", "37th", "38th", "39th", "40th") - using_toOrdinal <- sapply(c(0:40), "toOrdinal") + using_toOrdinal <- toOrdinal(0:40) expect_equal( first_40, using_toOrdinal @@ -16,6 +16,6 @@ test_that("toOrdinal correctly processes integers 0-40 in English", { test_that("toOrdinal correctly errors when given a negative integer.",{ expect_error( - toOrdinal(-1), "Number supplied to 'toOrdinal' must be a non-negative integer." + toOrdinal(-1), "cardinal_number are not all non-negative" ) }) diff --git a/tests/testthat/test_toOrdinal_german.R b/tests/testthat/test_toOrdinal_german.R index f432af1..9f55c1b 100644 --- a/tests/testthat/test_toOrdinal_german.R +++ b/tests/testthat/test_toOrdinal_german.R @@ -4,7 +4,7 @@ test_that("toOrdinal correctly processes integers 0-20 in German", { first_20 <- c("0te", "1te", "2te", "3te", "4te", "5te", "6te", "7te", "8te", "9te", "10te", "11te", "12te", "13te", "14te", "15te", "16te", "17te", "18te", "19te", "20ste") - using_toOrdinal <- sapply(0:20, "toOrdinal", "GERMAN") + using_toOrdinal <- toOrdinal(0:20, "GERMAN") expect_equal( first_20, using_toOrdinal @@ -14,6 +14,6 @@ test_that("toOrdinal correctly processes integers 0-20 in German", { test_that("toOrdinal correctly errors when given a negative integer.",{ expect_error( - toOrdinal(-1, "GERMAN"), "Number supplied to 'toOrdinal' must be a non-negative integer." + toOrdinal(-1, "GERMAN"), "cardinal_number are not all non-negative" ) }) diff --git a/tests/testthat/test_toOrdinal_swedish.R b/tests/testthat/test_toOrdinal_swedish.R index 1ddf97e..71c54c1 100644 --- a/tests/testthat/test_toOrdinal_swedish.R +++ b/tests/testthat/test_toOrdinal_swedish.R @@ -15,7 +15,7 @@ test_that("toOrdinal correctly processes integers 0-40 in Swedish", { test_that("toOrdinal correctly processes integers 101, 102, 111, and 112 in Swedish", { adtl_nums <- c("101:a", "102:a", "111:e", "112:e") - using_toOrdinal <- sapply(c(101, 102, 111, 112), "toOrdinal", language="swedish") + using_toOrdinal <- toOrdinal(c(101, 102, 111, 112), language="swedish") expect_equal( adtl_nums, using_toOrdinal @@ -25,6 +25,6 @@ test_that("toOrdinal correctly processes integers 101, 102, 111, and 112 in Swed test_that("toOrdinal correctly errors when given a negative integer.",{ expect_error( - toOrdinal(-1), "Number supplied to 'toOrdinal' must be a non-negative integer." + toOrdinal(-1), "cardinal_number are not all non-negative" ) })