0

Tengo un código en R que me dice si la póliza de mi base de datos es nueva o no. Para ello tengo la BBDD ordenada por titular y fecha de emision luego le aplico este bucle:

#Format dates

emision <- as.POSIXct(datos$Fecha_Emision_Poliza, format= "%Y-%m-%d", tz="UTC")

anulacion <- as.POSIXct(datos$Fecha_Anulacion, format= "%Y-%m-%d", tz="UTC")


#Todo a TRUE

datos$Nuevos_Clientes[1] <- "T"


#La primera póliza a TRUE las demás a FALSE

for (t in 2:nrow(datos)) {

  datos$Nuevos_Clientes[t] <- "T"

  if (datos$Cod_Titular_Poliza[t]==datos$Cod_Titular_Poliza[t-1]){

    datos$Nuevos_Clientes[t] <- "F"
  }
}

#Defino vector con índices
vec <- vector(length = nrow(datos)) 
vec <- which(datos$Nuevos_Clientes == "T")

vec[length(vec)+1] <- nrow(datos)+1

#Creo una función para calcular el máximo de las anulaciones anteriores

max_anula <- function( q, w) {

  voc <- vector(length = q-w)

  for (m in w:(q-1)) {
    voc[m-w+1]<- anulacion[m]

  }

  maxi <- max(voc, na.rm = TRUE)

  return(maxi)
}

#Recorre las pólizas
s <- 1
for (h in vec){
  s <- s+1
if(h==max(vec) | s == length(vec)+1){
  break
}  
  else if (vec[s]-vec[s-1]==1){

  next}

  else {

for (i in (h+1):(vec[s]-1)){

  print(cat("Esta es i: ",i,"\n"))
  print(cat("Esta es s: ",s,"\n"))
  print(cat("Esta es h: ",h,"\n"))

  if(emision[i]==emision[i-1]){

    datos$Nuevos_Clientes[i]<-datos$Nuevos_Clientes[i-1]
  } 
  else if (is.na(anulacion[i-1]==TRUE)){

    for (n in i:(vec[s]-1)) {
      datos$Nuevos_Clientes[i]<- "F" #Como hay una arriba "Activa" todos los de abajo "F"

    }
    break #rompe el bucle ya no tengo que mirar más pólizas de este titular
  } else if (emision[i]<anulacion[i-1]){
    datos$Nuevos_Clientes[i]<- "F"
  }
    else if (as.numeric(emision[i])< max_anula(i-1, h)){ #Compruebo que la fecha más reciente de las anulaciones anteriores
                                                         #es mayor que la fecha de emision de la poliza
      datos$Nuevos_Clientes[i]<- "F" 
    }
    else 

      datos$Nuevos_Clientes[i]<- "T" 

                           }  
     }
}

El bucle funciona perfectamente. Por ejemplo, cargo una muestra como esta: Muestra de la BBDD

Y siendo una muestra de 100.000 filas R resuelve el bucle en menos de dos minutos. Ahora bien, cuando uso IBM SPPS Modeler 18.1 con un nodo de transformación de R tarda horas. En Modeler solo cambio el nombre del dataset por modelerData. Creo la nueva variable con:

modelerData$Nuevos_Clientes <- Nuevos_Clientes

Luego creo una variable con los nuevos metadatos:

newVar <- c(fieldName="Nuevos_Clientes", fieldLabel="", fieldStorage="string", fieldMeasure="", fieldFormat="", fieldRole="")

Y los guardo en modeler:

modelerDataModel <- cbind(modelerDataModel, newVar)

¿Alguien sabe por qué tarda tanto en ejecutarse en Modeler? He probado con una muestra de 1000 filas y Modeler lo hace en menos de 30 segundos, luego probé con 10.000 filas y Modeler lo hace en menos de un minuto. ¿Cómo puede ser que al ponerle 100.000 tarde tanto?

Muchas gracias.

4
  • En principio, más allá que tu código se podría implementar distinto, no veo ningún problema significativo que tire abajo la performance. Por lo que te sugiero aislar el código que representa el "cuello de botella". ¿Ya sabés cual es? ¿Qué parte del mismo? ¿O es el código adicional que implementas para el modeler? ¿Que es modelerDataModel? ¿Que tamaño tiene?. Mi sugerencia rápida, agrega un salida que vaya mostrando la hora en las partes principales del código: print(Sys.time()), luego analiza que parte se lleva la mayor parte del tiempo, y ahí nos dices. Commented el 21 oct. 2019 a las 16:16
  • Gracias por tu respuesta @PatricioMoracho Seguramente el código se pueda mejorar mucho. Pensé en usar vectorizaciones pero como tengo que recorrer las fechas de las pólizas de cada titular no se me ocurrió mejor forma que un loop. El cuello de botella estará a partir del código que continua a #Recorre las pólizas, pero lo estoy ejecutando ahora con los Sys.time() para verlo mejor. El código adicional para Modeler no creo que sea el problema. Es un código para que Modeler entienda la estructura de los datos de R.
    – Domians
    Commented el 22 oct. 2019 a las 9:34
  • modelerDataModel es una variable que contiene los metadatos del dataset de manera que Modeler lo entienda.
    – Domians
    Commented el 22 oct. 2019 a las 9:37
  • Aísla exactamente dónde el script se lleva la mayor parte del tiempo, eso es fundamental. Con respecto a modelerDataModel, lo que puedo decir es que cbind() para agregar columnas termina haciendo una copia completa del objeto, si éste tiene un volumen importante, este puede ser posible cuello de botella. Commented el 22 oct. 2019 a las 13:39

