Die effiziente und genaue Alter Berechnung (in Jahren, Monaten oder Wochen) in R gegeben, Geburtsdatum und einem beliebigen Datum

Ich bin mit der gemeinsamen Aufgabe, die Berechnung des Alters (in Jahren, Monaten oder Wochen) gegeben, das Geburtsdatum und ein willkürliches Datum. Die Sache ist die, dass sehr oft habe ich zu tun das über viele viele Datensätze (>300 Millionen), also performance ist ein zentrales Thema hier.

Nachdem eine schnelle Suche in SO und Google fand ich 3 alternativen:

  • Eine gemeinsame arithmetische Verfahren (/365.25) (link)
  • Verwendung von Funktionen new_interval() und duration() aus Paket lubridate (link)
  • Funktion age_calc() aus Paket eeptools (link, link, link)

So, hier ist mein Spielzeug-code:

# 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")

Reden wir später über die Genauigkeit und den Fokus zuerst auf die Leistung. Hier ist der code:

# 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)

Hier die Ergebnisse:

Die effiziente und genaue Alter Berechnung (in Jahren, Monaten oder Wochen) in R gegeben, Geburtsdatum und einem beliebigen Datum
Die effiziente und genaue Alter Berechnung (in Jahren, Monaten oder Wochen) in R gegeben, Geburtsdatum und einem beliebigen Datum

Fazit: die Leistung der lubridate und eeptools Funktionen ist viel schlimmer als das arithmetische Methode (/365.25 ist mindestens 10 mal schneller). Leider ist die arithmetische Methode ist nicht genau genug, und ich kann nicht leisten, die paar Fehler, die diese Methode machen.

"weil der Weg zu den modernen Gregorianischen Kalender
ist konstruiert, es ist keine einfache arithmetische
Methode, erzeugt ein person Alter, angegeben nach
gemeinsame Nutzung gemeinsame Nutzung bedeutet, dass eine person, die
Alter sollte immer eine ganze Zahl sein, die sich erhöht, genau auf
ein Geburtstag". (link)

Als ich Las einige Beiträge, die lubridate und eeptools machen keine solchen Fehler (obwohl ich noch nicht angeschaut, der code/Lesen Sie mehr über die Funktionen wissen, welche Methode Sie verwenden) und das ist, warum ich wollte, Sie zu benutzen, aber Ihre Leistung nicht für meine eigentlichen Anwendung.

Irgendwelche Ideen auf eine effiziente und genaue Methode zur Berechnung des Alters?

BEARBEITEN

Ops, es scheint lubridate auch Fehler macht. Und offenbar basiert auf diesem Beispiel Spielzeug, es macht mehr Fehler als der arithmetische Methode (siehe Zeilen 3, 6, 9, 12). (mache ich etwas falsch?)

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
Ich würde sein überrascht, wenn es etwas gibt, was schneller/einfacher als lubridate. Mein einziger Vorschlag, wenn Sie realllly müssen die Leistungssteigerung ist die arithmetische Methode zuerst, und dann wiederholen alle den "close calls" mit den lubridate Methode (so, zum Beispiel, wenn abs(floor(age) - age) < 0.01) dann verwenden lubridate)
Danke. sind Sie und erfahrene Benutzer von lubridate?, ..., als ich es in der Frage bearbeitet, ich fand, dass es Fehler macht (vielleicht mehr als die arithmetische Methode) aber ich habe gelesen in mehreren posts, dass lubridate war in der Tat eine der R-Pakete, die in der Lage war, genau zu berechnen Altersgruppen. So, jetzt Frage ich mich, wenn ich mache etwas falsch. (Ich denke nicht, ich bin im Grunde nach den Beispielen und es ist ziemlich einfach, aber nur double-checking)
Keine Lösung, aber difftime(givendate, birthdate) / 365.25 zu sein scheint rund 5% schneller als (givendate - birthdate) / 365.25). Könnte nützlich sein im Fall, dass Sie am Ende mit der Arithmetik.
guter Aufruf! -.Date nur Anrufe difftime mehr robust. Noch schneller sollte (unclass(givendate) - unclass(birthdate)) / 365.25 da diese weiter springt der Aufwand difftime.

