#' Print object returned by \code{restrict}
#'
#' @author Mattan S. Ben-Shachar
#' @param BFE an object returned by restrict
#' @param logBF should BF be presented as log(BF)? (defult, FALSE)
#' @param digits Number of digist to round numeric data.
#'
#' @export
print.resBF <- function(BFE, logBF = options()$BFE.print_logBF, digits = 3) {
# Print probabilities
writeLines('Restricted Model Probabilities:')
probs <- round(BFE$probability, digits = digits)
rownames(probs) <- 'Probability:'
colnames(probs) <- c('Prior','Posterior')
print.data.frame(probs)
writeLines('\n')
# Print BFs
res_BFs <- BFE$`log(BFs)`
# Make a matrix of BFs with colnames representing the numerator and
# rows are the denominator
BFMAT <- matrix(nrow = 3,ncol = 3)
rownames(BFMAT) <- colnames(BFMAT) <- c('Restricted','Full','Null')
diag(BFMAT) <- 0
BFMAT[upper.tri(BFMAT)] <- -1*t(res_BFs)[c(1,3,2)]
BFMAT[lower.tri(BFMAT)] <- t(res_BFs)[c(1,3,2)]
if (!logBF) {
writeLines('BFs:')
print(round(exp(BFMAT),digits = digits))
} else {
writeLines('log(BF)s:')
print(round(BFMAT,digits = digits))
}
writeLines('---\ncolumns are the numerator and rows are the denominator')
invisible(BFE)
}
#' Print object returned by \code{inferBF}
#'
#' @author Mattan S. Ben-Shachar
#' @param BFE an object returned by \code{inferBF}
#' @param logBF should BFs be presented as \code{log(BF)}?
#' @param digits Number of digist to round numeric data.
#' @param showSpec Show hypotheses specifications
#'
#' @import purrr
print.inferBF <- function(BFE,logBF = options()$BFE.print_logBF,digits = 3,showSpec = FALSE) {
is_est <- map_lgl(BFE,~any(colnames(.x)=='Estimate'))
writeLines('Hypotheses tested based on the model:')
writeLines(paste0('\t',attr(BFE,'model')))
# directed
if (any(!is_est)) {
dirs <- reduce(BFE[!is_est],rbind)
dirs <- round(dirs,digits = digits)
if (logBF) {
dirs[1:3] <- log(dirs[1:3])
colnames(dirs)[1:3] <- paste0('log(',colnames(dirs)[1:3],')')
}
writeLines('\nDirectional Tests:')
print.data.frame(dirs)
}
# point
if (any(is_est)) {
ests <- reduce(BFE[is_est],rbind)
ests <- round(ests,digits = digits)
if (logBF) {
ests$BF <- log(ests$BF)
colnames(ests)[5] <- 'log(BF)'
}
writeLines('\nPoint Tests:')
print.data.frame(ests)
writeLines(paste0('---\nHDI level: ', attr(BFE,'level')))
writeLines('Point BF calculated using the Savage-Dickey method')
}
if (showSpec) {
writeLines('\n')
spec <- as.data.frame(attr(BFE,'hyp'))
colnames(spec) <- 'Hypothesis.specification'
print.data.frame(spec)
}
invisible(BFE)
}
#' Convert object returned by \code{inferBF} to a \code{data.frame}
#'
#' @author Mattan S. Ben-Shachar
#' @param BFE an object returned by \code{inferBF}
#' @param type Which test type should be returned. Partial matching accepted.
#'
#' @export
#' @import dplyr
#' @import purrr
as.data.frame.inferBF <- function(BFE, type = c('both','point','direction')){
type <- match.arg(type[1],c('both','point','directional'))
is_est <- map_lgl(BFE,~any(colnames(.x)=='Estimate'))
model_types <- if (type=='point') {
is_est
} else if (type=='directional') {
!is_est
} else {
c(which(is_est),which(!is_est))
}
BFE %>%
map2(attr(BFE,'hyp'),
~mutate(.x,
Hypothesis = .y,
Type = ifelse('Estimate' %in% colnames(.x),"Point","Directional"))) %>%
.[model_types] %>%
bind_rows(.id = "Test") %>%
select(Type,Test,Hypothesis,everything()) %>%
arrange(desc(Type))
}
#' Print object returned by \code{hyp}
#'
#' @author Mattan S. Ben-Shachar
#' @param BFE an object returned by \code{hyp}
#'
#' @importFrom purrr map_chr
#' @importFrom rlang quo_name
print.hypBF <- function(BFE){
if (length(BFE)==1) {
writeLines('One Hypothesis:')
} else {
writeLines(paste0(length(BFE),' Hypotheses:'))
}
spec <- as.data.frame(map_chr(BFE,quo_name))
colnames(spec) <- 'Hypothesis specification'
print.data.frame(spec)
invisible(BFE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.