gets: R/predict.gets.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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
predict.gets <-
function(object, spec=NULL, n.ahead=12,
  newmxreg=NULL, newvxreg=NULL, newindex=NULL,
  n.sim=1000, innov=NULL, return=TRUE, plot=NULL,
  plot.options=list(), ...)
{
  ##create new object to add stuff to in order to use predict.arx()
  object.new <- object

  ##spec:
  if(is.null(spec)){
    if(object$gets.type=="getsm"){ spec <- "mean" }
    if(object$gets.type=="getsv"){ spec <- "variance" }
  }else{
    spec.type <- c("mean", "variance", "both")
    which.type <- charmatch(spec, spec.type)
    spec <- spec.type[which.type]
  } #end if(..)else(..)
  if( spec %in% c("variance","both") ){ stop("variance-forecasts with predict.gets not available yet") }


  ##-----------------------------------
  ## arguments mean-equation:
  ##-----------------------------------

  if("mX" %in% names(object$aux)) {
    ##what dynamics specified in gum?
    gum.ar <- eval(object$aux$call.gum$ar)
    ##what dynamics remain in spec?
    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]
    }

    ##need to check for constant
    if(!is.null(object$aux$call.gum$mc)) {
      ##but the constant needs to have been retained...
      if ( "mconst" %in% object$aux$mXnames ) { object.new$call$mc <- TRUE }
    }

    if(is.null(object$aux$call.gum$mc) && "mconst" %in% object$aux$mXnames) {
      ##ensure that when we call predict.arx we set mc=TRUE
      object.new$call$mc <- !is.null(object$aux$call.gum$mc)
      ##need to also get rid of mconst in mX
      #object.new$mX <- object$aux$mX[,-grep("mconst",object$aux$mXnames)]
    }

    ##mxreg needs to be null if only thing in it is dynamics (i.e. ar variables)
    if(NROW(grep("^ar\\d+$",object$aux$mXnames))==object$aux$mXncol) {
      object.new$call$mxreg <- NULL
    } else {
      object.new$call$mxreg <- object$aux$call.gum$mxreg
    } ##if there is non-arch variables in mXreg, user needs to specify newmxreg

  } else {

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

  }

  ##-----------------------------------
  ## arguments variance-equation:
  ##-----------------------------------

#  if("vX" %in% names(object$aux)) {
#
#    ##what dynamics specified in gum?
#    gum.arch <- eval(object$aux$call.gum$arch)
#    ##what dynamics remain in spec?
#    spec.arch <- as.numeric(gsub("arch(\\d+)","\\1",object$aux$vXnames[grep("^arch\\d+$",object$aux$vXnames)]))
#    if(NROW(spec.arch)==0) {
#      object.new$call$arch <- NULL
#    } else { ##check that dynamics in specific are subset of those in gum
#      object.new$call$arch <- spec.arch[spec.arch %in% gum.arch]
#    }
#
#    ##which asyms specified in gum?
#    gum.asym <- eval(object$aux$call.gum$asym)
#    ##which asyms remain in spec?
#    spec.asym <- as.numeric(gsub("asym(\\d+)","\\1",object$aux$vXnames[grep("^asym\\d+$",object$aux$vXnames)]))
#    if(NROW(spec.asym)==0) {
#      object.new$call$asym <- NULL
#    } else { ##check that dynamics in specific are subset of those in gum
#      object.new$call$asym <- spec.asym[spec.asym %in% gum.asym]
#    }
#
#    ##which asyms specified in gum?
#    gum.log.ewma <- eval(object$aux$call.gum$log.ewma)
#    if(!is.null(gum.log.ewma)){ stop("'log.ewma' not available yet for 'predict.gets' ") }
#
#    ##vxreg needs to be null if only thing in it is dynamics (i.e. arch variables)
#    if(NROW(grep("^arch\\d+$",object$aux$vXnames))==object$aux$vXncol) {
#      object.new$call$vxreg <- NULL
#    } else {
#      object.new$call$vxreg <- object$aux$call.gum$vxreg
#    } ##if there is non-arch variables in vXreg, user needs to specify newvxreg
#
#  } else {

    object.new$call$arch <- NULL
    object.new$call$asym <- NULL
    object.new$call$log.ewma <- NULL
    object.new$call$vxreg <- NULL

#  }

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

  out <- predict.arx(object.new, spec=spec, n.ahead=n.ahead,
    newmxreg=newmxreg, newvxreg=newvxreg, newindex=newindex,
    n.sim=n.sim, innov=innov, 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.