将列从出生日期更改为年龄答案

【问题标题】：change a column from birth date to age in r将列从出生日期更改为年龄
【发布时间】：2015-01-21 16:08:01
【问题描述】：

我是第一次使用 data.table。

我的表中有大约 400,000 个年龄的列。我需要将它们从出生日期转换为年龄。

最好的方法是什么？

【问题讨论】：

对于其他看到这个的人，我发现另一个帖子上的答案最有帮助：stackoverflow.com/a/25450756/8506921

标签： r date

【解决方案1】：

我一直在思考这个问题，到目前为止对这两个答案都不满意。我喜欢使用lubridate，就像@KFB 所做的那样，但我也希望将事情很好地包装在一个函数中，就像我使用eeptools 包的答案一样。所以这是一个使用 lubridate 间隔方法的包装函数，并带有一些不错的选项：

#' Calculate age
#' 
#' By default, calculates the typical "age in years", with a
#' \code{floor} applied so that you are, e.g., 5 years old from
#' 5th birthday through the day before your 6th birthday. Set
#' \code{floor = FALSE} to return decimal ages, and change \code{units}
#' for units other than years.
#' @param dob date-of-birth, the day to start calculating age.
#' @param age.day the date on which age is to be calculated.
#' @param units unit to measure age in. Defaults to \code{"years"}. Passed to \link{\code{duration}}.
#' @param floor boolean for whether or not to floor the result. Defaults to \code{TRUE}.
#' @return Age in \code{units}. Will be an integer if \code{floor = TRUE}.
#' @examples
#' my.dob <- as.Date('1983-10-20')
#' age(my.dob)
#' age(my.dob, units = "minutes")
#' age(my.dob, floor = FALSE)
age <- function(dob, age.day = today(), units = "years", floor = TRUE) {
    calc.age = interval(dob, age.day) / duration(num = 1, units = units)
    if (floor) return(as.integer(floor(calc.age)))
    return(calc.age)
}

用法示例：

> my.dob <- as.Date('1983-10-20')

> age(my.dob)
[1] 31

> age(my.dob, floor = FALSE)
[1] 31.15616

> age(my.dob, units = "minutes")
[1] 16375680

> age(seq(my.dob, length.out = 6, by = "years"))
[1] 31 30 29 28 27 26

【讨论】：

这是我一直在寻找的答案。 (We meet again)
警告信息：'new_interval' 已弃用；改用“间隔”。在版本“1.5.0”中已弃用。
这有关于生日的问题。例如，age(dob = as.Date("1970-06-01"), age.day = as.Date("2018-05-31"))（此人 48 岁生日的前一天）应该返回 47，但它返回的是 48（48.03014 和 floor = FALSE）。一定有更简洁的方法，但as.numeric(as.period(interval(as.Date("1970-06-01"), as.Date("2018-05-31"))), "years") 似乎更好（它返回 47.9988）
这算不算闰年日？似乎将间隔除以固定的 365 天，但并非每年都有 365 天。

【解决方案2】：

从this blog entry的cmets中，我在eeptools包中找到了age_calc函数。它处理边缘情况（闰年等），检查输入并且看起来非常健壮。

library(eeptools)
x <- as.Date(c("2011-01-01", "1996-02-29"))
age_calc(x[1],x[2]) # default is age in months

[1] 46.73333 224.83118

age_calc(x[1],x[2], units = "years") # but you can set it to years

[1] 3.893151 18.731507

floor(age_calc(x[1],x[2], units = "years"))

[1] 3 18

为了您的数据

yourdata$age <- floor(age_calc(yourdata$birthdate, units = "years"))

假设您想要整数年的年龄。

【讨论】：

【解决方案3】：

假设您有一个 data.table，您可以执行以下操作：

library(data.table)
library(lubridate)
# toy data
X = data.table(birth=seq(from=as.Date("1970-01-01"), to=as.Date("1980-12-31"), by="year"))
Sys.Date()

选项 1：使用润滑包中的“as.period”

X[, age := as.period(Sys.Date() - birth)][]
         birth                   age
 1: 1970-01-01  44y 0m 327d 0H 0M 0S
 2: 1971-01-01  43y 0m 327d 6H 0M 0S
 3: 1972-01-01 42y 0m 327d 12H 0M 0S
 4: 1973-01-01 41y 0m 326d 18H 0M 0S
 5: 1974-01-01  40y 0m 327d 0H 0M 0S
 6: 1975-01-01  39y 0m 327d 6H 0M 0S
 7: 1976-01-01 38y 0m 327d 12H 0M 0S
 8: 1977-01-01 37y 0m 326d 18H 0M 0S
 9: 1978-01-01  36y 0m 327d 0H 0M 0S
