Nothing
##' Extract, set, or alter coefficients
##'
##' Extract, set, or modify the estimated parameters from a fitted model.
##'
##' @name coef
##' @rdname coef
##' @aliases coef<- coef<-,missing-method
##' @docType methods
##' @include pomp_class.R listie.R
##' @family extraction methods
NULL
##' @importFrom stats coef
setGeneric("coef")
setGeneric(
"coef<-",
function (object, ..., value)
standardGeneric("coef<-")
)
setMethod(
"coef<-",
signature=signature(object="missing"),
definition=function (...) {
reqd_arg("coef<-","object") #nocov
}
)
##' @rdname coef
##' @export
setMethod(
"coef",
signature=signature(object="listie"),
definition=function(object, ...) {
x <- do.call(cbind,lapply(object,coef))
names(dimnames(x)) <- c("name",".id")
x
}
)
##' @rdname coef
##' @param object an object of class \sQuote{pomp}, or of a class extending \sQuote{pomp}
##' @param pars optional character; names of parameters to be retrieved or set.
##' @param transform logical; perform parameter transformation?
##' @param \dots ignored or passed to the more primitive function
##'
##' @details
##' \code{coef} allows one to extract the parameters from a fitted model.
##'
##' \code{coef(object,transform=TRUE)} returns the parameters transformed onto
##' the estimation scale.
##' @export
setMethod(
"coef",
signature=signature(object="pomp"),
definition=function (object, pars, transform = FALSE, ...) {
if (length(object@params)>0) {
if (transform)
params <- partrans(object,params=object@params,...,dir="toEst")
else
params <- object@params
if (missing(pars))
pars <- names(params)
else {
excl <- setdiff(pars,names(params))
nexcl <- length(excl)
if (nexcl > 0) {
pStop(who="coef","name",ngettext(nexcl," ","s "),
paste(sQuote(excl),collapse=","),
" correspond",ngettext(nexcl,"s",""),
" to no parameter",ngettext(nexcl,".","s."))
}
}
params[pars]
} else {
numeric(0)
}
}
)
##' @rdname coef
##' @param value numeric vector or list; values to be assigned.
##' If \code{value = NULL}, the parameters are unset.
##' @details
##' \code{coef(object) <- value} sets or alters the coefficients of a
##' \sQuote{pomp} object.
##'
##' \code{coef(object,transform=TRUE) <- value} assumes that \code{value} is on
##' the estimation scale, and applies the \dQuote{from estimation scale}
##' parameter transformation from \code{object} before altering the
##' coefficients.
##' @export
setMethod(
"coef<-",
signature=signature(object="pomp"),
definition=function (object, pars, transform = FALSE, ..., value) {
if (is.null(value)) value <- numeric(0)
if (is.list(value)) value <- unlist(value)
if (missing(pars)) { ## replace the whole params slot with 'value'
if (length(value)>0) {
if (transform)
value <- partrans(object,params=value,...,dir="fromEst")
pars <- names(value)
if (is.null(pars)) {
pStop(who="coef<-",sQuote("value")," must be a named vector.")
}
}
object@params <- value
} else { ## replace or append only the parameters named in 'pars'
if (!is.null(names(value))) ## we ignore the names of 'value'
pWarn(who=-2L,"names of ",sQuote("value")," are being discarded.")
if (length(object@params)==0) { ## no pre-existing 'params' slot
val <- numeric(length(pars))
names(val) <- pars
val[] <- value
if (transform) val <- partrans(object,params=val,...,dir="fromEst")
object@params <- val
} else { ## pre-existing params slot
params <- coef(object,transform=transform)
val <- numeric(length(pars))
names(val) <- pars
val[] <- value
excl <- !(pars%in%names(params)) ## new parameter names
if (any(excl)) { ## append parameters
nexcl <- sum(excl)
pWarn(who=-2L,ngettext(nexcl,"name","names")," ",
paste(sQuote(pars[excl]),collapse=","),
" refer",ngettext(nexcl,"s","")," to no existing parameter",
ngettext(nexcl,"","s"),"; ",
ngettext(nexcl,"it is","they are")," being concatenated.")
params <- c(params,val[excl])
}
params[pars] <- val
if (transform) params <- partrans(object,params=params,...,dir="fromEst")
object@params <- params
}
}
storage.mode(object@params) <- "double"
object
}
)
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.