rewrite toOrdinal()

.Rbuildignore

@@ -5,3 +5,5 @@
 ^LICENSE.md
 ^\.appveyor\.yml$
 ^vignettes/releases$
+^.*\.Rproj$
+^\.Rproj\.user$

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="[email protected]", 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 <[email protected]>
 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

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)

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

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{[email protected]} }
 
 \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 }

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

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

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