10: 1979-01-01  35y 0m 327d 6H 0M 0S
11: 1980-01-01 34y 0m 327d 12H 0M 0S

选项2：如果你不喜欢选项1的格式，你可以这样做：

yr = duration(num = 1, units = "years")
X[, age := new_interval(birth, Sys.Date())/yr][]
# you get
         birth      age
 1: 1970-01-01 44.92603
 2: 1971-01-01 43.92603
 3: 1972-01-01 42.92603
 4: 1973-01-01 41.92329
 5: 1974-01-01 40.92329
 6: 1975-01-01 39.92329
 7: 1976-01-01 38.92329
 8: 1977-01-01 37.92055
 9: 1978-01-01 36.92055
10: 1979-01-01 35.92055
11: 1980-01-01 34.92055

相信选项 2 应该更可取。

【讨论】：

选项 2 在生日方面存在问题 - 请参阅我对 @Gregor 答案的评论。举个具体的例子，yr = duration(num = 1, units = "years"); birth <- as.Date("1970-06-01"); age_as_at <- as.Date("2018-05-31"); interval(birth, age_as_at)/yr 应该小于 48

【解决方案4】：

我更喜欢使用lubridate 包来执行此操作，借用我最初在另一个post 中遇到的语法。

有必要根据 R 日期对象标准化您的输入日期，最好使用 lubridate::mdy() 或 lubridate::ymd() 或类似函数（如果适用）。您可以使用interval() 函数生成一个描述两个日期之间经过的时间的间隔，然后使用duration() 函数定义该间隔应该如何“切块”。

我总结了从下面两个日期计算年龄的最简单情况，使用 R 中最新的语法。

df$DOB <- mdy(df$DOB)
df$EndDate <- mdy(df$EndDate)
df$Calc_Age <- interval(start= df$DOB, end=df$EndDate)/                      
                     duration(n=1, unit="years")

年龄可以使用基数 R 'floor()` 函数向下舍入到最接近的完整整数，如下所示：

df$Calc_AgeF <- floor(df$Calc_Age)

或者，基 R round() 函数中的 digits= 参数可用于向上或向下舍入，并指定返回值中的确切小数位数，如下所示：

df$Calc_Age2 <- round(df$Calc_Age, digits = 2) ## 2 decimals
df$Calc_Age0 <- round(df$Calc_Age, digits = 0) ## nearest integer

值得注意的是，一旦输入日期通过上述计算步骤（即interval()和duration()函数），返回值将是数字，不再是R中的日期对象。这很重要而lubridate::floor_date() 仅限于日期时间对象。

无论输入日期是否出现在data.table 或data.frame 对象中，上述语法都有效。

【讨论】：

这与生日周围的其他答案有相同的问题

【解决方案5】：

我想要一个不会增加我的依赖超过data.table 的实现，这通常是我唯一的依赖。 data.table 仅用于 mday，表示月份中的某一天。

开发功能

这个函数在逻辑上是我对某人年龄的看法。我从 [当年] - [生日] - 1 开始，如果他们在当年已经过生日，则加 1。要检查该偏移量，我首先考虑月份，然后（如有必要）每月的某一天。

这是一步一步的实现：

agecalc <- function(origin, current){
    require(data.table)
    y <- year(current) - year(origin) - 1
    offset <- 0
    if(month(current) > month(origin)) offset <- 1
    if(month(current) == month(origin) & 
       mday(current) >= mday(origin)) offset <- 1
    age <- y + offset
    return(age)
}

生产函数

这是相同的逻辑重构和矢量化：

agecalc <- function(origin, current){
    require(data.table)
    age <- year(current) - year(origin) - 1
    ii <- (month(current) > month(origin)) | (month(current) == month(origin) & 
                                                  mday(current) >= mday(origin))
    age[ii] <- age[ii] + 1
    return(age)
}

使用字符串的实验函数

您还可以对月/日部分进行字符串比较。或许有时这会更有效，例如，如果您将年份作为数字，将出生日期作为字符串。

agecalc_strings <- function(origin, current){
    origin <- as.character(origin)
    current <- as.character(current)
    
    age <- as.numeric(substr(current, 1, 4)) - as.numeric(substr(origin, 1, 4)) - 1
    if(substr(current, 6, 10) >= substr(origin, 6, 10)){
        age <- age + 1
    }
    return(age)
}

对矢量化“生产”版本的一些测试：

## Examples for specific dates to test the calculation with things like 
## beginning and end of months, and leap years:
agecalc(as.IDate("1985-08-13"), as.IDate("1985-08-12"))
agecalc(as.IDate("1985-08-13"), as.IDate("1985-08-13"))
agecalc(as.IDate("1985-08-13"), as.IDate("1986-08-12"))
agecalc(as.IDate("1985-08-13"), as.IDate("1986-08-13"))
agecalc(as.IDate("1985-08-13"), as.IDate("1986-09-12"))

