Ускорить двойной за цикл - PullRequest
Новая
       5

Ускорить двойной за цикл

0 голосов
/ 12 февраля 2019

У меня проблема с продолжительностью цикла double for с оператором if в R. В одном наборе данных у меня около 3000000 строк (DF1), а в другом - около 22 (DF2).).Пример двух фреймов данных, которые я имею, приведен ниже. 

DF1
DateTime                 REG
2018-07-01 12:00:00      NHDG
2018-07-12 11:55:23      NSKR

DF2
StartDateTime           EndDateTime         Direction
2018-07-01 07:55:11    2018-07-01 12:01:56     W
2018-07-12 11:00:23    2018-07-12 11:45:00     E

Я хочу пометить что-либо в DF1, когда DateTime находится между StartDateTime и EndDateTime.Следовательно, результат будет следующим: 

DF1  
DateTime                 REG      Flag
2018-07-01 12:00:00      NHDG      1
2018-07-12 11:55:23      NSKR      0

Код, который я использовал в настоящее время: 

#Flag if in delay or not
DF1$Flag<-0

for (i in 1:nrow(DF1)){
  for (j in 1:nrow(DF2)){
    if ((DF1$DateTime[i] >= DF2$StartDateTime[j]) & (DF1$DateTime <= DF2$EndDateTime[j])){
      DF1$Flag[i]<-1
    } else {
      DF1$Flag[i]<-DF1$Flag
    }
  }
}

Я более чем рад, что этот код будет удален из цикла forесли возможно.

Ответы [ 4 ]

0 голосов
/ 12 февраля 2019

Одним из более быстрых способов было бы использовать cross () от tidyr для пересечения df1 и df2, установить флаг для строки в новом фрейме данных, а затем использовать aggregate (), чтобы уменьшить количество строк вниз.Этот метод предполагает, что в df1 нет повторяющихся записей.Если они есть, они будут объединены. 

> df1
             DateTime  REG
1 2018-07-01 12:00:00 NHDG
2 2018-07-12 11:55:23 NSKR
> df2
        StartDateTime         EndDateTime Direction
1 2018-07-01 07:55:11 2018-07-01 12:01:56         W
2 2018-07-12 11:00:23 2018-07-12 11:45:00         E
> # Create a DF with rows for each combination of df1 rows with df2 rows
> tmp <- crossing(df1, df2)
> tmp
             DateTime  REG       StartDateTime         EndDateTime Direction
1 2018-07-01 12:00:00 NHDG 2018-07-01 07:55:11 2018-07-01 12:01:56         W
2 2018-07-01 12:00:00 NHDG 2018-07-12 11:00:23 2018-07-12 11:45:00         E
3 2018-07-12 11:55:23 NSKR 2018-07-01 07:55:11 2018-07-01 12:01:56         W
4 2018-07-12 11:55:23 NSKR 2018-07-12 11:00:23 2018-07-12 11:45:00         E
> # Create a new column for the flag
> tmp$flag <- tmp$DateTime >= tmp$StartDateTime & tmp$DateTime <= tmp$EndDateTime
> tmp
             DateTime  REG       StartDateTime         EndDateTime Direction  flag
1 2018-07-01 12:00:00 NHDG 2018-07-01 07:55:11 2018-07-01 12:01:56         W  TRUE
2 2018-07-01 12:00:00 NHDG 2018-07-12 11:00:23 2018-07-12 11:45:00         E FALSE
3 2018-07-12 11:55:23 NSKR 2018-07-01 07:55:11 2018-07-01 12:01:56         W FALSE
4 2018-07-12 11:55:23 NSKR 2018-07-12 11:00:23 2018-07-12 11:45:00         E FALSE
> # Drop the unwanted columns
> tmp <- tmp[,c("DateTime", "REG", "flag")]
> tmp
             DateTime  REG  flag
1 2018-07-01 12:00:00 NHDG  TRUE
2 2018-07-01 12:00:00 NHDG FALSE
3 2018-07-12 11:55:23 NSKR FALSE
4 2018-07-12 11:55:23 NSKR FALSE
> # Sum all flags for a given df1 date and limit total to 1
> df1 <- aggregate(flag ~ DateTime + REG, tmp, FUN = function(x) {min(1, sum(x))})
> df1
             DateTime  REG flag
1 2018-07-01 12:00:00 NHDG    1
2 2018-07-12 11:55:23 NSKR    0
>

