Консолидация нескольких временных интервалов внутри групповой единицы (предпочтительно dplyr или data.table) - PullRequest
2 голосов
/ 11 марта 2019

У меня есть небольшая хитрая проблема с кодированием, на которую я надеялся, что у кого-то может быть решение.

По сути, у меня есть очень большой набор данных о пребывании (идентификаторы лиц, пропуски, выписки),> 10 млн.

library(dplyr)
library(lubridate)

dat <- read.csv(text="
personid, start, end
1, 2017-09-01, 2017-10-01
1, 2017-10-05, 2017-10-07
2, 2017-10-21, 2017-11-01
3, 2017-12-01, 2017-12-15
3, 2017-12-27, 2017-12-31") %>%
  transmute(
    personid,
    start = ymd(start), 
    end = ymd(end))

Каждое пребывание не перекрывается, но у нас есть логическое правилогде, если пребывание происходит в течение 10 дней друг от друга, мы хотим объединить их как единое целое (т.е. оставить более раннее признание и последующее увольнение).Чтобы окончательный набор данных был уникальным, он должен находиться не менее 10 дней друг от друга.

например:

1, 2017-09-01, 2017-10-07
2, 2017-10-21, 2017-11-01
3, 2017-12-01, 2017-12-15
3, 2017-12-27, 2017-12-31

Есть несколько сообщений о перекрывающихся интервалах, но это немного отличается: Объединение набора временных интервалов, цепочек интервалов в один интервал Я думаю, что это слишком сложно по сравнению с тем, что мне нужно.

Я также надеялся на решение dplyr или data.table, хотя оператор group_by занимает довольно много времени.

1 Ответ

2 голосов
/ 11 марта 2019

Одна tidyverse возможность. Сначала мы group_by person_id и создаем новую переменную (diffe), которая имеет разницу в днях между текущим start днем ​​и предыдущим (lag) end днем. Мы группируем каждые person_id и diffe, которые находятся в пределах 10 дней, в одну группу и выбираем first start день и last end день из каждой группы.

library(tidyverse)

dat %>%
  group_by(personid) %>%
  mutate(diffe = as.numeric(start - lag(end))) %>%
  replace_na(list(diffe = 0)) %>%
  group_by(personid, group = cumsum(diffe > 10)) %>%
  summarise(start = first(start), 
            end = last(end)) %>%
  select(-group)


#  personid   start      end       
#     <int>   <date>     <date>    
#1        1 2017-09-01 2017-10-07
#2        2 2017-10-21 2017-11-01
#3        3 2017-12-01 2017-12-15
#4        3 2017-12-27 2017-12-31
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...