Как реконструировать данный набор данных о забронированной поездке в желаемый связанный набор данных о поездке, используя, возможно, функции spread () и gather () в R? - PullRequest
Новая
       83

Как реконструировать данный набор данных о забронированной поездке в желаемый связанный набор данных о поездке, используя, возможно, функции spread () и gather () в R?

0 голосов
/ 07 мая 2020

У меня есть следующий набор данных зарезервированной поездки: 

bktrips <- data.frame(
  userID =c("P001", "P001", "P001", "P001", "P001", "P002", "P002", "P002", "P002"), 
  mode = c("bus", "train", "taxi", "bus", "train", "taxi","bus", "train", "taxi"), 
  Origin = c("O1", "O2", "O3", "O4", "O5", "O6", "O7", "O8", "O9"), 
  Destination = c("D1", "D2", "D3", "D4", "D5", "D6", "D7","D8", "D9" ), 
  depart_dt = c("2019-11-05 8:00:00","2019-11-05 8:30:00", "2019-11-05 11:00:00", "2019-11-05 11:40:00", "2019-11-06 8:00:00", "2019-11-06 9:10:00", "2019-11-07 8:00:00", "2019-11-08 8:00:00", "2019-11-08 8:50:00"), 
  Olat = c("-33.87085", "-33.87138", "-33.79504", "-33.87832", "-33.89158", "-33.88993", "-33.89173", "-33.88573", "-33.88505"), 
  Olon = c("151.2073", "151.2039", "151.2737", "151.2174","151.2485", "151.2805","151.2469", "151.2169","151.2156"), 
  Dlat = c("-33.87372", "-33.87384", "-33.88323", "-33.89165", "-33.88993", "-33.89177", "-33.88573", "-33.87731", "-33.88573"), 
  Dlon = c("151.1957", "151.2126", "151.2175", "151.2471","151.2471", "151.2805","151.2514", "151.2175","151.2169")
)

Теперь мне нужно реструктурировать этот набор данных зарезервированной поездки, чтобы подготовить связанный набор данных поездки.

Например, свяжите поездку на автобусе и поезде (с одним и тем же идентификатором пользователя, P001) в одну связанную поездку и переопределите исходную и конечную точки для этой поездки (O1 и D2, соответственно).

Нам нужно использовать правила для связывания поездок (поездка с тем же идентификатором пользователя, пункт назначения предыдущей поездки находится рядом с исходной точкой следующей поездки (в пределах 1 км), временной интервал между окончанием предыдущей поездки и отправлением следующей поездки меньше чем 60 минут).

В наборе данных зарезервированной поездки переменные:

  • Olat = Широта отправления
  • Olon = Долгота отправления
  • Dlat = Широта конечного пункта
  • Dlon = Долгота пункта назначения

Кто-нибудь может мне помочь, пожалуйста? Я новый пользователь R. Заранее большое спасибо.

Ответы [ 2 ]

1 голос
/ 07 мая 2020

Вот подход с использованием dplyr и geosphere для расчета расстояний. Я использую lubridate, чтобы исправить столбец даты.

Сначала мы исправляем классы ваших столбцов. Далее мы полагаемся на тот факт, что трипсы должны происходить во временном порядке. Таким образом, мы вычисляем расстояние от предыдущего пункта назначения с помощью lag от dplyr и distHaversine от geosphere и времени с момента предыдущего отправления. 

library(dplyr)
library(geosphere)
library(lubridate)
bktrips %>%
  mutate(depart_dt = ymd_hms(depart_dt)) %>%
  mutate_at(vars(contains(c("lat","lon"))),list(~as.numeric(as.character(.)))) %>%
  group_by(userID) %>% 
  arrange(depart_dt,.by_group = TRUE) %>%
  mutate(DistPrevDest = distHaversine(cbind(Olon,Olat),cbind(lag(Dlon),lag(Dlat))),
         TimePrevDep = difftime(depart_dt,lag(depart_dt))) %>%
  dplyr::select(-depart_dt,-contains(c("lat","lon")))
  userID mode  Origin Destination DistPrevDest TimePrevDep
  <fct>  <fct> <fct>  <fct>              <dbl> <drtn>     
1 P001   bus   O1     D1                   NA    NA mins  
2 P001   train O2     D2                  801.   30 mins  
3 P001   taxi  O3     D3                10434.  150 mins  
4 P001   bus   O4     D4                  547.   40 mins  
5 P001   train O5     D5                  130. 1220 mins  
6 P002   taxi  O6     D6                   NA    NA mins  
7 P002   bus   O7     D7                 3105. 1370 mins  
8 P002   train O8     D8                 3188. 1440 mins  
9 P002   taxi  O9     D9                  879.   50 mins

Теперь мы можем добавить TripID, используя некоторые logi c и cumsum.

Затем мы группируем TripID и используем summarize, чтобы переопределить все столбцы. 

bktrips %>%
  mutate(depart_dt = ymd_hms(depart_dt)) %>%
  bktrips %>%
  mutate(depart_dt = ymd_hms(depart_dt)) %>%
  mutate_at(vars(contains(c("lat","lon"))),list(~as.numeric(as.character(.)))) %>%
  group_by(userID) %>% 
  arrange(depart_dt,.by_group = TRUE) %>%
  mutate(DistPrevDest = distHaversine(cbind(Olon,Olat),cbind(lag(Dlon),lag(Dlat))),
         TimePrevDep = difftime(depart_dt,lag(depart_dt))) %>%
  mutate(TripID = cumsum(!((is.na(DistPrevDest) | DistPrevDest < 1000) & (is.na(TimePrevDep) |TimePrevDep < 60)))) %>%
  group_by(userID,TripID) %>%
  summarize(mode = paste(mode,collapse = ","),
            Origin = first(Origin),
            Destination = last(Destination),
            depart_dt = paste(depart_dt,collapse = ","),
            Olat = first(Olat),
            Olon = first(Olon),
            Dlat = last(Dlat),
            Dlon = last(Dlon))
  userID TripID mode       Origin Destination depart_dt                                Olat  Olon  Dlat  Dlon
  <fct>   <int> <chr>      <fct>  <fct>       <chr>                                   <dbl> <dbl> <dbl> <dbl>
