首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >在R给定出生日期和任意日期中高效和准确的年龄计算(以年份、月份或周为单位)

在R给定出生日期和任意日期中高效和准确的年龄计算(以年份、月份或周为单位)
EN

Stack Overflow用户
提问于 2015-06-29 22:37:26
回答 4查看 27.2K关注 0票数 23

考虑到出生日期和任意日期,我面临着计算年龄(以年数、月或周为单位)的共同任务。问题是,我经常要在许多记录(>3亿)中这样做,所以性能是这里的一个关键问题。

在SO和Google中快速搜索之后,我找到了3种选择:

  • 一个通用算法过程(/365.25) (链接)
  • 从包new_interval() (链接)中使用函数lubridateduration()
  • 来自包age_calc()的函数eeptools (链接链接链接)

这是我的玩具代码:

代码语言:javascript
复制
# Some toy birthdates
birthdate <- as.Date(c("1978-12-30", "1978-12-31", "1979-01-01", 
                       "1962-12-30", "1962-12-31", "1963-01-01", 
                       "2000-06-16", "2000-06-17", "2000-06-18", 
                       "2007-03-18", "2007-03-19", "2007-03-20", 
                       "1968-02-29", "1968-02-29", "1968-02-29"))

# Given dates to calculate the age
givendate <- as.Date(c("2015-12-31", "2015-12-31", "2015-12-31", 
                       "2015-12-31", "2015-12-31", "2015-12-31", 
                       "2050-06-17", "2050-06-17", "2050-06-17",
                       "2008-03-19", "2008-03-19", "2008-03-19", 
                       "2015-02-28", "2015-03-01", "2015-03-02"))

# Using a common arithmetic procedure ("Time differences in days"/365.25)
(givendate-birthdate)/365.25

# Use the package lubridate
require(lubridate)
new_interval(start = birthdate, end = givendate) / 
                     duration(num = 1, units = "years")

# Use the package eeptools
library(eeptools)
age_calc(dob = birthdate, enddate = givendate, units = "years")

让我们稍后讨论准确性,并首先关注性能。下面是代码:

代码语言:javascript
复制
# Now let's compare the performance of the alternatives using microbenchmark
library(microbenchmark)
mbm <- microbenchmark(
    arithmetic = (givendate - birthdate) / 365.25,
    lubridate = new_interval(start = birthdate, end = givendate) /
                                     duration(num = 1, units = "years"),
    eeptools = age_calc(dob = birthdate, enddate = givendate, 
                        units = "years"),
    times = 1000
)

# And examine the results
mbm
autoplot(mbm)

以下是研究结果:

一句话:lubridateeeptools函数的性能比算术方法差得多(/365.25至少快10倍)。不幸的是,算术方法不够精确,我承受不起这种方法会犯的几个错误。

“由于现代公历的构造方式,没有一种直接的算术方法可以计算出一个人的年龄,这是根据一般用法-通常的用法-意味着一个人的年龄应该始终是一个在生日时确切增加的整数”。(链接)

当我在一些帖子上阅读时,lubridateeeptools没有犯过这样的错误(不过,我还没有看过代码/阅读了更多关于这些函数使用的方法),这也是我想要使用它们的原因,但是它们的性能对我的实际应用程序不起作用。

对于一种有效而准确的方法来计算年龄有什么想法吗?

编辑

看来lubridate也会犯错误。显然,基于这个玩具例子,它比算术方法犯的错误更多(参见第3、6、9、12行)。(我做错什么了吗?)

代码语言:javascript
复制
toy_df <- data.frame(
    birthdate = birthdate,
    givendate = givendate,
    arithmetic = as.numeric((givendate - birthdate) / 365.25),
    lubridate = new_interval(start = birthdate, end = givendate) /
        duration(num = 1, units = "years"),
    eeptools = age_calc(dob = birthdate, enddate = givendate,
                        units = "years")
)
toy_df[, 3:5] <- floor(toy_df[, 3:5])
toy_df

    birthdate  givendate arithmetic lubridate eeptools
