Хранение строк, которые охватывают несколько временных диапазонов

Question

У меня есть кадр данных (da), где каждая строка имеет временную метку в порядке возрастания (интервалы между каждой временной меткой являются случайными).

Я хотел сохранить ряды da в зависимости от того, попало ли его время в промежутки времени между двумя другими векторами (first.times и second.times). Так что я бы итеративно пошел вниз по векторам first.time и second.time и увидел бы, есть ли у da времена в этих интервалах (min = first times и max = second.times), с которыми я сохраняю, а остальные Я не знаю.

Единственный способ, которым я понял, как это сделать - это цикл for, но это может занять некоторое время. Вот код с некоторыми примерами данных:

#Set start and end dates
date1 <- as.POSIXct(strptime('1970-01-01 00:00', format = '%Y-%m-%d %H:%M'))
date2 <- as.POSIXct(strptime('1970-01-05 23:00', format = '%Y-%m-%d %H:%M'))

#Interpolate 250000 dates in between (dates are set to random intervals)
dates <- c(date1 + cumsum(c(0, round(runif(250000, 20, 200)))), date2)

#Set up dataframe
da <- data.frame(dates = dates,
                 a = round(runif(1, 1, 10)),
                 b = rep(c('Hi', 'There', 'Everyone'), length.out = length(dates)))
head(da); dim(da)

#Set up vectors of time
first.times <- seq(date1,      #First time in sequence is date1
                   date2,      #Last time in sequence is date2
                   by = 13*60) #Interval of 13 minutes between each time (13 min * 60 sec)

second.times <- first.times + 5*60 #Second time is 5 min * 60 seconds later
head(first.times); length(first.times)
head(second.times); length(second.times)

#Loop to obtain rows
subsetted.dates <- da[0,]
system.time(for(i in 1:length(first.times)){
  subsetted.dates <- rbind(subsetted.dates, da[da$dates >= first.times[i] & da$dates < second.times[i],])
})
 user  system elapsed 
2.590   0.825   3.520 

Мне было интересно, есть ли более эффективный и быстрый способ сделать то, что я делал в цикле for. С этим примером набора данных все идет довольно быстро, но мой фактический набор данных может занять 45 секунд на каждую итерацию, а при 1000 итерациях это может занять некоторое время!

Любая помощь будет иметь большое значение!

Спасибо!

Answer 1

По сравнению с исходной настройкой ...

> subsetted.dates <- da[0,]
> system.time(for(i in 1:length(first.times)){
+   subsetted.dates <- rbind(subsetted.dates, da[da$dates >= first.times[i] & da$dates < second.times[i],])
+ })
   user  system elapsed 
   3.97    0.35    4.33 

... можно получить небольшое улучшение производительности, используя lapply:

> system.time({
+   subsetted.dates <- lapply(1:length(first.times),function(i) da[da$dates >= first.times[i] & da$dates < second.times[i],])
+   subsetted.dates <- do.call(rbind,subsetted.dates)
+ })
   user  system elapsed 
   3.37    0.26    3.75 

Немного изменивАлгоритм, если вы сначала создаете индекс дат с немного меньшим набором данных, а затем применяете его, это приводит к еще лучшей производительности:

> system.time({
+   da_dates <- da$dates
+   da_inds <- lapply(1:length(first.times),function(i) which(da_dates >= first.times[i] & da_dates < second.times[i]))
+   subsetted.dates <- da[unlist(da_inds),]
+ })
   user  system elapsed 
   2.60    0.31    2.94 

Предположение, что интервалы времени равныможно упорядочить по временному порядку (в этом случае они уже были по временному порядку) и что они не перекрываются, проблема становится еще быстрее:

system.time({ 
  da_date_order <- order(da$dates)
  da_date_back_order <- order(da$dates)
  da_sorted_dates <- sort(da$dates)
  da_selected_dates <- rep(FALSE,length(da_sorted_dates))
  j = 1
  for (i in 1:length(da_dates)) {
    if (da_sorted_dates[i] >= first.times[j] & da_sorted_dates[i] < second.times[j]) {
      da_selected_dates[i] <- TRUE
    } else if (da_sorted_dates[i] >= second.times[j]) {
      j = j + 1
      if (j > length(second.times)) {
        break
      }
    }
  }
  subsetted.dates <- da[da_date_back_order[da_selected_dates],]
})

user  system elapsed 
0.98    0.00    1.01 

И если вы разрешите сортировку исходного набора данных daтогда решение будет еще быстрее:

system.time({
  da <- da[order(da$dates),]
  da_sorted_dates <- da$dates
  da_selected_dates <- rep(FALSE,length(da_sorted_dates))
  j = 1
  for (i in 1:length(da_dates)) {
    if (da_sorted_dates[i] >= first.times[j] & da_sorted_dates[i] < second.times[j]) {
      da_selected_dates[i] <- TRUE
    } else if (da_sorted_dates[i] >= second.times[j]) {
      j = j + 1
      if (j > length(second.times)) {
        break
      }
    }
  }
  subsetted.dates <- da[da_selected_dates,]
})

user  system elapsed 
0.63    0.00    0.63 

Answer 2

Никогда не используйте rbind или cbind в цикле!Это приводит к чрезмерному копированию в памяти.См. Патрик Бернс 'R Interno: Круг 2 - Растущие объекты .Вместо этого создайте список фреймов данных, равный rbind один раз вне цикла:

Поскольку вы выполняете итерацию по элементам между векторами равной длины, рассмотрите mapply или его оболочку списка, Map:

df_list <- Map(function(f, s) da[da$dates >= f & da$dates < s,],
               first.times, second.times)

# EQUIVALENT CALL
df_list <- mapply(function(f, s) da[da$dates >= f & da$dates < s,],
                  first.times, second.times, SIMPLIFY=FALSE)

Даже рассмотрите возможность добавления первого и второго раза во фрейм данных с помощью transform для добавления столбцов:

df_list <- Map(function(f, s) transform(da[da$dates >= f & da$dates < s,], 
                                        first_time = f, second_time = s),
               first.times, second.times)

Оттуда используйте множество решений для списка строк связывания фреймов данных:

# BASE
final_df <- do.call(rbind, df_list)

# PLYR
final_df <- rbind.fill(df_list)

# DPLYR
final_df <- bind_rows(df_list)

# DATA TABLE
final_df <- rbindlist(df_list)

Проверьте примеры тестов здесь: Преобразование списка фреймов данных в один фрейм данных