################################################
## Abstract Model

ParameterObject <- setClass("ParameterObject", representation())

setGeneric("pvec",function(param) standardGeneric("pvec"))
setGeneric("pvec<-",function(param,value) standardGeneric("pvec<-"))

setMethod("pvec","ParameterObject",
          function (param)
          stop("No pvec method supplied for class", class(param))
          )
setMethod("pvec<-","ParameterObject",
          function (param,value)
          stop("No pvec method supplied for class", class(param))
          )

## Placeholder for a parameter object which will be defined later.
NullParameter <-
setClass("NullParameter",contains="ParameterObject")
NullParameter <- function () {new("NullParameter")}


AbstractModel <- setClass("AbstractModel",
                          slots=c(param="ParameterObject",
                                  paramtype="character"),
                          prototype=list(param=NullParameter(),
                                         paramtype="UNDEFINED")
                          )
setGeneric("parameters",function(model) standardGeneric("parameters"))
setGeneric("parameters<-",function(model,value) standardGeneric("parameters<-"))

setMethod("parameters","AbstractModel",
          function(model) model@param)
setMethod("parameters<-","AbstractModel",
          function(model,value) {
            if (!is(value,model@paramtype) || is(value,"NullParameter"))
              stop("Parameter must be a ",model@paramtype)
            model@param <- value
            model
          })


#######################################################################
## Proficiency Models

ProficiencyModel <- setClass("ProficiencyModel",
                             contains="AbstractModel")




setGeneric("nlatent",function(pm) standardGeneric("nlatent"))
setGeneric("drawPMParam", function(pm,background=NA) standardGeneric("drawPMParam"))
setGeneric("lpriorPMParam", function(pm,param=parameters(pm),background=NA)
           standardGeneric("lpriorPMParam"))
setGeneric("drawInitialLatent", function(pm,ncases=1,background=NA,param=parameters(pm))
           standardGeneric("drawInitialLatent"))
setGeneric("lpriorLatent", function(pm,latent,background=NA,param=parameters(pm))
           standardGeneric("lpriorLatent"))
setGeneric("optimalPMParams", function (pm,latent,weights=1,
                                        background=NA,
                                        param=parameters(pm),control=list(),
                                        maxit=100,nowarn=FALSE,Bayes=TRUE)
           standardGeneric("optimalPMParams"))



setMethod("drawPMParam","ProficiencyModel",
          function (pm,background=NA)
          stop("No parameter initialization method supplied for class", class(pm))
          )
setMethod("lpriorPMParam", "ProficiencyModel",
          function(pm,param=parameters(pm),background=NA)
          stop("No lpriorPMParam method for class", class(pm)))
setMethod("drawInitialLatent","ProficiencyModel",
          function (pm,ncases=1,background=NA, param=parameters(pm))
          stop("No data initialization method supplied for class", class(pm))
          )
setMethod("lpriorLatent","ProficiencyModel",
          function (pm,latent,background=NA,param=parameters(pm))
          stop("No prior evaluation supplied for class", class(pm))
          )


ProficiencyGrowthModel <- setClass("ProficiencyGrowthModel",
                                   representation(usesSuccess = "logical"),
                                   prototype(usesSuccess=FALSE),
                                   contains="ProficiencyModel")


setGeneric("successProb", function(pm,param,latent,action=NA,background=NA)
           standardGeneric("successProb"))
setGeneric("drawSuccess", function(pm,param,latent,action=NA,background=NA)
           standardGeneric("drawSuccess"))
setGeneric("llikeSuccess", function(pm,param,latent,success,action=NA,background=NA)
           standardGeneric("llikeSuccess"))

setGeneric("advanceLatent", function(pm,param,latent,success=NA,action=NA,background=NA,time=1)
           standardGeneric("advanceLatent"))



setGeneric("nsuccess",function(pm) standardGeneric("nsuccess"))
setGeneric("naction",function(pm) standardGeneric("naction"))

