/
full-seq.R
66 lines (58 loc) · 1.66 KB
/
full-seq.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
#' Generate sequence of fixed size intervals covering range.
#'
#' @param range range
#' @param size interval size
#' @param ... other arguments passed on to methods
#' @keywords internal
#' @export
fullseq <- function(range, size, ...) UseMethod("fullseq")
#' @export
fullseq.numeric <- function(range, size, ..., pad = FALSE) {
if (zero_range(range)) {
return(range + size * c(-1, 1) / 2)
}
x <- seq(
round_any(range[1], size, floor),
round_any(range[2], size, ceiling),
by = size
)
if (pad) {
# Add extra bin on bottom and on top, to guarantee that we cover complete
# range of data, whether right = T or F
c(min(x) - size, x, max(x) + size)
} else {
x
}
}
#' @export
fullseq.Date <- function(range, size, ...) {
seq(floor_date(range[1], size), ceiling_date(range[2], size), by = size)
}
#' @export
fullseq.POSIXt <- function(range, size, ...) {
# for subsecond interval support
# seq() does not support partial secs in character strings
parsed <- parse_unit_spec(size)
if (parsed$unit == "sec") {
seq(floor_time(range[1], size), ceiling_time(range[2], size), by = parsed$mult)
} else {
seq(floor_time(range[1], size), ceiling_time(range[2], size), by = size)
}
}
#' @export
fullseq.difftime <- function(range, size, ...) {
if (is.numeric(size)) {
size_seconds <- size
} else {
size_seconds <- unit_seconds(size)
}
input_units <- units(range)
x <- seq(
round_any(as.numeric(range[1], units = "secs"), size_seconds, floor),
round_any(as.numeric(range[2], units = "secs"), size_seconds, ceiling),
by = size_seconds
)
x <- as.difftime(x, units = "secs")
units(x) <- input_units
x
}