R/AllClasses-06-Prior-mixin-specific.R

## Mixin class describing specific slots in priors

setClass("aMixMixin",
         slots = c(aMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             aMix <- object@aMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             n.along <- dimBeta[iAlong]
             ## 'aMix' has length n.along - 1
             if (!identical(length(aMix), n.along - 1L))
                 return(gettextf("'%s' does not have length %s-1",
                                 "aMix", "n.along"))
             TRUE
         })

setClass("aNoTrendMixin",
         slots = c(aNoTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             aNoTrend <- object@aNoTrend
             K <- object@K
             ## 'aNoTrend' has length K
             if (!identical(length(aNoTrend), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "aNoTrend", "K"))
             ## elements of 'aNoTrend' have length 1L
             if (!identical(length(aNoTrend[[1L]]), 1L))
                 return(gettextf("elements of '%s' do not have length %d",
                                 "aNoTrend", 1L))
             TRUE
         })

setClass("aWithTrendMixin",
         slots = c(aWithTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             aWithTrend <- object@aWithTrend
             K <- object@K
             ## 'aWithTrend' has length K
             if (!identical(length(aWithTrend), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "aWithTrend", "K"))
             ## elements of 'aWithTrend' have length 2
             if (!identical(length(aWithTrend[[1L]]), 2L))
                 return(gettextf("elements of '%s' doe not have length %d",
                                 "aWithTrend", 2L))
             TRUE
         })


setClass("aSeasonMixin",
         slots = c(aSeason = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             aSeason <- object@aSeason
             K <- object@K
             nSeason <- object@nSeason
             ## 'aSeason' has length K
             if (!identical(length(aSeason), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "aSeason", "K"))
             ## elements of 'aSeason'  have length 'nSeason'
             if (!identical(length(aSeason[[1L]]), as.integer(nSeason)))
                 return(gettextf("elements of '%s' doe not have length '%s'",
                                 "aWithTrend", "nSeason"))
             TRUE
         })

setClass("AAlphaMixin",
         slots = c(AAlpha = "Scale"),
         contains = "VIRTUAL")