setGeneric("llikeAdvanceLatent", function(pm,param,oldlatent,newlatent,
                                 success=NA,action=NA,background=NA,time=1)
           standardGeneric("llikeAdvanceLatent"))





setMethod("drawSuccess", "ProficiencyGrowthModel",
           function(pm,param,latent,action=NA,background=NA) {
             if (pm@usesSuccess) {
               stop("No success generation method supplied for class", class(pm))
             } else {
               NULL
             }
           })
setMethod("successProb", "ProficiencyGrowthModel",
           function(pm,param,latent,action=NA,background=NA) {
             if (pm@usesSuccess) {
               stop("No success generation method supplied for class", class(pm))
             } else {
               NULL
             }
           })

setMethod("llikeSuccess", "ProficiencyGrowthModel",
           function(pm,param,latent,success,action=NA,background=NA) {
             if (pm@usesSuccess) {
               stop("No success evaluation method supplied for class", class(pm))
             } else {
               0
             }
           })


setMethod("advanceLatent", "ProficiencyGrowthModel",
           function(pm,param,latent,success=NA,action=NA,background=NA,time=1)
           stop("No data advancement method supplied for class", class(pm)))

setMethod("llikeAdvanceLatent", "ProficiencyGrowthModel",
           function(pm,param,oldlatent,newlatent,success=NA,action=NA,background=NA,time=1)
           stop("No data advancement evaluation method supplied for class", class(pm)))


setMethod("nsuccess","ProficiencyGrowthModel",
          function (pm) {
            if (pm@usesSuccess) {
              stop("No success dimension method supplied for class", class(pm))
            } else {
              return (0)
            }
          })


#########################################################################
## Evidence Model

EvidenceModel <- setClass("EvidenceModel",
                          representation(Q="array"),
                          contains="AbstractModel")


setGeneric("Q",function(em) standardGeneric("Q"))
setGeneric("Q<-",function(em,value) standardGeneric("Q<-"))

setGeneric("nobserved",function(em) standardGeneric("nobserved"))
setGeneric("drawEMParam", function(em,background=NA,QQ=Q(em)) standardGeneric("drawEMParam"))
setGeneric("lpriorEMParam", function(em,param=parameters(em),background=NA,QQ=Q(em))
           standardGeneric("lpriorEMParam"))


setGeneric("llikeObs", function(em,obs,latent,background=NA,QQ=Q(em),param=parameters(em))
           standardGeneric("llikeObs"))
setGeneric("drawObs", function(em,latent,background=NA,QQ=Q(em),param=parameters(em))
           standardGeneric("drawObs"))
setGeneric("optimalEMParams", function (em,obs,latent,weights=1,
                                      background=NA,QQ=Q(em),
                                      param=parameters(em),control=list(),
                                      maxit=100,nowarn=FALSE,Bayes=TRUE)
           standardGeneric("optimalEMParams"))




## Scales a Q-matrix according to is column sums.
scaleQ <- function (Q) {
  sqrt(sweep(Q*Q,1,apply(Q*Q,1,sum),"/"))
}

setMethod("Q","EvidenceModel",
          function(em) em@Q)
setMethod("Q<-","EvidenceModel",
          function(em,value) {
            em@Q <- value
            em
          })

## This should be a pretty good default
setMethod("nobserved", "EvidenceModel",
          function(em) nrow(em@Q))


setMethod("drawEMParam","EvidenceModel",
          function (em,background=NA,QQ=Q(em))
          stop("No parameter initialization method supplied for class", class(em))
          )
setMethod("lpriorEMParam", "EvidenceModel",
          function(em,param=parameters(em),background=NA,QQ=Q(em))
          stop("No lpriorEMParam method for class", class(em)))

setMethod("llikeObs", "EvidenceModel",
           function(em,obs,latent,background=NA,QQ=Q(em),param=parameters(em))
           stop("No likelihood evaluation method supplied for class", class(em))
           )

