Thursday, August 22, 2013

Forecasting con Redes Neurales (usando SAP HANA y R)

Usualmente...cuando uso R...trato de usar también SAP HANA...y la forma más simple de hacerlo trabajar es de hecho, haciendo una conexión ODBC....rápido y sencillo...

Primero, me fuí a mi SAP HANA Studio para obtener el query...el cual es basicamente...obtener todos los asientos (Primera Clase, Business, Clase Económica) de todos los vuelos que sucedieron entre los años 2010 y 2012.

Query from HANA Studio 
SELECT FLDATE, SEATSOCC, SEATSOCC_B, SEATSOCC_F 
FROM SFLIGHT.SFLIGHT WHERE YEAR(FLDATE) BETWEEN '2010' AND '2012'

El resultado se verá así...


Pero...queremos tener todos los asientos sumarizados en una sola variable y tambien organizados por Mes/Año. Y aunque podemos hacer eso con SQL...eso le quitaría toda la diversión a R...

Getting and formatting data 
library("RODBC")

format_date<-function(p_date){
  p_date<-as.Date(as.character(p_date),"%Y%m%d")
  p_date<-format(p_date,"%Y%m")
  return(p_date)
}

ch<-odbcConnect("HANA",uid="SYSTEM",pwd="********")
result<-sqlQuery(ch,"SELECT FLDATE, SEATSOCC, SEATSOCC_B, SEATSOCC_F 
                 FROM SFLIGHT.SFLIGHT WHERE YEAR(FLDATE) BETWEEN '2010' AND '2012'")
odbcCloseAll()
dates<-result$FLDATE
dates<-format_date(dates)
result$FLDATE = dates
result_agg<-aggregate(cbind(SEATSOCC,SEATSOCC_B,SEATSOCC_F)~.,data=result,FUN=sum)
result_total<-data.frame(FLDATE=result_agg$FLDATE,SEATS=result_agg$SEATSOCC+
                         result_agg$SEATSOCC_B+result_agg$SEATSOCC_F,stringsAsFactors=FALSE)

Primero, usando la librería RODBC nos conectamos a nuestro servidor SAP HANA. Luego, tomamos las fechas y utilizado una función customizada, los convertimos a Mes/Año. Hacemos una agregación para obtener la suma de todos los asientos y luego construímos un Data Frame para poder manejar los datos.

Cuando imprimos el resultado final...vamos a darnos cuenta de algo que seguramente había escapados de nuestros ojos...


Para el 2010, los meses empiezan en Abril, lo cual significa que de Enero a Marzo no hay información...y lo mismo pasa con el 2012 donde la información termina en Abril y de Junio a Diciembre no hay nada.

Como queremos hacer un Forecasting con Redes Neuronales...esta data incompleta no nos va a servir para nada...así que debemos hacer algo para corregir esto...

Algo que podemos hacer, por lo menos para el 2012, es el Moving Average...que es basicamente tomar los valores de Eneto a Abril, sumarlos, dividirlos por el números de meses y luego asignar este valor a Mayo (201205)...luego...tomar el valor desde Febrero a Mayo y hacer los mismo para Junio...y seguir así -:)

Para el 2010 paracer ser un poco más complicado...pero es casi lo mismo...utilizo algo que me gusta llamar Backward Average...sin importarme cual es un nombre real -:P Basicamente, tomamos los valores de Diciembre a Abril, sumarlos, dividirlos por el número de meses y determinar el valor para Marzo...y seguir así...

Veamos el código...

Moving and Backward Average 
library("RODBC")

format_date<-function(p_date){
  p_date<-as.Date(as.character(p_date),"%Y%m%d")
  p_date<-format(p_date,"%Y%m")
  return(p_date)
}