setClass("AComponentWeightMixMixin",
         slots = c(AComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("ADeltaMixin",
         slots = c(ADelta = "Scale"),
         contains = "VIRTUAL")

setClass("ADelta0Mixin",
         slots = c(ADelta0 = "Scale"),
         contains = "VIRTUAL")

setClass("AEtaCoefMixin",
         slots = c(AEtaCoef = "ScaleVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             P <- object@P@.Data
             AEtaCoef <- object@AEtaCoef
             ## 'AEtaCoef' has length P-1
             if (!identical(length(AEtaCoef), P - 1L))
                 return(gettextf("'%s' does not have length %s-1",
                                 "AEtaCoef", "P"))
             TRUE
         })

setClass("AEtaInterceptMixin",
         slots = c(AEtaIntercept = "Scale"),
         contains = "VIRTUAL")

setClass("AKnownVecMixin",
         slots = c(AKnownVec = "ScaleVec"),
         contains = "VIRTUAL")

setClass("AKnownAllVecMixin",
         slots = c(AKnownAllVec = "ScaleVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             alphaKnownAll <- object@alphaKnownAll@.Data
             AKnownAllVec <- object@AKnownAllVec@.Data
             ## 'alphaKnownAll' and 'AKnownAllVec' have same length
             if (!identical(length(alphaKnownAll), length(AKnownAllVec)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "alphaKnownAll", "AKnownAllVec"))
             TRUE
         })

setClass("ALevelComponentWeightMixMixin",
         slots = c(ALevelComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("ASDLogNuCMPMixin",
         slots = c(ASDLogNuCMP = "Scale"),
         contains = "VIRTUAL")

setClass("AMoveMixin",
         slots = c(AMove = "Scale"),
         contains = "VIRTUAL")

setClass("ASeasonMixin",
         slots = c(ASeason = "Scale"),
         contains = "VIRTUAL")

setClass("ATauMixin",
         slots = c(ATau = "Scale"),
         contains = "VIRTUAL")

setClass("AVectorsMixMixin",
         slots = c(AVectorsMix = "Scale"),
         contains = "VIRTUAL")

setClass("AllStrucZeroMixin",
         slots = c(allStrucZero = "logical"),
         contains = "VIRTUAL",
         validity = function(object) {
             allStrucZero <- object@allStrucZero
             J <- object@J@.Data
             ## length 'J'
             if (!identical(length(allStrucZero), J))
                 return(gettextf("'%s' does not have length '%s'",
                                 "allStrucZero", "J"))
             ## no missing values
             if (any(is.na(allStrucZero)))
                 return(gettextf("'%s' has missing values",
                                 "allStrucZero"))
             ## not all TRUE
             if (all(allStrucZero))
                 return(gettext("'%s' all %s",
                                "allStrucZero", "TRUE"))
             TRUE
         })

setClass("AlongAllStrucZeroMixin",
         slots = c(alongAllStrucZero = "logical"),
         contains = "VIRTUAL",
         validity = function(object) {
             alongAllStrucZero <- object@alongAllStrucZero
             L <- object@L@.Data
             ## length 'L'
             if (!identical(length(alongAllStrucZero), L))
                 return(gettextf("'%s' does not have length '%s'",
                                 "alongAllStrucZero", "L"))
             ## no missing values
             if (any(is.na(alongAllStrucZero)))
                 return(gettextf("'%s' has missing values",
                                 "alongAllStrucZero"))
             ## not all TRUE
             if (all(alongAllStrucZero))
                 return(gettext("'%s' all %s",
                                "alongAllStrucZero", "TRUE"))
             TRUE
         })

setClass("AlongMixin",
         slots = c(along = "character"),
         contains = "VIRTUAL",
         validity = function(object) {
             along <- object@along
             ## 'along' has length 1
             if (!identical(length(along), 1L))
                 return(gettextf("'%s' does not have length %d",
                                 "along", 1L))
             if (!is.na(along)) {
                 ## 'along' not blank
                 if (!nzchar(along))
                     return(gettextf("'%s' is blank",
                                     "along"))
             }
             TRUE
         })

setClass("AlphaDLMMixin",
         slots = c(alphaDLM = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             K <- object@K@.Data
             L <- object@L@.Data
             alphaDLM <- object@alphaDLM
             ## 'alphaDLM' has length '(K+1)L'
             if (!identical(length(alphaDLM), (K + 1L) * L))
                 return(gettextf("'%s' does not have length '%s'",
                                 "alphaDLM", "(K+1)L"))
             TRUE
         })

setClass("AlphaICARMixin",
         slots = c(alphaICAR = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             J <- object@J@.Data
             alphaICAR <- object@alphaICAR
             ## 'alphaICAR' has length 'J'
             if (!identical(length(alphaICAR), J))
                 return(gettextf("'%s' does not have length '%s'",
                                 "alphaICAR", "J"))
             TRUE
         })

setClass("AlphaKnownMixin",
         slots = c(alphaKnown = "ParameterVector"),
         contains = "VIRTUAL")

setClass("AlphaKnownAllMixin",
         slots = c(alphaKnownAll = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             alphaKnownAll <- object@alphaKnownAll@.Data
             J <- object@J@.Data
             ## length of 'alphaKnownAll' greater than or equal to 'J'
             if (length(alphaKnownAll) < J)
                 return(gettextf("length of '%s' less than '%s'",
                                 "alphaKnownAll", "J"))
             TRUE
         })

setClass("AlphaMixMixin",
         slots = c(alphaMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             J <- object@J@.Data
             alphaMix <- object@alphaMix
             ## 'alphaMix' has length 'J'
             if (!identical(length(alphaMix), J))
                 return(gettextf("'%s' does not have length '%s'",
                                 "alphaMix", "J"))
             TRUE
         })

setClass("CMixMixin",
         slots = c(CMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             CMix <- object@CMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             n.along <- dimBeta[iAlong]
             ## 'CMix' has length n.along
             if (!identical(length(CMix), n.along))
                 return(gettextf("'%s' does not have length '%s'",
                                 "CMix", "n.along"))
             TRUE
         })

setClass("CNoTrendMixin",
         slots = c(CNoTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             CNoTrend <- object@CNoTrend
             K <- object@K
             ## 'CNoTrend' has length K+1
             if (!identical(length(CNoTrend), as.integer(K) + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "CNoTrend", "K"))
             ## elements of 'CNoTrend' have length 1L
             if (!identical(length(CNoTrend[[1L]]), 1L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "CNoTrend", 1L))
             TRUE
         })

setClass("CWithTrendMixin",
         slots = c(CWithTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             CWithTrend <- object@CWithTrend
             K <- object@K
             ## 'CWithTrend' has length K+1
             if (!identical(length(CWithTrend), as.integer(K) + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "CWithTrend", "K"))
             ## elements of 'CWithTrend' are 2x2 matrices
             if (!all(sapply(CWithTrend, function(x) identical(dim(x), c(2L, 2L)))))
                 return(gettextf("elements of '%s' are not 2x2 matrices",
                                 "CWithTrend"))
             TRUE
         })

setClass("CSeasonMixin",
         slots = c(CSeason = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             CSeason <- object@CSeason
             K <- object@K
             nSeason <- object@nSeason
             ## 'CSeason' has length K+1
             if (!identical(length(CSeason), as.integer(K) + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "CSeason", "K"))
             ## elements of 'CSeason' are length-nSeason vectors (not matrices)
             if (!all(sapply(CSeason, length) == nSeason))
                 return(gettextf("elements of '%s' do not have length '%s'",
                                 "CSeason", "nSeason"))
             TRUE
         })

setClass("ClassesMixin",
         slots = c(classes = "Values"),
         contains = "VIRTUAL",
         validity = function(object) {
             classes <- object@classes
             ## 'classes' does not have length 0
             if (identical(length(classes), 0L))
                 return(gettextf("'%s' has length %d",
                                 "classes", 0L))
             ## 'classes' has at least one dimension with
             ## dimtype "origin"
             dimtypes <- dimtypes(classes, use.names = FALSE)
             if (!("origin" %in% dimtypes))
                 return(gettextf("'%s' does not have dimension with dimtype \"%s\"",
                                 "classes", "origin"))
             ## 'classes' has no missing values
             if (any(is.na(classes)))
                 return(gettextf("'%s' has missing values",
                                 "classes"))
             ## 'classes' is integer
             if (!is.integer(classes))
                 return(gettextf("'%s' does not have type \"%s\"",
                                 "classes", "integer"))
             ## minimum value for 'classes' is 0 or 1
             if (!(min(classes) %in% 0:1))
                 return(gettextf("minimum value for '%s' is not %d or %d",
                                 "classes", 0L, 1L))
             ## 'classes' must have at least 2 distinct values
             elements.classes <- unique(as.integer(classes@.Data))
             if (length(elements.classes) < 2L)
                 return(gettextf("'%s' must have at least %d distinct values",
                                 "classes", 2L))
             ## unique values for 'classes' form unbroken series
             if (any(diff(sort(elements.classes)) != 1L))
                 return(gettextf("unique values of '%s' must be consecutive numbers",
                                 "classes"))
             TRUE
         })


## 'W' in notes
setClass("ComponentWeightMixMixin", 
         slots = c(componentWeightMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             componentWeightMix <- object@componentWeightMix@.Data
             weightMix <- object@weightMix@.Data
             ## 'componentWeightMix' has same length as 'weightMix'
             if (!identical(length(componentWeightMix), length(weightMix)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "componentWeightMix", "weightMix"))
             TRUE
         })             

setClass("ContrastsArgMixin",
         slots = c(contrastsArg = "list"),
         contains = "VIRTUAL")

setClass("DataMixin",
         slots = c(data = "data.frame"),
         contains = "VIRTUAL",
         validity = function(object) {
             data <- object@data
             if (length(data) > 0L) {
                 ## 'data' has no missing values
                 if (any(is.na(data)))
                     return(gettextf("'%s' has missing values",
                                     "data"))
                 ## 'data' has at least 2 rows
                 if (nrow(data) < 2L)
                     return(gettextf("'%s' has fewer than 2 rows",
                                     "data"))
                 ## 'data' has at least 1 column
                 if (ncol(data) < 1L)
                     return(gettextf("'%s' has 0 columns",
                                     "data"))
             }
             TRUE
         })

setClass("DeltaDLMMixin",
         slots = c(deltaDLM = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             K <- object@K@.Data
             L <- object@L@.Data
             deltaDLM <- object@deltaDLM
             ## 'deltaDLM' has length '(K+1)L'
             if (!identical(length(deltaDLM), (K + 1L) * L))
                 return(gettextf("'%s' does not have length '%s'",
                                 "deltaDLM", "(K+1)L"))
             TRUE
         })

setClass("DimBetaMixin",
         slots = c(dimBeta = "integer"),
         contains = "VIRTUAL",
         validity = function(object) {
             dimBeta <- object@dimBeta
             ## 'dimBeta' has no missing values
             if (any(is.na(dimBeta)))
                 return(gettextf("'%s' has missing values",
                                 "dimBeta"))
             ## all values of 'dimBeta' at least 2
             if (any(dimBeta < 2L))
                 return(gettextf("'%s' has values less than %d",
                                 "dimBeta", 2L))
             TRUE
         })

setClass("DimBetaOldMixin",
         slots = c(dimBetaOld = "integer"),
         contains = "VIRTUAL",
         validity = function(object) {
             dimBetaOld <- object@dimBetaOld
             ## 'dimBeta' has no missing values
             if (any(is.na(dimBetaOld)))
                 return(gettextf("'%s' has missing values",
                                 "dimBetaOld"))
             ## all values of 'dimBetaOld' at least 2
             if (any(dimBetaOld < 2L))
                 return(gettextf("'%s' has values less than %d",
                                 "dimBetaOld", 2L))
             TRUE
         })

setClass("EtaMixin",
         slots = c(eta = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             P <- object@P
             eta <- object@eta
             ## 'eta' has length 'P'
             if (!identical(length(eta), as.integer(P)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "eta", "P"))
             TRUE
         })

setClass("FormulaMixin",
         slots = c(formula = "formula"),
         contains = "VIRTUAL",
         validity = function(object) {
             formula <- object@formula
             if (length(formula) > 0L) {
                 ## 'formula' includes a response
                 if (!hasResponse(formula))
                     return(gettextf("formula '%s' does not include a response",
                                     deparse(formula)))
                 ## response in 'formula' is "mean"
                 if (!identical(deparse(formula[[2L]]), "mean"))
                     return(gettextf("response in formula '%s' is not '%s'",
                                     deparse(formula), "mean"))
                 ## 'formula' has intercept
                 has.intercept <- identical(attr(stats::terms(formula), "intercept"), 1L)
                 if (!has.intercept)
                     return(gettextf("formula '%s' does not include an intercept",
                                     deparse(formula)))
                 ## 'formula' has at least one predictor, other than intercept
                 if (identical(length(attr(stats::terms(formula), "term.labels")), 0L))
                     return(gettextf("formula '%s' does not include any predictors (other than the intercept)",
                                     deparse(formula)))
             }
             TRUE
         })

setClass("FoundIndexClassMaxPossibleMixMixin",
         slots = c(foundIndexClassMaxPossibleMix = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("GWithTrendMixin",
         slots = c(GWithTrend = "NumericMatrixSquare"),
         contains = "VIRTUAL",
         validity = function(object) {
             GWithTrend <- object@GWithTrend
             ## 'GWithTrend' has 2 rows
             if (!identical(nrow(GWithTrend), 2L))
                 return(gettextf("'%s' does not have %d rows",
                                 "GWithTrend", 2L))
             TRUE
         })

setClass("HasAlphaDLMMixin",
         slots = c(hasAlphaDLM = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasAlphaICARMixin",
         slots = c(hasAlphaICAR = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasAlphaMixMixin",
         slots = c(hasAlphaMix = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasCovariatesMixin",
         slots = c(hasCovariates = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasAlphaKnownMixin",
         slots = c(hasAlphaKnown = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasLevelMixin",
         slots = c(hasLevel = "LogicalFlag"),
         contains = "VIRTUAL")

## setClass("HasLevelMixin",
##          slots = c(hasLevel = "LogicalFlag"),
##          contains = "VIRTUAL",
##          validity = function(object) {
##              hasLevel <- object@hasLevel@.Data
##              CWithTrend <- object@CWithTrend@.Data
##              DC <- object@DC@.Data
##              DCInv <- object@DCInv@.Data
##              if (!hasLevel) {
##                  ## first element of CWithTrend starts with 0
##                  if (!isTRUE(all.equal(CWithTrend[[1L]][1L], 0)))
##                      return(gettextf("'%s' is %s but first element of first element of '%s' is not %d",
##                                      "hasLevel", "FALSE", "CWithTrend", 0L))
##                  ## first element of DC starts with 0
##                  if (!isTRUE(all.equal(DC[[1L]][1L], 0)))
##                      return(gettextf("'%s' is %s but first element of first element of '%s' is not %d",
##                                      "hasLevel", "FALSE", "DC", 0L))
##                  ## first element of first element of DCInv is infinite
##                  if (is.finite(DCInv[[1L]][1L]))
##                      return(gettextf("'%s' is %s but first element of first element of '%s' is finite",
##                                      "hasLevel", "FALSE", "DCInv"))
##              }
##              TRUE
##          })             

setClass("HasMeanMixin",
         slots = c(hasMean = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("HasSeasonMixin",
         slots = c(hasSeason = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IAlongMixin",
         slots = c(iAlong = "integer"),
         contains = "VIRTUAL",
         validity = function(object) {
             iAlong <- object@iAlong
             ## 'iAlong' has length 1
             if (!identical(length(iAlong), 1L))
                 return(gettextf("'%s' does not have length %d",
                                 "iAlong", 1L))
             ## 'iAlong' is not missing
             if (is.na(iAlong))
                 return(gettextf("'%s' is missing",
                                 "iAlong"))
             ## 'iAlong' is positive
             if (iAlong <= 0)
                 return(gettextf("'%s' is non-positive",
                                 "iAlong"))
             TRUE
         })

setClass("IMethodPrior",
         slots = c(iMethodPrior = "integer"),
         contains = "VIRTUAL")

setClass("IndexClassMaxMixMixin",
         slots = c(indexClassMaxMix = "Counter"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## indexClassMaxMix >= 2
             if (indexClassMaxMix < 2L)
                 return(gettextf("'%s' is less than %d",
                                 "indexClassMaxMix", 2L))
             TRUE
         })

## 'k-tilde' in notes
setClass("IndexClassMaxPossibleMixMixin",
         slots = c(indexClassMaxPossibleMix = "Counter"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassMaxPossibleMix <- object@indexClassMaxPossibleMix@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## 'indexClassMaxPossibleMix' is less than or equal to 'indexClassMaxMix'
             if (indexClassMaxPossibleMix > indexClassMaxMix)
                 return(gettextf("'%s' is greater than '%s'",
                                 "indexClassMaxPossibleMix", "indexClassMaxMix"))
             TRUE
         })

## 'k-star' in notes
setClass("IndexClassMaxUsedMixMixin",
         slots = c(indexClassMaxUsedMix = "Counter"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassMaxUsedMix <- object@indexClassMaxUsedMix@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## 'indexClassMaxUsed' is less than or equal to 'indexClassMaxMix'
             if (indexClassMaxUsedMix > indexClassMaxMix)
                 return(gettextf("'%s' is greater than '%s'",
                                 "indexClassMaxUsedMix", "indexClassMaxMix"))
             TRUE
         })

## 'k' in notes
setClass("IndexClassMixMixin",
         slots = c(indexClassMix = "integer"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassMix <- object@indexClassMix
             J <- object@J@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## 'indexClassMix' has no missing values
             if (any(is.na(indexClassMix)))
                 return(gettextf("'%s' has missing values",
                                 "indexClassMix"))
             ## 'indexClassMix' has length 'J'
             if (!identical(length(indexClassMix), as.integer(J)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "indexClassMix", "J"))
             ## no values less than 1
             if (any(indexClassMix < 1L))
                 return(gettextf("'%s' has values less than '%s'",
                                 "indexClassMix", 1L))
             ## all values less than or equal to 'indexClassMaxMix'
             if (any(indexClassMix > indexClassMaxMix))
                 return(gettextf("'%s' has values greater than '%s'",
                                 "indexClassMix", "indexClassMaxMix"))
             TRUE
         })

setClass("IndexClassProbMixMixin",
         slots = c(indexClassProbMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassProbMix <- object@indexClassProbMix@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## 'indexClassProbMix' has length 'indexClassMaxMix'
             if (!identical(length(indexClassProbMix), indexClassMaxMix))
                 return(gettextf("'%s' does not have length '%s'",
                                 "indexClassMix", "indexClassMaxMix"))
             ## 'indexClassProbMix' non-negative
             if (any(indexClassProbMix < 0))
                 return(gettextf("'%s' has negative values",
                                 "indexClassProbMix"))
             TRUE
         })

setClass("InfantMixin",
         slots = c(infant = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IsKnownUncertainMixin",
         slots = c(isKnownUncertain = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IsNormMixin",
         slots = c(isNorm = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IsRobustMixin",
         slots = c(isRobust = "LogicalFlag"),
         contains = "VIRTUAL",
         validity = function(object) {
             isRobust <- object@isRobust@.Data
             isSaturated <- object@isSaturated@.Data
             ## if robust, is not saturated
             if (isRobust && isSaturated)
                 return(gettextf("prior is robust but '%s' is %s",
                                 "isSaturated", "TRUE"))
             TRUE
         })

setClass("IsSaturatedMixin",
         slots = c(isSaturated = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IsZeroVarMixin",
         slots = c(isZeroVar = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("IteratorProdVectorMix",
         slots = c(iteratorProdVectorMix = "MarginIterator"),
         contains = "VIRTUAL",
         validity = function(object) {
             iteratorProdVectorMix <- object@iteratorProdVectorMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             dimIterators <- iteratorProdVectorMix@dimIterators
             ## 'nBetween' slots of elements of 'dimIterators'
             ## equal to 'dimBeta', except that 'along' dimension
             ## has length 1
             n.between.obtained <- sapply(dimIterators, methods::slot, "nBetween")
             n.between.expected <- replace(dimBeta,
                                           list = iAlong,
                                           values = 1L)
             if (!identical(n.between.obtained, n.between.expected))
                 return(gettextf("'%s' slot of '%s' not consistent with '%s' and '%s'",
                                 "dimIterators", "iteratorProdVectorMix", "dimBeta",
                                 "iAlong"))
             TRUE
         })             

setClass("IteratorsDimsMixMixin",
         slots = c(iteratorsDimsMix = "list"),
         contains = "VIRTUAL",
         validity = function(object) {
             iteratorsDimsMix <- object@iteratorsDimsMix
             dimBeta <- object@dimBeta
             ## all elements of 'iteratorsDimsMix' have class "SliceIterator"
             if (!all(sapply(iteratorsDimsMix, methods::is, "SliceIterator")))
                 return(gettextf("'%s' has elements not of class \"%s\"",
                                 "iteratorsDimsMix", "SliceIterator"))
             ## length of 'indices' slot of each iterator equal to
             ## product of other dimension lengths
             for (i in seq_along(iteratorsDimsMix)) {
                 iterator <- iteratorsDimsMix[[i]]
                 length.obtained <- length(iterator@indices)
                 length.expected <- as.integer(prod(dimBeta[-i]))
                 if (!identical(length.obtained, length.expected))
                     return(gettextf("'%s' from element %d of '%s' does not have expected length",
                                     "indices", i, "iteratorsDimsMix"))
             }
             TRUE
         })

setClass("IteratorStateMixin",
         slots = c(iteratorState = "AlongIterator"),
         contains = "VIRTUAL",
         validity = function(object) {
             iterator <- object@iteratorState
             K <- object@K@.Data
             L <- object@L@.Data
             ## 'indices' have length K+1
             if (!identical(length(iterator@indices), K + 1L))
                 return(gettextf("'%s' does not have length %s",
                                 "indices", "K+1"))
             ## 'nWithin' times 'nBetween' equals 'L'
             L.expected <- iterator@nBetween * iterator@nWithin
             if (!identical(L.expected, L))
                 return(gettextf("'%s' times '%s' for '%s' does not equal %s",
                                 "nWithin", "nBetween", "iterator", "L"))
             TRUE
         })

setClass("IteratorStateOldMixin",
         slots = c(iteratorStateOld = "AlongIterator"),
         contains = "VIRTUAL",
         validity = function(object) {
             iterator <- object@iteratorStateOld
             J.old <- object@JOld@.Data
             L <- object@L@.Data
             K.old <- J.old %/% L
             ## 'indices' have length K.old + 1
             if (!identical(length(iterator@indices), K.old + 1L))
                 return(gettextf("'%s' does not have length %s",
                                 "indices", "K.old + 1"))
             ## 'nWithin' times 'nBetween' equals 'L'
             L.expected <- iterator@nBetween * iterator@nWithin
             if (!identical(L.expected, L))
                 return(gettextf("'%s' times '%s' for '%s' does not equal %s",
                                 "nWithin", "nBetween", "iterator", "L"))
             TRUE
         })

setClass("IteratorVMixin",
         slots = c(iteratorV = "AlongIterator"),
         contains = "VIRTUAL",
         validity = function(object) {
             iterator <- object@iteratorV
             K <- object@K@.Data
             L <- object@L@.Data
             ## 'indices' have length K
             if (!identical(length(iterator@indices), K))
                 return(gettextf("'%s' does not have length %s",
                                 "indices", "K"))
             ## 'nWithin' times 'nBetween' equals 'L'
             L.expected <- iterator@nBetween * iterator@nWithin
             if (!identical(L.expected, L))
                 return(gettextf("'%s' times '%s' for '%s' does not equal %s",
                                 "nWithin", "nBetween", "iterator", "L"))
             TRUE
         })

setClass("JMixin",
         slots = c(J = "Length"),
         contains = "VIRTUAL")

setClass("JOldMixin",
         slots = c(JOld = "Length"),
         contains = "VIRTUAL")

setClass("KLMixin",
         slots = c(K = "Length",
                        L = "Length"),
         contains = "VIRTUAL",
         validity = function(object) {
             J <- object@J@.Data
             K <- object@K@.Data
             L <- object@L@.Data
             ## J = KL
             if (!identical(K * L, J))
                 return(gettextf("'%s' not equal to '%s' times '%s'",
                                 "J", "K", "L"))
             TRUE
         })

## 'z' in notes
setClass("LatentComponentWeightMixMixin", 
         slots = c(latentComponentWeightMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             ## 'latentComponentWeightMix' has length J * indexClassMaxMix
             latentComponentWeightMix <- object@latentComponentWeightMix@.Data
             J <- object@J@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             if (length(latentComponentWeightMix) != J * indexClassMaxMix)
                 return(gettextf("'%s' does not have length '%s'",
                                 "latentComponentWeightMix", "J * indexClassMaxMix"))
             TRUE
         })

## 'u' in notes
setClass("LatentWeightMixMixin", 
         slots = c(latentWeightMix = "UnitIntervalVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             ## 'latentWeightMix' has length 'J'
             latentWeightMix <- object@latentWeightMix@.Data
             J <- object@J@.Data
             if (length(latentWeightMix) != J)
                 return(gettextf("'%s' does not have length '%s'",
                                 "latentWeightMix", "J"))
             TRUE
         })

setClass("LevelComponentWeightMinMaxMixin",
         slots = c(minLevelComponentWeight = "numeric",
                   maxLevelComponentWeight = "numeric"),
         contains = "VIRTUAL",
         validity = function(object) {
             minLevelComponentWeight <- object@minLevelComponentWeight
             maxLevelComponentWeight <- object@maxLevelComponentWeight
             for (name in c("minLevelComponentWeight", "maxLevelComponentWeight")) {
                 value <- methods::slot(object, name) 
                 ## 'minLevelComponentWeight', 'maxLevelComponentWeight' have length 1
                 if (!identical(length(value), 1L))
                     return(gettextf("'%s' does not have length %d",
                                     name, 1L))
                 ## 'minLevelComponentWeight', 'maxLevelComponentWeight' are double
                 if (!is.double(value))
                     return(gettextf("'%s' does not have type \"%s\"",
                                     name, "double"))
                 ## 'minLevelComponentWeight', 'maxLevelComponentWeight' are not missing
                 if (is.na(value))
                     return(gettextf("'%s' is missing",
                                     name))
             }
             ## minLevelComponentWeight < maxLevelComponentWeight
             if (minLevelComponentWeight >= maxLevelComponentWeight)
                 return(gettextf("'%s' greater than or equal to '%s'",
                                 "minLevelComponentWeight", "maxLevelComponentWeight"))
             TRUE
         })

## 'alpha' in notes
setClass("LevelComponentWeightMixMixin",
         slots = c(levelComponentWeightMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             levelComponentWeightMix <- object@levelComponentWeightMix@.Data
             weightMix <- object@weightMix@.Data
             ## 'levelComponentWeightMix' has same length as 'weightMix'
             if (!identical(length(levelComponentWeightMix), length(weightMix)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "levelComponentWeightMix", "weightMix"))
             TRUE
         })

setClass("LevelComponentWeightOldMixMixin",
                  slots = c(levelComponentWeightOldMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             levelComponentWeightOldMix <- object@levelComponentWeightOldMix@.Data
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## 'levelComponentWeightOldMix' has same length as 'indexClassMaxMix'
             if (!identical(length(levelComponentWeightOldMix),
                            indexClassMaxMix))
                 return(gettextf("'%s' does not have length '%s'",
                                 "levelComponentWeightOldMix",
                                 "indexClassMaxMix"))
             TRUE
         })             

setClass("mMixMixin",
         slots = c(mMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             mMix <- object@mMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             n.along <- dimBeta[iAlong]
             ## 'mMix' has length 'n.along'
             if (!identical(length(mMix), n.along))
                 return(gettextf("'%s' does not have length '%s'",
                                 "mMix", "n.along"))
             TRUE
         })

setClass("MNoTrendMixin",
         slots = c(mNoTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             mNoTrend <- object@mNoTrend
             K <- object@K@.Data
             ## 'mNoTrend' has length K+1
             if (!identical(length(mNoTrend), K + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "mNoTrend", "K"))
             ## elements of 'mNoTrend' have length 1L
             if (!identical(length(mNoTrend[[1L]]), 1L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "mNoTrend", 1L))
             TRUE
         })

setClass("MWithTrendMixin",
         slots = c(mWithTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             mWithTrend <- object@mWithTrend
             K <- object@K@.Data
             ## 'mWithTrend' has length K+1
             if (!identical(length(mWithTrend), K + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "mWithTrend", "K"))
             ## elements of 'mWithTrend' have length 2
             if (!identical(length(mWithTrend[[1L]]), 2L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "mWithTrend", 2L))
             TRUE
         })

setClass("MSeasonMixin",
         slots = c(mSeason = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             mSeason <- object@mSeason
             K <- object@K@.Data
             nSeason <- object@nSeason
             ## 'mSeason' has length K+1
             if (!identical(length(mSeason), K + 1L))
                 return(gettextf("'%s' does not have length %s+1",
                                 "mSeason", "K"))
             ## elements of 'mSeason' have length 'nSeason'
             if (!identical(length(mSeason[[1L]]), as.integer(nSeason)))
                 return(gettextf("elements of '%s' do not have length '%s'",
                                 "mSeason", "nSeason"))
             TRUE
         })

setClass("M0NoTrendMixin",
         slots = c(m0NoTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             m0NoTrend <- object@m0NoTrend
             L <- object@L@.Data@.Data
             ## 'm0NoTrend' has length L
             if (!identical(length(m0NoTrend), L))
                 return(gettextf("'%s' does not have length %s",
                                 "m0NoTrend", "L"))
             ## elements of 'm0NoTrend' have length 1L
             if (!identical(length(m0NoTrend[[1L]]), 1L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "m0NoTrend", 1L))
             TRUE
         })

setClass("M0WithTrendMixin",
         slots = c(m0WithTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             m0WithTrend <- object@m0WithTrend
             L <- object@L@.Data
             ## 'm0WithTrend' has length L
             if (!identical(length(m0WithTrend), L))
                 return(gettextf("'%s' does not have length %s",
                                 "m0WithTrend", "L"))
             ## elements of 'm0WithTrend' have length 2
             if (!identical(length(m0WithTrend[[1L]]), 2L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "m0WithTrend", 2L))
             TRUE
         })

setClass("M0SeasonMixin",
         slots = c(m0Season = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             m0Season <- object@m0Season
             L <- object@L@.Data
             nSeason <- object@nSeason@.Data
             ## 'm0Season' has length L
             if (!identical(length(m0Season), L))
                 return(gettextf("'%s' does not have length %s",
                                 "m0Season", "L"))
             ## elements of 'm0Season' have length 'nSeason'
             if (!identical(length(m0Season[[1L]]), nSeason))
                 return(gettextf("elements of '%s' do not have length '%s'",
                                 "m0Season", "nSeason"))
             TRUE
         })

setClass("MeanMixin",
         slots = c(mean = "Parameter"),
         contains = "VIRTUAL")

setClass("MeanDelta0Mixin",
         slots = c(meanDelta0 = "Parameter"),
         prototype = prototype(meanDelta0 = methods::new("Parameter", 0)),
         contains = "VIRTUAL")

setClass("MeanEtaCoefMixin",
         slots = c(meanEtaCoef = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             meanEtaCoef <- object@meanEtaCoef
             AEtaCoef <- object@AEtaCoef@.Data
             ## 'meanEtaCoef' has same length as 'AEtaCoef'
             if (!identical(length(meanEtaCoef), length(AEtaCoef)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "meanEtaCoef", "AEtaCoef"))
             TRUE
         })

setClass("MetadataMixin",
         slots = c(metadata = "MetaData"),
         contains = "VIRTUAL")

setClass("MetadataAllMixin",
         slots = c(metadataAll = "MetaData"),
         contains = "VIRTUAL",
         validity = function(object) {
             metadataAll <- object@metadataAll
             J <- object@J@.Data
             ## 'metadataAll' does not have any dimensions with dimtype "iteration"
             if ("iteration" %in% dimtypes(metadataAll))
                 return(gettextf("dimension with dimtype \"%s\"",
                                 "iteration"))
             ## 'metadataAll' does not have any dimensions with dimtype "quantile"
             if ("quantile" %in% dimtypes(metadataAll))
                 return(gettextf("dimension with dimtype \"%s\"",
                                 "quantile"))
             ## consistent with J
             if (prod(dim(metadataAll)) < J)
                 return(gettextf("'%s' not consistent with '%s'",
                                 "metadataAll", "J"))             
             TRUE
         })

## 'mu' in notes
setClass("MeanLevelComponentWeightMixMixin",
         slots = c(meanLevelComponentWeightMix = "Parameter"),
         prototype = prototype(meanLevelComponentWeightMix = methods::new("Parameter", 0)),
         contains = "VIRTUAL")

setClass("MultMixin",
         slots = c(mult = "Scale"),
         contains = "VIRTUAL")

setClass("MultAlphaMixin",
         slots = c(multAlpha = "Scale"),
         contains = "VIRTUAL")

setClass("MultComponentWeightMixMixin",
         slots = c(multComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("MultDeltaMixin",
         slots = c(multDelta = "Scale"),
         contains = "VIRTUAL")

setClass("MultDelta0Mixin",
         slots = c(multDelta0 = "Scale"),
         contains = "VIRTUAL")

setClass("MultEtaCoefMixin",
         slots = c(multEtaCoef = "ScaleVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             multEtaCoef <- object@multEtaCoef
             AEtaCoef <- object@AEtaCoef@.Data
             ## 'multEtaCoef' has same length as 'AEtaCoef'
             if (!identical(length(multEtaCoef), length(AEtaCoef)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "multEtaCoef", "AEtaCoef"))
             TRUE
         })

setClass("MultLevelComponentWeightMixMixin",
         slots = c(multLevelComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("MultMoveMixin",
         slots = c(multMove = "Scale"),
         contains = "VIRTUAL")

setClass("MultSeasonMixin",
         slots = c(multSeason = "Scale"),
         contains = "VIRTUAL")

setClass("MultTauMixin",
         slots = c(multTau = "Scale"),
         contains = "VIRTUAL")

setClass("MultVectorsMixMixin",
         slots = c(multVectorsMix = "Scale"),
         contains = "VIRTUAL")

setClass("NSeasonMixin",
         slots = c(nSeason = "Length"),
         contains = "VIRTUAL",
         validity = function(object) {
             nSeason <- object@nSeason
             ## at least 2 seasons
             if (nSeason < 2L)
                 return(gettextf("'%s' is less than %d",
                                 "nSeason", 2L))
             TRUE
         })

setClass("NuMixin",
         slots = c(nu = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuAlphaMixin",
         slots = c(nuAlpha = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuBetaMixin",
         slots = c(nuBeta = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuCMPMixin",
         slot = c(nuCMP = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             nuCMP <- object@nuCMP
             theta <- object@theta
             ## 'nuCMP' has same length as 'theta'
             if (!identical(length(nuCMP), length(theta)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "nuCMP", "theta"))
             TRUE
         })

setClass("NuComponentWeightMixMixin",
         slots = c(nuComponentWeightMix = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuDeltaMixin",
         slots = c(nuDelta = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuEtaCoefMixin",
         slots = c(nuEtaCoef = "DegreesFreedomVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             nuEtaCoef <- object@nuEtaCoef
             AEtaCoef <- object@AEtaCoef@.Data
             ## 'nuEtaCoef' has same length as 'AEtaCoef'
             if (!identical(length(nuEtaCoef), length(AEtaCoef)))
                 return(gettextf("'%s' and '%s' have different lengths",
                                 "nuEtaCoef", "AEtaCoef"))
             TRUE
         })

setClass("NuLevelComponentWeightMixMixin",
         slots = c(nuLevelComponentWeightMix = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuSeasonMixin",
         slots = c(nuSeason = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuTauMixin",
         slots = c(nuTau = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("NuVectorsMixMixin",
         slots = c(nuVectorsMix = "DegreesFreedom"),
         contains = "VIRTUAL")

setClass("OmegaAlphaMaxMixin",
         slots = c(omegaAlphaMax = "Scale"),
         contains = "VIRTUAL",
         validity = function(object) {
             omegaAlpha <- object@omegaAlpha@.Data
             omegaAlphaMax <- object@omegaAlphaMax@.Data
             if (omegaAlpha > omegaAlphaMax)
                 return(gettextf("'%s' is greater than '%s'",
                                 "omegaAlpha", "omegaAlphaMax"))
             TRUE
         })

setClass("OmegaAlphaMixin",
         slots = c(omegaAlpha = "Scale"),
         contains = "VIRTUAL")

setClass("OmegaDeltaMaxMixin",
         slots = c(omegaDeltaMax = "Scale"),
         contains = "VIRTUAL",
         validity = function(object) {
             omegaDelta <- object@omegaDelta@.Data
             omegaDeltaMax <- object@omegaDeltaMax@.Data
             if (omegaDelta > omegaDeltaMax)
                 return(gettextf("'%s' is greater than '%s'",
                                 "omegaDelta", "omegaDeltaMax"))
             TRUE
         })

setClass("OmegaDeltaMixin",
         slots = c(omegaDelta = "Scale"),
         contains = "VIRTUAL")

setClass("OmegaLevelComponentWeightMaxMixMixin",
         slots = c(omegaLevelComponentWeightMaxMix = "Scale"),
         contains = "VIRTUAL")

## 'eta' in notes
setClass("OmegaLevelComponentWeightMixMixin",
         slots = c(omegaLevelComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("OmegaSeasonMaxMixin",
         slots = c(omegaSeasonMax = "Scale"),
         contains = "VIRTUAL",
         validity = function(object) {
             omegaSeason <- object@omegaSeason@.Data
             omegaSeasonMax <- object@omegaSeasonMax@.Data
             if (omegaSeason > omegaSeasonMax)
                 return(gettextf("'%s' is greater than '%s'",
                                 "omegaSeason", "omegaSeasonMax"))
             TRUE
         })

setClass("OmegaSeasonMixin",
         slots = c(omegaSeason = "Scale"),
         contains = "VIRTUAL")

setClass("OmegaComponentWeightMaxMixMixin",
         slots = c(omegaComponentWeightMaxMix = "Scale"),
         contains = "VIRTUAL")

## 'epsilon' in notes
setClass("OmegaComponentWeightMixMixin",
         slots = c(omegaComponentWeightMix = "Scale"),
         contains = "VIRTUAL")

setClass("OmegaVectorsMaxMixMixin",
         slots = c(omegaVectorsMaxMix = "Scale"),
         contains = "VIRTUAL")

## 'sigma_A', 'sigma_S' in notes
setClass("OmegaVectorsMixMixin",
         slots = c(omegaVectorsMix = "Scale"))

setClass("PMixin",
         slots = c(P = "Length"),
         contains = "VIRTUAL",
         validity = function(object) {
             P <- object@P@.Data
             ## 'P' is 2 or more
             if (P < 2L)
                 return(gettextf("'%s' is less than %d",
                                 "P", 2L))
         })

setClass("PhiMixin",
         slots = c(phi = "numeric"),
         contains = "VIRTUAL",
         validity = function(object) {
             phi <- object@phi
             ## 'phi' has length 1
             if (!identical(length(phi), 1L))
                 return(gettextf("'%s' does not have length %d",
                                 "phi", 1L))
             ## 'phi' has type "double"
             if (!is.double(phi))
                 return(gettextf("'%s' does not have type \"%s\"",
                                 "phi", "double"))
             ## 'phi' is not missing
             if (is.na(phi))
                 return(gettext("'%s' is missing",
                                "phi"))
             ## 'phi' is non-negative
             if (phi < 0)
                 return(gettext("'%s' is negative",
                                "phi"))
             ## 'phi' is less than or equal to 1
             if (phi > 1)
                 return(gettext("'%s' is greater than %d",
                                "phi", 1L))
             TRUE
         })

setClass("PhiKnownMixin",
         slots = c(phiKnown = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("PhiMinMaxMixin",
         slots = c(minPhi = "numeric",
                   maxPhi = "numeric"),
         contains = "VIRTUAL",
         validity = function(object) {
             minPhi <- object@minPhi
             maxPhi <- object@maxPhi
             for (name in c("minPhi", "maxPhi")) {
                 value <- methods::slot(object, name) 
                 ## 'minPhi', 'maxPhi' have length 1
                 if (!identical(length(value), 1L))
                     return(gettextf("'%s' does not have length %d",
                                     name, 1L))
                 ## 'minPhi', 'maxPhi' are double
                 if (!is.double(value))
                     return(gettextf("'%s' does not have type \"%s\"",
                                     name, "double"))
                 ## 'minPhi', 'maxPhi' are not missing
                 if (is.na(value))
                     return(gettextf("'%s' is missing",
                                     name))
             }
             ## minPhi >= 0
             if (minPhi < 0)
                 return(gettextf("'%s' is less than %d",
                                 "minPhi", 0L))
             ## maxPhi <= 1
             if (maxPhi > 1)
                 return(gettextf("'%s' is greater than %d",
                                 "maxPhi", 1L))
             ## minPhi < maxPhi
             if (minPhi >= maxPhi)
                 return(gettextf("'%s' greater than or equal to '%s'",
                                 "minPhi", "maxPhi"))
             TRUE
         })

setClass("PhiMixMixin",
         slots = c(phiMix = "numeric"),
         contains = "VIRTUAL",
         validity = function(object) {
             phiMix <- object@phiMix
             ## 'phiMix' has length 1
             if (!identical(length(phiMix), 1L))
                 return(gettextf("'%s' does not have length %d",
                                 "phiMix", 1L))
             ## 'phiMix' has type "double"
             if (!is.double(phiMix))
                 return(gettextf("'%s' does not have type \"%s\"",
                                 "phiMix", "double"))
             ## 'phiMix' is not missing
             if (is.na(phiMix))
                 return(gettext("'%s' is missing",
                                "phiMix"))
             ## 'phiMix' is greater 0
             if (phiMix <= 0)
                 return(gettext("'%s' is less than or equal to %d",
                                "phiMix", 0L))
             ## 'phiMix' is less than 1
             if (phiMix >= 1)
                 return(gettext("'%s' is greater than or equal to %d",
                                "phiMix", 1L))
             TRUE
         })

setClass("PosProdVectorsMixMixin",
         slots = c(posProdVectors1Mix = "integer",
                   posProdVectors2Mix = "integer",
                   nBetaNoAlongMix = "integer"),
         contains = "VIRTUAL",
         validity = function(object) {
             posProdVectors1Mix <- object@posProdVectors1Mix
             posProdVectors2Mix <- object@posProdVectors2Mix
             nBetaNoAlongMix <- object@nBetaNoAlongMix
             dim.beta <- object@dimBeta
             iAlong <- object@iAlong
             pos1 <- dim.beta[1L]
             pos2 <- 1L
             n.beta <- 1L
             for (d in seq_along(dim.beta)) {
                 if (d < iAlong) {
                     pos1 <- pos1 * dim.beta[d + 1L]
                     pos2 <- pos2 * dim.beta[d]
                 }
                 if (d != iAlong)
                     n.beta <- n.beta * dim.beta[d]
             }
             ## 'posProdVectors1Mix' has correct value
             if (!identical(posProdVectors1Mix, pos1))
                 return(gettextf("'%s' not consistent with '%s' and '%s'",
                                 "posProdVectors1Mix", "dimBeta", "iAlong"))
             ## 'posProdVectors2Mix' has correct value
             if (!identical(posProdVectors2Mix, pos2))
                 return(gettextf("'%s' not consistent with '%s' and '%s'",
                                 "posProdVectors2Mix", "dimBeta", "iAlong"))
             ## 'nBetaNoAlongMix' has correct value
             if (!identical(nBetaNoAlongMix, n.beta))
                 return(gettextf("'%s' not consistent with '%s' and '%s'",
                                 "nBetaNoAlongMix", "dimBeta", "iAlong"))
             TRUE
         })             

## 'mu0' in notes
setClass("PriorMeanLevelComponentWeightMixMixin",
         slots = c(priorMeanLevelComponentWeightMix = "Parameter"),
         prototype = prototype(priorMeanLevelComponentWeightMix = methods::new("Parameter", 0)),
         contains = "VIRTUAL")

## 'sigma0' in notes
setClass("PriorSDLevelComponentWeightMixMixin",
         slots = c(priorSDLevelComponentWeightMix = "Scale"),
         prototype = prototype(prorSDLevelComponentWeightMix = methods::new("Scale", 1)),
         contains = "VIRTUAL")

setClass("ProdVectorsMixMixin",
         slots = c(prodVectorsMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             prodVectors <- object@prodVectorsMix@.Data
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## length of 'prodVectors' equal to product of non-along
             ## dimensions times indexClassMaxMix
             ans.obtained <- length(prodVectors)
             ans.expected <- as.integer(prod(dimBeta[-iAlong]) * indexClassMaxMix)
             if (!identical(ans.obtained, ans.expected)) {
                 return(gettextf("length of '%s' not equal to product of non-\"%s\" dimensions times '%s'",
                                 "prodVectors", "along", "indexClassMaxMix"))
             }
             TRUE
         })

setClass("RMixMixin",
         slots = c(RMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             RMix <- object@RMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             n.along <- dimBeta[iAlong]
             ## 'RMix' has length n.aong - 1
             if (!identical(length(RMix), n.along - 1L))
                 return(gettextf("'%s' does not have length %s-1",
                                 "RMix", "n.along"))
             TRUE
         })

setClass("RNoTrendMixin",
         slots = c(RNoTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             RNoTrend <- object@RNoTrend
             K <- object@K
             ## 'RNoTrend' has length K
             if (!identical(length(RNoTrend), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "RNoTrend", "K"))
             ## elements of 'RNoTrend' have length 1L
             if (!identical(length(RNoTrend[[1L]]), 1L))
                 return(gettextf("elements of '%s' do not have length '%d'",
                                 "RNoTrend", 1L))
             TRUE
         })

setClass("RWithTrendMixin",
         slots = c(RWithTrend = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             RWithTrend <- object@RWithTrend
             K <- object@K
             ## 'RWithTrend' has length K
             if (!identical(length(RWithTrend), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "RWithTrend", "K"))
             ## elements of 'RWithTrend' are 2x2 matrices
             if (!all(sapply(RWithTrend, function(x) identical(dim(x), c(2L, 2L)))))
                 return(gettextf("elements of '%s' are not 2x2 matrices",
                                 "RWithTrend"))
             TRUE
         })

setClass("RSeasonMixin",
         slots = c(RSeason = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             RSeason <- object@RSeason
             K <- object@K
             nSeason <- object@nSeason
             ## 'RSeason' has length K
             if (!identical(length(RSeason), as.integer(K)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "RSeason", "K"))
             ## elements of 'RSeason' are length-nSeason vectors (not matrices)
             if (!all(sapply(RSeason, length) == nSeason))
                 return(gettextf("elements of '%s' do not have length '%s'",
                                 "RSeason", "nSeason"))
             TRUE
         })


setClass("SDMeanLogNuCMPMixin",
         slots = c(sdMeanLogNuCMP = "Scale"),
         prototype = prototype(sdMeanLogNuCMP = methods::new("Scale", 1)),
         contains = "VIRTUAL")


setClass("Shape1Shape2PhiMixin",
         slots = c(shape1Phi = "Scale",
                   shape2Phi = "Scale"))

setClass("SlotsToExtract",
         slots = c(slotsToExtract = "character"),
         contains = "VIRTUAL")

setClass("SMixin",
         slots = c(s = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             s <- object@s@.Data
             K <- object@K@.Data
             L <- object@L@.Data
             nSeason <- object@nSeason@.Data
             ## 's' has length '(K+1)L'
             if (!identical(length(s), (K + 1L) * L))
                 return(gettextf("'%s' does not have length '%s'",
                                 "s", "(K+1)L"))
             ## elements of 's' have length 'nSeason'
             if (!identical(length(s[[1L]]), nSeason))
                 return(gettextf("elements of '%s' do not have length '%s'",
                                 "s", "nSeason"))
             TRUE
         })

setClass("SDLogNuCMPMixin",
         slots = c(sdLogNuCMP = "Scale"),
         contains = "VIRTUAL")

setClass("SpecAMixin",
         slots = c(A = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecAAlphaMixin",
         slots = c(AAlpha = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecAComponentWeightMixMixin",
         slots = c(AComponentWeightMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecADeltaMixin",
         slots = c(ADelta = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecADelta0Mixin",
         slots = c(ADelta0 = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecAEtaCoefMixin",
         slots = c(AEtaCoef = "SpecScaleVec"),
         contains = "VIRTUAL")

setClass("SpecALevelComponentWeightMixMixin",
         slots = c(ALevelComponentWeightMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecAMoveMixin",
         slots = c(AMove = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecASeasonMixin",
         slots = c(ASeason = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecATauMixin",
         slots = c(ATau = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecAVectorsMixMixin",
         slots = c(AVectorsMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecHasLevelMixin",
         slots = c(hasLevel = "LogicalFlag"),
         contains = "VIRTUAL")

setClass("SpecOmegaAlphaMaxMixin",
         slots = c(omegaAlphaMax = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecOmegaComponentWeightMaxMixMixin",
         slots = c(omegaComponentWeightMaxMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecOmegaDeltaMaxMixin",
         slots = c(omegaDeltaMax = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecOmegaLevelComponentWeightMaxMixMixin",
         slots = c(omegaLevelComponentWeightMaxMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecOmegaSeasonMaxMixin",
         slots = c(omegaSeasonMax = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecOmegaVectorsMaxMixMixin",
         slots = c(omegaVectorsMaxMix = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecPhiMixin",
         slots = c(phi = "numeric"),
         validity = function(object) {
             phi <- object@phi
             ## 'phi' has length 1
             if (!identical(length(phi), 1L))
                 return(gettextf("'%s' does not have length %d",
                                 "phi", 1L))
             ## 'phi' has type "double"
             if (!is.double(phi))
                 return(gettextf("'%s' does not have type \"%s\"",
                                 "phi", "double"))
             if (!is.na(phi)) {
                 ## if 'phi' is not missing: 'phi' is non-negative
                 if (phi < 0)
                     return(gettext("'%s' is negative",
                                    "phi"))
                 ## if 'phi' is not missing: 'phi' is less than or equal to 1
                 if (phi > 1)
                     return(gettext("'%s' is greater than %d",
                                    "phi", 1L))
             }
             TRUE
         })

setClass("SpecSDLogNuCMPMixin",
         slots = c(sdLogNuCMP = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecScaleMaxMixin",
         slots = c(scaleMax = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecTauMixin",
         slots = c(tau = "SpecScale"),
         contains = "VIRTUAL")

setClass("SpecTauMaxMixin",
         slots = c(tauMax = "SpecScale"),
         contains = "VIRTUAL")

setClass("SumsWeightsMixMixin",
         slots = c(sumsWeightsMix = "UnitIntervalVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             sumsWeightsMix <- object@sumsWeightsMix@.Data
             iAlong <- object@iAlong
             dim.beta <- object@dimBeta
             n.along <- dim.beta[iAlong]
             ## length of 'sumsWeightMix' equal to n.along
             if (!identical(length(sumsWeightsMix), n.along))
                 return(gettextf("'%s', '%s', and '%s' inconsistent",
                                 "sumsWeightsMix", "iAlong", "dimBeta"))
             TRUE
         })

setClass("TauMaxMixin",
         slots = c(tauMax = "Scale"),
         contains = "VIRTUAL",
         validity = function(object) {
             tau <- object@tau
             tauMax <- object@tauMax
             if (tau > tauMax)
                 return(gettextf("'%s' is greater than '%s'",
                                 "tau", "tauMax"))
             TRUE
         })

setClass("TauMixin",
         slots = c(tau = "Scale"),
         contains = "VIRTUAL")

setClass("ToleranceMixin",
         slots = c(tolerance = "Parameter"),
         prototype = prototype(tolerance = methods::new("Parameter", 1e-5)),
         contains = "VIRTUAL",
         validity = function(object) {
             tolerance <- object@tolerance@.Data
             ## 'tolerance' is positive
             if (tolerance <= 0)
                 return(gettextf("'%s' is non-positive",
                                 "tolerance"))
             TRUE
         })

setClass("UBetaMixin",
         slots = c(UBeta = "VarTDist"),
         contains = "VIRTUAL",
         validity = function(object) {
             J <- object@J
             UBeta <- object@UBeta
             ## 'UBeta' has length 'J'
             if (!identical(length(UBeta), as.integer(J)))
                 return(gettextf("'%s' does not have length '%s'",
                                 "UBeta", "J"))
             TRUE
         })

setClass("UEtaCoefMixin",
         slots = c(UEtaCoef = "VarTDist"),
         contains = "VIRTUAL",
         validity = function(object) {
             P <- object@P@.Data
             UEtaCoef <- object@UEtaCoef
             ## 'UEtaCoef' has length P-1
             if (!identical(length(UEtaCoef), P - 1L))
                 return(gettextf("'%s' does not have length %s-1",
                                 "UEtaCoef", "P"))
             TRUE
         })

setClass("UCDCMixin",
         slots = c(UC = "FFBSList",
                   DC = "FFBSList",
                   DCInv = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             K <- object@K@.Data
             for (name in c("UC", "DC", "DCInv")) {
                 value <- methods::slot(object, name)
                 ## 'UC', 'DC', 'DCInv' have length K+1
                 if (!identical(length(value), K + 1L))
                     return(gettextf("'%s' does not have length %s+1",
                                     name, "K"))
                 ## elements of 'UC', 'DC', 'DCInv' are 2x2 matrices
                 if (!all(sapply(value, function(x) identical(dim(x), c(2L, 2L)))))
                     return(gettextf("elements of '%s' are not 2x2 matrices",
                                     name))
             }
             TRUE
         })

setClass("URDRMixin",
         slots = c(UR = "FFBSList",
                   DRInv = "FFBSList"),
         contains = "VIRTUAL",
         validity = function(object) {
             K <- object@K@.Data
             for (name in c("UR", "DRInv")) {
                 value <- methods::slot(object, name)
                 ## 'UR', 'DRInv' have length K
                 if (!identical(length(value), K))
                     return(gettextf("'%s' does not have length %s",
                                     name, "K"))
                 ## elements of 'UR', 'DRInv' are 2x2 matrices
                 if (!all(sapply(value, function(x) identical(dim(x), c(2L, 2L)))))
                     return(gettextf("elements of '%s' are not 2x2 matrices",
                                     name))
             }
             TRUE
         })

## 'psi' in notes
setClass("VectorsMixMixin",
         slots = c(vectorsMix = "list"),
         contains = "VIRTUAL",
         validity = function(object) {
             vectorsMix <- object@vectorsMix
             dimBeta <- object@dimBeta
             iAlong <- object@iAlong
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## all elements of 'vectorsMix' have class "ParameterVector"
             if (!all(sapply(vectorsMix, methods::is, "ParameterVector")))
                 return(gettextf("'%s' has elements not of class \"%s\"",
                                 "vectorsMix", "ParameterVector"))
             ## Length of vector equals length of associated dimension
             ## times maximum number of classes, except for "along"
             ## dimension, where length is 0
             for (i in seq_along(vectorsMix)) {
                 vector <- vectorsMix[[i]]
                 length.obtained <- length(vector)
                 if (i == iAlong) {
                     length.expected <- 0L
                     if (length.obtained != length.expected)
                         return(gettextf("element of '%s' for \"%s\" dimension does not have length %d",
                                         "vectorsMix", "along", 0L))
                 }
                 else {
                     length.expected <- dimBeta[i] * indexClassMaxMix
                     if (length.obtained != length.expected)
                         return(gettextf("element %d of '%s' not equal to length of associated dimension times '%s'",
                                         i, "vectorsMix", "indexClassMaxMix"))
                 }
             }
             TRUE
         })

setClass("WSqrtMixin",
         slots = c(WSqrt = "NumericMatrixSquare",
                   WSqrtInvG = "NumericMatrixSquare"),
         contains = "VIRTUAL",
         validity = function(object) {
             WSqrt <- object@WSqrt
             WSqrtInvG <- object@WSqrtInvG
             for (name in c("WSqrt", "WSqrtInvG")) {
                 value <- methods::slot(object, name)
                 ## 'WSqrt', 'WSqrtInvG' have 2 rows
                 if (!identical(nrow(value), 2L))
                     return(gettextf("'%s' does not have %d rows",
                                     name, 2L))
             }
             ## 'WSqrt' is a  diagonal matrix
             if (!isTRUE(all.equal(WSqrt[c(2L, 3L)], c(0, 0))))
                 return(gettextf("'%s' is not diagonal",
                                 "WSqrt"))
             ## second element of 'WSqrtInvG' is 0
             if (!isTRUE(all.equal(WSqrtInvG[2L], 0)))
                 return(gettextf("second element of '%s' is not %d",
                                 "WSqrtInvG", 0L))
             TRUE
         })

## 'v' in notes
## weights stored as if matrix in which row is 'i.along' and column is 'class'
setClass("WeightMixMixin",
         slots = c(weightMix = "UnitIntervalVec"),
         contains = "VIRTUAL",
         validity = function(object) {
             weightMix <- object@weightMix@.Data
             iAlong <- object@iAlong
             dimBeta <- object@dimBeta
             n.along <- dimBeta[iAlong]
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## length of 'weightMix' equal to length of 'along' dimension
             ## multiplied by maximum number of classes
             length.obtained <- length(weightMix)
             length.expected <- n.along * indexClassMaxMix
             if (length.obtained != length.expected)
                 return(gettextf("length of '%s' not equal to length of \"%s\" dimension times '%s'",
                                 "weightMix", "along", "indexClassMaxMix"))
             TRUE
         })

setClass("YXXXMixMixin",
         slots = c(yXMix = "ParameterVector",
                   XXMix = "ParameterVector"),
         contains = "VIRTUAL",
         validity = function(object) {
             indexClassMaxMix <- object@indexClassMaxMix@.Data
             ## yXMix, XXMix have length 'indexClassMaxMix'
             for (name in c("yXMix", "XXMix")) {
                 value <- methods::slot(object, name)
                 value <- value@.Data
                 if (!identical(length(value), indexClassMaxMix))
                     return(gettextf("'%s' does not have length '%s'",
                                     name, "indexClassMaxMix"))
             }
             TRUE
         })

## Do not require that nrows >= ncols, since we have
## an informative prior on the coefficients.
setClass("ZMixin",
         slots = c(Z = "matrix"),
         contains = "VIRTUAL",
         validity = function(object) {
             J <- object@J
             P <- object@P
             Z <- object@Z
             allStrucZero <- object@allStrucZero
             ## 'Z' is double
             if (!is.double(Z))
                 return(gettextf("model matrix '%s' does not have type \"%s\"",
                                 "Z", "double"))
             ## 'Z' has no missing values
             if (any(is.na(Z)))
                 return(gettextf("model matrix '%s' has missing values",
                                 "Z"))
             ## 'Z' has 'J' rows
             if (!identical(nrow(Z), as.integer(J)))
                 return(gettextf("'%s' does not have '%s' rows",
                                 "Z", "J"))
             ## 'Z' has 'P' columns
             if (!identical(ncol(Z), as.integer(P)))
                 return(gettextf("'%s' does not have '%s' columns",
                                 "Z", "P"))
             ## first column all 1s
             first <- as.numeric(Z[!allStrucZero, 1L])
             if (!isTRUE(all.equal(first, rep(1, times = sum(!allStrucZero)))))
                 return(gettextf("first column of '%s' is not a vector of 1s",
                                 "Z"))
             TRUE
         })
StatisticsNZ/demest documentation built on Nov. 2, 2023, 7:56 p.m.