Skip to content

Commit 8965031

Browse files
dbetebennerdbetebenner
authored
Merge pull request #59 from dbetebenner/master
Adding in TURKISH functionality and updating for CRAN submission
2 parents 70872f4 + 1c70469 commit 8965031

File tree

6 files changed

+189
-161
lines changed

6 files changed

+189
-161
lines changed

‎DESCRIPTION

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: toOrdinal
2-
Version: 1.3-1.0
3-
Date: 2022-11-4
2+
Version: 1.3-9.0
3+
Date: 2024-11-26
44
Title: Cardinal to Ordinal Number & Date Conversion
55
Description: Language specific cardinal to ordinal number conversion.
66
Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="dbetebenner@nciea.org", role=c("aut", "cre")),

‎NAMESPACE

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
export(toOrdinal)
22
export(toOrdinalDate)
33
importFrom(crayon,bold,green,magenta,red,yellow)
4-
importFrom(utils,packageVersion)
4+
importFrom(utils,packageVersion,tail)

‎R/toOrdinal_Utility_Functions.R

Lines changed: 166 additions & 139 deletions
Original file line numberDiff line numberDiff line change
@@ -1,151 +1,102 @@
1-
###
21
### toOrdinal_INTERNAL
3-
###
4-
`toOrdinal_INTERNAL` <-
5-
function(
6-
cardinal_number,
7-
language="English",
8-
convert_to="ordinal_number") {
9-
10-
11-
### Utility function
12-
13-
strtail <- function(s, n=1) {
14-
if(n < 0) substring(s, 1-n)
15-
else substring(s, nchar(s)-n+1)
2+
`toOrdinal_INTERNAL` <-
3+
function(cardinal_number,
4+
language = "English",
5+
convert_to = "ordinal_number") {
6+
7+
### Tests of arguments
8+
if (floor(cardinal_number) != cardinal_number || cardinal_number < 0) {
9+
stop("Number supplied to 'toOrdinal' must be a non-negative integer.", call. = FALSE)
1610
}
1711

12+
supported_languages <- c("DUTCH", "ENGLISH", "FRENCH", "GERMAN", "GERMAN_ALT", "SPANISH", "SWEDISH", "TURKISH")
13+
if (!toupper(language) %in% supported_languages) {
14+
stop(paste("Language", language, "is not supported. Supported languages:",
15+
paste(supported_languages, collapse = ", ")), call. = FALSE)
16+
}
17+
18+
### ORDINAL_NUMBER
19+
if (gsub("_", " ", toupper(convert_to))=="ORDINAL NUMBER") {
20+
21+
# Suffix handling by language
22+
suffix <- switch(toupper(language),
23+
"DUTCH" = {
24+
suffix <- if (cardinal_number %% 100 >= 11 && cardinal_number %% 100 <= 19) {
25+
"de" # Numbers from 11 to 19 always use "de"
26+
} else if (cardinal_number %% 10 == 1 || cardinal_number %% 10 == 8 || cardinal_number %% 10 == 0) {
27+
"ste" # Numbers ending in 1, 8, or 0 use "ste"
28+
} else {
29+
"de" # All other cases use "de"
30+
}
31+
},
32+
"ENGLISH" = {
33+
tmp <- strTail(as.character(cardinal_number), 2)
34+
if (tmp %in% c("11", "12", "13")) "th" else {
35+
last <- strTail(tmp, 1)
36+
c("st", "nd", "rd", "th")[(match(last, c("1", "2", "3", "0"), nomatch = 4))]
37+
}
38+
},
39+
"FRENCH" = if (cardinal_number == 1) "re" else "e",
40+
"GERMAN" = if (cardinal_number <= 19) "te" else "ste",
41+
"GERMAN_ALT" = ".",
42+
"SPANISH" = {
43+
last <- strTail(as.character(cardinal_number), 1)
44+
if (last %in% c("1", "3")) ".er" else "..\u00BA"
45+
},
46+
"SWEDISH" = {
47+
tmp_1char <- strTail(as.character(cardinal_number), 1)
48+
tmp_2char <- strTail(as.character(cardinal_number), 2)
49+
if (tmp_2char %in% c("11", "12") || tmp_1char %in% c("0", "3", "4", "5", "6", "7", "8", "9")) ":e" else ":a"
50+
},
51+
"TURKISH" = {
52+
"."
53+
},
54+
stop("Language logic not implemented.")
55+
) ### END switch
56+
57+
return(paste0(cardinal_number, suffix))
58+
} ### END if "ORDINAL_NUMBER"
59+
60+
if (gsub("_", " ", toupper(convert_to))=="ORDINAL WORD") {
61+
62+
# Suffix handling by language
63+
ordinal_word <- switch(toupper(language),
64+
"DUTCH" = {
65+
stop("Language logic not implemented.")
66+
},
67+
"ENGLISH" = {
68+
stop("Language logic not implemented.")
69+
},
70+
"FRENCH" = {
71+
stop("Language logic not implemented.")
72+
},
73+
"GERMAN" = {
74+
stop("Language logic not implemented.")
75+
},
76+
"GERMAN_ALT" = {
77+
stop("Language logic not implemented.")
78+
},
79+
"SPANISH" = {
80+
stop("Language logic not implemented.")
81+
},
82+
"SWEDISH" = {
83+
stop("Language logic not implemented.")
84+
},
85+
"TURKISH" = {
86+
word <- get_turkish_number_word(cardinal_number)
87+
return(paste0(word, turkish_ordinal_suffix(word)))
88+
},
89+
stop("Language logic not implemented.")
90+
) ### END switch
91+
} ### END if "ORDINAL_WORD"
92+
} ### END toOrdinal_INTERNAL
1893

19-
### Argument tests
20-
21-
supported_languages_ordinal_number <- c("DUTCH", "ENGLISH", "FRENCH", "GERMAN", "GERMAN_ALT", "SPANISH", "SWEDISH")
22-
supported_languages_ordinal_word <- ""
23-
if (floor(cardinal_number)!=cardinal_number | cardinal_number < 0) stop("Number supplied to 'toOrdinal' must be a non-negative integer.", call.=FALSE)
24-
25-
26-
#######################################################
27-
###
28-
### convert_to ordinal_number
29-
###
30-
#######################################################
31-
32-
if (identical(toupper(convert_to), "ORDINAL_NUMBER")) {
33-
34-
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)
35-
36-
37-
### DUTCH
38-
39-
if (toupper(language)=="DUTCH") {
40-
tmp <- strtail(as.character(cardinal_number), 2)
41-
tmp.suffix <- "ste"
42-
if (tmp %in% c('8', paste(0, 8, sep=""))) tmp.suffix <- "ste"
43-
if (tmp %in% c('1', paste(c(0, 2:9), 1, sep=""))) tmp.suffix <- "ste"
44-
if (tmp %in% c(0, 2:7, 9, paste(0, c(2:7,9) , sep=""))) tmp.suffix <- "de"
45-
if (tmp %in% paste(1, 0:9 , sep="")) tmp.suffix <- "de"
46-
}
47-
48-
49-
### ENGLISH
50-
51-
if (toupper(language)=="ENGLISH") {
52-
tmp <- strtail(as.character(cardinal_number), 2)
53-
if (tmp %in% c('1', paste(c(0, 2:9), 1, sep=""))) tmp.suffix <- "st"
54-
if (tmp %in% c('2', paste(c(0, 2:9), 2, sep=""))) tmp.suffix <- "nd"
55-
if (tmp %in% c('3', paste(c(0, 2:9), 3, sep=""))) tmp.suffix <- "rd"
56-
if (tmp %in% c('11', '12', '13')) tmp.suffix <- "th"
57-
if (tmp %in% c('4', paste(0:9, 4, sep=""))) tmp.suffix <- "th"
58-
if (tmp %in% c('5', paste(0:9, 5, sep=""))) tmp.suffix <- "th"
59-
if (tmp %in% c('6', paste(0:9, 6, sep=""))) tmp.suffix <- "th"
60-
if (tmp %in% c('7', paste(0:9, 7, sep=""))) tmp.suffix <- "th"
61-
if (tmp %in% c('8', paste(0:9, 8, sep=""))) tmp.suffix <- "th"
62-
if (tmp %in% c('9', paste(0:9, 9, sep=""))) tmp.suffix <- "th"
63-
if (tmp %in% c('0', paste(0:9, 0, sep=""))) tmp.suffix <- "th"
64-
}
65-
66-
67-
### FRENCH
68-
69-
if (toupper(language)=="FRENCH") {
70-
if (cardinal_number==1) tmp.suffix <- "re" else tmp.suffix <- "e"
71-
}
72-
73-
74-
### GERMAN (standard method of adding a suffix "." to the number)
75-
76-
if (toupper(language)=="GERMAN_ALT") {
77-
if (cardinal_number >=0) tmp.suffix <- "."
78-
}
79-
80-
81-
### GERMAN (informal *te and *ste endings)
82-
83-
if (toupper(language)=="GERMAN") {
84-
if (cardinal_number >=0 & cardinal_number <= 19) tmp.suffix <- "te"
85-
if (cardinal_number >= 20) tmp.suffix <- "ste"
86-
}
87-
88-
89-
### SPANISH
90-
91-
if (toupper(language)=="SPANISH") {
92-
tmp <- strtail(as.character(cardinal_number), 1)
93-
if (tmp %in% c('1', '3')) tmp.suffix <- ".er"
94-
if (tmp %in% c('0', '2', '4', '5', '6', '7', '8', '9')) tmp.suffix <- ".\u00BA"
95-
}
96-
97-
98-
### SWEDISH
99-
100-
if (toupper(language)=="SWEDISH") {
101-
tmp_1char <- strtail(as.character(cardinal_number), 1)
102-
tmp_2char <- strtail(as.character(cardinal_number), 2)
103-
if (tmp_1char %in% c('0', '3', '4', '5', '6', '7', '8', '9') | tmp_2char %in% c('11', '12')) {
104-
tmp.suffix <- ":e"
105-
} else if (tmp_1char %in% c('1', '2')) {
106-
tmp.suffix <- ":a"
107-
}
108-
}
109-
110-
111-
### TURKISH
112-
113-
if (toupper(language)=="TURKISH") {
114-
}
115-
116-
return(paste(cardinal_number, tmp.suffix, sep=""))
117-
118-
} ### if (identical(toupper(convert_to), "ORDINAL_NUMBER"))
119-
120-
121-
######################################################################
122-
###
123-
### convert_to ordinal_word
124-
###
125-
######################################################################
126-
127-
if (identical(toupper(convert_to), "ORDINAL_WORD")) {
128-
129-
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)
130-
131-
132-
### ENGLISH
133-
134-
135-
136-
137-
} ### if (identical(toupper(convert_to), "ORDINAL_WORD"))
138-
} ### END toOrdinal
139-
140-
###
14194
### toOrdinalDate_INTERNAL
142-
###
14395
`toOrdinalDate_INTERNAL` <-
14496
function(
14597
date=NULL,
14698
language="English") {
14799

148-
149100
### ENGLISH
150101

151102
if (toupper(language)=="ENGLISH") {
@@ -155,4 +106,80 @@ function(
155106

156107
### OTHER LANGUAGES
157108

158-
} ### END toOrdinalDate
109+
} ### END toOrdinalDate_INTERNAL
110+
111+
### strTail
112+
`strTail` <-
113+
function(
114+
string,
115+
n_char = 1) {
116+
117+
# Ensure n_char is an integer and within valid bounds
118+
if (!is.numeric(n_char) || n_char != as.integer(n_char)) {
119+
stop("n_char must be an integer.")
120+
}
121+
122+
# Apply the function to each element of the vector
123+
result <- sapply(string, function(str) {
124+
if (!is.character(str)) stop("Each element must be a character string.")
125+
126+
string_len <- nchar(str)
127+
128+
if (abs(n_char) > string_len && n_char > 0) n_char <- string_len
129+
if (abs(n_char) > string_len && n_char < 0) n_char <- -string_len
130+
131+
if (n_char < 0) substr(str, -n_char + 1, string_len)
132+
else substr(str, max(1, string_len - n_char + 1), string_len)
133+
})
134+
135+
names(result) <- NULL # Remove names from the result
136+
return(result)
137+
} ### END strTail
138+
139+
# Function to get Turkish word for number
140+
get_turkish_number_word <- function(number) {
141+
turkish_number_words <- c(
142+
"1" = "bir", "2" = "iki", "3" = "\u00FC\u00E7", "4" = "d\u00F6rt", "5" = "be\u015F",
143+
"6" = "alt\u0131", "7" = "yedi", "8" = "sekiz", "9" = "dokuz", "10" = "on",
144+
"20" = "yirmi", "30" = "otuz", "40" = "k\u0131rk", "50" = "elli",
145+
"60" = "altm\u0131\u015F", "70" = "yetmi\u015F", "80" = "seksen", "90" = "doksan",
146+
"100" = "y\u00FCz", "200" = "iki y\u00FCz", "300" = "\u00FC\u00E7 y\u00FCz", "400" = "d\u00F6rt y\u00FCz",
147+
"500" = "be\u015F y\u00FCz", "600" = "alt\u0131 y\u00FCz", "700" = "yedi y\u00FCz",
148+
"800" = "sekiz y\u00FCz", "900" = "dokuz y\u00FCz"
149+
)
150+
151+
if (number %in% as.numeric(names(turkish_number_words))) {
152+
return(turkish_number_words[as.character(number)])
153+
} else if (number < 1000) {
154+
hundreds <- as.character(floor(number / 100) * 100)
155+
remainder <- number %% 100
156+
if (remainder == 0) {
157+
return(turkish_number_words[hundreds])
158+
} else {
159+
return(paste(turkish_number_words[hundreds], get_turkish_number_word(remainder)))
160+
}
161+
} else {
162+
stop("Numbers above 999 are not currently supported.")
163+
}
164+
} ### END get_turkish_number_word
165+
166+
# Turkish ordinal suffix logic
167+
`turkish_ordinal_suffix` <-
168+
function(
169+
word) {
170+
171+
vowels <- c("a", "\u0131", "o", "u", "e", "i", "\u00F6", "\u00FC")
172+
last_vowel <- tail(unlist(strsplit(word, ""))[unlist(strsplit(word, "")) %in% vowels], 1)
173+
174+
if (last_vowel %in% c("a", "\u0131")) {
175+
suffix <- "\u0131nc\u0131"
176+
} else if (last_vowel %in% c("o", "u")) {
177+
suffix <- "uncu"
178+
} else if (last_vowel %in% c("e", "i")) {
179+
suffix <- "inci"
180+
} else if (last_vowel %in% c("\u00F6", "\u00FC")) {
181+
suffix <- "\u00FCnc\u00FC"
182+
}
183+
184+
return(suffix)
185+
} ### END turkish_ordinal_suffix

‎inst/CITATION

Lines changed: 14 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,15 @@
1-
citHeader("To cite package 'toOrdinal' in publications, please use:")
2-
3-
citEntry(entry = "Manual",
4-
title = "{toOrdinal}: Function for Converting Cardinal to Ordinal Numbers by Adding a Language Specific Ordinal Indicator to the Number",
5-
author = "Damian W. Betebenner",
6-
year = "2022",
7-
note = "R package version 1.3-1.0",
8-
url = "https://centerforassessment.github.io/toOrdinal/",
9-
10-
textVersion = paste("Damian W. Betebenner (2022).",
11-
"toOrdinal: Function for Converting Cardinal to Ordinal Numbers by Adding a Language Specific Ordinal Indicator to the Number",
12-
"(R package version 1.3-1.0",
13-
"URL https://centerforassessment.github.io/toOrdinal/")
1+
bibentry(
2+
bibtype = "Manual",
3+
header = "To cite the toOrdinal package in publications use:",
4+
title = "{toOrdinal}: Function for Converting Cardinal to Ordinal Numbers by Adding a Language Specific Ordinal Indicator to the Number.",
5+
author = person(given = c("Damian", "W."), family = "Betebenner"),
6+
year = "2024",
7+
note = "R package version 1.3-9.0",
8+
url = "https://centerforassessment.github.io/toOrdinal/",
9+
textVersion = paste(
10+
"Damian W. Betebenner (2024).",
11+
"{toOrdinal}: Function for Converting Cardinal to Ordinal Numbers by Adding a Language Specific Ordinal Indicator to the Number.",
12+
"(R package version 1.3-9.0)",
13+
"URL: https://centerforassessment.github.io/toOrdinal/"
14+
)
1415
)

‎man/toOrdinal-package.Rd

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ Language specific cardinal to ordinal number conversion.
1111
\tabular{ll}{
1212
Package: \tab toOrdinal\cr
1313
Type: \tab Package\cr
14-
Version: \tab 1.3-1.0\cr
15-
Date: \tab 2022-11-4\cr
14+
Version: \tab 1.3-9.0\cr
15+
Date: \tab 2024-11-26\cr
1616
License: \tab GPL-3\cr
1717
LazyLoad: \tab yes\cr
1818
}

‎tests/testthat/test_toOrdinal_dutch.R

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
context("Dutch tests")
22

33
test_that("toOrdinal correctly processes integers 0-30 in Dutch", {
4-
first_30 <- c("0de", "1ste", "2de", "3de", "4de", "5de", "6de", "7de", "8ste",
5-
"9de", "10de", "11de", "12de", "13de", "14de", "15de", "16de",
6-
"17de", "18de", "19de", "20ste", "21ste", "22ste", "23ste",
7-
"24ste", "25ste", "26ste", "27ste", "28ste", "29ste", "30ste")
4+
first_30 <- c("0ste", "1ste", "2de", "3de", "4de", "5de", "6de", "7de", "8ste",
5+
"9de", "10ste", "11de", "12de", "13de", "14de", "15de", "16de",
6+
"17de", "18de", "19de", "20ste", "21ste", "22de", "23de",
7+
"24de", "25de", "26de", "27de", "28ste", "29de", "30ste")
88
using_toOrdinal <- sapply(0:30, "toOrdinal", "DUTCH")
99

1010
expect_equal(

0 commit comments

Comments
 (0)