1  1978-12-30 2015-12-31         37        37       37
2  1978-12-31 2015-12-31         36        37       37
3  1979-01-01 2015-12-31         36        37       36
4  1962-12-30 2015-12-31         53        53       53
5  1962-12-31 2015-12-31         52        53       53
6  1963-01-01 2015-12-31         52        53       52
7  2000-06-16 2050-06-17         50        50       50
8  2000-06-17 2050-06-17         49        50       50
9  2000-06-18 2050-06-17         49        50       49
10 2007-03-18 2008-03-19          1         1        1
11 2007-03-19 2008-03-19          1         1        1
12 2007-03-20 2008-03-19          0         1        0
13 1968-02-29 2015-02-28         46        47       46
14 1968-02-29 2015-03-01         47        47       47
15 1968-02-29 2015-03-02         47        47       47
EN

回答 4

Stack Overflow用户

回答已采纳

发布于 2015-06-29 23:36:34

好的,我在另一个帖子中找到了这个函数

代码语言:javascript
复制
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)
}

它是由@Jim发布的,它说:“下面的函数使用日期对象的向量并计算年龄,正确地计算闰年。这似乎是一个比其他任何答案都更简单的解决方案。”

它确实更简单,它做到了我一直在寻找的窍门。平均而言,它实际上比算术方法快(大约75% )。

代码语言:javascript
复制
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)

至少在我的示例中,它不会犯任何错误(而且在任何示例中都不应该这样;它是一个使用ifelses的非常简单的函数)。

代码语言:javascript
复制
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

我不认为它是一个完整的解决方案,因为我也希望在几个月或几个星期内有年龄,而且这个功能多年来都是特定的。不管怎么说,我把它贴在这里是因为它解决了几年后的问题。我不会接受,因为:

  1. 我会等“吉姆”把它作为答复发出去。
  2. 我会等着看其他人是否想出了一个完整的解决方案(有效的,准确的,生产年龄在几年,几个月或几个星期,如所期望的那样)。
票数 24
EN

Stack Overflow用户

发布于 2015-12-07 00:09:51

lubridate出现上述错误的原因是,您正在计算持续时间(两个瞬间之间发生的确切时间,其中1年=3153600s),而不是周期(两个瞬间之间时钟时间的变化)。

要获得时钟时间的变化(以年份、月份、天数等为单位),您需要使用

代码语言:javascript
复制
as.period(interval(start = birthdate, end = givendate))

,它提供以下输出

代码语言:javascript
复制
 "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" 

要只提取年份,可以使用以下方法

代码语言:javascript
复制
as.period(interval(start = birthdate, end = givendate))$year
 [1] 37 37 36 53 53 52 50 50 49  1  1  0 46 47 47

注:可悲的是,看起来比上面的方法还要慢!

代码语言:javascript
复制
> 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
票数 31
EN

Stack Overflow用户

发布于 2016-02-21 22:46:14

我本打算在评论中留下这个问题,但我认为这是值得单独回答的。正如@Molx所指出的,您的“算术”方法并不像看起来那么简单--看看-.Date的代码,最重要的是:

代码语言:javascript
复制
return(difftime(e1, e2, units = "days"))

因此,Date类对象上的“算术”方法实际上是difftime函数的包装器。那difftime呢?如果你想要的是原始速度的话,这也有很多开销。

关键是从1970年1月1日起,Date对象被存储为整数天数(尽管它们实际上不是以integer的形式存储,因此在data.table中诞生了IDate类),所以我们只需减去这些数据并完成这些操作,但是为了避免调用-.Date方法,我们必须对输入进行unclass

代码语言:javascript
复制
(unclass(birthdate) - unclass(givendate)) / 365.25

就您的成本而言,这种方法比@Jim的age方法还要快几个数量级。

下面是一些更大的测试数据:

代码语言:javascript
复制
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))

(不包括eeptools,因为它速度太慢了

代码语言:javascript
复制
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

因此,我们还强调了在小规模数据上制定基准的愚蠢之处。

@Jim方法的最大代价是,随着向量的增长,as.POSIXlt的开销越来越大。

不精确的问题仍然存在,但是除非这种准确性是最重要的,否则unclass方法似乎是无与伦比的。

票数 6
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/31126726

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档