/
autopadZeros-methods.R
116 lines (106 loc) · 3.19 KB
/
autopadZeros-methods.R
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
#' @name autopadZeros
#' @inherit AcidGenerics::autopadZeros
#'
#' @note Updated 2023-09-21.
#'
#' @inheritParams AcidRoxygen::params
#' @param ... Additional arguments.
#'
#' @return `character`.
#'
#' @seealso
#' - [stringr::str_pad()].
#'
#' @examples
#' ## integer ====
#' autopadZeros(c(1L, 10L, 100L))
#'
#' ## character ====
#' ## Left side.
#' autopadZeros(c("1-EV-DMSO", "10-EV-DMSO", "2-EV-DMSO-B"))
#' ## Right side.
#' autopadZeros(c("A1", "B10", "C100"))
NULL
## Updated 2020-06-15.
`autopadZeros,integer` <- # nolint
function(object) {
names <- names(object)
object <- as.character(object)
object <- autopadZeros(object)
names(object) <- names
object
}
## Updated 2023-10-27.
`autopadZeros,character` <- # nolint
function(object) {
x <- unname(object)
dict <- list(
"int" = FALSE,
"intPattern" = "^([[:digit:]]+)$",
"leftPattern" = "^([[:digit:]]+)(.+)$",
"rightPattern" = "^(.*[^0-9]+)([[:digit:]]+)$"
)
if (allAreMatchingRegex(x = x, pattern = dict[["intPattern"]])) {
dict[["int"]] <- TRUE
} else if (
allAreMatchingRegex(x = x, pattern = dict[["leftPattern"]])
) {
dict[["side"]] <- "left"
dict[["pattern"]] <- dict[["leftPattern"]]
} else if (
allAreMatchingRegex(x = x, pattern = dict[["rightPattern"]])
) {
dict[["side"]] <- "right"
dict[["pattern"]] <- dict[["rightPattern"]]
} else {
assert(
!any(c(
isMatchingRegex(x = x, pattern = dict[["intPattern"]]),
isMatchingRegex(x = x, pattern = dict[["leftPattern"]]),
isMatchingRegex(x = x, pattern = dict[["rightPattern"]])
)),
msg = "Partial padding match detected."
)
return(object)
}
if (isTRUE(dict[["int"]])) {
num <- x
} else {
assert(requireNamespaces("AcidBase"))
match <- AcidBase::strMatch(x = x, pattern = dict[["pattern"]])
if (identical(dict[["side"]], "left")) {
colnames(match) <- c("string", "num", "stem")
} else if (identical(dict[["side"]], "right")) {
colnames(match) <- c("string", "stem", "num")
}
num <- match[, "num"]
}
width <- max(nchar(num))
num <- sprintf(paste0("%0", width, "d"), as.integer(num))
if (isTRUE(dict[["int"]])) {
x <- num
} else {
stem <- match[, "stem"]
if (identical(dict[["side"]], "left")) {
x <- paste0(num, stem)
} else if (identical(dict[["side"]], "right")) {
x <- paste0(stem, num)
}
}
names(x) <- names(object)
x
}
#' @rdname autopadZeros
#' @export
setMethod(
f = "autopadZeros",
signature = signature(object = "character"),
definition = `autopadZeros,character`
)
#' @rdname autopadZeros
#' @export
setMethod(
f = "autopadZeros",
signature = signature(object = "integer"),
definition = `autopadZeros,integer`
)