Фильтрация наблюдений по конкретному условию даты с использованием data.table - PullRequest
Новая
       6

Фильтрация наблюдений по конкретному условию даты с использованием data.table

3 голосов
/ 22 июня 2019

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

Итак, если пользователь предпринял это действие для "2018-01-01", "2018-03-01" и«2018-07-01», я хочу оставить только «2018-01-01» и «2018-07-01».

Аналогично, если пользователь предпринял действие по «2018-01»-01 "," 2018-03-01 "," 2018-07-01 "и" 2019-03-01 "Я хочу оставить только" 2018-01-01 "," 2018-07-01 "," 2019-03-01 ".

До сих пор я создал длинный и неработающий код. 

# What I want to achieve
library(data.table)

dataIhave <- data.table(id    = c(1, 1, 1, 1, 2, 2, 3, 4), 
                        dates = c("2018-01-01", 
                                  "2018-03-01",
                                  "2018-07-01",
                                  "2019-01-01",
                                  "2018-01-03", 
                                  "2018-07-02", 
                                  "2018-02-01",
                                  "2018-02-01"))

dataIwant <- data.table(id    = c(1, 1, 1, 2, 3, 4), 
                        dates = c("2018-01-01", 
                                  "2018-07-01",
                                  "2019-01-01",
                                  "2018-01-01", 
                                  "2018-02-01",
                                  "2018-02-01"))

Ответы [ 5 ]

6 голосов
/ 22 июня 2019

Это вариант с повторяющимся соединением ответа @ Уве: 

library(lubridate)
dataIhave[, dates := as.IDate(dates)]

ids = unique(dataIhave$id)

dataIhave[, seq := NA_integer_]
s = 1L
w = dataIhave[.(ids), on=.(id), mult="first", which = TRUE]
dataIhave[w, seq := s]
while (TRUE){
  w = dataIhave[
    dataIhave[w, .(id, dates = dates %m+% months(6))], 
    on = .(id, dates), roll = -Inf, nomatch = 0, which = TRUE
  ]

  if (!length(w)) break
  s = s + 1L
  dataIhave[w, seq := s]
}

dataIhave[!is.na(seq)]

   id      dates seq
1:  1 2018-01-01   1
2:  1 2018-07-01   2
3:  1 2019-01-01   3
4:  2 2018-01-03   1
5:  3 2018-02-01   1
6:  4 2018-02-01   1

Цикл принимает строки w, определенные для id, переводит их dates на шесть месяцев вперед и принимает следующую найденную строку, если таковая имеется. Аргументы для объединения:

  • Таблицы с синтаксисом объединения x[i, ...]
    • x = dataIhave
    • i = dataIhave[w, .(id, dates = dates %m+% months(6))]
  • on = .(id, date): столбцы для сопоставления по
  • roll = -Inf: найти следующее совпадение в последнем столбце в on=
  • nomatch = 0: если совпадений не найдено, пропустить
  • which = TRUE: возвращаемый совпадающий номер строки

Кроме того, если есть повторяющиеся даты (см. Второй пример в посте @ Uwe):

  • mult = "first": принять только первое совпадение для каждой строки i

При выборе первой строки с помощью id перед циклом я предполагаю, что данные сортируются по dates в пределах id (поэтому я не использую order, как это делает ответ @ Уве).

3 голосов
/ 22 июня 2019

Если я правильно понимаю, ОП хочет отбросить те даты, которые находятся на расстоянии менее шести месяцев от начала периода, и начать новый период с первой даты, которая находится на расстоянии более 6 месяцев от начала предыдущего период (отдельно для каждого id).

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

library(data.table)
library(lubridate)
dataIhave[, dates := as.Date(dates)]
dataIhave[, keep := TRUE]
dataIhave[order(id, dates)
  , keep := {
    start <- dates[1L]
    for (i in tail(seq_along(dates), -1L)) {
      if (dates[i] < start %m+% months(6)) {
        keep[i] <- FALSE
      } else {
        start <- dates[i]
      }
    }
    keep
  }, by = id][]

   id      dates  keep
1:  1 2018-01-01  TRUE
2:  1 2018-03-01 FALSE
3:  1 2018-07-01  TRUE
4:  1 2019-01-01  TRUE
5:  2 2018-01-03  TRUE
6:  2 2018-07-02 FALSE
7:  3 2018-02-01  TRUE
8:  4 2018-02-01  TRUE

Наконец, 

dataIhave[(keep), -"keep"]

   id      dates
1:  1 2018-01-01
2:  1 2018-07-01
3:  1 2019-01-01
4:  2 2018-01-03
5:  3 2018-02-01
6:  4 2018-02-01

2-й контрольный пример