1 respuesta 1

0

Parece que la vieja máxima de divide y vencerás es la solución al problema. No es necesario recorrer todas las pólizas sino solo las de aquellos titulares que tengan más de una. Ahora el programa no tarda más de una hora.

Por tanto:

#Todo a TRUE
datos$Nuevos_Clientes[1] <- "T"

Luego dividimos el data set para solo recorrer los titulares que tengan más de una póliza:

titulares_0 <- datos %>% group_by(Cod_Titular_Poliza)%>% tally() %>% filter(n ==1) # una poliza

names(titulares_0) <- c("v1", "n")

titulares_1 <- datos %>% group_by(Cod_Titular_Poliza)%>% tally() %>% filter(n >1) # + Una Poliza

names(titulares_1) <- c("v2", "n")

datos_1 <- merge(datos, titulares_1, by.x = "Cod_Titular_Poliza", by.y = "v2")

datos_0 <- merge(datos, titulares_0, by.x = "Cod_Titular_Poliza", by.y = "v1")

Probablemente el código anterior se pueda mejorar pero así funciona. Después, formateo las fechas, solo para datos_1, porque datos_0 siempre será "T":

emision <- as.POSIXct(datos_1$Fecha_Emision_Poliza, format= "%Y-%m-%d", tz="UTC")

anulacion <- as.POSIXct(datos_1$Fecha_Anulacion, format= "%Y-%m-%d", tz="UTC")

Ahora le digo que ponga "T" solo la primera póliza de cada Titular, las demás a "F" y además como el dataset tiene errores en la Fecha de Emision, lo arreglo dándole la fecha de la póliza anterior (Seguramente esto también se pueda mejorar, pero son muy pocos caso):

for (t in 2:nrow(datos_1)) {

  print(cat("Esta es t: ",t,"\n"))

  if (datos_1$Cod_Titular_Poliza[t]==datos_1$Cod_Titular_Poliza[t-1]){

    datos_1$Nuevos_Clientes[t] <- "F"

    if (is.na(emision[t]==TRUE)){
      emision[t] <- emision[t-1]
    }
  }
}

#Defino vector con índices
vec <- vector(length = nrow(datos_1)) 
vec <- which(datos_1$Nuevos_Clientes == "T")

vec[length(vec)+1] <- nrow(datos_1)+1

Creo una función para calcular la fecha de anulación más reciente para cada Titular:

max_anula <- function( q, w) {

  voc <- vector(length = q-w)

  for (m in w:(q-1)) {
    voc[m-w+1]<- anulacion[m]

  }

  maxi <- max(voc, na.rm = TRUE)

  return(maxi)
}

Y además creo otra función para saber si hay alguna póliza anterior "Activa":

max_anula_na <- function( q, w) {

  voc <- vector(length = q-w)

  for (m in w:(q-1)) {
    voc[m-w+1]<- datos_1$Estado_Poliza[m]

  }

  maxi <- min(voc)

  return(maxi)
}

Ahora viene el loop que va a recorrer todas las pólizas de datos_1:

s <- 1
for (h in vec){
  s <- s+1
  if(h==max(vec) | s == length(vec)+1){
    break
  }  
  else if (vec[s]-vec[s-1]==1){

    next}

  else {

    for (i in (h+1):(vec[s]-1)){

      if(emision[i]==emision[i-1]){

        datos_1$Nuevos_Clientes[i]<-datos_1$Nuevos_Clientes[i-1]

      } 

        else if (is.na(anulacion[i-1]==TRUE) | max_anula_na(i-1,h)==1){

        for (n in i:(vec[s]-1)) {
          datos_1$Nuevos_Clientes[i]<- "F" #Como hay una arriba "Activa" todos los de abajo "F"

        }
        break #rompe el bucle ya no tengo que mirar más pólizas de este titular
      } else if (emision[i]<anulacion[i-1]){

        datos_1$Nuevos_Clientes[i]<- "F"
      }
      else if (as.numeric(emision[i])< max_anula(i-1, h)){ #Compruebo que la fecha más reciente de las anulaciones anteriores
        #es mayor que la fecha de emision de la poliza
        datos_1$Nuevos_Clientes[i]<- "F" 
      }
      else 

        datos_1$Nuevos_Clientes[i]<- "T" 

    }  
  }
}

````

Y por último uno los dos conjuntos de datos:

````
datos <- rbind(datos_1,datos_0)
````


1
  • Parece que a pesar de dividir el dataset en Modeler sigue tardando demasiado. En R lo hizo en una hora aprox. En Modeler lleva 15 horas y media sin terminar. Hay algo mal en la implementación de R en Modeler
    – Domians
    Commented el 24 oct. 2019 a las 7:45

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.