-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathcardinal.R
More file actions
121 lines (100 loc) · 3.73 KB
/
Copy pathcardinal.R
File metadata and controls
121 lines (100 loc) · 3.73 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#' Convert numbers to cardinal character vectors (one, two, three)
#'
#' @param x A numeric vector
#' @param max_n A numeric vector.
#' When the absolute value of `x` is greater than `max_n`, `x` remains
#' numeric instead of being converted to words.
#' If `max_n` is negative, no `x`s will be converted to words.
#' (This can be useful when `max_n` is passed by another function.)
#' Defaults to `Inf`, which converts all `x`s to words.
#' @param negative A character vector to append to negative numbers.
#' Defaults to `"negative"`.
#' @inheritDotParams fracture::frac_mat -mixed
#'
#' @details # Fractions
#'
#' Decimal components of `x` are automatically converted to fractions by
#' [fracture::frac_mat()].
#'
#' @return A character vector of the same length as `x`
#' @family number names
#' @seealso [uncardinal()] to convert character vectors to numbers
#' @export
#' @example examples/cardinal.R
cardinal <- function(x, max_n = Inf, negative = "negative", ...) {
numeric <- x
n <- length(x)
if (!n) return(character(0))
if (all(is.na(x) & !is.nan(x))) return(as.character(x))
if (!is.numeric(x)) stop("`x` must be numeric")
if (!is.numeric(max_n)) stop("`max_n` must be numeric")
if (length(max_n) != 1 && length(max_n) != n)
stop("`max_n` must be either length one or the same length as `x`")
if (!is.character(negative)) stop("`negative` must be of type character")
if (length(negative) == 1) {
negative <- rep_len(negative, length(x))
}
if (length(negative) != n)
stop("`negative` must be length one or the same length as `x`")
finite <- is.finite(x)
card <- character(n)
card[finite & abs(x) > max_n] <- str_remove_all(
format(x[finite & abs(x) > max_n], scientific = FALSE), " "
)
unmaxed <- card == character(1)
minus <- character(n)
minus[finite & x < 0 & unmaxed] <- paste0(
negative[finite & x < 0 & unmaxed], " "
)
x[unmaxed] <- abs(x[unmaxed])
finite <- unmaxed & finite
if (any(finite)) {
decimal <- numeric(n)
decimal[finite] <- x[finite] %% 1
fraction <- character(n)
fraction[decimal != 0] <- convert_fraction(decimal[decimal != 0], ...)
x[finite] <- x[finite] %/% 1
card[finite] <- format(x[finite], scientific = FALSE)
nchar <- ceiling(nchar(card[finite][[1]]) / 3) * 3
card[finite] <- format(
card[finite], justify = "right", width = nchar, scientific = FALSE
)
n_finite <- sum(finite)
segment <- matrix(
rep(card[finite], nchar / 3), ncol = n_finite, byrow = TRUE
)
segment <- substr(
segment,
rep(seq(1, nchar, 3), n_finite),
rep(seq(3, nchar, 3), n_finite)
)
segment <- convert_hundreds(segment)
nrow <- nrow(segment)
power <- segment
power[] <- rep(powers[seq_len(nrow)], n_finite)
power <- power[nrow:1, ]
power[segment == ""] <- ""
segment[] <- paste0(segment, power)
card[finite] <- apply(segment, 2, paste, collapse = "")
card[finite & card == "" & fraction == ""] <- "zero"
and <- character(n)
and[finite & card != "" & fraction != ""] <- " and "
card[finite] <- paste0(trimws(card), and, fraction)[finite]
}
card[is.infinite(x)] <- "infinity"
card <- paste0(minus, card)
card[is.na(x)] <- NA
card[is.nan(x)] <- NaN
args <- as.list(match.call()[-1])
args[["x"]] <- NULL
structure(
card,
numeric = numeric,
nombre = "cardinal",
args = args,
class = c("nombre", "character")
)
}
#' @rdname cardinal
#' @export
nom_card <- cardinal