ARIMA_monthly_model.R

require(zoo)
require(lubridate)
require(forecast)
require(RODBC) 
require(DBI)
require(RODBCext)

FN_ExecuteForecast <- function(myDataSet, myConnection) {
  #browser()
  
  InputQuery <- #query to pull data from DB
  #ViewName <- 'FCST_Params_02' #test
  ViewName <- myDataSet
  InputQuery <- gsub("@FCST_Params",ViewName, InputQuery)
  
  df <- sqlQuery(dbpush, InputQuery)
  #print(InputQuery)
  
  #REMOVE CURRENT MONTHS REVENUE DATA 
  df <- df[1:nrow(df)-1,]
  
  # GENERATE METRICS AND ADD TO ORIGINAL DATASET  
  metrics <- function (data) {
    
    output <- data.frame()
    mean   <- vector()
    sd     <- vector()
    cumsum <- vector()
    
    revenue     <- data$Revenue
    ma.window   <- 3
    sd.window   <- ma.window
    
    for (i in 1:length(revenue)) {
      
      if (i < ma.window) { 
        cumsum[i] <- sum(revenue[1:i]) 
        mean[i]   <- NA
        sd[i]     <- NA
        
      } else {
        cumsum[i] <- sum(revenue[1:i]) 
        mean[i] <- (sum(revenue[(i - (ma.window - 1) ):i]) / ma.window)  
        sd[i]   <- (sd(revenue[(i - (ma.window - 1) ):i]))
        
      }
    } 
    
    output <- cbind(data, mean, sd, cumsum)
    return(output)
  }
  df <- metrics(df)
  
  # APPLY FILTER TO DATA BASED ON CONDITION(S)
  filter <- function (data) { 
    
    window  <- 6 
    output  <- data.frame()
    rev.diff<- vector() 
    
    org.rev <- data$Revenue
    alt.rev <- data$Revenue 
    mean    <- data$mean
    sd      <- data$sd
    
    for (i in 1:length(org.rev)) {
      
      if (i < window) { 
        alt.rev[i]  <- org.rev[i]
        rev.diff[i] <- 0 
        
      } else if (sd[i] > sd[i-1] * 1.96) {
        alt.rev[i]  <- mean[i-1] + (sd[i-1] * 1.96)
        rev.diff[i] <- org.rev[i] - alt.rev[i]
        
      } else { 
        rev.diff[i] <- 0
        alt.rev[i] <- alt.rev[i]
        org.rev[i] <- org.rev[i]
        
      }
    }
    
    output <- as.data.frame(cbind(alt.rev, rev.diff))
    return(output)
  }
  adj.rev <- filter(df)
  df      <- cbind(df, adj.rev)
  
  #PARAMETERS (CHANGE IF DESIRED)
  
  p <- 1
  d <- 1
  q <- 0
  order           <- c(p,d,q)
  
  P <- 0 
  D <- 1
  Q <- 0
  seasonal.order  <- c(P,D,Q)
  
  #CHANGE THIS VALUE FOR WINDOW ALTERATIONS (11 = FORECAST 11 PERIODS OUT)
  forecast.qty    <- 11
  
  #DO NOT CHANGE THIS VALUE (MONTHLY MODEL = 12 PERIODS)
  forecast.period <- 12
  
  fit      <- arima(df["Revenue"], 
                    order = order, 
                    seasonal = list(order = seasonal.order, 
                                    period = forecast.period))
  
  forecast <- forecast(fit, h = forecast.qty) 
  
  generate.dates <- function(forecast.qty, df) {
    #browser() 
    current.date <- ymd(max(as.character(df$Date)))
    dates <- vector()
    
    for(period in 1:forecast.qty) {
      dates[period] <- as.character(current.date %m+% months(period))
    }
    
    return(dates)
  }
  
  #CREATE TABLE TO PASS TO EXPERIMENTS DB
  results    <- data.frame()
  
  today            <- as.character(rep(Sys.Date(), times = forecast.qty))
  pred.rev         <- forecast$mean
  p                <- rep(p, times = forecast.qty)
  d                <- rep(d, times = forecast.qty)
  q                <- rep(q, times = forecast.qty)
  P                <- rep(P, times = forecast.qty)
  D                <- rep(D, times = forecast.qty)
  Q                <- rep(Q, times = forecast.qty)
  ViewName         <- rep(ViewName, times = forecast.qty) #already dup'd?
  
  forecasted.dates <- generate.dates(forecast.qty, df)
  
  #BIND RESULTS SET VECTORS 
  results <- cbind(
    today,
    forecasted.dates,
    pred.rev,
    p,
    d,
    q,
    P,
    D,
    Q,
    ViewName
  )
  
  #FORMAT TO DATAFRAME 
  results                  <- as.data.frame(results)
  results$today            <- as.Date(results$today)
  results$forecasted.dates <- as.Date(results$forecasted.dates)
  
  #WRITE TABLE TO EXPERIEMENTS DB 
  sqlExecute(dbpush,
             "
             #sql query to write df back to db
              ",
             
             results[,c("today","forecasted.dates","pred.rev","p","d","q","P","D","Q","ViewName")])
  
}