如何在R中基于预定义模式对数据进行子集？

Question

我有一个数据集，里面有关于人们在某一段时间里去过的地方的信息--这些数据有三个层次的长格式嵌套。一是人，二是日，三是位置。每一行都表示一个位置。我有信息类型的位置(家庭，工作等)，旅行模式，以到达该地点(步行，自行车，公共汽车等)，以及抵达和离开时间。这是一本每日旅行日记，从家里开始，在家里结束。

我需要聚合数据，以创建关于每天每个人的下列旅行类型的信息：

1. Journey from home to work without detour. (H-W)
2. Journey from home to work with detour. (H-dt-W) the number of detour does not matter. 
3. Journey work to home without detour. (W-H) 
4. Journey work to home with detour. (W-dt-H) the number of detour does not matter
5. Journey starting from home and ending at home and does not include work in between. (H-O..-H)
6. Journey starting from work and ending at work and does not include home in between. (W-O..-W)

对于所有这些类别，我需要信息的旅行模式，和总旅行时间。例如:想象一个星期一；一个人在家里吃早餐，开车去办公室(W)；途中他在星巴克喝杯咖啡，然后从家里接一个同事(D)。在工作的一天里，这个人会去不同的地点拜访一个客户，然后回来工作，这次他会坐火车。然后那个人那天很早就回家了，因为他需要去杂货店。于是，这个人回到家，在地点(F)去杂货店，然后回到家，这一次走到杂货店。该人进行了不同类型的旅行:1) made (C)-W，2)W(E)-W，3)W，5)H(F)-H.他在旅途中使用了不同的方式: 1)开车，2)火车，3)步行。我们还可以使用到达时间和起飞时间来增加每个地点的旅行时间。下面是数据的表格形式。(下面的数据只是一个人的一天，但我的数据有更多的时间和人)。

    ###Data I have
Person   Day ID     Place   Location_Code   Mode    Arrive      Depart
   5        1       0           H           NA      NA          8:00:00 AM
   5        1       1           C           D       8:30:00 AM  9:30:00 AM
   5        1       2           D           D       10:00:00 AM 11:00:00 AM
   5        1       3           W           D       11:30:00 AM 12:00:00 PM
   5        1       4           E           T       1:00:00 PM  1:30:00 PM
   5        1       5           W           T       2:30:00 PM  3:45:00 PM
   5        1       6           H           D       4:00:00 PM  4:30:00 PM
   5        1       7           F           P       5:00:00 PM  6:00:00 PM
   5        1       8           H           P       7:00:00 PM  NA


###Data I want
Person  Day     Journey Type    Mode/s  Travel Time(hr)     
5       1       H-dt-W          DDD         1.5     
5       1       W-O-W           TT          2       
5       1       W-H             D           0.25        
5       1       H-O-H           PP          1.5

我还附上了一个图片的数据，我有和我想要的数据。

Answer 1

下面是使用来自tidyverse、data.table、lubridate和stringr的函数的解决方案。dt6是最后的输出。注意，除了dt6列之外，Journey Type与您想要的输出完全相同，因为我不知道编码的逻辑和方法(比如为什么because是that (C)-W？)。我刚把所有的信息都合并了。您可以根据您的喜好更改编码。

# Load package
library(tidyverse)
library(data.table)
library(lubridate)
library(stringr)

数据准备

# Create example data frame
dt <- read.table(text = "Person   'Day ID'     Place   Location_Code   Mode    Arrive      Depart
5        1       0           H           NA      NA          '8:00:00 AM'
5        1       1           C           D       '8:30:00 AM'  '9:30:00 AM'
5        1       2           D           D       '10:00:00 AM' '11:00:00 AM'
5        1       3           W           D       '11:30:00 AM' '12:00:00 PM'
5        1       4           E           T       '1:00:00 PM'  '1:30:00 PM'
5        1       5           W           T       '2:30:00 PM'  '3:45:00 PM'
5        1       6           H           D       '4:00:00 PM'  '4:30:00 PM'
5        1       7           F           P       '5:00:00 PM'  '6:00:00 PM'
5        1       8           H           P       '7:00:00 PM'  NA",
                 header = TRUE, stringsAsFactors = FALSE)

步骤1:转换“到达”和“到日期”时间类

年度和月份，2000-01，并不重要，如果所有的运动事件发生在同一天。我只是添加了它们，以便更容易地将其转换为date time类。

dt2 <- dt %>%
  mutate(Arrive = ymd_hms(paste0("2000-01-", Day.ID, " ", Arrive)),
         Depart = ymd_hms(paste0("2000-01-", Day.ID, " ", Depart))) 

步骤2:基于到达和分离将数据帧从宽格式转换为长格式。创建一个MoveID，这是与Place列的一个滞后差异。

dt3 <- dt2 %>%
  # Convert to long format
  gather(Action, Time, Arrive, Depart) %>%
  arrange(Person, Day.ID, Place, Location_Code, Action) %>%
  group_by(Person, Day.ID, Place, Location_Code) %>%
  # Create a Moving ID
  mutate(MoveID = lag(Place)) %>%
  ungroup() %>%
  fill(MoveID, .direction = "down") 

步骤3:计算每个MoveID出发和到达之间的时间差

dt4 <- dt3 %>%
  # Calculate time difference 
  group_by(Person, Day.ID, MoveID) %>%
  summarise(Travel_Time = difftime(dplyr::last(Time), dplyr::first(Time),
                                   units = "hours")) %>%
  ungroup() %>%
  select(MoveID, Travel_Time) %>%
  right_join(dt3, by = "MoveID") 

步骤4:将Travel_Time移动一个。基于模式创建一个运行长度ID。

dt5 <- dt4 %>%
  mutate(Travel_Time = lag(Travel_Time)) %>%
  mutate(RunID = rleid(Mode)) %>%
  group_by(Person, Day.ID, Place) %>%
  slice(1) %>%
  select(-Action, -Time) %>%
  ungroup()

步骤5:创建所有想要的列

dt6 <- dt5 %>%
  group_by(Person, Day.ID, RunID) %>%
  summarise(Travel_Time_Sum = sum(Travel_Time), 
            Mode_Sum = paste(Mode, collapse = ""),
            Journey = paste(Location_Code, collapse = "-")) %>%
  mutate(Journey = paste(str_sub(lag(Journey), start = -1, end = -1), 
                         Journey, sep = "-")) %>%
  # Remove any columns with NA in Travel_Time_Sum
  drop_na(Travel_Time_Sum) %>%
  select(Person, Day = Day.ID, `Journey Type` = Journey, `Mode/s` = Mode_Sum, 
         `Travel Time(hr)` = Travel_Time_Sum)