InformationsquelleAutor Hernando Casas | 2015-06-29

  1. 16

    Ok, so fand ich diese Funktion in einem anderen post:

    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)
}

    Es wurde geschrieben von @Jim sagte: "Die folgende Funktion nimmt einen Vektoren der Date-Objekte und berechnet das Alter, richtig Buchhaltung für die Schaltjahre. Scheint eine einfachere Lösung als jede der anderen Antworten".

    Ist es zwar einfacher und es tut den trick, den ich suchte. Im Durchschnitt ist er tatsächlich schneller als die arithmetische Methode (über 75% schneller).

    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)

    Die effiziente und genaue Alter Berechnung (in Jahren, Monaten oder Wochen) in R gegeben, Geburtsdatum und einem beliebigen Datum
    Die effiziente und genaue Alter Berechnung (in Jahren, Monaten oder Wochen) in R gegeben, Geburtsdatum und einem beliebigen Datum

    Und zumindest in meinem Beispiel, macht keine Fehler (und es sollte nicht in jedem Beispiel; es ist eine ziemlich einfache Funktion mit 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

    Ich halte es nicht als eine vollständige Lösung, weil ich wollte auch mit dem Alter in Monaten und Wochen, und diese Funktion ist spezifisch für die Jahre. Ich poste es hier trotzdem, weil es das problem löst, für das Alter in Jahren. Ich werde nicht akzeptieren, weil:

    1. Ich würde warten, bis @Jim poste es als Antwort.
    2. Ich werde warten, um zu sehen, ob jemand anderes kommen mit einer komplett-Lösung (eine effiziente, präzise und Herstellung Alter in Jahren, Monaten oder Wochen, wie gewünscht).

    InformationsquelleAutor Hernando Casas

  2. 14

    Den Grund lubridate zu sein scheint, die Fehler machen, die oben ist, dass Sie die Berechnung der Dauer (die genaue Höhe der Zeit, das Auftritt, zwischen zwei Augenblicken, wo 1 Jahr = 31536000s), sondern als Zeiten (die änderung in der Zeit, die Auftritt, zwischen zwei Augenblicken).

    Um die änderung in der Zeit (in Jahren, Monaten, Tagen, etc) Sie verwenden müssen 

    as.period(new_interval(start = birthdate, end = givendate))

    welche gibt die folgende Ausgabe

     "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"

    Nur extrahieren Jahre, können Sie die folgenden

    as.period(new_interval(start = birthdate, end = givendate))$year
 [1] 37 37 36 53 53 52 50 50 49  1  1  0 46 47 47

    Beachten Sie, dass dies werfen die folgende Warnmeldung (nicht sicher, warum):

     Warning message:
 In Ops.factor(left, right) : ‘-’ not meaningful for factors

    und leider scheint auch langsamer als die oben genannten Methoden!

    > 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
    new_interval() ist jetzt abgeschrieben in der lubridate - Paket, so interval() statt. Auch die "nicht sinnvoll für Faktoren" Warnmeldung (die aus as.period() behoben worden ist, so mehr erscheint.

    InformationsquelleAutor JWilliman

  3. 4

    Ich wurde hämmern an dieser und schließlich haben etwas, das a) perfekt genaue* (im Gegensatz zu alle der anderen Optionen so weit) und b) Recht schnell (siehe meine benchmarks in der anderen Antwort). Es stützt sich auf eine Reihe von arithmetischen habe ich von hand und die wunderbare foverlaps Funktion aus der data.table Paket.

    Die Essenz des Ansatzes ist die Verwendung der integer-Repräsentation der Dates, sowie zu erkennen, dass alle Geburtsdaten fallen in eine von vier 1461 (= 365 * 4 + 1)-Tag Zyklen, je nachdem, Wann das Nächstes Jahr ist, wenn es dauert 366 Tage für Ihre Geburtstag, zu kommen.

    Hier ist die Funktion:

    library(data.table)
