Первая [не особо задумываясь о том, что вы пытаетесь сделать] оптимизация, которую я бы предложил, - выделить хранилище для theOutput.В данный момент вы увеличиваете theOutput на каждой итерации цикла.В R это абсолютное нет нет !!Это то, что вы никогда не делаете, если вам не нравится ужасно медленный код.R должен копировать объект и расширять его во время каждой итерации, и это медленно.
Глядя на код, мы знаем, что theOutput должно иметь nrow(theData) - 1 строк и 3 столбца.Поэтому создайте это до начала цикла:
theOutput <- data.frame(matrix(ncol = 3, nrow = nrow(theData) - 1))
, затем заполните этот объект во время цикла:
theOutput[i, ] <- data.frame("ID" = curId, "START" = curStart, "END" = curEnd))
, например.
Не ясно, чтоSTART и END есть?если это числовые значения, то работа с матрицей, а не с фреймом данных также может повысить эффективность использования скорости.
Кроме того, создание фрейма данных на каждой итерации будет медленным.Я не могу рассчитать время, не тратя много своего времени, но вы можете просто заполнить нужные биты напрямую, не вызывая data.frame() вызов во время каждой итерации:
theOutput[i, "ID"] <- curId
theOutput[i, "START"] <- curStart
theOutput[i, "END"] <- curEnd
Лучший советОднако я могу дать вам, чтобы профилировать ваш код.Посмотрите, где узкие места и ускорить их.Запустите вашу функцию на небольшом подмножестве данных;размер которого достаточен, чтобы дать вам немного времени для сбора полезных данных профилирования без необходимости ждать целую вечность, чтобы завершить прогон профилирования.Чтобы профилировать в R, используйте Rprof():
Rprof(filename = "my_fun_profile.Rprof")
## run your function call here on a subset of the data
Rprof(NULL)
. Вы можете посмотреть на вывод, используя
summaryRprof("my_fun_profile.Rprof")
У Хэдли Уикхэма (@hadley) есть пакет, чтобы сделать это немногоПолегче.Он называется profr .И, как Дирк напоминает мне в комментариях, есть также пакет proftools Люка Тирни.
Редактировать: , так как ОП предоставил некоторые тестовые данныеЯ быстро добавил что-то, чтобы показать ускорение, достигнутое просто следуя хорошей практике цикла:
smoothingEpisodes2 <- function (theData) {
curId <- theData[1, "ID"]
curStart <- theData[1, "START"]
curEnd <- theData[1, "END"]
nr <- nrow(theData)
out1 <- integer(length = nr)
out2 <- out3 <- numeric(length = nr)
for(i in 2:nrow(theData)) {
nextId <- theData[i, "ID"]
nextStart <- theData[i, "START"]
nextEnd <- theData[i, "END"]
if (curId != nextId | (curEnd + 1) < nextStart) {
out1[i-1] <- curId
out2[i-1] <- curStart
out3[i-1] <- curEnd
curId <- nextId
curStart <- nextStart
curEnd <- nextEnd
} else {
curEnd <- max(curEnd, nextEnd, na.rm = TRUE)
}
}
out1[i] <- curId
out2[i] <- curStart
out3[i] <- curEnd
theOutput <- data.frame(ID = out1,
START = as.Date(out2, origin = "1970-01-01"),
END = as.Date(out3, origin = "1970-01-01"))
## drop empty
theOutput <- theOutput[-which(theOutput$ID == 0), ]
theOutput
}
Используя набор тестовых данных в объекте testData, я получаю:
> res1 <- smoothingEpisodes(testData)
> system.time(replicate(100, smoothingEpisodes(testData)))
user system elapsed
1.091 0.000 1.131
> res2 <- smoothingEpisodes2(testData)
> system.time(replicate(100, smoothingEpisodes2(testData)))
user system elapsed
0.506 0.004 0.517
ускорение на 50%.Не драматично, но просто достичь, просто не увеличивая объект на каждой итерации.