agecalc(as.IDate("2000-02-29"), as.IDate("2000-02-28"))
agecalc(as.IDate("2000-02-29"), as.IDate("2000-02-29"))
agecalc(as.IDate("2000-02-29"), as.IDate("2001-02-28"))
agecalc(as.IDate("2000-02-29"), as.IDate("2001-02-29"))
agecalc(as.IDate("2000-02-29"), as.IDate("2001-03-01"))
agecalc(as.IDate("2000-02-29"), as.IDate("2004-02-28"))
agecalc(as.IDate("2000-02-29"), as.IDate("2004-02-29"))
agecalc(as.IDate("2000-02-29"), as.IDate("2011-03-01"))

## Testing every age for every day over several years
## This test requires vectorized version:
d <- data.table(d=as.IDate("2000-01-01") + 0:10000)
d[ , b1 := as.IDate("2000-08-15")]
d[ , b2 := as.IDate("2000-02-29")]
d[ , age1_num := (d - b1) / 365]
d[ , age2_num := (d - b2) / 365]
d[ , age1 := agecalc(b1, d)]
d[ , age2 := agecalc(b2, d)]
d

下面是一个简单的数字和整数年龄图。如您所见整数年龄是一种阶梯模式，与（但低于）数字年龄的直线。

plot(numeric_age1 ~ today, dt, type = "l", 
     ylab = "ages", main = "ages plotted")
lines(integer_age1 ~ today, dt, col = "blue")

【讨论】：

【解决方案6】：

在处理闰年时，我对以月或年为单位计算年龄的任何回应都不满意，所以这是我使用 lubridate 包的函数。

基本上，它将from 和to 之间的时间间隔分成（最多）年块，然后调整该块是否为闰年的时间间隔。总间隔是每个块的年龄之和。

library(lubridate)

#' Get Age of Date relative to Another Date
#'
#' @param from,to the date or dates to consider
#' @param units the units to consider
#' @param floor logical as to whether to floor the result
#' @param simple logical as to whether to do a simple calculation, a simple calculation doesn't account for leap year.
#' @author Nicholas Hamilton
#' @export
age <- function(from, to = today(), units = "years", floor = FALSE, simple = FALSE) {

  #Account for Leap Year if Working in Months and Years
  if(!simple && length(grep("^(month|year)",units)) > 0){
    df = data.frame(from,to)
    calc = sapply(1:nrow(df),function(r){

      #Start and Finish Points
      st = df[r,1]; fn = df[r,2]

      #If there is no difference, age is zero
      if(st == fn){ return(0) }

      #If there is a difference, age is not zero and needs to be calculated
      sign = +1 #Age Direction
      if(st > fn){ tmp = st; st = fn; fn = tmp; sign = -1 } #Swap and Change sign

      #Determine the slice-points
      mid   = ceiling_date(seq(st,fn,by='year'),'year')

      #Build the sequence
      dates = unique( c(st,mid,fn) )
      dates = dates[which(dates >= st & dates <= fn)]

      #Determine the age of the chunks
      chunks = sapply(head(seq_along(dates),-1),function(ix){
        k = 365/( 365 + leap_year(dates[ix]) )
        k*interval( dates[ix], dates[ix+1] ) / duration(num = 1, units = units)
      })

      #Sum the Chunks, and account for direction
      sign*sum(chunks)
    })

  #If Simple Calculation or Not Months or Not years
  }else{
    calc = interval(from,to) / duration(num = 1, units = units)
  }

  if (floor) calc = as.integer(floor(calc))
  calc
}

【讨论】：

【解决方案7】：

(Sys.Date() - yourDate) / 365.25

【讨论】：

不错，但不是 100% 稳健。
我认为 .25 部分无关紧要，但这对于闰年生日来说是失败的。此外，您希望 trunc 用于整数年龄。
您解决了一个案例，并没有尝试回答问题中提出的编程问题。考虑修改。

【解决方案8】：

不使用任何额外包从两个日期计算年龄的一种非常简单的方法可能是：

df$age = with(df, as.Date(date_2, "%Y-%m-%d") - as.Date(date_1, "%Y-%m-%d"))

【讨论】：

【解决方案9】：

这是一个（我认为更简单的）使用 lubridate 的解决方案：

library(lubridate)

age <- function(dob, on.day=today()) {
    intvl <- interval(dob, on.day)
    prd <- as.period(intvl)
    return(prd@year)
}

【讨论】：