Запуск с большим количеством дат и сравнение с вашим исходным циклом for и приведенным выше методом sapply (): 

  Original for loop method: 6.282 sec elapsed
           sapply() method:  1.65 sec elapsed
crossing() and aggregate(): 0.385 sec elapsed

Полный скриптздесь: 

#!/usr/bin/env Rscript                                                                                                                              

library(tictoc)
library(tidyr)

# Setup: generate a lot of dates for performance comparison                                                                                         

beg <- as.POSIXct("2018-07-01 12:00:00")
end <- as.POSIXct("2100-12-01 12:00:00")
dates <- seq(beg, end, 60*60*24)

#df1 <- data.frame(c("2018-07-01 12:00:00", "2018-07-12 11:55:23"), c("NHDG","NSKR"))                                                               
df1 <- data.frame(dates, rep(c("NHDG","NSKR"), length(dates)/2))
df2 <- data.frame(c("2018-07-01 07:55:11", "2018-07-12 11:00:23"), c("2018-07-01 12:01:56", "2018-07-12 11:45:00"), c("W","E"))
colnames(df1) <- c("DateTime", "REG")
colnames(df2) <- c("StartDateTime","EndDateTime","Direction")

df1$DateTime <- as.POSIXct(df1$DateTime, tz = "America/Los_Angeles")
df2$StartDateTime <- as.POSIXct(df2$StartDateTime, tz = "America/Los_Angeles")
df2$EndDateTime <- as.POSIXct(df2$EndDateTime, tz = "America/Los_Angeles")

# Original (fixed)                                                                                                                                  

tic(sprintf("%30s", "Original for loop method"))

for (i in 1:nrow(df1)){
  df1$flag[i] <- 0
  for (j in 1:nrow(df2)){
    if ((df1$DateTime[i] >= df2$StartDateTime[j]) & (df1$DateTime[i] <= df2$EndDateTime[j])){
      df1$flag[i]<-1
      break
    }
  }
}

toc()

result1 <- df1
df1$flag <- NULL

# Sapply                                                                                                                                            

tic(sprintf("%30s", "sapply() method"))

df1$flag = sapply(df1$DateTime,
                  function(x) as.integer(sum(x >= df2$StartDateTime &
                                             x <= df2$EndDateTime) > 0))
toc()

result2 <- df1
df1$flag <- NULL

# Aggregate                                                                                                                                         

tic(sprintf("%30s", "crossing() and aggregate()"))

# Create a DF with rows for each combination of df1 rows with df2 rows                                                                              
tmp <- crossing(df1, df2)
# Create a new column for the flag                                                                                                                  
tmp$flag <- tmp$DateTime >= tmp$StartDateTime & tmp$DateTime <= tmp$EndDateTime
# Drop the unwanted columns                                                                                                                         
tmp <- tmp[,c("DateTime", "REG", "flag")]
# Sum all flags for a given df1 date and limit total to 1                                                                                           
df1 <- aggregate(flag ~ DateTime + REG, tmp, FUN = function(x) {min(1, sum(x))})
# Sort the rows by date                                                                                                                             
df1 <- df1[order(df1$DateTime),]
# Reset the row names (for comparison below)                                                                                                        
rownames(df1) <- NULL

toc()

result3 <- df1

# Prove that results are the same                                                                                                                   

if (!all.equal(result1, result2)) {
  print("MISMATCH")
  stop()
}

if (!all.equal(result1, result3)) {
  print(MISMATCH)
  stop()
}

print("PASS")
0 голосов
/ 12 февраля 2019

А как насчет этого? 

library(data.table)
DF1$flag <- as.numeric(sapply(seq(nrow(DF1)), function(x)
  DF1[x, "DateTime"] %between% c(min(DF2[x, "StartDateTime"]), max(DF2[x, "EndDateTime"]))))
#              DateTime  REG flag
# 1 2018-07-01 12:00:00 NHDG    1
# 2 2018-07-12 11:55:23 NSKR    0

Данные 

