Подмножество набора данных gps-дорожки на основе временных интервалов, собранных из второго набора данных - PullRequest
0 голосов
/ 09 октября 2019

У меня большой набор данных gps-track, и я хочу извлечь только те позиции, которые были заняты, когда наблюдатель дежурил. Другими словами, мне нужно разрезать GPS-треки в нескольких трансектах, на которых наблюдатель наблюдал. Периоды наблюдения находятся во второй базе данных, в которой наблюдатель регистрировал начало и конец (примерно ежечасно) периодов просмотра, так что время начала и время окончания, зарегистрированные для каждого дня, отмечают начало и конец периода наблюдения для этого дня вбольшинство случаев. Однако может случиться так, что просмотр по какой-то причине был приостановлен, а затем возобновлен через некоторое время в тот же день, так что две последовательные аннотации могут иметь промежуток времени между ними.

Я пытался использовать функции match () и dplyr: filter (), но не смог найти решение. Любая идея будет принята с благодарностью.

Ниже приведен упрощенный пример

DB1 (очень большая дорожка GPS в подмножество)

   date         time   lat      lon     
1  18/04/2017   6:10   34.01    -53.07
2  18/04/2017   6:20   34.02    -53.09
3  18/04/2017   6:30   34.04    -53.10
4  18/04/2017   6:40   34.05    -53.11
5  18/04/2017   6:50   34.07    -53.13
6  18/04/2017   7:00   34.08    -53.14
7  18/04/2017   7:10   34.01    -53.07
8  18/04/2017   7:20   34.02    -53.09
9  18/04/2017   7:30   34.04    -53.10
.      .         .       .         .
.      .         .       .         .
.      .         .       .         .
n   19/04/2017  6:10   34.05    -53.11
n+1 19/04/2017  6:20   34.07    -53.13
n+2 19/04/2017  6:30   34.08    -53.14

DB2 (периоды просмотра)

    date          start.watch   end.watch
1   2017-04-18    05:00         06:10
2   2017-04-18    06:10         06:30
3   2017-04-18    06:30         06:45
4   2017-04-18    07:20         08:20
.      .            .             . 
.      .            .             . 
.      .            .             . 
n   2017-04-19    06:20         07:20
n+1 2017-04-19    07:20         08:40

