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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
#' @title Fractional Years
#' @author Joonas Miettinen
#' @description Using Date objects, calculates given
#' dates as fractional years.
#' @param x a `Date` object, or anything that `[as.Date]`
#' accepts
#' @param year.length character string, either `"actual"` or
#' `"approx"`; can be abbreviated; see **Details**
#' @param ... additional arguments passed on to `[as.Date]`;
#' typically `format` when `x` is a character string variable,
#' and `origin` when `x` is numeric
#' @import data.table
#' @export
#' @details
#'
#' `x` should preferably be a `Date` or `IDate`
#' object, although it can also be a character string variable
#' which is coerced internally to `Date` format
#' using `[as.Date.character]`.
#'
#' When ` year.length = 'actual' `, fractional years are calculated as
#' ` year + (day_in_year-1)/365 ` for non-leap-years
#' and as ` year + (day_in_year-1)/366 ` for leap years.
#' If ` year.length = 'approx' `, fractional years are always
#' calculated as in ` year + (day_in_year-1)/365.242199 `.
#'
#' There is a slight difference, then, between the two methods
#' when calculating durations between fractional years. For
#' meticulous accuracy one might instead want to calculate durations using
#' dates (days) and convert the results to fractional years.
#'
#' Note that dates are effectively converted to fractional years at
#' ` 00:00:01 ` o'clock:
#'
#'
#' ` get.yrs("2000-01-01") = 2000 `, and
#' ` get.yrs("2000-01-02") = 2000 + 1/365.242199 `.
#'
#'
#' @seealso
#' `[Epi::cal.yr]`, `[as.Date.yrs]`, `[as.Date]`
#'
#' @return
#' A numeric vector of fractional years.
#'
#' @examples
#'
#' data("sire")
#' sire$dg_yrs <- get.yrs(sire$dg_date)
#' summary(sire$dg_yrs)
#'
#' ## see: ?as.Date.yrs
#' dg_date2 <- as.Date(sire$dg_yrs)
#' summary(as.numeric(dg_date2 - as.Date(sire$dg_date)))
#'
#' ## Epi's cal.yr versus get.yrs
#' d <- as.Date("2000-01-01")
#' Epi::cal.yr(d) ## 1999.999
#' get.yrs(d) ## 2000
#'
#' ## "..." passed on to as.Date, so character / numeric also accepted as input
#' ## (and whatever else as.Date accepts)
#' get.yrs("2000-06-01")
#' get.yrs("20000601", format = "%Y%m%d")
#' get.yrs("1/6/00", format = "%d/%m/%y")
#'
#' get.yrs(100, origin = "1970-01-01")
#'
#'
get.yrs <- function(x, year.length = "approx", ...) {
as.yrs(x, year.length = year.length, ...)
}
as.yrs <- function(x, year.length, ...) {
UseMethod("as.yrs")
}
#' @export
as.yrs.Date <- function(x, year.length = "approx", ...) {
year.length <- match.arg(year.length, c("actual", "approx"))
yl <- 365.242199
y <- year(x)
if (year.length == "actual") {
yl <- ifelse(is_leap_year(y), 366L, 365L)
}
d <- yday(x)
yrs <- y + (d - 1L)/yl
setattr(yrs, "year.length", year.length)
setattr(yrs, "class", c("yrs", "numeric"))
yrs
}
#' @export
as.yrs.default <- function(x, year.length = "approx", ...) {
x <- as.Date(x, ...)
as.yrs(x, year.length = year.length)
}
#' @title Coerce Fractional Year Values to Date Values
#' @author Joonas Miettinen
#' @param x an `yrs` object created by `get.yrs`
#' @param ... unused, included for compatibility with other `as.Date`
#' methods
#' @description Coerces an `yrs` object to a `Date` object.
#' Some loss of information comes if `year.length = "approx"`
#' was set when using `[get.yrs]`, so the transformation back
#' to `Date` will not be perfect there. With `year.length = "actual"`
#' the original values are perfectly retrieved.
#' @examples
#' data("sire", package = "popEpi")
#'
#' ## approximate year lengths: here 20 % have an extra day added
#' sire$dg_yrs <- get.yrs(sire$dg_date)
#' summary(sire$dg_yrs)
#' dg_date2 <- as.Date(sire$dg_yrs)
#' summary(as.numeric(dg_date2 - as.Date(sire$dg_date)))
#'
#' ## using actual year lengths
#' sire$dg_yrs <- get.yrs(sire$dg_date, year.length = "actual")
#' summary(sire$dg_yrs)
#' dg_date2 <- as.Date(sire$dg_yrs)
#' summary(as.numeric(dg_date2 - as.Date(sire$dg_date)))
#' @seealso `[get.yrs]`
#' @return
#' A vector of `Date` values based on the input fractional years.
#' @export
as.Date.yrs <- function(x, ...) {
yl <- attr(x, "year.length")
if (is.null(yl)) {
warning("x did not contain meta information about year length used ",
"when forming the yrs object. Assuming 'approx'.")
yl <- "approx"
}
y <- as.integer(x)
mu <- 365.242199
if (yl == "actual") {
mu <- ifelse(is_leap_year(y), rep(365L, length(x)), rep(364L, length(x)))
}
x <- x + 1L/mu
yd <- as.integer((x-y)*mu)
d <- as.Date(paste0(y, "-01-01")) + yd
d
}
|