moving_average<-function(p_values,year_start,month_start,year_end,month_end){
  month<-as.numeric(month_start) - 1
  init_month<-"01"
  if(length(month)==1){
    init_date<-paste(year_start,"0",month,sep='')
  }
  base_date<-paste(year_start,init_month,sep='')
  counter<-as.numeric(month_end) - as.numeric(month_start)
  
  values<-p_values
  
  for(i in 0:counter){
    values<-subset(values, FLDATE <= init_date & FLDATE >= base_date) 
    new_value<-floor(mean(values$SEATS))
    new_values<-data.frame(FLDATE=paste(year_start,month_start,sep=''),SEATS=new_value)
    p_values<-rbind(p_values,new_values)
    month_start<-as.numeric(month_start) + 1
    if(nchar(month_start)==1){
      month_start<-paste("0",month_start,sep='')
    }
    values<-rbind(values,new_values)
    month<-month + 1
    init_month<-as.numeric(init_month) + 1
    if(nchar(month)==1){
      init_date<-paste(year_start,"0",month,sep='')
    }else{
      init_date<-paste(year_start,month,sep='')
    }
    if(nchar(init_month)==1){
      base_date<-paste(year_start,"0",init_month,sep='')  
    }else{
      base_date<-paste(year_start,init_month,sep='')  
    }
  }
  return(p_values)
}

backward_average<-function(p_values,year_start,month_start,year_end,month_end){
  month<-as.numeric(month_start) - 1
  init_month<-"12"
  if(length(month)==1){
    init_date<-paste(year_start,"0",month,sep='')
  }
  base_date<-paste(year_start,init_month,sep='')
  counter<-as.numeric(month_start) - as.numeric(month_end)
  
  values<-p_values
  
  for(i in 0:counter){
    values<-subset(values, FLDATE <= base_date & FLDATE >= init_date) 
    new_value<-floor(mean(values$SEATS))
    new_values<-data.frame(FLDATE=paste(year_start,month_start,sep=''),SEATS=new_value)
    p_values<-rbind(p_values,new_values)
    month_start<-as.numeric(month_start) - 1
    if(nchar(month_start)==1){
      month_start<-paste("0",month_start,sep='')
    }
    values<-rbind(values,new_values)
    month<-month + 1
    init_month<-as.numeric(init_month) - 1
    if(nchar(month)==1){
      init_date<-paste(year_start,"0",month,sep='')
    }else{
      init_date<-paste(year_start,month,sep='')
    }
    if(nchar(init_month)==1){
      base_date<-paste(year_start,"0",init_month,sep='')  
    }else{
      base_date<-paste(year_start,init_month,sep='')  
    }
  }
  return(p_values)
}

ch<-odbcConnect("HANA",uid="SYSTEM",pwd="********")
result<-sqlQuery(ch,"SELECT FLDATE, SEATSOCC, SEATSOCC_B, SEATSOCC_F 
                 FROM SFLIGHT.SFLIGHT WHERE YEAR(FLDATE) BETWEEN '2010' AND '2012'")
odbcCloseAll()
dates<-result$FLDATE
dates<-format_date(dates)
result$FLDATE = dates
result_agg<-aggregate(cbind(SEATSOCC,SEATSOCC_B,SEATSOCC_F)~.,data=result,FUN=sum)
result_total<-data.frame(FLDATE=result_agg$FLDATE,SEATS=result_agg$SEATSOCC+
                         result_agg$SEATSOCC_B+result_agg$SEATSOCC_F,stringsAsFactors=FALSE)
result_total<-moving_average(result_total,"2012","05","2012","12")
result_total<-backward_average(result_total,"2010","03","2010","01")

Cuando ejecutamos...nos daremos cuenta que de hecho...tenemos los 3 años con valores completos -;)


Ahora...podemos utilizar finalmente el Forecasting -;)

Neural_Network_Forecasting.R 
library("RODBC")
library("forecast")

format_date<-function(p_date){
  p_date<-as.Date(as.character(p_date),"%Y%m%d")
  p_date<-format(p_date,"%Y%m")
  return(p_date)
}