Важнейшим моментом здесь является обнаружение начала нового периода (в пределах каждого id).

В качестве дополнительного контрольного примера я добавил две даты к id == 1, 2018-07-01 и 2018-07-02.
2018-07-01 является дубликатом. Обе даты должны быть удалены, поскольку они лежат в течение второго 6-месячного периода, начиная с 2018-07-01. 

dataIhave <- fread("
 id      dates
  1 2018-01-01
  1 2018-03-01
  1 2018-07-01
  1 2018-07-01
  1 2018-07-02
  1 2019-01-01
  2 2018-01-03
  2 2018-07-02
  3 2018-02-01
  4 2018-02-01")

Действительно, приведенный выше код возвращает тот же вывод, что и в исходном тестовом примере OP.

Удалить строки только в течение первых шести месяцев для каждого id

Если , вопрос интерпретируется только для удаления записей в течение первого 6-месячного периода для каждого id и сохранения всей даты через 6 месяцев, что может быть достигнуто с помощью 

dataIhave[!dataIhave[, .I[dates < dates[1L] %m+% months(6L)][-1L], by = id]$V1]

, который возвращает 

   id      dates
1:  1 2018-01-01
2:  1 2018-07-01
3:  1 2018-07-01
4:  1 2018-07-02
5:  1 2019-01-01
6:  2 2018-01-03
7:  3 2018-02-01
8:  4 2018-02-01

для второго контрольного примера. (Обратите внимание, что это упрощенная версия ответа Jaap .)

2 голосов
/ 22 июня 2019

Другой вариант: 

library(lubridate)
library(data.table)

dataIhave[, dates := as.Date(dates)]

dataIhave[, keep := dates >= dates[1] %m+% months(6), by = id
          ][dataIhave[, .I[1], by = id][[2]], keep := TRUE
            ][!!keep, -"keep"]

, что дает: 

   id      dates
1:  1 2018-01-01
2:  1 2018-07-01
3:  1 2019-01-01
4:  2 2018-01-03
5:  3 2018-02-01
6:  4 2018-02-01
1 голос
/ 27 июня 2019

Использование non-equi join и igraph для избежания неявных циклов и рекурсии: 

#data prep
dataIhave[, dates := as.IDate(dates, format="%Y-%m-%d")]
setorder(dataIhave[, rn:=rowid(id)], id, dates)
dataIhave[, end := as.IDate(sapply(dates, 
    function(d) seq(d, by="6 months", length.out=2L)[2L]))]

#non-equi self join to find first date that is after 6months
nonequi <- dataIhave[dataIhave, on=.(id, dates>=end), mult="first", by=.EACHI,
    .(i.id, i.rn, x.rn, i.dates, x.dates)]

library(igraph)
nonequi[, {
        #create graph from the previous join
        g <- graph_from_data_frame(.SD[, .(i.rn, x.rn)])
        #plot(g)

        #find the leaf nodes
        leaf <- sapply(V(g), function(x) length(neighbors(g,x))==0L)

        #from the first date (i.e. node = V(g)["1"]), find the path starting from this date.
        path <- get.all.shortest.paths(g, V(g)["1"], leaf)$res

        #return all dates (i.e. nodes) in this path
        .(dates=i.dates[i.rn %in% na.omit(V(g)[path[[1L]]]$name)])
    },
    by=.(id=i.id)]

output: 

   id      dates
1:  1 2018-01-01
2:  1 2018-07-01
3:  1 2019-01-01
4:  2 2018-01-03
5:  3 2018-02-01
6:  4 2018-02-01

Или рекурсивный подход, аналогичный решению Uwe: 

dataIhave[, dates := as.IDate(dates, format="%Y-%m-%d")]
unique(dataIhave[,
    .(dates=as.IDate(Reduce(
        function(x, y) if (y >= seq(x, by="6 months", length.out=2L)[2L]) y else x,
        dates,
        accumulate=TRUE))),
    .(id)])

вывод: 

   id      dates
1:  1 2018-01-01
2:  1 2018-07-01
3:  1 2019-01-01
4:  2 2018-01-03
5:  3 2018-02-01
6:  4 2018-02-01
0 голосов
/ 22 июня 2019 
library(lubridate)
library(data.table)

dataiHave[, dates := ymd(dates)]
dataiHave[, difDates := as.numeric(difftime(dates, units = "weeks"))]

dataIHave[difDates >= 24, .(id, dates)]

Это дает желаемый результат?

Месяцы имеют нерегулярную продолжительность, поэтому вам придется придерживаться единицы времени фиксированной продолжительности.

Вы также можете проверить ?lubridate::interval, lubridate::as. duration и этот вопрос: Разница во времени с годами с lubridate?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...