get_age <- function(birthdays, ref_dates){
  x <- data.table(bday <- unclass(birthdays),
                  #rem: how many days has it been since the lapse of the
                  #  most recent quadrennium since your birth?
                  rem = ((ref <- unclass(ref_dates)) - bday) %% 1461)
  #cycle_type: which of the four years following your birthday
  #  was the one that had 366 days? 
  x[ , cycle_type := 
       foverlaps(data.table(start = bdr <- bday %% 1461L, end = bdr),
                 #these intervals were calculated by hand;
                 #  e.g., 59 is Feb. 28, 1970. I made the judgment
                 #  call to say that those born on Feb. 29 don't
                 #  have their "birthday" until the following March 1st.
                 data.table(start = c(0L, 59L, 424L, 790L, 1155L), 
                            end = c(58L, 423L, 789L, 1154L, 1460L), 
                            val = c(3L, 2L, 1L, 4L, 3L),
                            key = "start,end"))$val]
  I4 <- diag(4L)[ , -4L] #for conciseness below
  #The `by` approach might seem a little abstruse for those
  #  not familiar with `data.table`; see the edit history
  #  for a more palatable version (which is also slightly slower)
  x[ , extra := 
       foverlaps(data.table(start = rem, end = rem),
                 data.table(start = st <- cumsum(c(0L, rep(365L, 3L) +
                                                     I4[.BY[[1L]],])),
                            end = c(st[-1L] - 1L, 1461L),
                            int_yrs = 0:3, key = "start,end")
       )[ , int_yrs + (i.start - start) / (end + 1L - start)], by = cycle_type]
  #grand finale -- 4 years for every quadrennium, plus the fraction:
  4L * ((ref - bday) %/% 1461L) + x$extra
}

    Vergleich auf Ihre Haupt-Beispiel:

    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"),
  mine = get_age(birthdate, givendate)
)

