% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/CST_CategFc.R
\name{CST_CategFc}
\alias{CST_CategFc}
\title{Make categorical forecast based on a multi-model forecast with potential for calibrate}
\usage{
CST_CategFc(exp, obs, method = "pool", amt.cat = 3)
}
\arguments{
\item{exp}{an object of class \code{s2dv_cube} as returned by \code{CST_Load} function, containing the seasonal forecast experiment data in the element named \code{$data}.}

\item{obs}{an object of class \code{s2dv_cube} as returned by \code{CST_Load} function, containing the observed data in the element named \code{$data}.}

\item{method}{method used to produce the categorical forecast, can be either "pool", "comb", "mmw" or "obs". The method pool assumes equal weight for all ensemble members while the method comb assumes equal weight for each model. The weighting method is descirbed in Rajagopalan et al. (2002), Robertson et al. (2004) and Van Schaeybroeck and Vannitsem (2019). The obs method returns the categories of the observation. The models corresponding to each ensemble member should be introduced through dimnames of the exp object. All results are obtained through cross validation.}

\item{amt.cat}{is the amount of categories. Equally-sized quantiles will be calculated based on the amount of categories.}
}
\value{
an object of class \code{s2dv_cube} containing the categorical forecasts in the element called \code{$data}.
}
\description{
This function converts an multi-model ensemble forecast into a categorical forecast. The categories are quantiles (e.g. terciles) and different methods are included to combine the different models. These include ensemble pooling (equal weight for all ensemble members), model combination (equal weight for each model) and model weighting. The weighting method is described in Rajagopalan et al. (2002), Robertson et al. 2004 and Van Schaeybroeck and Vannitsem (2019). The method is based on optimization of the ignorance score and weighs the occurence probabilities of the different models and the climatology.
}
\examples{

# Example 1
mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7)
dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7)
dimnames(mod1)[[2]] <- c("MF", "MF", "UKMO")
obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7)
dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7)
lon <- seq(0, 30, 5)
lat <- seq(0, 25, 5)
exp <- list(data = mod1, lat = lat, lon = lon)
obs <- list(data = obs1, lat = lat, lon = lon)
attr(exp, 'class') <- 's2dv_cube'
attr(obs, 'class') <- 's2dv_cube'
a <- CST_CategFc(exp = exp, obs = obs, amt.cat = 3, method = "mmw")

# Example 2
amt.dataset <- 1
lst.dataset <- paste0("dataset_", seq(1,amt.dataset))
lst.model <- c("MF", "ECMWF", "UKMO")
amt.model <- length(lst.model)
amt.member.per.model <- c(2, 5, 7)
amt.member <- sum(amt.member.per.model)
lst.member <- unlist(mapply(function(x, y){rep(x, y)}, lst.model, 
 amt.member.per.model, USE.NAMES = FALSE))
lst.member.cat <- unlist(mapply(function(x, y){rep(x, y)}, 
 seq(1,amt.model), amt.member.per.model, USE.NAMES = FALSE))
msk.mdl <- sapply(lst.model,function(x){lst.member == x})
amt.sdate <- 100
lst.sdate <- paste0(1980 + seq(1, amt.sdate), "-01-01")
amt.ftime <- 3
lst.ftime <- paste0("month_", seq(1, amt.ftime))
amt.lon <- 2
lst.lon <- paste0("lon_",seq(1,amt.lon))
amt.lat <- 3 
lst.lat <- paste0("lat_",seq(1,amt.lat))
bias <- c(0.3, 0.6, 0.3)
slope <- c(1, 1.4, 1.8)
noise.level.fc <- 0.1 * slope
noise.level.obs <- 0.1
amt.data.pts <- amt.dataset * amt.sdate * amt.ftime * amt.lon * amt.lat
obs1 <- array(data = rnorm(amt.data.pts),
 dim = c(dataset = amt.dataset, member = 1, sdate = amt.sdate
   , ftime = amt.ftime, lon = amt.lon, lat = amt.lat),
 dimnames = list(dataset = lst.dataset, member = c("obs"), 
   sdate = lst.sdate, ftime = lst.ftime, lon = lst.lon, lat = lst.lat))
tmp.noise.obs <- array(data = rnorm(amt.data.pts, 0, noise.level.obs),
 dim = c(dataset = amt.dataset, member = 1, sdate = amt.sdate,
   ftime = amt.ftime, lon = amt.lon, lat = amt.lat),
 dimnames = list(dataset = lst.dataset, member = c("obs"),
   sdate = lst.sdate, ftime = lst.ftime, lon = lst.lon, lat = lst.lat))
mod1 <- array(data = rnorm(amt.data.pts * amt.member, 0, noise.level.fc),
 dim = c(dataset = amt.dataset, member = amt.member, sdate = amt.sdate,
   ftime = amt.ftime, lon = amt.lon, lat = amt.lat),
 dimnames = list(dataset = lst.dataset, member = lst.member,
   sdate = lst.sdate, ftime = lst.ftime, lon = lst.lon, lat = lst.lat))

for(i.mbr in seq(1, amt.member)){
 mdl.to.use <- lst.member.cat[i.mbr]
 mod1[ , i.mbr, , , , ] <- (obs1[ , 1, , , , ] + mod1[ , i.mbr, , , , ]) / 
   slope[mdl.to.use] + bias[mdl.to.use]
}
obs1 <- obs1 + tmp.noise.obs 

lon <- seq(0, 30, amt.lon)
lat <- seq(0, 25, amt.lat)
exp <- list(data = mod1, lat = lat, lon = lon)
obs <- list(data = obs1, lat = lat, lon = lon)
attr(exp, 'class') <- 's2dv_cube'
attr(obs, 'class') <- 's2dv_cube'
amt.cat <- 3
cat.comb <- CST_CategFc(exp, obs, amt.cat, method = "comb")
cat.pool <- CST_CategFc(exp, obs, amt.cat, method = "pool")
cat.obs <- CST_CategFc(exp, obs, amt.cat, method = "obs")
cat.mmw <- CST_CategFc(exp, obs, amt.cat, method = "mmw")
rps.comb <- mean((cat.comb$data - cat.obs$data)^2, na.rm = TRUE)
rps.pool <- mean((cat.pool$data - cat.obs$data)^2, na.rm = TRUE)
rps.mmw <- mean((cat.mmw$data - cat.obs$data)^2, na.rm = TRUE)
rps.clim <- mean((1/amt.cat - cat.obs$data)^2, na.rm = TRUE)
cat("RPSS comb / pool / mmw: ",1 - rps.comb / rps.clim, 
 1 - rps.pool / rps.clim, 1 - rps.mmw / rps.clim)

}
\references{
Rajagopalan, B., Lall, U., & Zebiak, S. E. (2002). Categorical climate forecasts through regularization and optimal combination of multiple GCM ensembles. Monthly Weather Review, 130(7), 1792-1811.

Robertson, A. W., Lall, U., Zebiak, S. E., & Goddard, L. (2004). Improved combination of multiple atmospheric GCM ensembles for seasonal prediction. Monthly Weather Review, 132(12), 2732-2744.

Van Schaeybroeck, B., & Vannitsem, S. (2019). Postprocessing of Long-Range Forecasts. In Statistical Postprocessing of Ensemble Forecasts (pp. 267-290).
}
\author{
Bert Van Schaeybroeck, \email{bertvs@meteo.be}
}
