R/FcEchoStateANN.R

In Mthrun/TSAT: Time Series Analysis Tools (TSAT)

# res = FcEchoStateANN(DataVec)
#
# DESCRIPTION
# Forecast Echo state ANN  --- TODO: Add a more specific description
#
# INPUT
# DataVec             [1:n] numerical vector of regular (equidistant) time series data.
# SplitAt             Index of row where the DataVec is divided into test and train data. If not given n is used
# ForecastHorizon     Scalar defining the timesteps to forecast ahead
# Seasonality         Main saisonality of data, is used for generating batches of data. Default is 28
# Scaled              TRUE: automatic scaling
# OPTIONAL
# Time                [1:n] character vector of Time in the length of data
# PlotIt              FALSE (default), do nothing. TRUE: plots the forecast versus the validation set.
# ...                 further arguments for echos::train_esn
#
# OUTPUT
# Model               ANN model generated by echos
# FitStats            Output of forecast_esn in echos package
# Forecast            Forecast generated by the ANN model where we put in the last portion of the training set of 
#                     length forecast_length as data to predict from. The test data stays untouched.
# TestData            [(k+1):n] vector, the part of Response not used in the model
# TestTime            [(k+1):n] vector, time of response not used in the model
# TrainData           [1:k] vector, the part of Response used in the model
# TrainTime           [1:k] vector, time of Training data if given
# TrainingForecast    [1:k] vector, forecasted value using TrainData
#
# DETAILS
# requires internally also \pkg{tsibble} 
# NOTE: Seems that the package changed from using tsibble as input to normal numeric vectors
#
# Author: MCT


