Как сравнить все значения со следующими, используя group_by в R - PullRequest
0 голосов
/ 23 января 2019

У меня есть фрейм данных с датами, которые я хотел бы сравнить с помощью group_by, но мне нужно сравнить их со ВСЕМИ другими датами в их группе, чтобы создать маршрут без пропусков или перекрытий, чтобы я мог получить только максимальное значениедата и минимальная дата начала для каждого идентификатора, воспроизводимый пример:

ID <- c(1,1,1,3,3,7,7,7,22,22,32,32,173,173,213,213,230,330,330,330,330,150579)
EndDate <- c("9999-12-31","2018-04-30","2015-07-31","9999-12-31","2008-07-26","9999-12-31","9999-12-31","2011-08-31","9999-12-31","2006-11-30","9999-12-31","2007-06-30","9999-12-31","2010-09-30","9999-12-31","2013-04-30","9999-12-31","9999-12-31","2016-12-31","2016-09-30","2015-08-31","9999-12-31")
BegDate <- c("2015-08-01","2017-10-23","1983-12-05","2015-11-12","2003-02-24","2017-04-01","2014-07-15","1991-11-04","2006-12-01","1979-08-01","2007-07-01","1979-08-01","2010-10-01","1987-04-01","1980-10-20","2008-05-01","1983-02-14","1982-01-01","2016-10-01","2015-09-01","2014-02-01","1982-09-01")

df_dates <- data.frame(ID,EndDate,BegDate)

ID       EndDate       BegDate
1        9999-12-31    2015-08-01
1        2018-04-30    2017-10-23
1        2015-07-31    1983-12-05
3        9999-12-31    2015-11-12
3        9999-12-31    2015-11-12
7        9999-12-31    2017-04-01
7        9999-12-31    2014-07-15
7        2011-08-31    1991-11-04
22       9999-12-31    2006-12-01
22       2006-11-30    1979-08-01
32       9999-12-31    2007-07-01
32       2007-06-30    1979-08-01
173      9999-12-31    2010-10-01
173      2010-09-30    1987-04-01
213      9999-12-31    1980-10-20
213      2013-04-30    2008-05-01
233      9999-12-31    2016-06-01
233      2016-05-31    1998-10-01
330      9999-12-31    1982-01-01
330      2016-12-31    2016-10-01
330      2016-09-30    2015-09-01
330      2015-08-31    2014-02-01
150579   9999-12-31    1982-09-01

Я пробовал dplyr, но не знаю, как сделать сравнение между ВСЕМИ элементами группы.Я использовал цикл for, но фрейм данных огромен, и скорость необходима.

v_result <- c()

for(i in unique(df_dates$ID)){
   df_temp <- df_dates[df_dates$ID == i,]

   df_temp$EndDate <- as.Date(df_temp$EndDate,"%Y%m%d")
   df_temp$BegDate <- as.Date(df_temp$BegDate,"%Y%m%d")

   v_row <- (1:nrow(df_temp))

   for (j in v_row){
      h = j + 1
      elm <- v_row[!v_row %in% j]
      findNext <- FALSE

      for(h in elm){
        if((df_temp$EndDate[j] >= df_temp$EndDate[h] AND 
            df_temp$BegDate[j] <= df_temp$BegDate[h]) |
            df_temp$BegDate[j] - days(1) == df_temp$EndDate[h]){
              findNext <- TRUE
         }
      }
   v_result <- c(v_result,findNext) 
   } 
}

Как вы можете видеть, много циклов for, и я не понимаю семейство функций applyочень хорошо, плюс, вероятно, есть более 150 тыс. идентификаторов, так что это нереальный вариант.Моя идея состояла в том, чтобы пометить как ложные перекрывающиеся и те, которые представляют пробел, и отфильтровать их, что позволило мне взять максимум и минимум

df_final <- df_final%>%
   group_by(ID)%>%
   mutate(
    Biggest = max(EndDate),
    Lowest = min(BegDate)
   )

, генерируя что-то вроде этого:

ID       EndDate       BegDate
1        9999-12-31    1983-12-05
3        9999-12-31    2015-11-12
7        9999-12-31    2014-07-15
22       9999-12-31    1979-08-01
32       9999-12-31    1979-08-01
173      9999-12-31    2017-07-01
213      9999-12-31    1980-10-20
233      9999-12-31    1998-10-01
330      9999-12-31    1982-01-01
150579   9999-12-31    1982-09-01

Дата окончания не всегда может быть 9999-12-31, поскольку это самая большая дата по идентификатору, соответствующая периоду без пропусков и игнорирующим перекрытия.Я боролся с этим уже несколько дней и не могу добиться прогресса.

Есть ли способ сделать это с помощью dplyr, который эффективен для больших фреймов данных?

Ответы [ 3 ]

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

Логика вашего окончательного вывода не совсем ясна.Например, давайте сделаем что-нибудь с data.table (должно быть эффективно для больших фреймов данных) и magrittr (для лучшей читаемости):

library(data.table)
library(magrittr)

calc_cummax <- function(x) (setattr(cummax(unclass(x)), "class", c("Date", "IDate")))

