如何根据 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)

对于所有这些类别，我需要旅行模式和总旅行时间的信息。 例如：想象一个星期一；一个人在他家（H）醒来，吃完早餐，然后开车去办公室（W）；在途中，他在星巴克停下来喝杯咖啡（C），然后从家里接一位同事（D）。白天上班，去不同地点（E）拜访客户，然后回来上班；这次他坐火车。然后该人当天提早离开家，因为他需要去杂货店。所以这个人回到家，去地点（F）买杂货，然后回到家，这次是走到杂货店。这个人做了不同的旅行：1）H-dt（C-D）-W，2）W-O（E）-W，3）W-H，5）H-O（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

我还enter image description here附上了一张我拥有的数据和我想要拥有的数据的图片。

Answer 1

这是一个使用来自tidyverse、data.table、lubridate 和stringr 的函数的解决方案。 dt6 是最终输出。请注意，dt6 与您想要的输出完全相同，除了 Journey Type 列，因为我不知道您的编码的逻辑和含义（例如为什么 H-C-D-W 是 H-dt(C-D)-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 步：将 Arrive 和 Depart 转换为日期时间类

年份和月份2000-01，如果您的所有移动事件都发生在同一日期，则无关紧要。我只是添加它们以便更容易转换为日期时间类。

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

步骤2：根据Arrive和Depart将数据帧从宽格式转换为长格式。创建一个 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 移动 1。根据模式创建运行长度 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)