Протестируйте несколько условий для классификации и подсчета

Question

Я новичок в R и кодировании в целом. У меня есть большой набор данных, но вот образец. Для каждого месяца каждого года каждый case_number должен быть классифицирован как РЕБЕНОК или ВЗРОСЛЫЙ и подсчитан. Номер дела может повторяться через месяц, но каждый case_number может учитываться только один раз в месяц. ad, cs и em - это векторы, которые включают служебные коды.

Конечный результат, который мне нужно сгенерировать, имеет следующие столбцы: YEAR, MONTH, ADULT_COUNT, CHILD_COUNT. Case_number будет учитываться в каждом месяце в соответствии со следующими правилами:

1. Если МВЗ только в объявлении, то ВЗРОСЛЫМ.
2. Если МВЗ только в CS, тогда РЕБЕНОК.
3. Если МВЗ только в em, то ADULT, если age_at_service> 21, иначе CHILD
4. Если МВЗ в объявлении и em, тогда ADULT
5. Если МВЗ в cs и em, то CHILD
6. Если МВЗ в CS и объявлении, см. Первый экземпляр в месяце. Если это в cs = CHILD, иначе ADULT

# create sample dataset
case_number <- c(1,1,1,1,2,2,3,4,4,4,5,5)
age_at_service <- c(20,20,20,20,34,34,15,45,45,45,24,24)
cost_center <- c(4000,4121,2000,2000,4000,121,2000,2121,4000,121,121,121)
year <- c(2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019)
month <- c(1,1,1,1,2,1,1,1,1,1,2,2)
date <- c('1/12/2019','1/11/2019','1/8/2019','1/1/2019','2/3/2019'
          ,'1/7/2019','1/4/2019','1/23/2019','1/12/2019','1/3/2019','2/12/2019','2/14/2019')
date <- as.Date(date,format = '%m/%d/%Y')

tb <- tibble(case_number, age_at_service, cost_center, month, year, date)
# service codes
ad <- c(4000,4121)
cs <- c(2000,2121)
em <- (121)

В приведенных выше примерах данных результаты будут:

>  YEAR  MONTH  ADULT  CHILD    
>  2019    1      2      2
>  2019    2      2      0

У меня есть создал более простой c код, но я не уверен, с чего начать для этой задачи. Любое направление ценится.

Answer 1

Если условие основано на 'age_at_service, то мы создаем столбец' grp 'на основе ограничения по возрасту, получаем строки distinct на основе' case_number ',' year ',' month ',' grp ', count частота и изменение слишком «широкого» формата с помощью pivot_wider

library(dplyr)
library(tidyr)
tb %>% 
   mutate(grp = case_when(age_at_service > 21 ~ "ADULT", TRUE ~ "CHILD")) %>%
   distinct(case_number, year, month, grp) %>%
   count(year, month, grp) %>% 
   pivot_wider(names_from = grp, values_from = n, values_fill = list(n = 0))
# A tibble: 2 x 4
#    year month ADULT CHILD
#  <dbl> <dbl> <int> <int>
#1  2019     1     2     2
#2  2019     2     2     0

---

Или если мы рассмотрим использование полного списка условий на основе векторов 'ad', 'cs ',' em ', поместите их в list, преобразуйте в столбец с двумя столбцами, затем выполните объединение с помощью' tb ', arrange строк на основе' year ',' month ',' case_number ',' date ', после группировки по годам, месяцам, cost_center, создайте столбец grp на основе условий и затем сделайте то же самое, что и в приведенном выше примере, например distinct/count/pivot_wider

library(purrr)
library(tibble)
lst(ad, cs, em) %>%
     enframe(value = "cost_center") %>% 
     unnest(c(cost_center)) %>% 
     right_join(tb) %>%
     arrange(year, month, case_number, date) %>% 
     group_by(year, month, case_number) %>% 
     mutate(grp = case_when(n_distinct(name) == 1 && name == 'ad'
           ~ 'ADULT', 
       n_distinct(name) == 1 && name == 'cs' ~ 'CHILD',
       n_distinct(name) == 1 && name  == 'em' & age_at_service > 21 ~ 'ADULT',
        all(c('ad', 'em') %in% name) ~ 'ADULT',
        all(c('cs', 'em') %in% name) ~ 'CHILD',
        all(c('cs', 'ad') %in% name) && first(name)=='cs' ~ 'CHILD',
        all(c('cs', 'ad') %in% name) && first(name) != 'cs' ~ 'ADULT',
        TRUE ~ NA_character_)) %>% 
        ungroup %>% 
        distinct(case_number, year, month, grp) %>%
        count(year, month, grp) %>% 
        pivot_wider(names_from = grp, values_from = n, values_fill = list(n = 0))
# A tibble: 2 x 4
#   year month ADULT CHILD
#  <dbl> <dbl> <int> <int>
#1  2019     1     2     2
#2  2019     2     2     0