-
Notifications
You must be signed in to change notification settings - Fork 29
/
Copy pathhandlers.R
89 lines (83 loc) · 2.09 KB
/
handlers.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
width <- function(x) {
x <- as.numeric(x)
class(x) <- c("numeric", "width")
x
}
to_date_handler <- function(format = NULL) {
if (is.null(format)) {
format <- "%Y-%m-%d"
}
handler <- function(x) {
as.Date(x, format = format)
}
attr(handler, "format") <- format
attr(handler, "type") <- "Date"
class(handler) <- c("function", "handler")
handler
}
to_time_handler <- function(format = NULL) {
if (is.null(format)) {
format <- "%H:%M:%S"
}
handler <- function(x) {
strptime(x, format = format)
}
attr(handler, "format") <- format
attr(handler, "type") <- "POSIXct"
class(handler) <- c("function", "handler")
handler
}
to_factor_handler <- function(levels = NULL, labels = levels) {
handler <- function(x) {
if (is.null(levels)) {
factor(x)
} else {
factor(x, levels = levels, labels = labels)
}
}
attr(handler, "levels") <- levels
attr(handler, "labels") <- labels
attr(handler, "type") <- "factor"
class(handler) <- c("function", "handler")
handler
}
to_numeric_handler <- function(dec = 0, sign = "") {
handler <- function(x) {
if (is(dec, "character")) {
dec <- get(dec, envir = parent.frame())
}
if (!sign %in% c("+", "-", "")) {
sign <- get(sign, envir = parent.frame())
}
x <- paste0(sign, x)
as.numeric(x) / (10^as.numeric(dec))
}
attr(handler, "dec") <- dec
attr(handler, "sign") <- sign
attr(handler, "type") <- "numeric"
class(handler) <- c("function", "handler")
handler
}
pass_thru_handler <- function() {
handler <- identity
attr(handler, "type") <- "character"
class(handler) <- c("function", "handler")
handler
}
to_strtime_handler <- function(format = NULL, tz = NULL) {
if (is.null(format)) {
format <- "%H%M%OS"
}
if (is.null(tz)) {
tz <- "GMT"
}
handler <- function(x) {
z <- str_pad(x, 9, pad = "0") |> str_match("(\\d{6})(\\d{3})")
t <- str_c(z[, 2], ".", z[, 3])
strptime(t, format = format, tz = tz)
}
attr(handler, "format") <- format
attr(handler, "type") <- "strtime"
class(handler) <- c("function", "handler")
handler
}