#' Get an xtable or kable object that describes change in deviance in terms of
#' strength of evidence
#'
#' @param kable Whether to return a kable. Defaults to \code{kable=FALSE} and an
#' \code{xtable} object is returned.
#'
#' @importFrom xtable xtable
#' @export evidence
evidence <- function(kable=FALSE){
dev <- cbind(c("< 2", "2 -- 6", "6 -- 10", "> 10"),
c("Weak", "Modest", "Strong", "Very strong"))
colnames(dev) <- c("Change in deviance", "Strength of evidence")
rownames(dev) <- c("", " ", " ", " ")
if (kable){
knitr::kable(dev)
} else {
xtable(dev, label="tab:deviance", align="llr",
caption="Interpretation of change in deviance in terms of strength of evidence.")
}
}
#' Take a list of evmOpt objects and return an xtable
#'
#' @param x A list, each element of which is an object of class "evm". It is
#' assumed that the first element of \code{x} is the null model.
#' @param kable Whether to return a \code{kable} object. Defaults to \code{kable=FALSE}
#' and an \code{xtable} object is returned.
#' @param digits The number of significant digits to display.
#' @param label The label to use for the table. Defaults to \code{label='tab:aic'}.
#' @param caption The caption for the table.
#' @details Use \code{print(res, sanitize.text.function=function(x) x, include.rownames=FALSE)}.
#' @export
AICtable <- function(x, kable=FALSE, digits=3, label="tab:aic",
caption="Comparison of various generalized Pareto models in terms of number of coefficients, log-likelihood, AIC and change in deviance from the null model."){
aic <- sapply(x, function(x){ AIC(x) })
ll <- sapply(x, function(x){ x$loglik })
dev <- as.character(signif(2*(ll - ll[1]), digits))
dev[1] <- "-"
np <- sapply(x, function(x) length(coef(x)))
getfo <- function(wh){
fo <- wh$formulae # <----------------------------------- XXX XXX XXX XXX
fo <- lapply(fo, function(x) unlist(strsplit(as.character(x)[2], " + ", fixed=TRUE)))
fo <- sapply(fo, function(x) paste0("f(", paste(x, collapse=", "), ")"))
fo <- paste0("$", paste(paste0("\\", names(fo), "=", fo), collapse=", "), "$")
gsub("`", "", fo)
}
fo <- sapply(x, getfo)
res <- cbind(fo, np, signif(ll, digits), signif(aic, digits), dev)
colnames(res) <- c("Model", "\\#Coef.", "Loglik.", "AIC", "$\\Delta$ Dev.")
# Even if print.xtable is told to ignore rownames, the align argument needs to assume
# they're there, which is why it appears to have the wrong length.
if (kable){
knitr::kable(res)
} else {
res <- xtable(res, label=label, caption=caption, align=c("l", "l", rep("r", 4)))
oldClass(res) <- "AICtable"
res
}
}
#' @method print AICtable
#' @export
print.AICtable <- function(x, include.rownames=FALSE, ...){
oldClass(x) <- c("xtable", "data.frame")
print.xtable(x, include.rownames=include.rownames, sanitize.text.function=function(x) x)
invisible()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.