Nothing
######################################################
## assignment/accessor functions for some slots. ##
## (thanks to the kernlab package for the template) ##
######################################################
###### Overall ######
# Method to get the degrees of freedom from either a model objected or fitted model object
if(!isGeneric("model.df")){
if (is.function("model.df"))
fun <- model.df
else fun <- function(object) standardGeneric("model.df")
setGeneric("model.df", fun)
}
setMethod("model.df", "mpt.model", function(object) object@check[["df"]][["model"]])
setMethod("model.df", "mpt", function(object) object@model@check[["df"]][["model"]])
setGeneric("model.df<-", function(x, value) standardGeneric("model.df<-"))
setReplaceMethod("model.df", "mpt.model", function(x, value) {
if (!is.numeric(value)) stop("the mdf for the model must be numeric")
x@check[["df"]][["model"]] <- value
x
})
setReplaceMethod("model.df", "mpt", function(x, value) {
if (!is.numeric(value)) stop("the mdf for the model must be numeric")
object@model@check[["df"]][["model"]] <- value
x
})
########################
## Methods for Models ##
########################
##### MPT Model #####
if(!isGeneric("check")){
if (is.function("check"))
fun <- check
else fun <- function(object) standardGeneric("check")
setGeneric("check", fun)
}
setMethod("check", "mpt.model", function(object) object@check)
setGeneric("check<-", function(x, value) standardGeneric("check<-"))
setReplaceMethod("check", "mpt.model", function(x, value) {
if (!is.list(value)) stop("the model check must be a list")
x@check <- value
x
})
if(!isGeneric("initial.model")){
if (is.function("initial.model"))
fun <- initial.model
else fun <- function(object) standardGeneric("initial.model")
setGeneric("initial.model", fun)
}
setMethod("initial.model", "mpt.model", function(object) object@initial.model)
setGeneric("initial.model<-", function(x, value) standardGeneric("initial.model<-"))
setReplaceMethod("initial.model", "mpt.model", function(x, value) {
if (!is.list(value)) stop("the initial model must be a list")
x@initial.model <- value
x
})
if(!isGeneric("model.data.frame")){
if (is.function("model.data.frame"))
fun <- model.data.frame
else fun <- function(object) standardGeneric("model.data.frame")
setGeneric("model.data.frame", fun)
}
setMethod("model.data.frame", "mpt.model", function(object) object@model.data.frame)
setGeneric("model.data.frame<-", function(x, value) standardGeneric("model.data.frame<-"))
setReplaceMethod("model.data.frame", "mpt.model", function(x, value) {
if (!is.data.frame(value)) stop("the model.data.frame must be a data.frame")
x@model.data.frame <- value
x
})
if(!isGeneric("model.list")){
if (is.function("model.list"))
fun <- model.list
else fun <- function(object) standardGeneric("model.list")
setGeneric("model.list", fun)
}
setMethod("model.list", "mpt.model", function(object) object@model.list)
setGeneric("model.list<-", function(x, value) standardGeneric("model.list<-"))
setReplaceMethod("model.list", "mpt.model", function(x, value) {
if (!is.list(value)) stop("the model.list must be a list")
x@model.list <- value
x
})
if(!isGeneric("initial.model.data.frame")){
if (is.function("initial.model.data.frame"))
fun <- initial.model.data.frame
else fun <- function(object) standardGeneric("initial.model.data.frame")
setGeneric("initial.model.data.frame", fun)
}
setMethod("initial.model.data.frame", "mpt.model", function(object) object@initial.model.data.frame)
setGeneric("initial.model.data.frame<-", function(x, value) standardGeneric("initial.model.data.frame<-"))
setReplaceMethod("initial.model.data.frame", "mpt.model", function(x, value) {
if (!is.data.frame(value)) stop("the initial.model.data.frame must be a data.frame")
x@initial.model.data.frame <- value
x
})
### BMPT model ###
if(!isGeneric("A")){
if (is.function("A"))
fun <- A
else fun <- function(object) standardGeneric("A")
setGeneric("A", fun)
}
setMethod("A", "bmpt.model", function(object) object@A)
setGeneric("A<-", function(x, value) standardGeneric("A<-"))
setReplaceMethod("A", "bmpt.model", function(x, value) {
if (!is.array(value)) stop("A must be an array")
x@A <- value
x
})
if(!isGeneric("B")){
if (is.function("B"))
fun <- B
else fun <- function(object) standardGeneric("B")
setGeneric("B", fun)
}
setMethod("B", "bmpt.model", function(object) object@B)
setGeneric("B<-", function(x, value) standardGeneric("B<-"))
setReplaceMethod("B", "bmpt.model", function(x, value) {
if (!is.array(value)) stop("B must be an array")
x@B <- value
x
})
if(!isGeneric("lbmpt")){
if (is.function("lbmpt"))
fun <- lbmpt
else fun <- function(object) standardGeneric("lbmpt")
setGeneric("lbmpt", fun)
}
setMethod("lbmpt", "bmpt.model", function(object) object@lbmpt)
setGeneric("lbmpt<-", function(x, value) standardGeneric("lbmpt<-"))
setReplaceMethod("lbmpt", "bmpt.model", function(x, value) {
if (!is.character(value)) stop("lbmpt must be a character vector")
x@lbmpt <- value
x
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.