df_final <- setDT(df_dates) %>%
  .[, `:=` (BegDate = as.Date(as.character(BegDate), "%Y-%m-%d"),
            EndDate = as.Date(as.character(EndDate), "%Y-%m-%d"))] %>%
  .[order(ID, BegDate),] %>%
  .[, max_until_now := shift(calc_cummax(EndDate)), by = ID] %>%
  .[, lead_max := shift(max_until_now, type = "lead"), by = ID] %>%
  .[is.na(max_until_now), max_until_now := lead_max, by = ID] %>%
  .[(max_until_now + 1L) >= BegDate, gap_between := 0, by = ID] %>% 
  .[(max_until_now + 1L) < BegDate, gap_between := 1, by = ID] %>%
  .[is.na(gap_between), gap_between := 0] %>% 
  .[, ("fakeidx") := cumsum(gap_between), by = ID] %>%
  .[, .(BegDate = min(BegDate), EndDate = max(EndDate)), by = .(ID, fakeidx)] %>% 
  #.[, .SD[.N], by = ID] %>%
  .[, ("fakeidx") := NULL]

Вывод здесь:

        ID    BegDate    EndDate
 1:      1 1983-12-05 9999-12-31
 2:      3 2003-02-24 2008-07-26
 3:      3 2015-11-12 9999-12-31
 4:      7 1991-11-04 2011-08-31
 5:      7 2014-07-15 9999-12-31
 6:     22 1979-08-01 9999-12-31
 7:     32 1979-08-01 9999-12-31
 8:    173 1987-04-01 9999-12-31
 9:    213 1980-10-20 9999-12-31
10:    230 1983-02-14 9999-12-31
11:    330 1982-01-01 9999-12-31
12: 150579 1982-09-01 9999-12-31

Если вы посмотрите на 2-й и 4-й ряд, вы увидите, что, по вашему мнению, их там быть не должно.

Однако между ними существует разрыв, поэтому мы не можем просто взять самое низкое BegDate, и нам нужно перейти к этому шагу, чтобы получить ваш окончательный результат.

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

library(data.table)
library(magrittr)

calc_cummax <- function(x) (setattr(cummax(unclass(x)), "class", c("Date", "IDate")))

df_final <- setDT(df_dates) %>%
  .[, `:=` (BegDate = as.Date(as.character(BegDate), "%Y-%m-%d"),
            EndDate = as.Date(as.character(EndDate), "%Y-%m-%d"))] %>%
  .[order(ID, BegDate),] %>%
  .[, max_until_now := shift(calc_cummax(EndDate)), by = ID] %>%
  .[, lead_max := shift(max_until_now, type = "lead"), by = ID] %>%
  .[is.na(max_until_now), max_until_now := lead_max, by = ID] %>%
  .[(max_until_now + 1L) >= BegDate, gap_between := 0, by = ID] %>% 
  .[(max_until_now + 1L) < BegDate, gap_between := 1, by = ID] %>%
  .[is.na(gap_between), gap_between := 0] %>% 
  .[, ("fakeidx") := cumsum(gap_between), by = ID] %>%
  .[, .(BegDate = min(BegDate), EndDate = max(EndDate)), by = .(ID, fakeidx)] %>% 
  .[, .SD[.N], by = ID] %>%
  .[, ("fakeidx") := NULL]

Производя:

        ID    BegDate    EndDate
 1:      1 1983-12-05 9999-12-31
 2:      3 2015-11-12 9999-12-31
 3:      7 2014-07-15 9999-12-31
 4:     22 1979-08-01 9999-12-31
 5:     32 1979-08-01 9999-12-31
 6:    173 1987-04-01 9999-12-31
 7:    213 1980-10-20 9999-12-31
 8:    230 1983-02-14 9999-12-31
 9:    330 1982-01-01 9999-12-31
10: 150579 1982-09-01 9999-12-31
0 голосов
/ 23 января 2019

Без фильтра:

 df_dates %>% unique(by="ID") %>% mutate(EndDate=ymd(EndDate), BegDate=ymd(BegDate)) %>% group_by(ID) %>% summarize(max(EndDate), min(BegDate))

С фильтром перед group_by (как в цикле for).Обратите внимание на использование ведущей функции для сравнения одной даты с датой следующей строки.

df_dates %>% unique(by="ID") %>% mutate(EndDate=ymd(EndDate), BegDate=ymd(BegDate)) %>% filter(EndDate >= lead(EndDate) & BegDate <= lead(BegDate) | BegDate-1 == lead(EndDate) ) %>% group_by(ID) %>% summarize(max(EndDate), min(BegDate))

С фильтром после group_by (поскольку намерение не очень ясно из вашего примера)

df_dates %>% unique(by="ID") %>% mutate(EndDate=ymd(EndDate), BegDate=ymd(BegDate)) %>%  group_by(ID) %>% filter(EndDate >= lead(EndDate) & BegDate <= lead(BegDate) | BegDate-1 == lead(EndDate) )  %>% summarize(max(EndDate), min(BegDate))
0 голосов
/ 23 января 2019

Начиная с вашего кода для создания кадра данных df_dates выше, следующий код создаст таблицу внизу:

df_dates <- data.frame(ID,EndDate,BegDate)

df_dates %>%
  mutate(EndDate=as.Date(EndDate, "%Y-%m-%d"),      #Your as.Date calls above didn't include
         BegDate=as.Date(BegDate, "%Y-%m-%d")) %>%  #the '-' character between values
  group_by(ID) %>%
  summarise(                                        #using 'summarise' produces one row per
    Biggest = max(EndDate),                         #grouped 'ID'. 'mutate' keeps all rows.
    Lowest = min(BegDate)
  )

Надеюсь, это поможет в том, как dplyr даст вам ожидаемые результаты?

...