Unobserved Components Model Predictions: predict.UCM not working in rucm package

Question

I built a model using ucm function. However when i try to forecast for future, it's not letting me pass the independent variables.

library("rucm")
library("lubridate")

#Create Simulated Data
Date<- as.Date(seq(from=as.Date('2012-01-01'),to=as.Date('2014-03-31'),by=1),"%Y-%m-%d")
Actual <- sample(27:65,length(Date),replace = TRUE)
DOW <- wday(Date)
Month <- month(Date)
DOM <- mday(Date)
Week <- week(Date)
Ya <- year(Date)
Ya <- ifelse(Ya=="2014",2,1)
a <- data.frame(Date,Actual,DOW,Month,DOM,Week,Ya)
a$Date<-as.Date(a$Date,"%Y-%m-%d")

abc <- cbind(Weekday=model.matrix(~as.factor(a$DOW)),
             Mont=model.matrix(~as.factor(a$Month)),
             Day=model.matrix(~as.factor(a$DOM)),a[,7,drop=FALSE],
             Weekofyear=model.matrix(~as.factor(a$Week)))

abc<-data.frame(abc)

abc<-data.frame(abc[,c(-1,-8,-20,-52)])

abc2 <- subset(abc,abc$Ya==1)
abc2 <- abc2[,-48]
abc3 <- subset(abc,abc$Ya==2)
abc3 <- abc3[,-48]

#train and insample MAPE
a1<-subset(a,a$Ya==1)
a2<-subset(a,a$Ya==2)
#build model
dat <- as.data.frame(cbind(a1[,2,drop=FALSE], abc2))
fo <- as.formula(paste("Actual ~ ", paste(names(dat)[2:42], collapse= "+")))
fit_train_ucm <- ucm(fo, data = dat, cycle = TRUE, cycle.period = 365)

#predict for future
predict(fit_train_ucm,n.ahead = 90,newdata = abc3)

i am getting this error

Error in is.SSModel(newdata, na.check = TRUE, return.logical = FALSE) : 
  Object is not of class 'SSModel'

Update: Based on suggestion by package author from GitHub, i used below code(sorry to say this is not very self explanatory, i did however try to edit code)

SSModel(rep(NA,nrow(abc3)) ~ x + SSMtrend(2, Q = list(fit_train_ucm$est.var.level, fit_train_ucm$est.var.slope)) + SSMseasonal(12, Q = fit_train_ucm$est.var.season), H = fit_train_ucm$irr.var, data=abc3)

Now the error message is

Error in eval(expr, envir, enclos) : object 'x' not found

Any help on this?

Answer 1

This bug of prediction with newdata in ucm is yet to corrected.

This is how you can get predictions for an out-of-sample period.

indep <- paste(names(dat)[2:42], collapse= "+")
newdata1 <- SSModel(as.formula(paste0("rep(NA,nrow(abc3)) ~ ", indep, "+ SSMtrend(1, Q =  list(fit_train_ucm$est.var.level))",
               "+ SSMcycle(365, Q = fit_train_ucm$est.var.cycle)")), H = fit_train_ucm$irr.var, data=abc3)
pred<-predict(fit_train_ucm$model, newdata=newdata1)

So basically here I am using the predict function from KFAS package. To use the predict function, I have to define the data to be an object of class SSModel.

You will take all the parameters that you used in the model as independent variables and run a State space model with NA's as independent variable.

P.S.: I will keep the comments in mind to write a better answer next time.

Answer 2

Just so someone lands at this page again in future - there has been some update on the git repo maintained by the author to approach this problem in simplistic way. Please check this commit

Alternatively, pasting the function which one may use from that commit:

predict.ucm <- function(object, n.ahead, newdata,...){

  #### Predict in sample ####

  if (missing(newdata)) {
    return(predict(object = object$model, n.ahead = n.ahead))
  } 

  #### Predict out of sample ####

  # Regression variables.
  model_variables <- paste0(names(object$est), collapse = " + ")

  # Trend

  # Case 1 no trend
  if (is.null(object$est.var.level) & is.null(object$est.var.slope)) { 
    model_trend <- ""
  }
  # Case 2 level and trend
  if (!is.null(object$est.var.level) & !is.null(object$est.var.slope)) { 
    model_trend <- "+ SSMtrend(degree = 2, Q = list(object$est.var.level, object$est.var.slope))"
  }
  # Case 3 level only / trend only is not allowed in R
  if (!is.null(object$est.var.level) & is.null(object$est.var.slope)) { 
    model_trend <- "+ SSMtrend(degree = 1, Q = list(object$est.var.level))"
  }

  # Seasonality
  if (!is.null(object$est.var.season)) {
    model_season <- sprintf("+ SSMseasonal(period = %s, Q = object$est.var.season)", 
                            object$call['season.length'] %>% as.character())
  } else { 
    model_season <- ""
  }

  # Cycle
  if (!is.null(object$est.var.cycle)) {
    model_cycle <- sprintf("+ SSMcycle(period = %s, Q = object$est.var.cycle)", 
                           object$call['cycle.period'] %>% as.character())
  } else { 
    model_cycle <- ""
  }

  # Combine all components into a formula
  model_formula <- as.formula(sprintf("rep(NA,nrow(newdata)) ~ %s %s %s %s",
                                      model_variables,
                                      model_trend,
                                      model_season,
                                      model_cycle
  ))

  # Build a SSM object for the prediction
  oos_data <- KFAS::SSModel(formula = model_formula, H = object$irr.var, data = newdata)

  # Return the predictions
  predict(object$model, newdata = oos_data)

}

EDIT
In case you are interested in predicting on a new data which is considered as for the same time period as the original model was built using, then following edit can be made in the above function. That new data should ideally include the same dependent variable values which was used to build the first model.

  # Using same dependent which was used initially to fit the estimates, instead of NA
  model_formula <- as.formula(paste0(
    object$model$terms[[2]],
    sprintf(
      " ~ %s %s %s %s",
      model_variables,
      model_trend,
      model_season,
      model_cycle
    )
  ))
  # Build a SSM object for the prediction
  oos_data <- KFAS::SSModel(formula = model_formula, H = object$irr.var, data = newdata)
  
  # Return the predictions for in sample only - hence removing newdata arg
  # predict(object$model, newdata = oos_data)
  predict(oos_data)