Замените «for loop» в моей функции, чтобы быстрее сделать код на больших данных?

Question

Я сделал следующую функцию в R, которая узнает количество обс в определенный промежуток времени.

time_interval <- function(time_vector){ 

    time_seq <- seq(from=as.POSIXct("2012-01-01 00:00:00", tz="UTC"), 
        to=as.POSIXct("2012-01-01 23:00:00", tz="UTC"), by="hour") 


    time_seq <- strftime(time_seq, format="%H:%M:%S", tz = "UTC") 
    start_time <- times(time_seq) 
    end_time <- times(start_time) + times("01:59:59") 
    time_df <- data.frame(start_time = start_time, end_time = end_time) 


    format_time_vector <-times(time_vector) #converting into times format 


    time_count <- c() 
    time_interval <- c() 

    for(i in 1:NROW(time_df)){ 
    time_count <- append(time_count,sum(format_time_vector >= times(time_df[i,1]) & format_time_vector <= times(time_df[i,2]))) 

    time_interval <- append(time_interval,paste(as.character(time_df[i,1]), as.character(time_df[i,2]))) 

    } 
    my_new_data <- data.frame(timeinterval = time_interval, timecount = time_count) 

    return(my_new_data) 
} 

Я следующий кадр данных

structure(list(email_address_hash = structure(1:3, .Label = c("0004eca7b8bed22aaf4b320ad602505fe9fa9d26", 
"00198ee5364d73796e0e352f1d2576f8e8fa99db", "35c0ef2c2a804b44564fd4278a01ed25afd887f8" 
), class = "factor"), open_times = structure(c(1L, 3L, 2L), .Label = c("04:39:24 10:39:43", 
"09:57:20 19:00:09", "21:12:04 07:05:23 06:31:24"), class = "factor"), 
    desired_training_list = list(list("04:39:24"), list(c("21:12:04", 
    "07:05:23")), list("09:57:20")), desired_testing_list = c("10:39:43", 
    "06:31:24", "19:00:09")), .Names = c("email_address_hash", 
"open_times", "desired_training_list", "desired_testing_list" 
), row.names = c(NA, -3L), class = "data.frame") 

Ниже, как мои данные выглядит

Цель: - Узнает интервал времени, в котором мы имеем максимальное наблюдение. Мы занимаем промежуток времени в 2 часа. Например, если у нас 10 обс между интервалом времени 00: 00: 00-2: 00: 00 и 5 сс между временным интервалом 8: 00: 00-10: 00: 00. Мы выберем 00: 00: 00-2: 00: 00 в качестве выходного сигнала и отобразим его в столбце кадра данных

Обратите внимание, что если у нас есть одно и то же обс во всем интервале времени, то мы можем случайным образом выбрать любое время, интервал для наилучшего временного интервала этого клиента.

Я попробовал следующий подход

data$training_best_time <- rep('NA',NROW(data)) 
data$training_best_time_count <- rep(0,NROW(data)) 
data$training_best_time<- apply(data[,3,drop= FALSE], MARGIN = 1, function(x) as.character(setorder(time_interval(as.vector(unlist(x))), -timecount)[1,1])) 

data$training_best_time_count <- apply(data[,3,drop= FALSE], MARGIN = 1, function(x) as.character(setorder(time_interval(as.vector(unlist(x))), -timecount)[1,2])) 

Это как мой результат выглядит

Проблема: - Когда я запускаю эту функцию над миллионами строк это займет 4-5 часов для завершения или даже намного большего. Я хочу сделать это быстрее

Оценка области проблем: - Из моего опыта работы с data.table Я думаю, что это моя собственная функция, которая заставляет R тратить много времени. Хотя я не уверен. Я также пробовал цикл внутри data.table, но это не очень полезно для сокращения времени выполнения.

Пожалуйста, помогите мне ускорить мой код. Пожалуйста, дайте мне знать, если у вас возникли трудности с пониманием моей проблемы.

Answer 1

Просто, чтобы остаться внутри вашей функции (и не упоминать, как это называется), вы можете найти некоторое улучшение, слегка отрегулировав петлю for. Вы можете предварительно выделить вектор для начала, что должно помочь, а также удалить time_interval части цикла целиком (так как вы можете векторизации этой части довольно легко):

time_count <- vector(mode = "integer", length = nrow(time_df)) 
for(i in 1:nrow(time_df)){ 
    time_count[i] <- sum(format_time_vector >= times(time_df[i,1]) & format_time_vector <= times(time_df[i,2])) 
} 
time_interval <- paste(time_df$start_time, time_df$end_time) 

Кроме того, я просто понял, что вы работаете весь сценарий дважды, один раз для каждого столбца вашего вывода, вы можете запустить его один раз, взяв оба вывода в виде элементов списка, а затем привязывая их как ваш кадр данных.

data2 <- lapply(data[[3]], function(x) as.character(setorder(time_interval(as.vector(unlist(x))), -timecount)[1,])) 
data2 <- do.call(rbind, data2) 
names(data2) <- c("training_best_time", "training_best_time_count") 
data <- cbind(data, data2)