Почему вычисление для каждой строки выполняется быстрее, чем проверка выполнения расчета?

Question

Я работал над dataframe с 200.000+ строками и многими столбцами. Давайте возьмем образец фиктивную версию, как такой, что ДФ:

set.seed(1) 
"timeslot" = c(as.integer(abs(runif(10000,min=1,max=1000)))) 
"ID" = c(LETTERS[abs(as.integer(rnorm(10000,2)**3))%%9+1]) 
"variable1" = c(as.integer(rnorm(10000,2)**3)) 
df = data.frame(timeslot,ID,variable1) 
df = df[order(df$timeslot, df$ID),] 

Я также вычислить столбец для проверки, если идентификатор этой строки также присутствует где-то в предыдущем временном интервале, называемый MIN1:

df$min1 <- sapply(seq(nrow(df)), function(x) 
{ 
    if(df[x, "timeslot"] == 1){0} else { 
    max(df[x, "ID"] %in% df[df$timeslot == df[x,"timeslot"] - 1,"ID"])} 
}) 

Это все идет хорошо и поставляет следующую голова (Df)/хвост (DF):

 timeslot ID variable1 min1 
4919  1 A  15 0 
2329  1 C  48 0 
7359  1 C   1 0 
1978  1 E   6 0 
2883  1 F   7 0 
7448  1 F  21 0 
------------------------------- 
8462  998 F   1 1 
1724  998 H   2 0 
989  999 A   7 1 
2589  999 D  12 1 
3473  999 D   0 1 
780  999 I   5 0 

Я хочу, чтобы выполнить некоторые вычисления на variable1, сгруппированные по уникальному временному интервалу + ID. Один из этих расчетов funfac:

total=0 
funfac <- function(x,y){ for (i in x){ (i <- i ** y); 
total <- total + i};return((abs(total/(length(x))))**(1/y));total=0 } 

Однако теперь наступает трудная часть: за ID в определенном временном интервале я хочу сделать расчет по всем же идентификаторами в этом временном интервале и в предыдущем временном интервале. Так что, если во временном слове «2» есть 3x D, а во временном слоте «1» есть 2x D, расчет должен выполняться по всем 5 Ds. Мой столбец min1 помогает определить, присутствует ли этот идентификатор в предыдущем слоте. Если нет: расчет должен вернуть NA.

Сначала я сделал это с помощью следующего кода:

lp5 = c() 
for (j in 1:nrow(df)){ 
    if (df[j,"min1"] == 0){lp5 = c(lp5,NA)} else { 
    total = 0 
    x = df[which((df[,"timeslot"] == df[j,"timeslot"] | df[,"timeslot"] == (df[j,"timeslot"]-1)) & df[,"ID"]==(df[j,"ID"])),"variable1"] 
    for (i in x){ 
     i = (i ** 5); 
     total <- total + i 
    } 
    lp5 = c(lp5,((abs(total/(length(x))))**(1/(5)))) 
    } 
} 
tempdf = data.frame(df[,"timeslot"],df[,"ID"], lp5) 
lp5 = tempdf[!duplicated(tempdf[,1:2]),][,3] 

Выяснение, что я выполнил много вычислений двойной, я подумал: почему бы не проверить, если расчет уже сделано. Сделав это, добавив уникальный таймфрейм + ID в фреймворк данных, включая расчетное значение. И каждый раз проверяя, находится ли значение в области данных уже.

lp5DF = data.frame("timeslot" = numeric(0), "ID" = character(0), "lp5" = numeric(0)) 
for (j in 1:nrow(df)){ 
    if (duplicated(rbind(lp5DF[,1:2],data.frame(timeslot=df[j,"timeslot"], ID=df[j,"ID"])))[nrow(lp5DF)+1]) {next} else{ 
    if (df[j,"min1"] == 0){lp5DF = rbind(lp5DF, data.frame("timeslot" = df[j,"timeslot"], "ID" = df[j,"ID"], "lp5" = NA))} else { 
     total = 0 
     x = df[which((df[,"timeslot"] == df[j,"timeslot"] | df[,"timeslot"] == (df[j,"timeslot"]-1)) & df[,"ID"]==(df[j,"ID"])),"variable1"] 
     for (i in x){ 
     (i <- i ** 5);total <- total + i 
     } 
     lp5DF = rbind(lp5DF, data.frame("timeslot" = df[j,"timeslot"], "ID" = df[j,"ID"], "lp5" = ((abs(total/(length(x))))**(1/5))))    } 
    } 
} 

Выход (голова/хвост) из lp5DF будет:

timeslot ID lp5 
1  1 A NA 
2  1 B NA 
3  1 C NA 
4  1 D NA 
5  1 E NA 
6  1 F NA 
------------------------- 
7738  999 B 14.83423 
7739  999 C 14.80149 
7740  999 E  NA 
7741  999 F 49.48538 
7742  999 G 23.05222 
7743  999 H  NA 

и: lp5DF[,3]==lp5

Однако проверить это, казалось, было намного медленнее (6.5x в моем случае) , Так как я должен много раз выполнять этот расчет, используя множество строк (фреймворк может быть расширен позже в проекте), мои пути слишком медленные. Почему вторая такая медленная, и есть ли способ ускорить это? Возможно, что-то с lapply или пакетом dplyr?

Answer 1

Существует только много возможностей для оптимизации. Попробуйте изучить пакеты обработки данных, такие как dplyr, data.table.

min1 можно рассчитать, используя технику из here

library(dplyr) 
dfs <- split(df$ID, df$timeslot) 
df$min1 <- unlist(mapply(`%in%`, dfs, lag(dfs))) 

lp5 немного сложнее, но управляемо

df1 <- df %>% 
    group_by(timeslot, ID) %>% 
    summarise(min1 = all(min1), s = sum(variable1^5), n = n()) %>% 
    group_by(ID) %>% 
    mutate(s1 = s + lag(s), n1 = n + lag(n), lp5 = ifelse(min1, abs((s1/n1)^(1/5)), NA)) 
lp5 <- df1$lp5 

data.table эквивалент

library(data.table) 
setDT(df) 
dt1 <- df[, .(min1 = all(min1), s = sum(variable1^5), n = .N), by=.(timeslot, ID)] 
dt1[, `:=`(s1 = s + shift(s), n1 = n + shift(n)), by=ID] 
dt1[min1==TRUE, lp5 := abs((s1/n1)^(1/5)), by=ID] 
lp5 <- dt1$lp5