R/predict.isat.R

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
predict.isat <-
function(object, n.ahead=12,
  newmxreg=NULL, newindex=NULL, return=TRUE, plot=NULL,
  plot.options=list(), ...)
{

  ##create new object to add stuff to in order to use predict.arx()
  object.new <- object

  ##------------
  ## arguments:
  ##------------

  if("mX" %in% names(object$aux)) {

    ##check if constant is retained:
    if("mconst" %in% object$aux$mXnames){
      object.new$call$mc <- TRUE
    }else{
      object.new$call$mc <- NULL
    }

    ##what dynamics specified in gum?
    gum.ar <- eval(object$call$ar)
    ##what dynamics remain in specific?
    spec.ar <- as.numeric(gsub("ar(\\d+)","\\1",object$aux$mXnames[grep("^ar\\d+$",object$aux$mXnames)]))
    if(NROW(spec.ar)==0) {
      object.new$call$ar <- NULL
    } else { ##check that dynamics in specific are subset of those in gum
      object.new$call$ar <- spec.ar[spec.ar %in% gum.ar]
    }

    ##"mxreg" argument:
    mc.and.ar.length <- length(object.new$call$mc)+length(object.new$call$ar)
    if(NCOL(object$aux$mX) > mc.and.ar.length){
      object.new$call$mxreg <- "mxreg"
    }else{
      object.new$call$mxreg <- NULL
    }
    
    ##if sis and tis terms retained need to adapt mxreg call ...
    if(!is.null(object$ISnames)) {
    
      ##J-dog, add your code here??
      if(is.null(object$call$mxreg)) { #need to ensure predict.arx knows there are mx variables
        object.new$call$mxreg <- "mXis"
      }
      
      ##... and need to specify newmxreg of right dimension:
      ##if we're here it means the isat call did not specify any mxregs
      ##hence what is in mX in the object are terms retained by isat
      ##we can automatically create isat terms into sample period (exception uis)
      if(is.null(newmxreg)) { 
        ##if no newmxreg specified we add iis/sis/tis from scratch
        
        ##first check that there shouldn't be something in newmxreg...
        if(!is.null(object$call$mxreg)){ stop("'newmxreg' is NULL") }
        
        ##assuming not, then we start from scratch adding the indicators...
        newmxreg <- c() 
      }
      
      if(any(regexpr("^iis",object$ISnames)>-1)){##isat retained some iis terms
        for(i in object$ISnames[grep("^iis",object$ISnames)]) {
          newmxreg <- cbind(newmxreg,rep(0,n.ahead))
        }
      }
      if(any(regexpr("^sis",object$ISnames)>-1)){##isat retained some sis terms
        for(i in object$ISnames[grep("^sis",object$ISnames)]) {
          newmxreg <- cbind(newmxreg,rep(1,n.ahead))
        }
      }
      if(any(regexpr("^tis",object$ISnames)>-1)){##isat retained some tis terms
        for(i in object$ISnames[grep("^tis",object$ISnames)]) {
          newmxreg <- cbind(newmxreg,
                            seq(1,n.ahead)+object$aux$mX[NROW(object$aux$mX),i])
        }
      }
            
    }

  } else {

    object.new$call$mc <- NULL
    object.new$call$ar <- NULL
    ##to do: log.ewma
    object.new$call$mxreg <- NULL

  }


  ##-----------------------------------
  ## pass on arguments to predict.arx:
  ##-----------------------------------

  out <- predict.arx(object.new, spec="mean", n.ahead=n.ahead,
    newmxreg=newmxreg, newvxreg=NULL, newindex=newindex,
    return=return, plot=plot, plot.options=plot.options)

  ##-------------------
  ## return forecasts:
  ##-------------------

  if(return){ return(out) }

}

Questions? Problems? Suggestions? or email at ian@mutexlabs.com.

Please suggest features or report bugs with the GitHub issue tracker.

All documentation is copyright its authors; we didn't write any of that.