Результирующая БД должна быть: `

1  18/04/2017   6:10   34.01    -53.07
2  18/04/2017   6:20   34.02    -53.09
3  18/04/2017   6:30   34.04    -53.10
4  18/04/2017   6:40   34.05    -53.11

8  18/04/2017   7:20   34.02    -53.09
9  18/04/2017   7:30   34.04    -53.10

n   19/04/2017  6:10   34.05    -53.11
n+1 19/04/2017  6:20   34.07    -53.13
n+2 19/04/2017  6:30   34.08    -53.14

Ответы [ 2 ]

0 голосов
/ 10 октября 2019

Вот альтернатива, которая делает основанное на диапазоне (нечеткое) соединение, основанное на перекрытиях времени. Он использует data.table::foverlaps, который требует (по крайней мере для этого объединения), чтобы два кадра были правильными data.table объектами, потому что он требует четкой установки ключей.

Этот метод имеет несколько требований:

  1. Все временные метки легко сопоставимы численно, я преобразую их в POSIXt объекты;
  2. Ключи установлены как минимум для второй таблицы (и могут помочь в первой),Последние два ключа для каждого должны быть началом и концом каждого временного интервала;и
  3. Да, вы правильно прочитали, даже для «одиночных временных наблюдений» нужны два поля отметок времени.

Примечание: я использую magrittr исключительно для разбивки процесса насвоего рода трубопровод;это совсем не обязательно, просто облегчает чтение. Кроме того, я использую copy() и setDT, а затем присваиваю новую переменную в первую очередь потому, что (1) я итерировал несколько раз, но каждый раз хотел начать с свежих данных;и что еще более важно (2), поскольку data.table работает с побочным эффектом , я хочу призвать вас попробовать это, но не уничтожать ваши локальные данные, пока вы не освоитесь с ними в качестве побочного эффекта. Вы можете легко - data.table - изменить его по факту.

Сначала я настрою необходимые условия.

library(data.table)
library(magrittr)

DB1dt <- copy(DB1) %>%
  setDT() %>%
  .[, dt := as.POSIXct(paste(date, time), format = "%d/%m/%Y %H:%M") ] %>%
  # remove unneeded columns
  .[, c("date", "time") := NULL ] %>%
  .[, dt2 := dt ] %>%
  setkey(dt, dt2)

DB2dt <- copy(DB2) %>%
  setDT() %>%
  .[, startdt := as.POSIXct(paste(date, start.watch), format = "%Y-%m-%d %H:%M") ] %>%
  .[, enddt := as.POSIXct(paste(date, end.watch), format = "%Y-%m-%d %H:%M") - 1e-5 ] %>%
  # remove unneeded columns
  .[, c("date", "start.watch", "end.watch") := NULL ] %>%
  setkey(startdt, enddt)

DB1dt[1:2,]
#      lat    lon                  dt                 dt2
# 1: 34.01 -53.07 2017-04-18 06:10:00 2017-04-18 06:10:00
# 2: 34.02 -53.09 2017-04-18 06:20:00 2017-04-18 06:20:00
DB2dt[1:2,]
#                startdt               enddt
# 1: 2017-04-18 05:00:00 2017-04-18 06:09:59
# 2: 2017-04-18 06:10:00 2017-04-18 06:29:59

К вашему сведению: использование -1e-5 - этопотому что соединение "inside" закрыто на обоих концах ([a,b], в отличие от open-right [a,b)), поэтому равенство на enddt будет соответствовать. Если вы хотите сохранить это, обращайтесь к вам.

Отсюда пересекающееся объединение просто:

foverlaps(DB1dt, DB2dt, type = "within", nomatch = NULL)
#                startdt               enddt   lat    lon                  dt                 dt2
# 1: 2017-04-18 06:10:00 2017-04-18 06:29:59 34.01 -53.07 2017-04-18 06:10:00 2017-04-18 06:10:00
# 2: 2017-04-18 06:10:00 2017-04-18 06:29:59 34.02 -53.09 2017-04-18 06:20:00 2017-04-18 06:20:00
# 3: 2017-04-18 06:30:00 2017-04-18 06:44:59 34.04 -53.10 2017-04-18 06:30:00 2017-04-18 06:30:00
# 4: 2017-04-18 06:30:00 2017-04-18 06:44:59 34.05 -53.11 2017-04-18 06:40:00 2017-04-18 06:40:00
# 5: 2017-04-18 07:20:00 2017-04-18 08:19:59 34.02 -53.09 2017-04-18 07:20:00 2017-04-18 07:20:00
# 6: 2017-04-18 07:20:00 2017-04-18 08:19:59 34.04 -53.10 2017-04-18 07:30:00 2017-04-18 07:30:00
# 7: 2017-04-19 06:20:00 2017-04-19 07:19:59 34.07 -53.13 2017-04-19 06:20:00 2017-04-19 06:20:00
# 8: 2017-04-19 06:20:00 2017-04-19 07:19:59 34.08 -53.14 2017-04-19 06:30:00 2017-04-19 06:30:00

Пример данных:

DB1 <- read.table(stringsAsFactors = FALSE, header = TRUE, text = "
date         time   lat      lon     
18/04/2017   6:10   34.01    -53.07
18/04/2017   6:20   34.02    -53.09
18/04/2017   6:30   34.04    -53.10
18/04/2017   6:40   34.05    -53.11
18/04/2017   6:50   34.07    -53.13
18/04/2017   7:00   34.08    -53.14
18/04/2017   7:10   34.01    -53.07
18/04/2017   7:20   34.02    -53.09
18/04/2017   7:30   34.04    -53.10
19/04/2017   6:10   34.05    -53.11
19/04/2017   6:20   34.07    -53.13
19/04/2017   6:30   34.08    -53.14")

DB2 <- read.table(stringsAsFactors = FALSE, header = TRUE, text = "
date          start.watch   end.watch
2017-04-18    05:00         06:10
2017-04-18    06:10         06:30
2017-04-18    06:30         06:45
2017-04-18    07:20         08:20
2017-04-19    06:20         07:20
2017-04-19    07:20         08:40")

Связанное чтение:

0 голосов
/ 10 октября 2019

Вот, думаю, решение вашего вопроса.

Код должен быть понятным, но вкратце, ключевой частью является создание столбцов даты и времени с интервалами с пакетом lubridate, а затем использование функции lubridate *1004* для проверки, является ли данныйвремя находится в заданных интервалах.

Надеюсь, это поможет.

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:base':
#> 
#>     date

db1 <- tribble(~date, ~time, ~lat, ~lon,
               "18/04/2017", "6:10", 34.01, -53.07,
               "18/04/2017", "6:20", 34.02, -53.09,
               "18/04/2017", "6:30", 34.04, -53.10,
               "18/04/2017", "6:40", 34.05, -53.11,
               "18/04/2017", "6:50", 34.07, -53.13,
               "18/04/2017", "7:00", 34.08, -53.14,
               "18/04/2017", "7:10", 34.01, -53.07,
               "18/04/2017", "7:20", 34.02, -53.09,
               "18/04/2017", "7:30", 34.04, -53.10
)

db2 <- tribble(~date, ~start.watch, ~end.watch,
               "2017-04-18", "05:00", "06:10",
               "2017-04-18", "06:10", "06:30",
               "2017-04-18", "06:30", "06:45",
               "2017-04-18", "07:20", "08:20")


db2_intervals <- db2 %>% 
  mutate(end_date = date) %>% 
  unite("start_datetime", date, start.watch) %>% 
  unite("end_datetime", end_date, end.watch) %>% 
  transmute(interval = interval(start = ymd_hm(start_datetime),
                                end = ymd_hm(end_datetime))) %>% 
  pull(interval)


db1 %>% 
  unite("datetime", date, time) %>% 
  mutate(datetime = lubridate::dmy_hm(datetime)) %>% 
  filter(datetime %within% as.list(db2_intervals)) 
#> # A tibble: 6 x 3
#>   datetime              lat   lon
#>   <dttm>              <dbl> <dbl>
#> 1 2017-04-18 06:10:00  34.0 -53.1
#> 2 2017-04-18 06:20:00  34.0 -53.1
#> 3 2017-04-18 06:30:00  34.0 -53.1
#> 4 2017-04-18 06:40:00  34.0 -53.1
#> 5 2017-04-18 07:20:00  34.0 -53.1
#> 6 2017-04-18 07:30:00  34.0 -53.1

Создано в 2019-10-09 пакетом Представить (v0.3.0)

...