toy_df
#     birthdate  givendate arithmetic lubridate   eeptools       mine
# 1  1978-12-30 2015-12-31 37.0020534 37.027397 37.0027397 37.0027322 #eeptools wrong: will be 366 days until 12/31/16, so fraction is 1/366
# 2  1978-12-31 2015-12-31 36.9993155 37.024658 37.0000000 37.0000000
# 3  1979-01-01 2015-12-31 36.9965777 37.021918 36.9972603 36.9972603
# 4  1962-12-30 2015-12-31 53.0020534 53.038356 53.0027397 53.0027322 #same problem
# 5  1962-12-31 2015-12-31 52.9993155 53.035616 53.0000000 53.0000000
# 6  1963-01-01 2015-12-31 52.9965777 53.032877 52.9972603 52.9972603
# 7  2000-06-16 2050-06-17 50.0013689 50.035616 50.0000000 50.0027397 #eeptools wrong: not exactly the birthday
# 8  2000-06-17 2050-06-17 49.9986311 50.032877 50.9972603 50.0000000 #eeptools wrong: _is_ exactly the birthday
# 9  2000-06-18 2050-06-17 49.9958932 50.030137 49.9945205 49.9972603 #eeptools wrong: fraction should be 364/365
# 10 2007-03-18 2008-03-19  1.0047912  1.005479  1.0027322  1.0027397 #eeptools wrong: 2/29 already passed, only 365 days until 3/19/2009
# 11 2007-03-19 2008-03-19  1.0020534  1.002740  1.0000000  1.0000000
# 12 2007-03-20 2008-03-19  0.9993155  1.000000  0.9966839  0.9972678 #eeptools wrong: we passed 2/29, so should be 365/366
# 13 1968-02-29 2015-02-28 46.9979466 47.030137 46.9977019 46.9972603 #my judgment: birthday occurs on 3/1 for 2/29 babies, so 364/365 the way there
# 14 1968-02-29 2015-03-01 47.0006845 47.032877 47.0000000 47.0000000
# 15 1968-02-29 2015-03-02 47.0034223 47.035616 47.0027397 47.0027322

    Diese Art von Ansatz kann erweitert werden, zu handhaben Monaten/Wochen ziemlich leicht. Monaten wird ein bisschen langatmig (angeben 4 Jahre im Wert von Monats-Längen), so dass ich nicht stören; Wochen ist einfach (Wochen unberührt Schaltjahr überlegungen, so können wir nur Division durch 7).

    Ich auch viele Fortschritte gemacht, auf diese Weise mit base Funktionalitäten, aber a) war es ganz hässlich (muss eine nicht-lineare transformation 0-1460 vermeiden Sie verschachtelte ifelse Aussagen, etc.) und b) das Ende einer for-Schleife (in form von apply über die gesamte Liste von Daten) unumgänglich war, also beschloss ich, das würde die Dinge verlangsamen viel. (die transformation ist x1 = (unclass(birthdays) - 59) %% 1461; x2 = x1 * (729 - x1) /402232 + x1 für die Nachwelt)

    Die ich Hinzugefügt habe, diese Funktion zu mein Paket.

    *(für Termine reicht, wenn nicht-Sprung Jahrhunderten nicht von Belang; ich glaube, dass die Erweiterung um solche Daten sollte nicht allzu aufwändig, jedoch)

    Für mich scheint die einzige Lösung, die funktioniert. Nice job!

    InformationsquelleAutor MichaelChirico

  4. 4

    Ich im Begriff war, zu verlassen, dies in den Kommentaren, aber ich denke, es ist würdig eines separaten Antwort. @Molx Punkte, die "arithmetische Methode" ist nicht so einfach wie es scheint-werfen Sie einen Blick auf den code für -.Date was am wichtigsten ist:

    return(difftime(e1, e2, units = "days"))

    So, der "arithmetische Methode", die auf Objekte der Klasse Date ist wirklich ein wrapper für die difftime Funktion. Was difftime? Auch dies hat eine Reihe von overhead, wenn das, was man nach der raw-Geschwindigkeit.

    Der Schlüssel ist, dass Date Objekte gespeichert sind als integer-Zahl der Tage seit/bis Jan. 1, 1970 (obwohl Sie eigentlich nicht so gespeichert, wie Sie integer, daher die Geburt der IDate Klasse data.table), so können wir nur subtrahieren diese und mit ihm getan werden, aber zu vermeiden, die -.Date - Methode aufgerufen wird, müssen wir unclass unsere Eingänge:

    (unclass(birthdate) - unclass(givendate)) / 365.25

    So weit wie bang für Ihre buck geht, dieser Ansatz ist noch mehrere Größenordnungen schneller als auch @Jim age Methode.

    Hier sind einige mehr skaliert-up test data:

    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))

    (ohne eeptools denn es ist fast unmöglich, langsamer--ein Blick auf den code für age_calc schlägt der code geht so weit, erstellen Sie eine Abfolge von Terminen für jedes paar von Daten (O(n^2)-ish), nicht zu vergessen würzen von 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

    Damit betonen wir auch die Torheit des benchmarking auf der small-scale-Daten.

    Den großen Preis von @Jim Methode ist, daß as.POSIXlt ist immer teurer als Ihre Vektoren wachsen.

    Das Problem der Ungenauigkeit bleibt, aber es sei denn, diese Genauigkeit ist von größter Bedeutung, es scheint, die unclass Methode ist beispiellos.

    InformationsquelleAutor MichaelChirico

Schreibe einen Kommentar