Nothing
#' @aliases update update.imprecise
#' @title
#' Updating Imprecise Prior
#'
#' @description
#' The function \code{update} applies to the Bayes rule to the imprecise prior
#' which is specified by \code{"\link{iprior}"} by taking \code{data} in the
#' \code{"\link{model}"}.
#'
#' @param object
#' an object of class \code{imprecise} produced from \code{"\link{iprior}"}.
#' See \sQuote{Details} for more information.
#'
#' @param silent
#' a logical value; Would like to see the report of progress messages
#' (including warnings and error messages) generated from numerical methods
#' that are used for a numerical approximation?
#' Defaults to \code{FALSE}.
#'
#' @param ...
#' Other named arguments to be passed to \code{\link{cpef}} and
#' \code{\link{cpef2reg}}; needs to be matched exactly.
#' See \sQuote{Details} for more information.
#'
#' @details
#' The function \code{update} calls the functions of \code{\link{cpef}} and
#' \code{\link{cpef2reg}} based on the \code{formula} specified
#' in the \code{\link{model}}.
#' Named arguements of \code{ztrunc}, \code{method}, and \code{apriori} are
#' passed to those functions.
#'
#' This \code{update} is the last stage on the imprecise inferential framework.
#' \code{stage} has the environment name called.
#'
#' \code{method} should be specified;
#' Five options are available on the use of \code{\link{cpef}};
#' Three options are available on the use of \code{\link{cpef2reg}}.
#' See the \sQuote{Details} of \code{\link{cpef}} and \code{\link{cpef2reg}}.
#'
#' In general, \code{MH} is safe from numerical failure on parameter estimation
#' with a small size of a sample.
#' \code{LA} is the most effieint for a large size of a sample (say,
#' \eqn{n>5e2} for zero-truncated case).
#'
#' @return A list with the components:
#' \item{m1}{The list containing all information of parameter estimation.}
#' \item{method}{The type of numerical method used for numerical approximation}
#' \item{xi}{The numeric vector for prediction if provided.}
#'
#' @keywords
#' Imprecise inferential framework, Poisson regression, Bayes
#'
#' @seealso
#' \code{\link{iprior}}, \code{\link{model}}, \code{\link{cpef}},
#' \code{\link{cpef2reg}}
#'
#' @examples
#' \dontrun{
#' ##
#' }
#' @references
#' Lee (2013) ``Imprecise inferential framework'', PhD thesis.
#'
#' @author Chel Hee Lee <gnustats@@gmail.com>
#'
#' @method update imprecise
#' @S3method update imprecise
# update.imprecise <- function(object, apriori= c("lgamma", "normal"), silent=FALSE,...){
update.imprecise <- function(object, silent=FALSE,...){
# sanity check
stopifnot(!missing(object))
if(object$stage != "iprior") stop("Not correct order of imprecise inferential framework. \n'update' should be followed by 'iprior'")
mc <- match.call()
object$stage <- "update" # mc[[1]]
# naming convention
init <- object$init
y <- object$y
X <- object$X
xreg <- object$xreg
xtms <- object$xtms
ztrunc <- object$ztrunc
applyBayes <- function(x, ...){
# Passing the information of an imprecise prior to the selected numerical
# approximation method
#
# Args:
# x: The component of an imprecise prior
#
# Return:
# The object including all numerical results
# Make sure which extreme point in the convex hull is.
xtms.i <- x
if (!silent) {
message("ID confirmation: ", sQuote(xtms.i))
}
# Access the i-th actual imprecise information
x <- xtms[[x]]
x <- as.vector(x)
if (xreg) {
fit <- cpef2reg(b=x, X=X, start=init, ...)
} else {
fit <- cpef(hparam=x, start=(log(mean(y))+rnorm(1)), ...)
}
return(fit)
}
# tracking the correct component of an imprecise prior
m1 <- lapply(X=names(xtms), FUN=applyBayes,
y=y, ztrunc=ztrunc, verbose=!silent, ...)
names(m1) <- lapply(m1, "[[", "xid")
object$m1 <- m1
# make sure if the same method is applied to all components
object$method <- unique(do.call(c, lapply(X=m1, "[[", "method")))
# show minimal information about what inputs the user provided
xtrc.apriori <- unique(lapply(m1, "[[", "apriori"))
stopifnot(length(xtrc.apriori)==1)
if (is.null(xtrc.apriori[[1]])) {
object$apriori <- NULL
} else {
object$apriori <- xtrc.apriori[[1]]
}
xtrc.B <- unique(lapply(m1, "[[", "B"))
stopifnot(length(xtrc.B)==1)
if (is.null(xtrc.B[[1]])) {
object$B <- NULL
} else {
object$B <- xtrc.B[[1]]
}
xtrc.xi <- unique(lapply(m1, "[[", "xi"))
stopifnot(length(xtrc.xi)==1)
if (is.null(xtrc.xi[[1]])) {
object$xi <- NULL
} else {
object$xi <- xtrc.xi[[1]]
}
invisible(object)
}
NULL
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.