Итерации по датам по группам в R с использованием циклов FOR - PullRequest
1 голос
/ 19 января 2020

Я пытаюсь заполнить «FinalDate» на основе «ExpectedDate» и «ObservedDate».

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

Как изменить код ниже, чтобы убедиться, что:

  • FinalDate заполнено в Группе
  • Номера итераций не пропускают ни одной строки
set.seed(2)
dat<-data.frame(Group=sample(LETTERS[1:10], 100, replace=TRUE), 
                Date=sample(seq(as.Date('2013/01/01'), as.Date('2020/01/01'), by="day"), 100))%>%
  mutate(ExpectedDate=Date+sample(10:200, 100, replace=TRUE),
         ObservedDate=Date+sample(10:200, 100, replace=TRUE))%>%
           group_by(Group)%>%
           arrange(Date)%>%
           mutate(n=row_number())%>%arrange(Group)%>%ungroup()%>%
  as.data.frame()

#generate some missing values in "ObservedDate"
dat[sample(nrow(dat),20), "ObservedDate"]<-NA

dat$FinalDate<-NA
for (i in 1:nrow(dat)){
  dat[i, "FinalDate"]<-if_else(!is.na(dat$"ObservedDate")[i] && 
                                 dat[i, "ObservedDate"] > dat[i-1, "ExpectedDate"] && 
                                 dat[i, "ObservedDate"] < dat[i+1, "ExpectedDate"],
                               dat[i, "ObservedDate"],
                               dat[i,"ExpectedDate"])
}
dat$FinalDate<-as.Date(dat$FinalDate) # convert numeric to Date format

например, в выводе ниже:

при i = 90 код ищет предыдущую ExpectedDate в букве I

, мы хотим, чтобы она искала ExpectedDate только в букве J. Если для группы нет предыдущей ожидаемой даты, а ObservedDate больше, чем ExpectedDate, но меньше, чем следующая ExpectedDate, затем FinalDate должна быть заполнена ExpectedDate.

при i = 100, код генерирует NA, потому что нет следующего доступного наблюдения

, который мы хотим это значение, которое должно быть заполнено таким образом, чтобы для последнего наблюдения в каждой группе FinalDate = ObservedDate, если ObservedDate больше, чем этот последний ExpectedDate в группе, в противном случае ExpectedDate.

    Group       Date ExpectedDate ObservedDate  n  FinalDate
88      I 2015-09-07   2015-12-05         <NA>  7 2015-12-05
89      I 2018-08-02   2018-11-01   2018-08-13  8 2018-11-01
90      J 2013-07-24   2013-08-30   2013-08-12  1 2013-08-30
91      J 2013-11-22   2014-01-02   2014-04-05  2 2014-04-05
92      J 2014-11-03   2015-03-23   2015-05-10  3 2015-05-10
93      J 2015-08-30   2015-12-09   2016-02-04  4 2016-02-04
94      J 2016-04-18   2016-09-03         <NA>  5 2016-09-03
95      J 2016-10-10   2017-01-29   2017-04-14  6 2017-04-14
96      J 2017-02-14   2017-07-05         <NA>  7 2017-07-05
97      J 2017-04-21   2017-10-01   2017-08-26  8 2017-08-26
98      J 2017-10-01   2018-01-27   2018-02-28  9 2018-02-28
99      J 2018-08-03   2019-01-31   2018-10-20 10 2018-10-20
100     J 2019-04-25   2019-06-23   2019-08-16 11       <NA>

1 Ответ

0 голосов
/ 19 января 2020

Мы можем позволить go выключить for l oop и использовать group_by, lag и lead здесь от dplyr:

library(dplyr)

dat %>%
  group_by(Group) %>%
  mutate(FinalDate = if_else(ObservedDate > lag(ExpectedDate) & 
                    ObservedDate < lead(ExpectedDate), ObservedDate, ExpectedDate)) 

Мы можем также сделайте это data.table::between

dat %>%
  group_by(Group) %>%
  mutate(FinalDate = if_else(data.table::between(ObservedDate, 
           lag(ExpectedDate), lead(ExpectedDate)), ObservedDate, ExpectedDate)) 
...