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

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

0 голосов
/ 09 января 2019

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

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 ]

0 голосов
/ 09 января 2019

Вам нужно будет очистить данные как 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
0 голосов
/ 09 января 2019

Если вы проверите выход 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

% г Год без века (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))
...