> dput(DF1)
structure(list(DateTime = structure(1:2, .Label = c("2018-07-01 12:00:00", 
"2018-07-12 11:55:23"), class = "factor"), REG = structure(1:2, .Label = c("NHDG", 
"NSKR"), class = "factor")), class = "data.frame", row.names = c(NA, 
-2L))
> dput(DF2)
structure(list(StartDateTime = structure(1:2, .Label = c("2018-07-01 07:55:11", 
"2018-07-12 11:00:23"), class = "factor"), EndDateTime = structure(1:2, .Label = c("2018-07-01 12:01:56", 
"2018-07-12 11:45:00"), class = "factor"), Direction = structure(2:1, .Label = c("E", 
"W"), class = "factor")), class = "data.frame", row.names = c(NA, 
-2L)) 

DF1$DateTime <- as.POSIXct(DF1$DateTime)
DF2$StartDateTime <- as.POSIXct(DF2$StartDateTime)
DF2$EndDateTime <- as.POSIXct(DF2$EndDateTime)
0 голосов
/ 12 февраля 2019

Может также пойти на foverlaps: 

library(data.table)

setDT(DF1)[, DateTime := as.POSIXct(DateTime)][, EndDateTime := DateTime]
setDT(DF2)[, `:=` (StartDateTime = as.POSIXct(StartDateTime), 
                   EndDateTime = as.POSIXct (EndDateTime))]

setkey(DF1, DateTime, EndDateTime)
setkey(DF2, StartDateTime, EndDateTime)

DF1[, Flag := foverlaps(DF1, DF2, type = "within", which = TRUE, mult = "first")][
  is.na(Flag), Flag := 0][, EndDateTime := NULL]

Это будет проверять для каждой даты в DF1, находится ли она в каком-либо интервале в DF2.

Это 'также будет быстрым, по крайней мере, согласно моим тестам.Тест с sapply: 

Unit: milliseconds
   expr         min           lq        mean      median           uq        max neval
     DT    4.752853     5.247319    18.38787     5.42855     6.950966   311.1944    25
 sapply 9413.337014 10598.926908 11206.14866 10892.91751 11746.901293 13568.7995    25

Это набор данных с 10 000 строк в DF1 и 12 в DF2.

Я запускал его только один раз на 300 000/22 строк, и вот что я получаю: 

Unit: seconds
   expr       min        lq      mean    median        uq       max neval
     DT  11.60865  11.60865  11.60865  11.60865  11.60865  11.60865     1
 sapply 674.05823 674.05823 674.05823 674.05823 674.05823 674.05823     1
0 голосов
/ 12 февраля 2019

Если я правильно понимаю, значение флага в DF1 должно быть установлено на 1, если DateTime находится между любым интервалом от DF2, верно?Затем следующий базовый код выполнит эту работу: 

DF1$Flag = sapply(DF1$DateTime, 
                  function(x) as.integer(sum(x >= DF2$StartDateTime & 
                                               x <= DF2$EndDateTime) > 0))
#              DateTime  REG Flag
# 1 2018-07-01 12:00:00 NHDG    1
# 2 2018-07-12 11:55:23 NSKR    0

Идея состоит в том, чтобы векторизовать сравнение: для каждого DateTime в DF1 (что-то вроде «циклического прохождения» до sapply) вы сравниваетезначение для всех интервалов (Start- и EndDateTime) от DF2 и вы sum результаты: если sum больше 0, то у вас есть хотя бы одна строка в DF2, где DateTime из DF1 падаетмежду его Start- и EndDateTime.Затем as.integer преобразует логический выход sum(...) > 0 в 1 или 0.

И, если вы хотите более быстрое решение, используйте dplyr: 

df1 = full_join(mutate(DF1, foo=1), mutate(DF2, foo=1), by='foo') %>% 
  mutate(Flag = as.integer(DateTime >= StartDateTime & DateTime <= EndDateTime)) %>%
  group_by(DateTime) %>% slice(which.max(Flag)) %>%
  select(DateTime, REG, Flag)

В противном случае: Похоже, проблема во втором цикле, над строками DF2 (цикл j): для каждой строки DF1 вы сравниваете дату с начальной и конечной датами подряд все строк DF2, в основном каждый раз перезаписывая полученное значение флага и сохраняя результат только для сравнения с самой последней строкой DF2 ...?Другими словами, i в DF1$Flag[i] <- ... не перемещается внутри цикла j (и каждый раз перезаписывается).

Так что если вы просто хотите сравнить минимальный и максимальный диапазон дат от DF2, вы можете просто сделать: 

DF1$Flag = as.integer((DF1$DateTime >= min(DF2$StartDateTime)) & (DF1$DateTime <= max(DF2$EndDateTime)))
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...