Расчеты с использованием функций lapply() и Reduce() требуют слишком много времени и памяти. Для 100 тыс. случаев понадобилось около часа.
Буду пробовать делать так, как советовал gamm
Пример расчетов для вектора длинной в 5 элементов
Код: Выделить всё
a1 <- c(1, 4)
a2 <- c(3, 8)
A <- data.frame(a1, a2)
G <- rep(0,5)
FF <- function(x){
tmp <- rep(0, 5 * ceiling((x[1]+x[2]-1)/5))
if(x[2] > 0) tmp[(x[1]):(x[1]+x[2]-1)] <- 1
B <- colSums(matrix(tmp, ncol=5, byrow=TRUE))
assign("G", G + B, envir = .GlobalEnv)
return(NULL)
}
apply(A,1,FF)
G
Получилось!!!
Окончательный вариант кода:
Код: Выделить всё
a1 <- hour(V$St)*60 + minute(V$St)
a1[a1 == 0] <- 1
a2 <- V$Tm
Tm <- data.frame(a1, a2)
G <- rep(0,1440)
FF <- function(x){
tmp <- rep(0, 1440 * ceiling((x[1]+x[2]-1)/1440))
if(x[2] > 0) tmp[(x[1]):(x[1]+x[2]-1)] <- 1
B <- colSums(matrix(tmp, ncol = 1440, byrow=TRUE))
assign("G", G + B, envir = .GlobalEnv)
return(NULL)
}
apply(Tm,1,FF)
D <- data.frame(Time = seq(0, 86340, by = 60), G)
D$Tm <- as.POSIXct(D$Time, origin = "1970-01-01", tz = "GMT")
ggplot(D, aes(x = Time, y = G)) +
geom_point(alpha = 0.2, colour = "red") +
geom_smooth(se = FALSE) +
scale_x_time(breaks = date_breaks("3 hours"),
labels = time_format("%H:%M", tz = "GMT"),
name = "hh:mm")
Данные за весь 2018 и 2019 год (почти миллион записей) вместе с построением графика были обработаны за время порядка одной минуты.
График
Еще раз спасибо gamm и nickleb за помощь!