Skip to content

Commit

Permalink
add pbf
Browse files Browse the repository at this point in the history
  • Loading branch information
cjvanlissa committed Apr 26, 2023
1 parent c95b023 commit ab0815d
Show file tree
Hide file tree
Showing 5 changed files with 143 additions and 3 deletions.
5 changes: 2 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
Package: bain
Type: Package
Date: 2021-12-06
Title: Bayes Factors for Informative Hypotheses
Version: 0.2.8
Version: 0.2.9
Authors@R: c(
person(c("Xin"), "Gu", role = c("aut"), email = "[email protected]"),
person(c("Herbert"), "Hoijtink", role = c("aut"), email = "[email protected]"),
Expand All @@ -27,7 +26,7 @@ LazyData: true
URL: https://informative-hypotheses.sites.uu.nl/software/bain/
BugReports: https://github.com/cjvanlissa/bain/
NeedsCompilation: yes
RoxygenNote: 7.1.2
RoxygenNote: 7.2.3
Depends:
R (>= 3.0.0),
stats
Expand Down
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,8 @@ S3method(get_estimates,lavaan)
S3method(get_estimates,lm)
S3method(get_estimates,matrix)
S3method(get_estimates,t_test)
S3method(pbf,default)
S3method(pbf,numeric)
S3method(print,Bain)
S3method(print,bain)
S3method(print,bain_sensitivity)
Expand All @@ -23,6 +25,7 @@ S3method(vcov,t_test)
export(bain)
export(bain_sensitivity)
export(get_estimates)
export(pbf)
export(seBeta)
export(t_test)
importFrom(lavaan,lavInspect)
Expand Down
86 changes: 86 additions & 0 deletions R/pbf.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,86 @@
#' @title Product Bayes Factor
#' @description The product Bayes factor (PBF) aggregates evidence for
#' an informative hypothesis across conceptual replication studies
#' without imposing assumptions about heterogeneity.
#' @param ... Additional arguments passed to `bain`.
#' @return A `data.frame` of class `pbf`.
#' @details Currently, the argument `x` accepts either:
#' * A list of `bain` objects, resulting from a call to `bain`.
#' * A list of model objects for which a `bain` method exists;
#' in this case, `pbf` will call `bain` on these model objects
#' before aggregating the Bayes factors.
#' @examples
#' pbf(yi = c(-.33, .32, .39, .31),
#' vi = c(.085, .034, .016, .071),
#' ni = c(7, 10, 13, 20))
#' @rdname pbf
#' @references Van Lissa, C. J., Kuiper, R. M., & Clapper, E.
#' (2023, April 25). Aggregating evidence from conceptual
#' replication studies using the product Bayes factor.
#' \doi{10.31234/osf.io/nvqpw}
#' @export
pbf <- function(...){
UseMethod("pbf")
}

#' @method pbf default
#' @param x An object for which a method exists, see Details.
#' @export
pbf.default <- function(x, ...){
if(!all(sapply(x, inherits, what = "bain"))){
cl <- match.call()
cl[[1L]] <- quote(bain)
for(i in (1:length(x))){
cl[['x']] <- x[[i]]
x[[i]] <- eval.parent(cl)
}
cl[['x']] <- x
cl[[1L]] <- quote(pbf)
eval.parent(cl)
}

# Merge the hypotheses from list item 1 and 2 into object merged
if(length(x) > 1){
hyps <- x[[1]]$hypotheses
for(i in length(x)-1){
hyps <- c(hyps, x[[i+1]]$hypotheses)
# Drop all non-duplicated hypotheses from merged
hyps <- hyps[duplicated(hyps)]
# If merged now has length 0, throw error
if(length(hyps) == 0){
stop("The objects passed to pbf() have no hypotheses in common.")
}
# Else, go back to step 1, but now merge merged with list item 3
}
}
BFs <- do.call(cbind, lapply(x, function(y){y$fit$BF.c[match(hyps, y$hypotheses)]}))
colnames(BFs) <- paste0("Sample ", 1:ncol(BFs))
res <- data.frame(PBF = apply(BFs, 1, prod), BFs)# obtain pbf ic, might need to change dependent on alternative hyp
rownames(res) <- paste0(sprintf('H%d: ', 1:length(hyps)),hyps) # give names
class(res) <- c("pbf", class(res))
return(res)
}

#' @method pbf numeric
#' @export
#' @rdname pbf
#' @param yi Numeric vector with the observed effect sizes.
#' @param vi Numeric vector with the observed sampling variances.
#' @param ni Integer vector with the sample sizes.
#' @param hypothesis A character string containing the informative hypotheses to evaluate.
pbf.numeric <- function(yi, vi, ni, hypothesis = "y = 0", ...){
est <- c("y" = 0)
hypars <- params_in_hyp(hypothesis)
if(!length(hypars) == 1) stop("The hypothesis may reference only a single parameter when using pbf() with arguments 'yi' and 'vi'.")
names(est) <- hypars[1]
bain_list <- mapply(FUN = function(y, v, n){
est[1] <- y
bain(x = est,
Sigma = matrix(v, 1, 1),
n = n,
hypothesis = hypothesis,
joint_parameters = 1,
...)},
y = yi, v = vi, n = ni, SIMPLIFY = FALSE)
pbf(bain_list, hypothesis = hypothesis)
}
48 changes: 48 additions & 0 deletions man/pbf.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 4 additions & 0 deletions news.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# bain 0.2.9

* Add pbf() function to compute product Bayes factors

# bain 0.2.8

* Minor bugfix to ensure compatibility with JASP
Expand Down

0 comments on commit ab0815d

Please sign in to comment.