Solución:
La razón por la que lubridate parece estar cometiendo errores arriba es que está calculando la duración (la cantidad exacta de tiempo que ocurre entre dos instantes, donde 1 año = 31536000s), en lugar de períodos (el cambio en la hora del reloj que ocurre entre dos instantes).
Para obtener el cambio en la hora del reloj (en años, meses, días, etc.), debe usar
as.period(interval(start = birthdate, end = givendate))
que da la siguiente salida
"37y 0m 1d 0H 0M 0S"
"37y 0m 0d 0H 0M 0S"
"36y 11m 30d 0H 0M 0S"
...
"46y 11m 30d 1H 0M 0S"
"47y 0m 0d 1H 0M 0S"
"47y 0m 1d 1H 0M 0S"
Para extraer años, puede usar lo siguiente
as.period(interval(start = birthdate, end = givendate))$year
[1] 37 37 36 53 53 52 50 50 49 1 1 0 46 47 47
¡La nota, lamentablemente, parece incluso más lenta que los métodos anteriores!
> mbm
Unit: microseconds
expr min lq mean median uq max neval cld
arithmetic 116.595 138.149 181.7547 184.335 196.8565 5556.306 1000 a
lubridate 16807.683 17406.255 20388.1410 18053.274 21378.8875 157965.935 1000 b
Ok, encontré esta función en otra publicación:
age <- function(from, to) {
from_lt = as.POSIXlt(from)
to_lt = as.POSIXlt(to)
age = to_lt$year - from_lt$year
ifelse(to_lt$mon < from_lt$mon |
(to_lt$mon == from_lt$mon & to_lt$mday < from_lt$mday),
age - 1, age)
}
Fue publicado por @Jim diciendo “La siguiente función toma un vector de objetos Date y calcula las edades, contabilizando correctamente los años bisiestos. Parece ser una solución más simple que cualquiera de las otras respuestas”.
De hecho, es más simple y hace el truco que estaba buscando. En promedio, en realidad es más rápido que el método aritmético (aproximadamente un 75% más rápido).
mbm <- microbenchmark(
arithmetic = (givendate - birthdate) / 365.25,
lubridate = interval(start = birthdate, end = givendate) /
duration(num = 1, units = "years"),
eeptools = age_calc(dob = birthdate, enddate = givendate,
units = "years"),
age = age(from = birthdate, to = givendate),
times = 1000
)
mbm
autoplot(mbm)
Y al menos en mis ejemplos no comete ningún error (y no debería hacerlo en ningún ejemplo; es una función bastante sencilla usando ifelses).
toy_df <- data.frame(
birthdate = birthdate,
givendate = givendate,
arithmetic = as.numeric((givendate - birthdate) / 365.25),
lubridate = interval(start = birthdate, end = givendate) /
duration(num = 1, units = "years"),
eeptools = age_calc(dob = birthdate, enddate = givendate,
units = "years"),
age = age(from = birthdate, to = givendate)
)
toy_df[, 3:6] <- floor(toy_df[, 3:6])
toy_df
birthdate givendate arithmetic lubridate eeptools age
1 1978-12-30 2015-12-31 37 37 37 37
2 1978-12-31 2015-12-31 36 37 37 37
3 1979-01-01 2015-12-31 36 37 36 36
4 1962-12-30 2015-12-31 53 53 53 53
5 1962-12-31 2015-12-31 52 53 53 53
6 1963-01-01 2015-12-31 52 53 52 52
7 2000-06-16 2050-06-17 50 50 50 50
8 2000-06-17 2050-06-17 49 50 50 50
9 2000-06-18 2050-06-17 49 50 49 49
10 2007-03-18 2008-03-19 1 1 1 1
11 2007-03-19 2008-03-19 1 1 1 1
12 2007-03-20 2008-03-19 0 1 0 0
13 1968-02-29 2015-02-28 46 47 46 46
14 1968-02-29 2015-03-01 47 47 47 47
15 1968-02-29 2015-03-02 47 47 47 47
No lo considero una solución completa porque también quería tener la edad en meses y semanas, y esta función es específica para años. Lo publico aquí de todos modos porque resuelve el problema de la edad en años. No lo aceptaré porque:
- Esperaría a que @Jim lo publicara como respuesta.
- Esperaré para ver si alguien más presenta una solución completa (eficiente, precisa y que produzca la edad en años, meses o semanas, según lo desee).
Iba a dejar esto en los comentarios, pero creo que merece una respuesta por separado. Como señala @Molx, su método “aritmético” no es tan simple como parece. Eche un vistazo al código de -.Date, Más importante:
return(difftime(e1, e2, units = "days"))
Así, el método “aritmético” en objetos de clase Date es realmente un envoltorio para el difftime función. Qué pasa difftime? Esto también tiene un montón de gastos generales si lo que buscas es velocidad bruta.
La clave es que Date Los objetos se almacenan como un número entero de días desde / hasta el 1 de enero de 1970 (aunque en realidad no se almacenan como integer, de ahí el nacimiento de la IDate clase en data.table), por lo que podemos restarlos y terminar, pero para evitar la -.Date se llama al método, tenemos que unclass nuestras entradas:
(unclass(birthdate) - unclass(givendate)) / 365.25
En lo que respecta a la inversión, este enfoque es varios órdenes de magnitud más rápido que incluso el de @ Jim. age método.
Aquí hay algunos datos de prueba más ampliados:
set.seed(20349)
NN <- 1e6
birthdate <- as.Date(sprintf('%d-%02d-%02d',
sample(1901:2030, NN, TRUE),
sample(12, NN, TRUE),
sample(28, NN, TRUE)))
#average 30 years, most data between 20 and 40 years
givendate <- birthdate + as.integer(rnorm(NN, mean = 10950, sd = 1000))
(Excluyendo eeptools porque es casi increíblemente más lento: un vistazo al código de age_calc sugiere que el código va tan lejos como para crear una secuencia de fechas para cada par de fechas (O(n^2)-ish), sin mencionar una pizca de ifelses)
microbenchmark(
arithmetic = (givendate - birthdate) / 365.25,
lubridate = interval(start = birthdate, end = givendate) /
duration(num = 1, units = "years"),
age = age(from = birthdate, to = givendate),
fastar = (unclass(givendate) - unclass(birthdate)) / 365.25,
overlaps = get_age(birthdate, givendate),
times = 50)
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# arithmetic 28.153465 30.384639 62.96118 31.492764 34.052991 180.9556 50 b
# lubridate 94.327968 97.233009 157.30420 102.751351 240.717065 265.0283 50 c
# age 338.347756 479.598513 483.84529 483.580981 488.090832 770.1149 50 d
# fastar 7.740098 7.831528 11.02521 7.913146 8.090902 153.3645 50 a
# overlaps 316.408920 458.734073 459.58974 463.806255 470.320072 769.0929 50 d
Por lo tanto, también destacamos la locura de la evaluación comparativa de datos a pequeña escala.
El gran costo del método de @ Jim es que as.POSIXlt es cada vez más caro a medida que crecen sus vectores.
El problema de la inexactitud permanece, pero a menos que esta precisión sea primordial, parece que la unclass El método es incomparable.