Для каждой даты, как рассчитать дни до / с того момента (так называемые опережающие / отставания) ближайшего периода оплаты? - PullRequest
Новая
       14

Для каждой даты, как рассчитать дни до / с того момента (так называемые опережающие / отставания) ближайшего периода оплаты?

1 голос
/ 14 мая 2019

У меня есть диапазон date с, как показано ниже. Две из этих дат payDay. Для каждой даты, которая составляет 3 дня до и после дня выплаты жалованья, я хочу вернуть количество дней, предшествовавших payDay.

Ниже whatIHave иллюстрирует мои данные, а whatIWant показывает результат. Я хотел бы сделать это в dplyr. Любая помощь будет принята с благодарностью. Спасибо. 

whatIHave <- data.frame(
  date = seq(as.Date("2019/11/01"), as.Date("2019/12/01"), "days"),
  payDay = c(0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0))

whatIWant <- data.frame(
  date = seq(as.Date("2019/11/01"), as.Date("2019/12/01"), "days"),
  payDay = c(0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0),
  payDayLag = c(0,0,0,0,0,0,0,0,0,-3,-2,-1,0,1,2,3,0,0,0,0,0,-3,-2,-1,0,1,2,3,0,0,0))

1 Ответ

1 голос
/ 14 мая 2019

Можно указать строки, в которых payDay равен 1

. 
library(data.table)
library(dplyr)
ind <- which(whatIHave$payDay == 1)

Создать последовательность индекса строки на основе 'ind' 

v1 <- unlist(lapply(ind, function(i) (i-3):(i+3)))

Затем, используя переменную группировки на основе логического вектора, созданного путем проверки 'v1' %in% последовательности строк (row_number()), создайте 'payDayLag', вычтя row_number() из индекса строки, где PayDay составляет 1 

whatIHave %>% 
  group_by(group =  rleid(row_number() %in% v1)) %>% 
  mutate(payDayLag = if(all(payDay == 0)) 0 
         else row_number() - row_number()[payDay==1])  %>%
  ungroup %>%
  select(-group)
# A tibble: 31 x 3
#   date       payDay payDayLag
#   <date>      <dbl>     <dbl>
# 1 2019-11-01      0         0
# 2 2019-11-02      0         0
# 3 2019-11-03      0         0
# 4 2019-11-04      0         0
# 5 2019-11-05      0         0
# 6 2019-11-06      0         0
# 7 2019-11-07      0         0
# 8 2019-11-08      0         0
# 9 2019-11-09      0         0
#10 2019-11-10      0        -3
# … with 21 more rows

Если мы хотим это в одной цепочке 

library(tidyverse)
whatIHave %>%
    mutate(ind = row_number() * payDay) %>% 
    filter(payDay == 1) %>% 
    mutate(ind = map(ind, ~ (.x-3):(.x+3))) %>% 
    group_by(grp = row_number()) %>%
    unnest %>% 
    mutate(payDayLag =  row_number() - row_number()[4]) %>% 
    ungroup %>% 
    select(-payDay, -grp, -date) %>% 
    right_join(whatIHave %>%
                   mutate(ind = row_number()))  %>%
    mutate(payDayLag = replace_na(payDayLag, 0))

или без объединения 

whatIHave %>%
   mutate(ind =  list(map(which(payDay == 1), ~  (.x -3):(.x + 3)))) %>%
   group_by(grp = rleid(row_number() %in% unlist(ind[[1]]) )) %>%
   select(-ind) %>% 
   mutate(payDayLag = if(all(payDay == 0)) 0 
         else row_number() - row_number()[payDay == 1]) %>%
   ungroup %>%
   select(-grp)
...