statement - ¿Cómo optimizar el siguiente código con while-loop anidado? ¿Multicore una opción?

if else r studio

Question

Estoy teniendo un desafío con un código que lleva mucho tiempo ejecutar y me pregunto cuáles son los trucos clave para optimizar el tiempo de ejecución de este código. Tengo que admitir que el data.frame de entrada es significativo (140,000 filas) y que el data.frame de salida es de aproximadamente 220,000 filas.

Una muestra de la entrada data.frame:

head(extremes)
X_BusinessIDDescription     min         max         month
ID105                       2007-12-01  2008-06-01  2007-12-01
ID206                       2007-12-01  2009-07-01  2007-12-01
ID204                       2007-12-01  2008-02-01  2007-12-01
ID785                       2008-07-01  2010-08-01  2008-07-01
ID125                       2007-11-01  2008-07-01  2007-11-01
ID107                       2007-11-01  2011-06-01  2007-11-01

El data.frame que se extenderá con el bucle. El data.frame se inicia para obtener la estructura en su lugar.

output <- extremes[1,]
output
X_BusinessIDDescription     min         max         month
ID105                       2007-12-01  2008-06-01  2007-12-01

Otros valores

IDcounter <- 1
IDmax <- nrow(extremes)
linecounter <- 1

El while-loop me gustaría optimizar:

while (IDcounter <= IDmax){
    start <- extremes$min[IDcounter]
    end <- extremes$max[IDcounter] # add three months
    while(start <= end){
        output[linecounter,] <- extremes[IDcounter,]
        output$month[linecounter] <- start
        linecounter <- linecounter+1
        start <- seq(start, by ="month", length=2)[2]
    }
    IDcounter <- IDcounter + 1
}

Para un pequeño número de filas, este código se ejecuta bastante rápido, pero parece que se está desacelerando a medida que se extiende la salida.

El resultado se ve así:

head(output)
X_BusinessIDDescription     min         max         month
ID105                       2007-12-01  2008-06-01  2007-12-01
ID105                       2007-12-01  2008-06-01  2008-01-01
ID105                       2007-12-01  2008-06-01  2008-02-01
ID105                       2007-12-01  2008-06-01  2008-03-01
ID105                       2007-12-01  2008-06-01  2008-04-01
ID105                       2007-12-01  2008-06-01  2008-05-01

Por cada mes en el intervalo entre min y max en el archivo extremo se crea una fila.

También me interesaría saber cómo puedo hacer para que este código pueda tener en cuenta los múltiples núcleos de recursos informáticos disponibles. De acuerdo, admito que esto no es realmente una optimización, pero reducirá el tiempo de ejecución, que también es importante.

Jochem

Answer 1

Como ya se mencionó en @CarlWitthoft, debe reconsiderar su estructura de datos debido a la cantidad de datos duplicados.

Aquí encontrará un enfoque vectorizado simple:

  ## create all possible ranges of months
  ranges <- mapply(function(mi, ma) {seq(from=mi, to=ma, by="month")}, mi=extremes$min, ma=extremes$max)

  ## how many months per ID?
  n <- unlist(lapply(ranges, length))

  ## create new data.frame
  output <- data.frame(X_BusinessIDDescription=rep(extremes$X_BusinessIDDescription, n),
                      min=rep(extremes$min, n),
                      max=rep(extremes$max, n),
                      month=as.Date(unlist(ranges), origin="1970-01-01"), stringsAsFactors=FALSE)

Comparación con su enfoque:

extremes <- data.frame(X_BusinessIDDescription=c("ID105", "ID206", "ID204", "ID785", "ID125", "ID107"),
                      min=as.Date(c("2007-12-01", "2007-12-01", "2007-12-01", "2008-07-01", "2007-11-01", "2007-11-01")),
                      max=as.Date(c("2008-06-01", "2009-07-01", "2008-02-01", "2010-08-01", "2008-07-01", "2011-06-01")),
                      month=as.Date(c("2007-12-01", "2007-12-01", "2007-12-01", "2008-07-01", "2007-11-01", "2007-11-01")),
                      stringsAsFactors=FALSE)

approachWhile <- function(extremes) {
  output <- data.frame(X_BusinessIDDescription=NA, min=as.Date("1970-01-01"), max=as.Date("1970-01-01"), month=as.Date("1970-01-01"), stringsAsFactors=FALSE)
  IDcounter <- 1
  IDmax <- nrow(extremes)
  linecounter <- 1
  while (IDcounter <= IDmax){
    start <- extremes$min[IDcounter]
    end <- extremes$max[IDcounter] # add three months
    while(start <= end){
        output[linecounter,] <- extremes[IDcounter,]
        output$month[linecounter] <- start
        linecounter <- linecounter+1
        start <- seq(start, by ="month", length=2)[2]
    }
    IDcounter <- IDcounter + 1
  }
  return(output)
}

approachMapply <- function(extremes) {                       
  ranges <- mapply(function(mi, ma) {seq(from=mi, to=ma, by="month")}, mi=extremes$min, ma=extremes$max)

  n <- unlist(lapply(ranges, length))

  output <- data.frame(X_BusinessIDDescription=rep(extremes$X_BusinessIDDescription, n),
                      min=rep(extremes$min, n),
                      max=rep(extremes$max, n),
                      month=as.Date(unlist(ranges), origin="1970-01-01"), stringsAsFactors=FALSE)
  return(output)
}

identical(approachWhile(extremes), approachMapply(extremes)) ## TRUE

library("rbenchmark")

benchmark(approachWhile(extremes), approachMapply(extremes), order="relative")
#                      test replications elapsed relative user.self sys.self
#2 approachMapply(extremes)          100   0.176     1.00     0.172    0.000
#1  approachWhile(extremes)          100   6.102    34.67     6.077    0.008