setMethod("drawObs", "EvidenceModel",
           function(em,latent,background=NA,QQ=Q(em),param=parameters(em))
           stop("No observation generation method supplied for class", class(em))
           )





#################################################
## Periodic Assessment Model

PeriodicAssessmentModel <-
setClass("PeriodicAssessmentModel",
         representation(pgm="ProficiencyGrowthModel",
                        pgmparam = "list",
                        actions = "list",
                        ems="list",
                        emparams="list",
                        Qmats = "list",
                        ncycle="integer",
                        time="vector"),
         prototype(pgm=new("ProficiencyGrowthModel"),
                   pgmparam=list(),actions=list(),
                   ems=list(),emparams=list(),Qmats=list(),
                   time=1,ncycle=as.integer(0)))

setGeneric("ncycle",function(x) standardGeneric("ncycle"))
setGeneric("getQt",function(pamodel,time) standardGeneric("getQt"))
setGeneric("getActiont",function(pamodel,time) standardGeneric("getActiont"))
setGeneric("getCycletime",function(pamodel,time) standardGeneric("getCycletime"))
setGeneric("getPGM",function(pamodel) standardGeneric("getPGM"))
setGeneric("getPGMparam",
           function(pamodel) standardGeneric("getPGMparam"))
setGeneric("getPGMparam<-",
           function(pamodel,value) standardGeneric("getPGMparam<-"))
setGeneric("getEMt",function(pamodel,time) standardGeneric("getEMt"))
setGeneric("getEMparamt",function(pamodel,time) standardGeneric("getEMparamt"))
setGeneric("getEMparamt<-",function(pamodel,time,value) standardGeneric("getEMparamt<-"))


setMethod("ncycle","PeriodicAssessmentModel",
          function(x) x@ncycle)

setMethod("getQt","PeriodicAssessmentModel",
          function(pamodel,time) {
            if (length(pamodel@Qmats) == 0) {
              return (NULL)
            } else if (length(pamodel@Qmats) == 1) {
              return (pamodel@Qmats[[1]])
            } else {
              return (pamodel@Qmats[[time]])
            }
          })


setMethod("getActiont","PeriodicAssessmentModel",
          function(pamodel,time) {
            if (length(pamodel@action) == 0) {
              return (NULL)
            } else if (length(pamodel@action) == 1) {
              return (pamodel@action[[1]])
            } else {
              return (pamodel@action[[time]])
            }
          })


setMethod("getCycletime","PeriodicAssessmentModel",
          function(pamodel,time) {
            if (length(pamodel@cycletime) == 1) {
              return (pamodel@cycletime[1])
            } else {
              return (pamodel@cycletime[time])
            }
          })




setMethod("getPGM","PeriodicAssessmentModel",
          function(pamodel) pamodel@pgm)
setMethod("getPGMparam","PeriodicAssessmentModel",
           function(pamodel) pamodel@pgmparam)
setMethod("getPGMparam<-","PeriodicAssessmentModel",
           function(pamodel,value) {
             if (is.list(value)) {
               pamodel@pgmparam <- value
             } else {
               pamodel@pgmparam <- list(value)
             }
             pamodel
           })


setMethod("getEMt","PeriodicAssessmentModel",
          function(pamodel,time) {
            if (length(pamodel@ems) == 0) {
              return (NULL)
            } else if (length(pamodel@ems) == 1) {
              return (pamodel@ems[[1]])
            } else {
              return (pamodel@ems[[time]])
            }
          })

setMethod("getEMparamt","PeriodicAssessmentModel",
          function(pamodel,time) {
            return (pamodel@emparams[[time]])
          })

setMethod("getEMparamt<-","PeriodicAssessmentModel",
          function(pamodel,time,value) {
            pamodel@emparams[[time]] <- value
            pamodel
          })