Получение отрицательных возрастов с использованием lubridate для расчета возраста с даты рождения и текущей даты

У меня есть данные, которые выглядят так. Это дата-фрейм, содержащий дату рождения (среди прочего) для ряда людей.

library(tidyr)
library(dplyr)
library(magrittr)
library(lubridate)

df <- data.frame(
DATE_OF_BIRTH = c("20/10/01" , "15/04/88", "16/12/58", "15/10/91", "09/02/66", "02/07/03", "20/08/96", "22/04/99", "17/04/87", "17/08/56",
                "28/05/40", "26/07/59", "02/04/65", "17/08/93", "01/08/86", "30/07/01", "03/09/75", "17/09/65", "16/02/95", "11/06/03",
                "26/10/64", "25/02/73", "07/02/90", "31/03/38", "05/03/83", "10/02/61", "01/07/40", "15/08/51", "19/12/75", "25/11/58",
                "05/11/81", "05/12/02", "06/05/40", "23/09/69", "17/04/48", "02/07/58", "04/03/98", "26/11/03", "08/01/91", "23/12/07",
                "05/05/01", "23/10/08", "01/01/09", "29/10/63", "26/03/09", "03/02/75", "03/09/04", "17/01/80", "19/03/11", "05/07/83")
)

Я хочу рассчитать возраст каждого человека на основе даты его рождения по состоянию на 1 июля 2017 года.

Для расчета возраста я использую следующий код:

df <- df %>%
mutate(age = interval(start = dmy(df$DATE_OF_BIRTH), end = dmy('01/07/17')) / 
duration(num = 1, units = "years"))

Вывод из этого является правильным для некоторых людей, но для других я получаю отрицательное значение. Для этих людей их фактический возраст является абсолютным значением возраста abs(age) плюс 17

Может кто-нибудь сказать мне, как получить только положительные значения для возраста? Благодарю.

Я видел следующий вопрос: Эффективное и точное вычисление возраста (в годах, месяцах или неделях) в R с учетом даты рождения и произвольной даты, но это не включает проблему с отрицательными возрастами в качестве выходных данных.

Источник

2 ответа

Решение

Если вы проверите выход dmy функция

head(df$DATE_OF_BIRTH)
#[1] "20/10/01" "15/04/88" "16/12/58" "15/10/91" "09/02/66" "02/07/03"

head(dmy(df$DATE_OF_BIRTH))
#[1] "2001-10-20" "1988-04-15" "2058-12-16" "1991-10-15" "2066-02-09" "2003-07-02"

R интерпретирует годы 00 - 68 как 2000 - 2068 и 69 - 99 как 1969 - 1999. Следовательно, 58 считается 2058, 66 - 2066, а 88 - 1988.

От ?strptime

%y Год без века (00–99). При вводе значения от 00 до 68 имеют префикс от 20, а от 69 до 99 - от 19 - это поведение, определенное стандартами POSIX 2004 и 2008 годов, но они также говорят: "ожидается, что в будущей версии столетие по умолчанию будет выведено из год из двух цифр изменится

Для отрицательных значений вы можете добавить 100 к ним, чтобы получить эквивалентные положительные значения

library(dplyr)
library(lubridate)

df %>%
  mutate(age = interval(start = dmy(DATE_OF_BIRTH), end = dmy('01/07/17')) / 
          duration(num = 1, units = "years"), 
          age = if_else(age < 0, age + 100, age))


#   DATE_OF_BIRTH       age
#1       20/10/01 15.706849
#2       15/04/88 29.230137
#3       16/12/58 58.512329
#4       15/10/91 25.728767
#5       09/02/66 51.356164
#6       02/07/03 14.008219
#7       20/08/96 20.876712
#....

Чтобы получить разницу между датами в годах, вы также можете использовать interval как это

df %>%
  mutate(age = interval(dmy(DATE_OF_BIRTH), dmy('01/07/17')) / years(1),
         age = if_else(age < 0, age + 100, age))
Источник

Вам нужно будет очистить данные как lubridate или as.Date() даст одинаковые результаты.

Для любого преобразованного года, превышающего сегодняшний (нелогичный DoB), вычтите 100 лет из преобразованной даты, чтобы сделать ее релевантной. Код ниже содержит очищающую часть, описанную выше. Удачи с анализом данных!

library(tidyr)
library(dplyr)
library(magrittr)
library(lubridate)


library(tidyr)
library(dplyr)
library(magrittr)
library(lubridate)

df <- data.frame(
  DATE_OF_BIRTH = c("20/10/01" , "15/04/88", "16/12/58", "15/10/91", "09/02/66", "02/07/03", "20/08/96", "22/04/99", "17/04/87", "17/08/56",
                    "28/05/40", "26/07/59", "02/04/65", "17/08/93", "01/08/86", "30/07/01", "03/09/75", "17/09/65", "16/02/95", "11/06/03",
                    "26/10/64", "25/02/73", "07/02/90", "31/03/38", "05/03/83", "10/02/61", "01/07/40", "15/08/51", "19/12/75", "25/11/58",
                    "05/11/81", "05/12/02", "06/05/40", "23/09/69", "17/04/48", "02/07/58", "04/03/98", "26/11/03", "08/01/91", "23/12/07",
                    "05/05/01", "23/10/08", "01/01/09", "29/10/63", "26/03/09", "03/02/75", "03/09/04", "17/01/80", "19/03/11", "05/07/83")

)


#set the date for comparison
comparisondate<-as.Date("2017-07-01")

#Retrieve the lubridate format and clean it for incorrect conversions
df$DOBnew<-dmy(df$DATE_OF_BIRTH)
#calculate the age
df$age<-round(as.numeric(difftime(comparisondate,df$DOBnew,units="weeks")/52.25),digits=1)
df[df$age<0,"DOBnew"]<-df[df$age<0,"DOBnew"] %m-% years(100)

#recalculate age
df$age<-round(as.numeric(difftime(comparisondate,df$DOBnew,units="weeks")/52.25),digits=1)
df$age



[1] 15.7 29.2 58.5 25.7 51.3 14.0 20.8 18.2 30.2 60.8 77.0 57.9 52.2 23.8 30.9 15.9 41.8 51.7 22.3 14.0
[21] 52.6 44.3 27.4 79.1 34.3 56.3 76.9 65.8 41.5 58.5 35.6 14.6 77.0 47.7 69.1 58.9 19.3 13.6 26.4  9.5
[41] 16.1  8.7  8.5 53.6  8.3 42.3 12.8 37.4  6.3 33.9

all(df$age>0)
[1] TRUE
Источник
Другие вопросы по тегам