1 P001        0 bus,train  O1     D2          2019-11-05 08:00:00,2019-11-05 08:30:00 -33.9  151. -33.9  151.
2 P001        1 taxi,bus   O3     D4          2019-11-05 11:00:00,2019-11-05 11:40:00 -33.8  151. -33.9  151.
3 P001        2 train      O5     D5          2019-11-06 08:00:00                     -33.9  151. -33.9  151.
4 P002        0 taxi       O6     D6          2019-11-06 09:10:00                     -33.9  151. -33.9  151.
5 P002        1 bus        O7     D7          2019-11-07 08:00:00                     -33.9  151. -33.9  151.
6 P002        2 train,taxi O8     D9          2019-11-08 08:00:00,2019-11-08 08:50:00 -33.9  151. -33.9  151.

Я предлагаю вам также включить в свои данные время прибытия и вместо этого рассчитать разницу между отправлением и предыдущим прибытием.

Изменить : пропущено cumsum(). Теперь исправлено. Также не нужно больше rleid.

0 голосов
/ 07 мая 2020

Мне не ясно, где вы хотите go с этим, но вот начало расчета расстояния и времени поездки для каждой группы (по идентификатору пользователя). Мне нужно было быстро найти пакет для расчета расстояния по долготе и широте, и я нашел geosphere. Надеюсь, это поможет. 

library(dplyr)
library(tibble)
library(geosphere)

bktrips <- tibble(
  userID =c("P001", "P001", "P001", "P001", "P001", "P002", "P002", "P002", "P002"), 
  mode = c("bus", "train", "taxi", "bus", "train", "taxi","bus", "train", "taxi"), 
  Origin = c("O1", "O2", "O3", "O4", "O5", "O6", "O7", "O8", "O9"), 
  Destination = c("D1", "D2", "D3", "D4", "D5", "D6", "D7","D8", "D9" ), 
  depart_dt = c("2019-11-05 8:00:00","2019-11-05 8:30:00", "2019-11-05 11:00:00", "2019-11-05 11:40:00", "2019-11-06 8:00:00", "2019-11-06 9:10:00", "2019-11-07 8:00:00", "2019-11-08 8:00:00", "2019-11-08 8:50:00"), 
  Olat = c("-33.87085", "-33.87138", "-33.79504", "-33.87832", "-33.89158", "-33.88993", "-33.89173", "-33.88573", "-33.88505"), 
  Olon = c("151.2073", "151.2039", "151.2737", "151.2174","151.2485", "151.2805","151.2469", "151.2169","151.2156"), 
  Dlat = c("-33.87372", "-33.87384", "-33.88323", "-33.89165", "-33.88993", "-33.89177", "-33.88573", "-33.87731", "-33.88573"), 
  Dlon = c("151.1957", "151.2126", "151.2175", "151.2471","151.2471", "151.2805","151.2514", "151.2175","151.2169")
)

bktrips <- bktrips %>%
  mutate(depart_dt = as.POSIXct(depart_dt, format = "%Y-%m-%d %H:%M:%S"),
         Olat = as.numeric(Olat),
         Olon = as.numeric(Olon),
         Dlat = as.numeric(Dlat),
         Dlon = as.numeric(Dlon)) %>%
  group_by(userID) %>%
  mutate(trip_time = as.numeric(depart_dt - lag(depart_dt), units = 'mins')) %>%
  rowwise() %>%
  mutate(trip_distance = distm(x = c(Olon, Olat), y = c(Dlon, Dlat), fun = distHaversine))

> bktrips
Source: local data frame [9 x 11]
Groups: <by row>

# A tibble: 9 x 11
  userID mode  Origin Destination depart_dt            Olat  Olon  Dlat  Dlon trip_time trip_distance
  <chr>  <chr> <chr>  <chr>       <dttm>              <dbl> <dbl> <dbl> <dbl>     <dbl>         <dbl>
1 P001   bus   O1     D1          2019-11-05 08:00:00 -33.9  151. -33.9  151.        NA         1119.
2 P001   train O2     D2          2019-11-05 08:30:00 -33.9  151. -33.9  151.        30          849.
3 P001   taxi  O3     D3          2019-11-05 11:00:00 -33.8  151. -33.9  151.       150        11108.
4 P001   bus   O4     D4          2019-11-05 11:40:00 -33.9  151. -33.9  151.        40         3120.
5 P001   train O5     D5          2019-11-06 08:00:00 -33.9  151. -33.9  151.      1220          225.
6 P002   taxi  O6     D6          2019-11-06 09:10:00 -33.9  151. -33.9  151.        NA          205.
7 P002   bus   O7     D7          2019-11-07 08:00:00 -33.9  151. -33.9  151.      1370          787.
8 P002   train O8     D8          2019-11-08 08:00:00 -33.9  151. -33.9  151.      1440          939.
9 P002   taxi  O9     D9          2019-11-08 08:50:00 -33.9  151. -33.9  151.        50          142.
...