R/forecast.R

In mathieucarmassi/CaliCo: Code Calibration in a Bayesian Framework

#' A Reference Class to generates differents \code{forecast.class} objects
#'
#' @description See the function \code{\link{forecast}} which produces an instance of this class
#' This class comes with a set of methods, some of them being useful for the user:
#' See the documentation for \code{\link{forecast}}... Other methods
#' should not be called as they are designed to be used during the calibration process.
#'
#' Fields should not be changed or manipulated by the user as they are updated internally
#' during the estimation process.
#' @field modelfit a \code{\link{calibrate.class}} object generated by \code{\link{calibrate}}
#' @field md.new the new model created with the MAP estimator
#' @field x.new a new data set (according to the data set used for calibration)
#' @export
forecast.class <- R6Class(classname = "forecast.class",
                           public = list(
                             modelfit  = NULL,
                             md.new    = NULL,
                             x.new     = NULL,
                             initialize = function(modelfit,md.new,x.new)
                             {
                               self$modelfit    <- modelfit
                               self$md.new      <- md.new
                               self$x.new       <- x.new
                             },
                             print = function()
                             {
                               print(self$md.new)
                               cat("\n\n")
                               cat("Forecasting")
                               cat("\n")
                               cat("MAP estimator:\n")
                               print(estimators(self$modelfit)$MAP)
                             },
                             plot = function(x,...)
                             {
                               if (is.matrix(self$x.new)) l <- nrow(self$x.new)
                               else l <- length(self$x.new)
                               if (self$md.new$model %in% c("model1","model2"))
                               {
                                  df  <- self$md.new$model.fun(self$md.new$theta,self$md.new$var)
                               } else
                               {
                                  df  <- self$md.new$model.fun(self$md.new$theta,self$md.new$thetaD,
                                                               self$md.new$var)
                               }
                               if (missing(x)) stop("x is missing, no graph is displayed",call. = FALSE)
                               else df$x <- x
                               df1      <- df[1:(nrow(df)-l),]
                               df2      <- df[(nrow(df)-l+1):nrow(df),]
                               df1$type <- "calibrated code"
                               df2$type <- "forecasted"
                               Names    <- NULL
                               for (i in 1:l) Names <- c(Names,paste(i+nrow(df)-l))
                               rownames(df2) <- Names
                               df       <- rbind(df1,df2)
                               if (self$md.new$model %in% c("model1","model3"))
                               {
                                 p <- ggplot(df, aes(x=x,y=y,color=type))+ theme_light() + xlab("") + ylab("")+
                                 self$md.new$gglegend() + geom_ribbon(mapping = aes(x=x,ymin=q025,ymax=q975,fill=fill),
                                                                      alpha=0.4,linetype=1,
                                                                      colour="skyblue3",size=0.5)+
                                   scale_fill_manual(values = adjustcolor("skyblue3")) + geom_line()+
                                   scale_color_manual(values=c("red", "blue"))
                               } else
                               {
                                 df$fillGP <- "CI 95% GP"
                                 if (self$md.new$model == "model4")
                                 {
                                   col <- c("skyblue3","grey70")
                                   Alpha <- c(0.8,0.3)
                                   df$fillE <- "CI 95% discrepancy + noise"
                                 }else
                                 {
                                   col <- c("grey70","skyblue3")
                                   Alpha <- c(0.3,0.8)
                                   df$fillE <- "CI 95% noise"
                                 }
                                 p <- ggplot(df, aes(x=x,y=y))+
                                   geom_ribbon(mapping = aes(x=x,ymin=q025n,ymax=q975n,fill=fillE),
                                               alpha=0.8,linetype="twodash",colour="#999999",size=0.7)+
                                   geom_ribbon(mapping = aes(x=x,ymin=q025,ymax=q975,fill=fillGP),
                                               alpha=0.3,linetype="dotted",colour="#999999",size=0.7)+
                                   geom_line(mapping = aes(color=type))+
                                   scale_fill_manual(name = NULL,values = adjustcolor(col,alpha.f = 0.3))+
                                   guides(fill = guide_legend(override.aes = list(alpha = Alpha)))+
                                   self$md.new$gglegend()+scale_color_manual(values=c("red", "blue"))
                                 }
                               return(p)
                             }
                            ))