FcEchoStateANN=function(DataVec,
                          SplitAt,ForecastHorizon=1,Seasonality=28,Scaled=TRUE,
                          Time,PlotIt=FALSE,NoRolling=TRUE,...){
  
  if(missing(SplitAt)) {
    warning('Input for SplitAt was not given. Setting SplitAt to length(DataVec)')
    SplitAt = length(DataVec)
  }
  if(missing(ForecastHorizon)) {
    warning('Input for ForecastHorizon was not given. Setting ForecastHorizon to 1')
    ForecastHorizon = 1
  }
  if(missing(Time)) {
    Time = 1:length(DataVec)
    warning('No input for Time was given, will use 1:length(DataVec) for Time')
  }
  
  inputs = checkInputForecasting(DataVec, Time, SplitAt, ForecastHorizon, PlotIt)
  DataVec = inputs$DataVec
  Time = inputs$Time
  SplitAt = inputs$SplitAt
  ForecastHorizon = inputs$ForecastHorizon
  PlotIt = inputs$PlotIt
  
  if(!is.logical(Scaled)) {
    warning('Input for Scaled is not logical. Setting Scaled to TRUE')
    Scaled = TRUE
  }
  if(!(is.numeric(Seasonality) && length(Seasonality) == 1 && Seasonality >= 0)) {
    warning('Seasonality should be a positive scalar. Setting Seasonality to 28')
    Seasonality = 28
  }
  
  N = length(DataVec)
  
  errorMessage = packageMissingError("echos", N, SplitAt)
  if(errorMessage != FALSE){
    return(
      list(
        Model = NULL,
        FitStats = NULL,
        Forecast = rep(NaN, length(DataVec)-SplitAt),
        ForecastTrain = rep(NaN, SplitAt),
        Info = errorMessage
      )
    )
  }
  errorMessage = packageMissingError("tsibble", N, SplitAt) # Package probably not needed anymore
  if(errorMessage != FALSE){
    return(
      list(
        Model = NULL,
        FitStats = NULL,
        Forecast = rep(NaN, length(DataVec)-SplitAt),
        ForecastTrain = rep(NaN, SplitAt),
        Info = errorMessage
      )
    )
  }
  
  if(isTRUE(Scaled)){
    toRange=function(data, lower, upper){
        #taken from dbt.Transforms
        data <- as.matrix(data)
        if(lower==upper){
          error('interval width can not be 0!')
        }
        if (lower > upper){
          temp <- upper;
          upper <- lower;
          lower <- upper;
        }
        range <- upper - lower
        n <- dim(data)[1]
        d <- dim(data)[2]
        if ((n==1) & (d > 1)){ # row vector to colum vector
          data <- t(data)  
          wasRowVector <- 1
        }
        else{
          wasRowVector <- 0
        }
        nRow <- dim(data)[1]
        nCol <- dim(data)[2]
        min <-apply(data,2,min,na.rm=TRUE)
        min <- matrix(min,nRow,nCol,byrow=TRUE)
        max <- apply(data,2,max,na.rm=TRUE)
        max <- matrix(max,nRow,nCol,byrow=TRUE)
        # Range = Max-Min;
        range <- max-min
        range[range==0]<-1
        scaleData <- (data-min)/range
        scaleData <- lower + scaleData * (upper-lower)
        if(wasRowVector==1){
          scaleData = t(scaleData)
        }
        return(scaleData)
      }
    DataVec=toRange(DataVec,-1,1)
  }

  #if(missing(Time)) Time=1:length(DataVec)
  
  Percentage = 90
  
  #V=TSAT::SplitPercentageTS(DataVec,Time,Percentage = Percentage)
  #train=V$TrainingSet
  #test=V$TestSet
  #TimeTrain=V$TrainingTime
  #TimeTest=V$TestTime
  N = length(DataVec)
  split = N - SplitAt
  train = head(DataVec, N - split)
  test = tail(DataVec, split)
  TimeTrain= head(Time, N - split)
  TimeTest= tail(Time, split)
  
  #DF=data.frame(date_time=V$TrainingTime,value=train)
  #rownames(DF)=1:nrow(DF)
  #TSdata=tsibble::build_tsibble(x=DF)
  #date_time=V$TrainingTime
  #value=train
  
  model=NULL
  out=NULL
  
  if(isTRUE(NoRolling)){#swift
    #model=echos::train_esn(TSdata,lag=Seasonality,...)
    model=echos::train_esn(as.vector(train),lag=Seasonality,...) # Changed here from tstibble object as input
    #take the last saisonality batch to predict the forecast horizon
    #date_time=V$TrainingTime
    date_time=TimeTrain
    value=train
    out = echos::forecast_esn(model,n_ahead=length(test))
    future_forecast=out$point
  }else{
    #timestep 1
    #model=echos::train_esn(TSdata,lag=Seasonality,...)
    model=echos::train_esn(as.vector(train),lag=Seasonality,...) # Changed here from tstibble object as input
    #take the last saisonality batch to predict the forecast horizon
    #date_time=V$TrainingTime
    date_time=TimeTrain
    value=train
    out = echos::forecast_esn(model,n_ahead=ForecastHorizon)
    future_forecast=out$point

    #im prinzip das,aber dauert zu lange
    for(i in 1:(length(test)-ForecastHorizon)){#timestep 2:n

      #rolling forecast
      #take one point of the test set to predict again the next seasonality
      date_time=c(date_time,TimeTest[i])
      value=c(value,test[i])

      DF=data.frame(date_time=date_time,value=value)
      rownames(DF)=1:nrow(DF)
      TSdata=tsibble::build_tsibble(x=DF)

      #model_cur=echos::train_esn(TSdata,lag=Seasonality,...)
      model=echos::train_esn(as.vector(value),lag=Seasonality,...) # Changed here from tstibble object as input

      currentpred = echos::forecast_esn(model_cur,n_ahead=ForecastHorizon)
      if(ForecastHorizon==1)
        future_forecast=c(future_forecast,currentpred$point)
      else
        future_forecast[[i]]=currentpred

    }
    model=model_cur
    out=currentpred
  }

  # if(is.list(future_forecast)){
  #   names(future_forecast)=TimeTest
  # }
  
  if (PlotIt) {
    if(ForecastHorizon==1){
      future_forecast_cur=future_forecast
    get('plotEvaluationFilteredTS',
        envir = asNamespace('TSAT'),
        inherits = FALSE)(TimeTest, test, future_forecast_cur, FALSE)
    }else{
      #ToDo
    }
  }
  return(list(
    Model = model,
    FitStats = out,
    Forecast = future_forecast,
    TestData =test,
    TestTime=TimeTest,
    TrainData=train,
    TrainTime=TimeTrain
  ))
  
}