moving_average<-function(p_values,year_start,month_start,year_end,month_end){
  month<-as.numeric(month_start) - 1
  init_month<-"01"
  if(length(month)==1){
    init_date<-paste(year_start,"0",month,sep='')
  }
  base_date<-paste(year_start,init_month,sep='')
  counter<-as.numeric(month_end) - as.numeric(month_start)
  
  values<-p_values
  
  for(i in 0:counter){
    values<-subset(values, FLDATE <= init_date & FLDATE >= base_date) 
    new_value<-floor(mean(values$SEATS))
    new_values<-data.frame(FLDATE=paste(year_start,month_start,sep=''),SEATS=new_value)
    p_values<-rbind(p_values,new_values)
    month_start<-as.numeric(month_start) + 1
    if(nchar(month_start)==1){
      month_start<-paste("0",month_start,sep='')
    }
    values<-rbind(values,new_values)
    month<-month + 1
    init_month<-as.numeric(init_month) + 1
    if(nchar(month)==1){
      init_date<-paste(year_start,"0",month,sep='')
    }else{
      init_date<-paste(year_start,month,sep='')
    }
    if(nchar(init_month)==1){
      base_date<-paste(year_start,"0",init_month,sep='')  
    }else{
      base_date<-paste(year_start,init_month,sep='')  
    }
  }
  return(p_values)
}

backward_average<-function(p_values,year_start,month_start,year_end,month_end){
  month<-as.numeric(month_start) - 1
  init_month<-"12"
  if(length(month)==1){
    init_date<-paste(year_start,"0",month,sep='')
  }
  base_date<-paste(year_start,init_month,sep='')
  counter<-as.numeric(month_start) - as.numeric(month_end)
  
  values<-p_values
  
  for(i in 0:counter){
    values<-subset(values, FLDATE <= base_date & FLDATE >= init_date) 
    new_value<-floor(mean(values$SEATS))
    new_values<-data.frame(FLDATE=paste(year_start,month_start,sep=''),SEATS=new_value)
    p_values<-rbind(p_values,new_values)
    month_start<-as.numeric(month_start) - 1
    if(nchar(month_start)==1){
      month_start<-paste("0",month_start,sep='')
    }
    values<-rbind(values,new_values)
    month<-month + 1
    init_month<-as.numeric(init_month) - 1
    if(nchar(month)==1){
      init_date<-paste(year_start,"0",month,sep='')
    }else{
      init_date<-paste(year_start,month,sep='')
    }
    if(nchar(init_month)==1){
      base_date<-paste(year_start,"0",init_month,sep='')  
    }else{
      base_date<-paste(year_start,init_month,sep='')  
    }
  }
  return(p_values)
}

ch<-odbcConnect("HANA",uid="SYSTEM",pwd="********")
result<-sqlQuery(ch,"SELECT FLDATE, SEATSOCC, SEATSOCC_B, SEATSOCC_F 
                 FROM SFLIGHT.SFLIGHT WHERE YEAR(FLDATE) BETWEEN '2010' AND '2012'")
odbcCloseAll()
dates<-result$FLDATE
dates<-format_date(dates)
result$FLDATE = dates
result_agg<-aggregate(cbind(SEATSOCC,SEATSOCC_B,SEATSOCC_F)~.,data=result,FUN=sum)
result_total<-data.frame(FLDATE=result_agg$FLDATE,SEATS=result_agg$SEATSOCC+
                         result_agg$SEATSOCC_B+result_agg$SEATSOCC_F,stringsAsFactors=FALSE)
result_total<-moving_average(result_total,"2012","05","2012","12")
result_total<-backward_average(result_total,"2010","03","2010","01")
result_total <- result_total[order(result_total$FLDATE),] 
result_ts<-ts(result_total$SEATS,frequency=12,start=c(2010,1))

fit <- nnetar(result_ts)
fcast <- forecast(fit)
plot(fcast)

Veamos el gráfico generado...


Como pueden ver...la predicción del 2013 al 2015 es muy baja...pero es simplemente por el hecho de que el 2012 fué un año muy bajo...

Saludos,

Blag.
Posted by at
Labels: ,

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)