Groupes d'âge en tranches mensuelles

J'ai du mal à trouver une solution au problème suivant. J'ai un df avec id / dob's et un autre monthbucket df comme suit

microbenchmark::microbenchmark(
  MM=  monthbucket %>% group_by_all %>% expand(id=df$id) %>%  left_join(.,{df %>% mutate(birth_month =cut(dob, "month"))},by="id") %>%  mutate(age=time_length(difftime(startmonth, birth_month),"years")) %>% 
    mutate(age_cat=case_when(age<19 ~ "<19", age>64 ~ ">64",TRUE ~ "19-64")) %>%  group_by(month) %>% count(age_cat) %>%  gather(variable, count, n) %>%
    unite(variable, age_cat) %>% spread(variable, count)
  ,
  AkselA = {ages <- as.data.frame(t(unclass(outer(monthbucket$startmonth, df$dob, "-")/365.25)))
  ages <- do.call(data.frame, lapply(ages, cut, c(0, 19, 64, Inf), c("0-19", "19-64", "64+")))
  ages <- sapply(ages, table)
  colnames(ages) <- monthbucket$month
  },
  Cole1 ={t(table(apply(X = outer(month_bucket, birth_days, `-`) / 365.25, MARGIN = 2, FUN = cut, c(0,19,65, Inf)), rep(format(month_bucket,'%Y-%m'), length(birth_days))))
   },
  # cole2={ cast(CJ(month_bucket, birth_days)[, .N, by = .(month_bucket , cut(as.numeric(month_bucket - birth_days)/365.25, c(0,19,65,Inf)))], month_bucket ~ cut, value.var = 'N')
  # },
  # 
  Cole3={crossing(month_bucket, birth_days)%>%count(month_bucket, age_range = cut(as.numeric(month_bucket - birth_days) / 365.25, c(0,19,65,Inf)))%>%spread(age_range, n)
  },

  Cole4={all_combos <- expand.grid(month_bucket =  month_bucket, birth_days = birth_days) 
  all_combos$age <- as.numeric(all_combos$month_bucket - all_combos$birth_days) / 365.25
  all_combos$cut_r <- cut(all_combos$age, c(0,19,65,Inf))
  reshape(data = aggregate( all_combos$month_bucket, by = list(bucket = all_combos$month_bucket,age_group = all_combos$cut_r), FUN = length), timevar = 'age_group' , idvar = 'bucket', direction = 'wide'  )
},
times = 1L)

Unit: milliseconds
   expr        min         lq       mean     median         uq        max neval
     MM 4249.02810 4249.02810 4249.02810 4249.02810 4249.02810 4249.02810     1
 AkselA   17.12697   17.12697   17.12697   17.12697   17.12697   17.12697     1
  Cole1 3237.94534 3237.94534 3237.94534 3237.94534 3237.94534 3237.94534     1
  Cole3   23.63945   23.63945   23.63945   23.63945   23.63945   23.63945     1
  Cole4  877.92782  877.92782  877.92782  877.92782  877.92782  877.92782     1

Je veux obtenir une sortie qui me donne le nombre de membres dans les groupes d'âge ( 64) pour chacun de mes buckets mensuels. Le décompte change évidemment selon l'année lorsque les gens ont des anniversaires.

J'ai obtenu le calcul de l'âge avec quelque chose comme:

set.seed(33)

df <- data.frame(dob = sample(seq(as.Date('1940/01/01'), as.Date('2010/01/01'), by="day"), 10000),
                 id = seq(1:10000) )


monthbucket <- data.frame(month = format(seq(as.Date("2010-01-01"),as.Date("2011-01-01"),by="months"),'%Y-%m'),
                          startmonth = seq(as.Date("2010-01-01"),as.Date("2011-01-01"),by="months"),
                          endmonth = seq(as.Date("2010-02-01"),as.Date("2011-02-01"),by="months")-1)


birth_days <- df$dob
month_bucket <- monthbucket$startmonth

Je suppose que l'approche générale serait pour calculer l'âge de chaque moisbucket, attribuez-le à l'une des 3 tranches d'âge et comptez-le par mois. Des suggestions?

MODIFIER 1.

Merci pour toutes les différentes approches, je viens d'exécuter un bref benchmark sur les solutions pour déterminer quelle réponse accepter. D'une manière ou d'une autre, la solution de table de données n'a pas fonctionné sur mon ensemble de données de test, mais je vérifierai dès que j'aurai quelques minutes dans les prochains jours.

age.fct <- function(dob, bucketdate) {

  period <- as.period(interval(dob, bucketdate),unit = "year")
  period$year}

et le benchmark

set.seed(33)

df <- data.frame(dob = sample(seq(as.Date('1940/01/01'), as.Date('2010/01/01'), by="day"), 10),
                 id = seq(1:10) )


monthbucket <- data.frame(month = format(seq(as.Date("2010-01-01"),as.Date("2011-01-01"),by="months"),'%Y-%m'),
                          startmonth = seq(as.Date("2010-01-01"),as.Date("2011-01-01"),by="months"),
                          endmonth = seq(as.Date("2010-02-01"),as.Date("2011-02-01"),by="months")-1)

Basé sur la vitesse, l'approche d'AkselA semble être la plus rapide mais j'obtiens un résultat différent pour l'approche de MM par rapport à tous les autres (une fois que AkselA passe à 65 dans la partie coupée cut, c (0, 19, 64, Inf) .. . J'accepterai la réponse en fonction de la vitesse mais je regarderai les différences dans les résultats!