## mkForecast.r

mkForecast <- function(DT
                        , valueCol
                        , dateCol="date"
                        , byCols=key(DT)
                        , date_diff=c("month", "day", "week", "year")
                        , date.target=max(DT[[dateCol]])
                        , months.to.test=3
                        , method="all"
                        , verbose=TRUE
                        , fail.on.duplicates=FALSE
                      ) {

  ## This check also exists inside the createForecast. Used here as a safety before changing keys
  if (!length(method) || !(all(method %in% c("all", "full", "last12", "last7", "last3", "last2", "last4", "ma3", "self"))))
    stop ("Invalid method chosen")

  ## Try to auto-determine date_diff by taking a sample of DT and checking it's format
  ## This is poorly done.  
  if (missing(date_diff)) {
    dateSamples <- sampleRows(DT[[dateCol]], n.perc=0.1, chunksize=100, min=max(nrow(DT), 1e3), max=min(nrow(DT), 5e4), showWarnings=FALSE)
    date_diff   <- findDateInterval(dateSamples)
    if (is.na(date_diff))
      stop("could not auto-determine the interval for date_diff. Please set manually in mkForecast()")
  }

  byCols         <- setdiff(byCols, dateCol)
  byCols.date    <- c(dateCol, byCols)
  byCols.dateVal <- c(dateCol, byCols, valueCol)

  ## bank the key and colorder, to put it back how we found it
  key.bak <- key(DT)
  colorder.bak <- names(DT)

  ## set key for quicker indexing
  setkeyIfNot(DT, byCols.date, verbose=FALSE)


  ## Identify our target and test date
  date.test   <- max( DT[[dateCol]][ DT[[dateCol]] < date.target] )
  if (months.to.test > 1)
    date.test <- seq.Date(date.test, length.out=months.to.test, by="-1 months")

  value.test <- unique(DT[.(date.test), byCols.dateVal, with=FALSE], by=NULL)
  
  ## There should be no duplicates in value.test
  if (fail.on.duplicates &&  any(duplicated(value.test, by=byCols.date))) {
    warning("\n\n\t    --=: NOTE TO RICK :=--\n\n\tDuplicate values found in value.test\n\n\tEntering browser() mode before failing")
    browser(text="In mkForecast; Found duplicates for value.test by byCols.date... investigate.")
    stop("Duplicate values found in value.test")
  }

  # unique(DT[!is.na(get(valueCol))], by=byCols.dateVal)
  alldates <- CJ_allDatesByCols(DT=unique(DT[!is.na(get(valueCol))], by=byCols.dateVal), dateCol=dateCol, interval=date_diff)

 ##  target: DT[!is.na(get(valueCol))][alldates[date < date.target]]
 ##  test:   DT[!is.na(get(valueCol))][alldates[date < min(date.test)]]

    ## for scoping reasons, keep this function nested
    createForecast <- function(date_value, method="all") {

      method <- gsub("(forecast_|\\.error)", "", method)

      method.options <- c("all", "full", "last12", "last7", "last3", "last2", "last4", "ma3", "self")
      if (!length(method) || !all(method %in% method.options)) {
        ## Put the key back before failing
        setkeyIfNot(DT, key.bak, verbose=FALSE)
        stop(sprintf("Invalid method\nValid options are:  c%s", pasteQ(method.options, C=", ")))
      }

      DT[!is.na(get(valueCol))
        ][alldates[date < date_value]
        ][ , unique(removeNA(get(valueCol) ))
           , by=byCols.date
        ][ , {.ll <-list( NULL
                 , self   = if (any(method %in% c("all", "self"))) 
                               tail(V1, 1)
                 , ma3    = if (any(method %in% c("all", "ma3"))) 
                               mean(tail(V1, 3), na.rm=TRUE)
                 , last2  = if (any(method %in% c("all", "last2"))) 
                             as.numeric(forecast(tail(V1, 2), 1)[["mean"]])
               #  , last3  = if (any(method %in% c("all", "last3"))) 
               #              as.numeric(forecast(tail(V1, 3), 1)[["mean"]])
               #  , last4  = if (any(method %in% c("all", "last4"))) 
               #              as.numeric(forecast(tail(V1, 4), 1)[["mean"]])
                 , last7  = if (any(method %in% c("all", "last7"))) 
                             as.numeric(forecast(tail(V1, 7), 1)[["mean"]])
                 , last12 = if (any(method %in% c("all", "last12"))) 
                             as.numeric(forecast(tail(V1, 12), 1)[["mean"]])
                 , full   = if (any(method %in% c("all", "full"))) 
                             as.numeric(forecast(V1, 1)[["mean"]])

                 )

              names(.ll) <- paste0("forecast_", names(.ll))            
              .ll[!sapply(.ll, is.null)]
             }
           , by=byCols
        ][ , (dateCol) := date_value]
    } 


  browser(expr=inDebugMode("forecast"), text="In mkForecast right before executing createForecast()")

  ## ONLY TEST IF THERE IS MORE THAN ONE METHOD
  if (method == "all" || length(method) > 1)
  {
    ## Forecast using all methods
    DT.forecasts_test <- rbindlist(lapply(date.test, createForecast, method=method))
    
    ## Merge in .expectedValue
    matchKey(value.test, DT.forecasts_test, key=byCols.date, organize=TRUE)
    ## Ideally, we would use: 
    ##     DT.forecasts_test[value.test, ".expectedValue" := get(valueCol)]  
    ## but the 'get()' is presumably out of scope, so instead, using as.call(..)
    .j_expr   = as.call(c(quote(`:=`), ".expectedValue", as.name(valueCol)))
    DT.forecasts_test[value.test, eval(.j_expr)]

    ## extract the forecast columns from the results DT, to compare against expected
    forecastCols <- extract("forecast_", DT.forecasts_test)
    selfname_(forecastCols)

    ## Calculate the errors for each forecasted value
    foreCastErrors <- sapply(forecastCols, function(fCol) {
                        ecol <- gsub("forecast_(.+)", "\\1.error", fCol)
                        DT.forecasts_test[ , (ecol) := .expectedValue - get(fCol)]
                        # j = sprintf("mean(%s ^2, na.rm=TRUE", ecol)  
                        DT.forecasts_test[ , mean(get(ecol)^2, na.rm=TRUE)]  
                      })

    method.using <- names(which.min(foreCastErrors))
  } else {
    method.using <- sprintf("forecast_%s", method)
  }

  verboseMsg(verbose, sprintf("Using method '%s' for predictions of %s", gsub("forecast_", "", method.using), valueCol), time=FALSE)

  ## Forecast using method.using
  DT.forecasts_target <- createForecast(date.target, method=method.using)
  setnames(DT.forecasts_target, method.using, "forecastedValue")

  ## The original needs and colorder it's key back
  setkeyIfNot(DT, key.bak, verbose=FALSE)
  setcolorder(DT, colorder.bak)

  if (all(key.bak %in% names(DT.forecasts_target)))
    setkeyIfNot(DT.forecasts_target, key.bak, organize=TRUE, verbose=FALSE)
  else
    setkeyIfNot(DT.forecasts_target, byCols.date, organize=TRUE, verbose=FALSE)

  setattr(DT.forecasts_target, "method", gsub("forecast_", "", method.using))
  return(DT.forecasts_target)
}