Я пытаюсь выполнить код, который занимает слишком много времени (> 6 дней). Может быть, есть способ сделать его более эффективным. Любые идеи?

library(haven)
library(plyr)
AFILIAD1 <- read_sav("XXXX")
#this sav has around 6 million rows.

AFILIAD1$F_ALTA<- as.character(AFILIAD1$F_ALTA)
AFILIAD1$F_BAJA<- as.character(AFILIAD1$F_BAJA)


AFILIAD1$F_ALTA <- as.Date(AFILIAD1$F_ALTA, "%Y%m%d")
AFILIAD1$F_BAJA <- as.Date(AFILIAD1$F_BAJA, "%Y%m%d")
#starting and ending date

meses <- seq(as.Date("1900-01-01"), as.Date("2014-12-31"), by = "month")

#this is the function that needs to be more efficient 
ocupados <- function(pruebas){
 previo <- c()
 total <- c()
   for( i in 1:length(meses)){
     for( j in 1:nrow(pruebas)){
       ifelse(pruebas$F_ALTA[j] <= meses[i]  & pruebas$F_BAJA[j] >= 
       meses[i], previo[j]<- pruebas$IPF[j],previo[j]<- NA)
      }
    total[i] <- (length(unique(previo))-1)
   }
  names(total)<-meses
  return(total)
}

#this takes >6 days to execute
afiliado1 <- ocupados(AFILIAD1)
r
0
Juan Carbonell 23 Апр 2018 в 00:55

1 ответ

Лучший ответ

Вы можете многое сделать, чтобы это ускорить. Вот один пример:

library(tidyverse) % adds pipes
ocupados <- function(pruebas) {
  total <- map_int(meses, function(x) {
    with(pruebas, {
      IPF[F_ALTA <= x & F_BAJA >= x] %>%
        n_distinct() #I'm assuming you subtract 1 to remove the NA effect - no longer needed
    })
  })
  names(total) <- meses
  return(total)
}

Здесь есть два больших ускорения. Во-первых, внутренний цикл реализован в скомпилированном коде (поэтому вы его здесь не видите), что принесет вам огромную экономию.
Во-вторых, мы никогда не определяем пустые векторы. Эти пустые векторы необходимо копировать КАЖДЫЙ раз, когда вы увеличиваете длину, что очень дорого. Вместо этого все, что я сохраняю, - это конечный результат. Семейство функций apply ведет себя как циклы, но реализует код в функции.

Если вы не знакомы с оператором канала (%>%), все, что он делает, это вызывает следующую функцию с результатом предыдущей функции в качестве следующего аргумента. Так

length(unique(x))

Такой же как

x %>%
  unique() %>%
  length()

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

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

3
Melissa Key 22 Апр 2018 в 23:36