Question

我有这个数据框，里面有人来往或离开这个国家的记录。 'date'和'inout'表示一个人是在某个日期前往该国的（'I'）或外（'O'）。 Id = 1于2008-10-06离开该国，并于2009-04-30再次返回。

数据：

df <- data.frame( id=c(1,1,2,2,2,2,3), 
date=c('2008-10-06','2009-04-30', '1999-07-25','2004-02-27','2005-06-09','2013-07-01','2010-09-07'), 
inout = c('O','I','I','O','I','O','I'))

  id       date inout
1  1 2008-10-06     O
2  1 2009-04-30     I
3  2 1999-07-25     I
4  2 2004-02-27     O
5  2 2005-06-09     I
6  2 2013-07-01     O
7  3 2010-09-07     I

我需要一个像这样的新数据框：

   id      start        end destination
1   1 1900-01-01 2008-10-06        home
2   1 2008-10-06 2009-04-30      abroad
3   1 2009-04-30 2017-08-01        home
4   2 1900-01-01 1999-07-25      abroad
5   2 1999-07-25 2004-02-27        home
6   2 2004-02-27 2005-06-09      abroad
7   2 2005-06-09 2013-07-01        home
8   2 2013-07-01 2017-08-01      abroad
9   3 1900-01-01 2010-09-07      abroad
10  3 2010-09-07 2017-08-01        home

每个人的第一次入住以默认日期1900-01-01开始，最后一次入住以当前日期（2017-08-01）结束。在这个数据框架中，Id = 1是从1900-01-01到2008-10-06在国外从2008年10月6日到2009年4月30日回家，再次从2009-04-30到2017-08- 01。

任何人都可以帮助我。如果需要，最好使用dplyr包装。最好的问候

Answer 1

这是我的解决方案。它假定df每次行程有两个连续的行，因此数据集中有偶数行（否则不起作用）。为了测试这一点，我在df添加了一个新行，上面粘贴的行只有7行，因此第四行不完整：

library(dplyr)
library(tidyr)
library(lubridate)

df %>%
  mutate(trips = rep(seq(1, n() / 2), each = 2)) %>%
  group_by(trips) %>%
  spread(inout, date) %>%
  mutate(start = if_else(date(I) < date(O), I, O),
         end = if_else(date(I) < date(O), O, I),
         destination = if_else(date(I) < date(O), 'home', 'abroad')) %>%
  ungroup %>%
  select(-c(trips, I, O))

##      id      start        end destination
##   <chr>     <fctr>     <fctr>       <chr>
## 1     1 2008-10-06 2009-04-30      abroad
## 2     2 1999-07-25 2004-02-27        home
## 3     2 2005-06-09 2013-07-01        home
## 4     3 2010-09-07 2012-03-08        home

Answer 2

Base R.相当凌乱。似乎工作。

do.call(rbind, lapply(split(df, df$id), function(a) {
    cbind(id = rep(a$id, length.out = NROW(a)+1),
          setNames(object = data.frame(do.call(
        rbind, lapply(1:(NROW(a) + 1), function(i)
            c("1970-01-01", as.character(a$date), "2017-08-01")[i:(i + 1)])
    )),
    nm = c("Start", "End")),
    Destination = if (a$inout[1] == "O") {
        rep(x = c("home", "abroad"),
            length.out = NROW(a) + 1)
    } else{
        rep(x = c("abroad", "home"),
            length.out = NROW(a) + 1)
    })
}))
#    id      Start        End Destination
#1.1  1 1970-01-01 2008-10-06        home
#1.2  1 2008-10-06 2009-04-30      abroad
#1.3  1 2009-04-30 2017-08-01        home
#2.1  2 1970-01-01 1999-07-25      abroad
#2.2  2 1999-07-25 2004-02-27        home
#2.3  2 2004-02-27 2005-06-09      abroad
#2.4  2 2005-06-09 2013-07-01        home
#2.5  2 2013-07-01 2017-08-01      abroad
#3.1  3 1970-01-01 2010-09-07      abroad
#3.2  3 2010-09-07 2017-08-01        home

在R中：如何从时间戳创建连续的日期间隔

2 个答案: