BayesFactor/0000755000176200001440000000000013300035654012453 5ustar liggesusersBayesFactor/inst/0000755000176200001440000000000013277750604013444 5ustar liggesusersBayesFactor/inst/tests/0000755000176200001440000000000013043077372014601 5ustar liggesusersBayesFactor/inst/tests/test-ttest.R0000644000176200001440000000127613043077372017052 0ustar liggesusers context('t-test') data('ToothGrowth') test_that('ttest works', { ttestBF(ToothGrowth$len, ToothGrowth$dose) ttestBF(formula=len~supp, data=ToothGrowth) }) test_that('rejects bad input', { expect_error( ttestBF(formula=len~dose, data=ToothGrowth), 'Indep. groups t test requires a factor with exactly 2 levels.', fixed=TRUE ) expect_error( ttestBF(formula=len~dose+supp, data=ToothGrowth), 'Indep. groups t test can only support 1 factor as predictor.', fixed=TRUE ) expect_error( ttestBF(formula=len~dose:supp, data=ToothGrowth), 'Interaction terms are not allowed in t test.', fixed=TRUE ) }) BayesFactor/inst/tests/test-correlationBF.R0000644000176200001440000000021213043077372020425 0ustar liggesusers context("correlationBF") set.seed(0) test_that("correlation works", { x <- runif(100) y <- x + rnorm(100) correlationBF(x, y) }) BayesFactor/inst/tests/test-anovaBF.R0000644000176200001440000000044313043077372017216 0ustar liggesusers context("anovaBF") test_that("Puzzles example works", { data(puzzles) bf = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", iterations=1000, progress = FALSE) expect_that(bf, is_a("BFBayesFactor")) expect_that(length(bf), is_equivalent_to(4)) }) BayesFactor/inst/tests/test-regressionBF.R0000644000176200001440000000074013043077372020272 0ustar liggesusers context("regressionBF") set.seed(0) test_that("regressionBF works", { x <- rnorm(100) a <- rnorm(100) y <- x + a + rnorm(100) data <- data.frame(y, x, a) regressionBF(y ~ x + a, data) }) test_that("regressionBF errors appropriately", { x <- rnorm(100) a <- rnorm(100) y <- x + a + rnorm(100) data <- data.frame(y, x, a) expect_error( regressionBF(y ~ x * a, data), 'Interactions not allowed in regressionBF (try generalTestBF)', fixed=TRUE) }) BayesFactor/inst/tests/test-proportionBF.R0000644000176200001440000000133313043077372020324 0ustar liggesusers context("proportionBF") test_that("bad p values are handled correctly", { expect_error( proportionBF(0, N=0, p=0), 'p must be between 0 and 1', fixed=TRUE) expect_error( proportionBF(0, N=0, p=1), 'p must be between 0 and 1', fixed=TRUE) expect_error( proportionBF(0, N=0, p=-100), 'p must be between 0 and 1', fixed=TRUE) expect_error( proportionBF(0, N=0, p=12), 'p must be between 0 and 1', fixed=TRUE) }) test_that("no samples is handled correctly", { proportionBF(0, N=0, p=0.5) }) test_that("floor/ceiling values behave correctly", { proportionBF( 0, N=100, p=0.5) proportionBF(100, N=100, p=0.5) }) BayesFactor/inst/tests/test-specialchars.R0000644000176200001440000000353213043077372020345 0ustar liggesusers context('special chars') e <- function(x) composeTerm(paste0(x, ' :`"\'')) p <- paste0 data('ToothGrowth') ToothGrowth$dose <- as.factor(ToothGrowth$dose) colnames(ToothGrowth) <- paste0(colnames(ToothGrowth), ' :`"\'') test_that('ttestBF accepts column names with special chars', { formula <- p(e('len'), '~', e('supp')) formula <- as.formula(formula) results <- ttestBF(formula=formula, data=ToothGrowth) expect_that(results, is_a("BFBayesFactor")) expect_that(length(results), is_equivalent_to(1)) }) test_that('anovaBF accepts column names with special chars', { formula <- p(e('len'), '~', e('supp')) formula <- as.formula(formula) results <- anovaBF(formula=formula, data=ToothGrowth) expect_that(results, is_a("BFBayesFactor")) expect_that(length(results), is_equivalent_to(1)) formula <- p(e('len'), '~', e('supp'), '*', e('dose')) formula <- as.formula(formula) results <- anovaBF(formula=formula, data=ToothGrowth) expect_that(results, is_a("BFBayesFactor")) expect_that(length(results), is_equivalent_to(4)) }) test_that('generalTestBF accepts column names with special chars', { data(puzzles) names(puzzles) <- paste0(colnames(puzzles), ' :`"\'') formula <- p(e('RT'), '~', e('shape'), '*', e('color'), '*', e('ID')) formula <- as.formula(formula) bf <- generalTestBF(formula, whichRandom=e('ID'), data = puzzles) expect_that(bf, is_a("BFBayesFactor")) expect_that(length(bf), is_equivalent_to(18)) }) test_that("regressionBF accepts column names with special chars", { set.seed(0) x <- rnorm(100) a <- rnorm(100) y <- x + a + rnorm(100) data <- data.frame(y, x, a) colnames(data) <- paste0(colnames(data), ' :`"\'') formula <- as.formula(p(e('y'), '~', e('x'), '+', e('a'))) bf <- regressionBF(formula, data) expect_that(bf, is_a("BFBayesFactor")) expect_that(length(bf), is_equivalent_to(3)) }) BayesFactor/inst/tests/test-generalTestBF.R0000644000176200001440000000036613043077372020373 0ustar liggesusers context('generalTestBF') data(puzzles) test_that('generalTestBF works', { bf <- generalTestBF(RT ~ shape*color*ID, whichRandom="ID", data = puzzles) expect_that(bf, is_a("BFBayesFactor")) expect_that(length(bf), is_equivalent_to(18)) }) BayesFactor/inst/tests/test-contingencyBF.R0000644000176200001440000000075513043077372020440 0ustar liggesusers context("contingencyBF") test_that("contingencyBF works", { data <- matrix(c(3, 6, 4, 9), nrow=2) contingencyTableBF(data, sampleType='poisson') contingencyTableBF(data, sampleType='jointMulti', fixedMargin='rows') contingencyTableBF(data, sampleType='jointMulti', fixedMargin='cols') contingencyTableBF(data, sampleType='indepMulti', fixedMargin='rows') contingencyTableBF(data, sampleType='indepMulti', fixedMargin='cols') contingencyTableBF(data, sampleType='hypergeom') }) BayesFactor/inst/doc/0000755000176200001440000000000013274042531014177 5ustar liggesusersBayesFactor/inst/doc/odds_probs.html0000644000176200001440000017501113277750603017241 0ustar liggesusers Odds and probabilities using BayesFactor

Fork me on GitHub

BayesFactor logo


Odds and probabilities using BayesFactor

Richard D. Morey

BayesFactor on facebook Find us on facebook
BayesFactor blog Follow the BayesFactor blog

Share via
share on facebook tweet BayesFactor submit to reddit submit to google plus share by email


The Bayes factor is only one part of Bayesian model comparison. The Bayes factor represents the relative evidence between two models – that is, the change in the model odds due to the data – but the odds are what are being changed. For any two models \({\cal M}_0\) and \({\cal M}_1\) and data \(y\),

\[ \frac{P({\cal M}_1\mid y)}{P({\cal M}_0\mid y)} = \frac{P(y \mid {\cal M}_1)}{P(y\mid{\cal M}_0)} \times\frac{P({\cal M}_1)}{P({\cal M}_0)}; \] that is, the posterior odds are equal to the Bayes factor times the prior odds.

Further, these odds can be converted to probabilities, if we assume that all the models sum to known probability.

Prior odds with BayesFactor

data(puzzles)
bf = anovaBF(RT ~ shape*color + ID, whichRandom = "ID", data = puzzles)
bf
## Bayes factor analysis
## --------------
## [1] shape + ID                       : 2.89 ±1.63%
## [2] color + ID                       : 2.8  ±0.85%
## [3] shape + color + ID               : 11.6 ±1.48%
## [4] shape + color + shape:color + ID : 4.24 ±3.1%
## 
## Against denominator:
##   RT ~ ID 
## ---
## Bayes factor type: BFlinearModel, JZS

With the addition of BFodds objects, we can compute prior and posterior odds. A prior odds object can be created from the structure of an existing BayesFactor object:

prior.odds = newPriorOdds(bf, type = "equal")
prior.odds
## Prior odds
## --------------
## [1] shape + ID                       : 1
## [2] color + ID                       : 1
## [3] shape + color + ID               : 1
## [4] shape + color + shape:color + ID : 1
## 
## Against denominator:
##   RT ~ ID 
## ---
## Model type: BFlinearModel, JZS

For now, the only type of prior odds is “equal”. However, we can change the prior odds to whatever we like with the priorOdds function:

priorOdds(prior.odds) <- c(4,3,2,1)
prior.odds
## Prior odds
## --------------
## [1] shape + ID                       : 4
## [2] color + ID                       : 3
## [3] shape + color + ID               : 2
## [4] shape + color + shape:color + ID : 1
## 
## Against denominator:
##   RT ~ ID 
## ---
## Model type: BFlinearModel, JZS

Posterior odds with BayesFactor

We can multiply the prior odds by the Bayes factor to obtain posterior odds:

post.odds = prior.odds * bf
post.odds
## Posterior odds
## --------------
## [1] shape + ID                       : 11.6 ±1.63%
## [2] color + ID                       : 8.4  ±0.85%
## [3] shape + color + ID               : 23.2 ±1.48%
## [4] shape + color + shape:color + ID : 4.24 ±3.1%
## 
## Against denominator:
##   RT ~ ID 
## ---
## Model type: BFlinearModel, JZS

Prior/posterior probabilities with BayesFactor

Odds objects can be converted to probabilities:

post.prob = as.BFprobability(post.odds)
post.prob
## Posterior probabilities
## --------------
## [1] shape + ID                       : 0.239  ±NA%
## [2] color + ID                       : 0.174  ±NA%
## [3] shape + color + ID               : 0.479  ±NA%
## [4] shape + color + shape:color + ID : 0.0875 ±NA%
## [5] ID                               : 0.0207 ±NA%
## 
## Normalized probability:  1  
## ---
## Model type: BFlinearModel, JZS

By default the probabilities sum to 1, but we can change this by renormalizing. Note that this normalizing constant is arbitrary, but it can be helpful to set it to specific values.

post.prob / .5
## Posterior probabilities
## --------------
## [1] shape + ID                       : 0.12   ±NA%
## [2] color + ID                       : 0.0868 ±NA%
## [3] shape + color + ID               : 0.24   ±NA%
## [4] shape + color + shape:color + ID : 0.0438 ±NA%
## [5] ID                               : 0.0103 ±NA%
## 
## Normalized probability:  0.5  
## ---
## Model type: BFlinearModel, JZS

In addition, we can select subsets of the probabilities, and the normalizing constant is adjusted to the sum of the model probabilities:

post.prob[1:3]
## Posterior probabilities
## --------------
## [1] shape + ID         : 0.239 ±NA%
## [2] color + ID         : 0.174 ±NA%
## [3] shape + color + ID : 0.479 ±NA%
## 
## Normalized probability:  0.892  
## ---
## Model type: BFlinearModel, JZS

…which can, in turn, be renormalized:

post.prob[1:3] / 1
## Posterior probabilities
## --------------
## [1] shape + ID         : 0.268 ±NA%
## [2] color + ID         : 0.195 ±NA%
## [3] shape + color + ID : 0.537 ±NA%
## 
## Normalized probability:  1  
## ---
## Model type: BFlinearModel, JZS

In the future, the ability to filter these objects will be added, as well as model averaging based on posterior probabilities and samples.


Social media icons by Lokas Software.

This document was compiled with version 0.9.12-4.2 of BayesFactor (R version 3.5.0 (2018-04-23) on x86_64-apple-darwin15.6.0).

BayesFactor/inst/doc/index.html0000644000176200001440000010474113277750550016215 0ustar liggesusers BayesFactor manual files

alt text


BayesFactor manual files

BayesFactor/inst/doc/compare_lme4.R0000644000176200001440000001740613277750550016713 0ustar liggesusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ## ----message=FALSE,warning=FALSE----------------------------------------- library(arm) library(lme4) ## ------------------------------------------------------------------------ # Number of participants N <- 20 sig2 <- 1 sig2ID <- 1 # 3x3x3 design, with participant as random factor effects <- expand.grid(A = c("A1","A2","A3"), B = c("B1","B2","B3"), C = c("C1","C2","C3"), ID = paste("Sub",1:N,sep="") ) Xdata <- model.matrix(~ A*B*C + ID, data=effects) beta <- matrix(c(50, -.2,.2, 0,0, .1,-.1, rnorm(N-1,0,sqrt(sig2ID)), 0,0,0,0, -.1,.1,.1,-.1, 0,0,0,0, 0,0,0,0,0,0,0,0), ncol=1) effects$y = rnorm(Xdata%*%beta,Xdata%*%beta,sqrt(sig2)) ## ------------------------------------------------------------------------ # Typical repeated measures ANOVA summary(fullaov <- aov(y ~ A*B*C + Error(ID/(A*B*C)),data=effects)) ## ----fig.width=10,fig.height=4------------------------------------------- mns <- tapply(effects$y,list(effects$A,effects$B,effects$C),mean) stderr = sqrt((sum(resid(fullaov[[3]])^2)/fullaov[[3]]$df.resid)/N) par(mfrow=c(1,3),cex=1.1) for(i in 1:3){ matplot(mns[,,i],xaxt='n',typ='b',xlab="A",main=paste("C",i), ylim=range(mns)+c(-1,1)*stderr,ylab="y") axis(1,at=1:3,lab=1:3) segments(1:3 + mns[,,i]*0,mns[,,i] + stderr,1:3 + mns[,,i]*0,mns[,,i] - stderr,col=rgb(0,0,0,.3)) } ## ------------------------------------------------------------------------ t.is = system.time(bfs.is <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID") ) t.la = system.time(bfs.la <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID", method = "laplace") ) ## ----fig.width=6,fig.height=6-------------------------------------------- t.is t.la plot(log(extractBF(sort(bfs.is))$bf),log(extractBF(sort(bfs.la))$bf), xlab="Default Sampler",ylab="Laplace approximation", pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2) abline(0,1) bfs.is ## ----message=FALSE------------------------------------------------------- chains <- lmBF(y ~ A + B + C + ID, data=effects, whichRandom = "ID", posterior=TRUE, iterations=10000) lmerObj <- lmer(y ~ A + B + C + (1|ID), data=effects) # Use arm function sim() to sample from posterior chainsLmer = sim(lmerObj,n.sims=10000) ## ------------------------------------------------------------------------ BF.sig2 <- chains[,colnames(chains)=="sig2"] AG.sig2 <- (chainsLmer@sigma)^2 qqplot(log(BF.sig2),log(AG.sig2),pch=21,bg=rgb(0,0,1,.2), col=NULL,asp=TRUE,cex=1,xlab="BayesFactor samples", ylab="arm samples",main="Posterior samples of\nerror variance") abline(0,1) ## ------------------------------------------------------------------------ AG.raneff <- chainsLmer@ranef$ID[,,1] BF.raneff <- chains[,grep('ID-',colnames(chains),fixed='TRUE')] plot(colMeans(BF.raneff),colMeans(AG.raneff),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Random effect posterior means") abline(0,1) ## ----tidy=FALSE---------------------------------------------------------- AG.fixeff <- chainsLmer@fixef BF.fixeff <- chains[,1:10] # Adjust AG results from reference cell to sum to 0 Z = c(1, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3) dim(Z) = c(7,10) Z = t(Z) AG.fixeff2 = t(Z%*%t(AG.fixeff)) ## Our grand mean has heavier tails qqplot(BF.fixeff[,1],AG.fixeff2[,1],pch=21,bg=rgb(0,0,1,.2),col=NULL,asp=TRUE,cex=1,xlab="BayesFactor estimate",ylab="arm estimate",main="Grand mean posterior samples") abline(0,1) plot(colMeans(BF.fixeff[,-1]),colMeans(AG.fixeff2[,-1]),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Fixed effect posterior means") abline(0,1) ## Compare posterior standard deviations BFsd = apply(BF.fixeff[,-1],2,sd) AGsd = apply(AG.fixeff2[,-1],2,sd) plot(sort(AGsd/BFsd),pch=21,bg=rgb(0,0,1,.2),col="black",cex=1.2,ylab="Ratio of posterior standard deviations (arm/BF)",xlab="Fixed effect index") ## AG estimates are slightly larger, consistent with sig2 estimates ## probably due to prior ## ----message=FALSE,warning=FALSE----------------------------------------- library(languageR) library(xtable) ## ------------------------------------------------------------------------ data(primingHeidPrevRT) primingHeidPrevRT$lRTmin1 <- log(primingHeidPrevRT$RTmin1) ###Frequentist lr4 <- lmer(RT ~ Condition + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime + ResponseToPrime*RTtoPrime +BaseFrequency ,primingHeidPrevRT) # Get rid rid of some outlying response times INDOL <- which(scale(resid(lr4)) < 2.5) primHeidOL <- primingHeidPrevRT[INDOL,] ## ------------------------------------------------------------------------ # Center continuous variables primHeidOL$BaseFrequency <- primHeidOL$BaseFrequency - mean(primHeidOL$BaseFrequency) primHeidOL$lRTmin1 <- primHeidOL$lRTmin1 - mean(primHeidOL$lRTmin1) primHeidOL$RTtoPrime <- primHeidOL$RTtoPrime - mean(primHeidOL$RTtoPrime) ## ------------------------------------------------------------------------ # LMER lr4b <- lmer( RT ~ Condition + ResponseToPrime + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL) # BayesFactor B5out <- lmBF( RT ~ Condition + ResponseToPrime + Word + Subject + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL , whichRandom = c("Word", "Subject"), posterior = TRUE, iteration = 50000,columnFilter=c("Word","Subject")) lmerEff <- fixef(lr4b) bfEff <- colMeans(B5out[,1:10]) ## ----results='asis'------------------------------------------------------ print(xtable(cbind("lmer fixed effects"=names(lmerEff))), type='html') ## ----tidy=FALSE---------------------------------------------------------- # Adjust lmer results from reference cell to sum to 0 Z = c(1, 1/2, 1/2, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0,-1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1/2, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2) dim(Z) = c(7,10) Z = t(Z) # Do reparameterization by pre-multimplying the parameter vector by Z reparLmer <- Z %*% matrix(lmerEff,ncol=1) # put results in data.frame for comparison sideBySide <- data.frame(BayesFactor=bfEff,lmer=reparLmer) ## ----results='asis'------------------------------------------------------ print(xtable(sideBySide,digits=4), type='html') ## ------------------------------------------------------------------------ # Notice Bayesian shrinkage par(cex=1.5) plot(sideBySide[-1,],pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2, main="fixed effects\n (excluding grand mean)") abline(0,1, lty=2) BayesFactor/inst/doc/priors.Rmd0000644000176200001440000000746713274042567016210 0ustar liggesusers ![alt text](extra/logo.png) ------ ```{r echo=FALSE,message=FALSE,results='hide'} ``` Prior checks =========== ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") set.seed(2) ``` The BayesFactor has a number of prior settings that should provide for a consistent Bayes factor. In this document, Bayes factors are checked for consistency. Independent-samples t test and ANOVA ------ The independent samples $t$ test and ANOVA functions should provide the same answers with the default prior settings. ```{r} # Create data x <- rnorm(20) x[1:10] = x[1:10] + .2 grp = factor(rep(1:2,each=10)) dat = data.frame(x=x,grp=grp) t.test(x ~ grp, data=dat) ``` If the prior settings are consistent, then all three of these numbers should be the same. ```{r} as.vector(ttestBF(formula = x ~ grp, data=dat)) as.vector(anovaBF(x~grp, data=dat)) as.vector(generalTestBF(x~grp, data=dat)) ``` Regression and ANOVA ------ In a paired design with an additive random factor and and a fixed effect with two levels, the Bayes factors should be the same, regardless of whether we treat the fixed factor as a factor or as a dummy-coded covariate. ```{r} # create some data id = rnorm(10) eff = c(-1,1)*1 effCross = outer(id,eff,'+')+rnorm(length(id)*2) dat = data.frame(x=as.vector(effCross),id=factor(1:10), grp=factor(rep(1:2,each=length(id)))) dat$forReg = as.numeric(dat$grp)-1.5 idOnly = lmBF(x~id, data=dat, whichRandom="id") summary(aov(x~grp+Error(id/grp),data=dat)) ``` If the prior settings are consistent, these two numbers should be almost the same (within MC estimation error). ```{r} as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(lmBF(x ~ forReg+id, data=dat, whichRandom="id")/idOnly) ``` Independent t test and paired t test ------- Given the effect size $\hat{\delta}=t\sqrt{N_{eff}}$, where the effective sample size $N_{eff}$ is the sample size in the one-sample case, and \[ N_{eff} = \frac{N_1N_2}{N_1+N_2} \] in the two-sample case, the Bayes factors should be the same for the one-sample and two sample case, given the same observed effect size, save for the difference from the degrees of freedom that affects the shape of the noncentral $t$ likelihood. The difference from the degrees of freedom should get smaller for a given $t$ as $N_{eff}\rightarrow\infty$. ```{r} # create some data tstat = 3 NTwoSample = 500 effSampleSize = (NTwoSample^2)/(2*NTwoSample) effSize = tstat/sqrt(effSampleSize) # One sample x0 = rnorm(effSampleSize) x0 = (x0 - mean(x0))/sd(x0) + effSize t.test(x0) # Two sample x1 = rnorm(NTwoSample) x1 = (x1 - mean(x1))/sd(x1) x2 = x1 + effSize t.test(x2,x1) ``` These (log) Bayes factors should be approximately the same. ```{r} log(as.vector(ttestBF(x0))) log(as.vector(ttestBF(x=x1,y=x2))) ``` Paired samples and ANOVA ------ A paired sample $t$ test and a linear mixed effects model should broadly agree. The two are based on different models — the paired t test has the participant effects substracted out, while the linear mixed effects model has a prior on the participant effects — but we'd expect them to lead to the same conclusions. These two Bayes factors should be lead to similar conclusions. ```{r} # using the data previously defined t.test(x~grp,data=dat,paired=TRUE) as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(ttestBF(x=dat$x[dat$grp==1],y=dat$x[dat$grp==2],paired=TRUE)) ``` ------- *This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/inst/doc/priors.R0000644000176200001440000000437313277750604015661 0ustar liggesusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- ## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") set.seed(2) ## ------------------------------------------------------------------------ # Create data x <- rnorm(20) x[1:10] = x[1:10] + .2 grp = factor(rep(1:2,each=10)) dat = data.frame(x=x,grp=grp) t.test(x ~ grp, data=dat) ## ------------------------------------------------------------------------ as.vector(ttestBF(formula = x ~ grp, data=dat)) as.vector(anovaBF(x~grp, data=dat)) as.vector(generalTestBF(x~grp, data=dat)) ## ------------------------------------------------------------------------ # create some data id = rnorm(10) eff = c(-1,1)*1 effCross = outer(id,eff,'+')+rnorm(length(id)*2) dat = data.frame(x=as.vector(effCross),id=factor(1:10), grp=factor(rep(1:2,each=length(id)))) dat$forReg = as.numeric(dat$grp)-1.5 idOnly = lmBF(x~id, data=dat, whichRandom="id") summary(aov(x~grp+Error(id/grp),data=dat)) ## ------------------------------------------------------------------------ as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(lmBF(x ~ forReg+id, data=dat, whichRandom="id")/idOnly) ## ------------------------------------------------------------------------ # create some data tstat = 3 NTwoSample = 500 effSampleSize = (NTwoSample^2)/(2*NTwoSample) effSize = tstat/sqrt(effSampleSize) # One sample x0 = rnorm(effSampleSize) x0 = (x0 - mean(x0))/sd(x0) + effSize t.test(x0) # Two sample x1 = rnorm(NTwoSample) x1 = (x1 - mean(x1))/sd(x1) x2 = x1 + effSize t.test(x2,x1) ## ------------------------------------------------------------------------ log(as.vector(ttestBF(x0))) log(as.vector(ttestBF(x=x1,y=x2))) ## ------------------------------------------------------------------------ # using the data previously defined t.test(x~grp,data=dat,paired=TRUE) as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(ttestBF(x=dat$x[dat$grp==1],y=dat$x[dat$grp==2],paired=TRUE)) BayesFactor/inst/doc/compare_lme4.html0000644000176200001440000413745713277750550017473 0ustar liggesusers Comparison of BayesFactor against other packages

alt text


Comparison of BayesFactor against other packages

This R markdown file runs a series of tests to ensure that the BayesFactor package is giving correct answers, and can gracefully handle probable input.

library(arm)
library(lme4)

ANOVA

First we generate some data.

# Number of participants
N <- 20
sig2 <- 1
sig2ID <- 1

# 3x3x3 design, with participant as random factor
effects <- expand.grid(A = c("A1","A2","A3"),
                       B = c("B1","B2","B3"),
                       C = c("C1","C2","C3"),
                       ID = paste("Sub",1:N,sep="")
)
Xdata <- model.matrix(~ A*B*C + ID, data=effects)
beta <- matrix(c(50,
          -.2,.2,
          0,0,
          .1,-.1,
          rnorm(N-1,0,sqrt(sig2ID)),
          0,0,0,0,
          -.1,.1,.1,-.1,
          0,0,0,0,
          0,0,0,0,0,0,0,0),
               ncol=1)
effects$y = rnorm(Xdata%*%beta,Xdata%*%beta,sqrt(sig2))
# Typical repeated measures ANOVA
summary(fullaov <- aov(y ~ A*B*C + Error(ID/(A*B*C)),data=effects))
## 
## Error: ID
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 19    648    34.1               
## 
## Error: ID:A
##           Df Sum Sq Mean Sq F value Pr(>F)   
## A          2   13.8    6.92    8.12 0.0012 **
## Residuals 38   32.4    0.85                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: ID:B
##           Df Sum Sq Mean Sq F value Pr(>F)
## B          2    2.4    1.19    1.18   0.32
## Residuals 38   38.4    1.01               
## 
## Error: ID:C
##           Df Sum Sq Mean Sq F value Pr(>F)  
## C          2    5.5   2.767    2.95  0.064 .
## Residuals 38   35.6   0.937                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: ID:A:B
##           Df Sum Sq Mean Sq F value Pr(>F)
## A:B        4    1.6   0.402    0.41    0.8
## Residuals 76   73.8   0.971               
## 
## Error: ID:A:C
##           Df Sum Sq Mean Sq F value Pr(>F)  
## A:C        4   12.4   3.103    3.33  0.014 *
## Residuals 76   70.7   0.931                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: ID:B:C
##           Df Sum Sq Mean Sq F value Pr(>F)
## B:C        4    2.3   0.583    0.46   0.77
## Residuals 76   96.6   1.271               
## 
## Error: ID:A:B:C
##            Df Sum Sq Mean Sq F value Pr(>F)
## A:B:C       8   12.6    1.58     1.4    0.2
## Residuals 152  170.7    1.12

We can plot the data with standard errors:

mns <- tapply(effects$y,list(effects$A,effects$B,effects$C),mean)
stderr = sqrt((sum(resid(fullaov[[3]])^2)/fullaov[[3]]$df.resid)/N)

par(mfrow=c(1,3),cex=1.1)
for(i in 1:3){
  matplot(mns[,,i],xaxt='n',typ='b',xlab="A",main=paste("C",i), 
          ylim=range(mns)+c(-1,1)*stderr,ylab="y")
  axis(1,at=1:3,lab=1:3)
  segments(1:3 + mns[,,i]*0,mns[,,i] + stderr,1:3 + mns[,,i]*0,mns[,,i] - stderr,col=rgb(0,0,0,.3))
}

plot of chunk unnamed-chunk-5

Bayes factor

Compute the Bayes factors, while testing the Laplace approximation

t.is = system.time(bfs.is <- anovaBF(y ~ A*B*C + ID, data = effects, 
                                     whichRandom="ID")
)
t.la = system.time(bfs.la <- anovaBF(y ~ A*B*C + ID, data = effects, 
                                     whichRandom="ID",
                                     method = "laplace")
)
t.is
##    user  system elapsed 
##   8.700   0.106   9.084
t.la
##    user  system elapsed 
##   4.440   0.044   4.550
plot(log(extractBF(sort(bfs.is))$bf),log(extractBF(sort(bfs.la))$bf),
     xlab="Default Sampler",ylab="Laplace approximation",
     pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2)
abline(0,1)

plot of chunk unnamed-chunk-7

bfs.is
## Bayes factor analysis
## --------------
## [1] A + ID                                    : 9.02     ±0.93%
## [2] B + ID                                    : 0.059    ±1.76%
## [3] A + B + ID                                : 0.563    ±6.68%
## [4] A + B + A:B + ID                          : 0.00796  ±4.56%
## [5] C + ID                                    : 0.229    ±0.85%
## [6] A + C + ID                                : 2.29     ±5.06%
## [7] B + C + ID                                : 0.0133   ±1.08%
## [8] A + B + C + ID                            : 0.141    ±7.7%
## [9] A + B + A:B + C + ID                      : 0.00196  ±4.48%
## [10] A + C + A:C + ID                         : 2.49     ±13.1%
## [11] A + B + C + A:C + ID                     : 0.138    ±2.12%
## [12] A + B + A:B + C + A:C + ID               : 0.00206  ±2.86%
## [13] B + C + B:C + ID                         : 0.000251 ±1.44%
## [14] A + B + C + B:C + ID                     : 0.00253  ±2.14%
## [15] A + B + A:B + C + B:C + ID               : 3.67e-05 ±2.09%
## [16] A + B + C + A:C + B:C + ID               : 0.00264  ±1.66%
## [17] A + B + A:B + C + A:C + B:C + ID         : 4.11e-05 ±2.89%
## [18] A + B + A:B + C + A:C + B:C + A:B:C + ID : 8.47e-06 ±1.88%
## 
## Against denominator:
##   y ~ ID 
## ---
## Bayes factor type: BFlinearModel, JZS

Comparison to lmer and arm

We can use samples from the posterior distribution to compare BayesFactor with lmer and arm.

chains <- lmBF(y ~ A + B + C + ID, data=effects, whichRandom = "ID", posterior=TRUE, iterations=10000)

lmerObj <- lmer(y ~ A + B + C + (1|ID), data=effects)
# Use arm function sim() to sample from posterior
chainsLmer = sim(lmerObj,n.sims=10000)

Compare estimates of variance

BF.sig2 <- chains[,colnames(chains)=="sig2"]
AG.sig2 <- (chainsLmer@sigma)^2
qqplot(log(BF.sig2),log(AG.sig2),pch=21,bg=rgb(0,0,1,.2),
       col=NULL,asp=TRUE,cex=1,xlab="BayesFactor samples",
       ylab="arm samples",main="Posterior samples of\nerror variance")
abline(0,1)

plot of chunk unnamed-chunk-9

Compare estimates of participant effects:

AG.raneff <- chainsLmer@ranef$ID[,,1]
BF.raneff <-  chains[,grep('ID-',colnames(chains),fixed='TRUE')]
plot(colMeans(BF.raneff),colMeans(AG.raneff),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Random effect posterior means")
abline(0,1)

plot of chunk unnamed-chunk-10

Compare estimates of fixed effects:

AG.fixeff <- chainsLmer@fixef
BF.fixeff <-  chains[,1:10]

# Adjust AG results from reference cell to sum to 0
Z = c(1,  1/3,  1/3,  1/3,  1/3,  1/3,  1/3,
      0, -1/3, -1/3,    0,    0,    0,    0,
      0,  2/3, -1/3,    0,    0,    0,    0,
      0, -1/3,  2/3,    0,    0,    0,    0,
      0,     0,   0, -1/3, -1/3,    0,    0,
      0,     0,   0,  2/3, -1/3,    0,    0,
      0,     0,   0, -1/3,  2/3,    0,    0,
      0,     0,   0,    0,    0, -1/3, -1/3,
      0,     0,   0,    0,    0,  2/3, -1/3,
      0,     0,   0,    0,    0, -1/3,  2/3)
dim(Z) = c(7,10)
Z = t(Z)

AG.fixeff2 = t(Z%*%t(AG.fixeff))

## Our grand mean has heavier tails
qqplot(BF.fixeff[,1],AG.fixeff2[,1],pch=21,bg=rgb(0,0,1,.2),col=NULL,asp=TRUE,cex=1,xlab="BayesFactor estimate",ylab="arm estimate",main="Grand mean posterior samples")
abline(0,1)

plot of chunk unnamed-chunk-11

plot(colMeans(BF.fixeff[,-1]),colMeans(AG.fixeff2[,-1]),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Fixed effect posterior means")
abline(0,1)

plot of chunk unnamed-chunk-11

## Compare posterior standard deviations
BFsd = apply(BF.fixeff[,-1],2,sd)
AGsd = apply(AG.fixeff2[,-1],2,sd)
plot(sort(AGsd/BFsd),pch=21,bg=rgb(0,0,1,.2),col="black",cex=1.2,ylab="Ratio of posterior standard deviations (arm/BF)",xlab="Fixed effect index")

plot of chunk unnamed-chunk-11

## AG estimates are slightly larger, consistent with sig2 estimates
## probably due to prior

Another comparison with lmer

We begin by loading required packages…

library(languageR)
library(xtable)

…and creating the data set to analyze.

data(primingHeidPrevRT)

primingHeidPrevRT$lRTmin1 <- log(primingHeidPrevRT$RTmin1)

###Frequentist 

lr4 <- lmer(RT ~ Condition + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime + ResponseToPrime*RTtoPrime +BaseFrequency ,primingHeidPrevRT)
# Get rid rid of some outlying response times
INDOL <- which(scale(resid(lr4)) < 2.5)
primHeidOL <- primingHeidPrevRT[INDOL,]

The first thing we have to do is center the continuous variables. This is done automatically by lmBF(), as required by Liang et al. (2008). This, of course, changes the definition of the intercept.

# Center continuous variables
primHeidOL$BaseFrequency <- primHeidOL$BaseFrequency - mean(primHeidOL$BaseFrequency)
primHeidOL$lRTmin1 <- primHeidOL$lRTmin1 - mean(primHeidOL$lRTmin1)
primHeidOL$RTtoPrime <- primHeidOL$RTtoPrime - mean(primHeidOL$RTtoPrime)

Now we perform both analyses on the same data, and place the fixed effect estimates for both packages into their own vectors.

# LMER
lr4b <- lmer(  RT ~ Condition + ResponseToPrime +  (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL)
# BayesFactor
B5out <- lmBF( RT ~ Condition + ResponseToPrime +     Word +    Subject  + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency  , primHeidOL , whichRandom = c("Word", "Subject"),  posterior = TRUE, iteration = 50000,columnFilter=c("Word","Subject"))

lmerEff <- fixef(lr4b)
bfEff <- colMeans(B5out[,1:10])

lmer uses a “reference cell” parameterization, rather than imposing sum-to-0 constraints. We can tell what the reference cell is by looking at the parameter names.

print(xtable(cbind("lmer fixed effects"=names(lmerEff))), type='html')
lmer fixed effects
1 (Intercept)
2 Conditionheid
3 ResponseToPrimeincorrect
4 lRTmin1
5 RTtoPrime
6 BaseFrequency
7 ResponseToPrimeincorrect:RTtoPrime

Notice what's missing: for the categorical parameters, we are missing Conditionbaseheid and ResponseToPrimecorrect. For the slope parameters, we are missing ResponseToPrimecorrect:RTtoPrime. The missing effects tell us what the reference cells are. Since the reference cell parameterization is just a linear transformation of the sum-to-0 parameterization, we can create a matrix that allows us to move from one to the other. We call this \(10 \times 7\) matrix Z. It takes the 7 “reference-cell” parameters from lmer and maps them into the 10 linearly constrained parameters from lmBF.

The first row of Z transforms the intercept (reference cell) to the grand mean (sum-to-0). We have to add half of the two fixed effects back into the intercept. The second and third row divide the totl effect of Condition into two equal parts, one for baseheid and one for heid. Rows four and five do the same for ResponseToPrime.

The slopes that do not enter into interactions are fine as they are; however, ResponseToPrimecorrect:RTtoPrime serves as our reference cell for the ResponseToPrime:RTtoPrime interaction. We treat these slopes analogously to the grand mean; we take RTtoPrime and add half the ResponseToPrimeincorrect:RTtoPrime effect to it, to make it a grand mean slope. The last two rows divide up the ResponseToPrimeincorrect:RTtoPrime effect between ResponseToPrimeincorrect:RTtoPrime and ResponseToPrimecorrect:RTtoPrime.

# Adjust lmer results from reference cell to sum to 0
Z = c(1,   1/2, 1/2,    0,    0,    0,    0,
      0,  -1/2,   0,    0,    0,    0,    0,
      0,   1/2,   0,    0,    0,    0,    0,
      0,     0,-1/2,    0,    0,    0,    0,
      0,     0, 1/2,    0,    0,    0,    0,
      0,     0,   0,    1,    0,    0,    0,
      0,     0,   0,    0,    1,    0,  1/2,
      0,     0,   0,    0,    0,    1,    0,
      0,     0,   0,    0,    0,    0, -1/2,
      0,     0,   0,    0,    0,    0,  1/2)
dim(Z) = c(7,10)
Z = t(Z)

# Do reparameterization by pre-multimplying the parameter vector by Z
reparLmer <- Z %*% matrix(lmerEff,ncol=1)

# put results in data.frame for comparison
sideBySide <- data.frame(BayesFactor=bfEff,lmer=reparLmer)

We can look at them side by side for comparison:

print(xtable(sideBySide,digits=4), type='html')
BayesFactor lmer
mu 6.6419 6.6430
Condition-baseheid 0.0170 0.0192
Condition-heid -0.0170 -0.0192
ResponseToPrime-correct -0.0597 -0.0643
ResponseToPrime-incorrect 0.0597 0.0643
lRTmin1-lRTmin1 0.0987 0.1037
RTtoPrime-RTtoPrime 0.1186 0.1281
BaseFrequency-BaseFrequency -0.0089 -0.0092
ResponseToPrime:RTtoPrime-correct.&.RTtoPrime 0.0957 0.1084
ResponseToPrime:RTtoPrime-incorrect.&.RTtoPrime -0.0957 -0.1084

…and plot them:

# Notice Bayesian shrinkage
par(cex=1.5)
plot(sideBySide[-1,],pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2, main="fixed effects\n (excluding grand mean)")
abline(0,1, lty=2)

plot of chunk unnamed-chunk-19

The results are quite close to one another, with a bit of Bayesian shrinkage.


This document was compiled with version 0.9.12-4.2 of BayesFactor (R version 3.5.0 (2018-04-23) on x86_64-apple-darwin15.6.0).

BayesFactor/inst/doc/index.Rmd0000644000176200001440000000070312476040463015757 0ustar liggesusers ![alt text](extra/logo.png) ------ BayesFactor manual files ------ ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) ``` * [Main manual](manual.html) * [Posterior odds and probabilities](odds_probs.html) * [Prior checks](priors.html) * [Comparison to arm/lmer](compare_lme4.html) BayesFactor/inst/doc/priors.html0000644000176200001440000014574013277750604016430 0ustar liggesusers Prior checks

alt text


Prior checks

The BayesFactor has a number of prior settings that should provide for a consistent Bayes factor. In this document, Bayes factors are checked for consistency.

Independent-samples t test and ANOVA

The independent samples \(t\) test and ANOVA functions should provide the same answers with the default prior settings.

# Create data
x <- rnorm(20)
x[1:10] = x[1:10] + .2
grp = factor(rep(1:2,each=10))

dat = data.frame(x=x,grp=grp)

t.test(x ~ grp, data=dat)
## 
##  Welch Two Sample t-test
## 
## data:  x by grp
## t = 0.5, df = 20, p-value = 0.6
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.793  1.255
## sample estimates:
## mean in group 1 mean in group 2 
##           0.411           0.180

If the prior settings are consistent, then all three of these numbers should be the same.

as.vector(ttestBF(formula = x ~ grp, data=dat))
## Alt., r=0.707 
##         0.431
as.vector(anovaBF(x~grp, data=dat))
##   grp 
## 0.431
as.vector(generalTestBF(x~grp, data=dat))
##   grp 
## 0.431

Regression and ANOVA

In a paired design with an additive random factor and and a fixed effect with two levels, the Bayes factors should be the same, regardless of whether we treat the fixed factor as a factor or as a dummy-coded covariate.

# create some data
id = rnorm(10)
eff = c(-1,1)*1
effCross = outer(id,eff,'+')+rnorm(length(id)*2)
dat = data.frame(x=as.vector(effCross),id=factor(1:10), grp=factor(rep(1:2,each=length(id))))
dat$forReg = as.numeric(dat$grp)-1.5
idOnly = lmBF(x~id, data=dat, whichRandom="id")

summary(aov(x~grp+Error(id/grp),data=dat))
## 
## Error: id
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals  9   49.1    5.46               
## 
## Error: id:grp
##           Df Sum Sq Mean Sq F value Pr(>F)   
## grp        1   25.3   25.33    17.1 0.0025 **
## Residuals  9   13.3    1.48                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

If the prior settings are consistent, these two numbers should be almost the same (within MC estimation error).

as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly)
## grp + id 
##     23.1
as.vector(lmBF(x ~ forReg+id, data=dat, whichRandom="id")/idOnly)
## forReg + id 
##        23.2

Independent t test and paired t test

Given the effect size \(\hat{\delta}=t\sqrt{N_{eff}}\), where the effective sample size \(N_{eff}\) is the sample size in the one-sample case, and \[ N_{eff} = \frac{N_1N_2}{N_1+N_2} \] in the two-sample case, the Bayes factors should be the same for the one-sample and two sample case, given the same observed effect size, save for the difference from the degrees of freedom that affects the shape of the noncentral \(t\) likelihood. The difference from the degrees of freedom should get smaller for a given \(t\) as \(N_{eff}\rightarrow\infty\).

# create some data
tstat = 3
NTwoSample = 500
effSampleSize = (NTwoSample^2)/(2*NTwoSample)
effSize = tstat/sqrt(effSampleSize)

# One sample
x0 = rnorm(effSampleSize)
x0 = (x0 - mean(x0))/sd(x0) + effSize

t.test(x0)
## 
##  One Sample t-test
## 
## data:  x0
## t = 3, df = 200, p-value = 0.003
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  0.0652 0.3143
## sample estimates:
## mean of x 
##      0.19
# Two sample
x1 = rnorm(NTwoSample)
x1 = (x1 - mean(x1))/sd(x1)
x2 = x1 + effSize

t.test(x2,x1)
## 
##  Welch Two Sample t-test
## 
## data:  x2 and x1
## t = 3, df = 1000, p-value = 0.003
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.0656 0.3138
## sample estimates:
## mean of x mean of y 
##  1.90e-01  4.98e-18

These (log) Bayes factors should be approximately the same.

log(as.vector(ttestBF(x0)))
## Alt., r=0.707 
##          1.72
log(as.vector(ttestBF(x=x1,y=x2)))
## Alt., r=0.707 
##          1.77

Paired samples and ANOVA

A paired sample \(t\) test and a linear mixed effects model should broadly agree. The two are based on different models — the paired t test has the participant effects substracted out, while the linear mixed effects model has a prior on the participant effects — but we'd expect them to lead to the same conclusions.

These two Bayes factors should be lead to similar conclusions.

# using the data previously defined
t.test(x~grp,data=dat,paired=TRUE)
## 
##  Paired t-test
## 
## data:  x by grp
## t = -4, df = 9, p-value = 0.003
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -3.48 -1.02
## sample estimates:
## mean of the differences 
##                   -2.25
as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly)
## grp + id 
##     23.1
as.vector(ttestBF(x=dat$x[dat$grp==1],y=dat$x[dat$grp==2],paired=TRUE))
## Alt., r=0.707 
##          18.9

This document was compiled with version 0.9.12-4.2 of BayesFactor (R version 3.5.0 (2018-04-23) on x86_64-apple-darwin15.6.0).

BayesFactor/inst/doc/compare_lme4.Rmd0000644000176200001440000002352213274043465017225 0ustar liggesusers ![alt text](extra/logo.png) ------ ```{r echo=FALSE,message=FALSE,results='hide'} library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ``` Comparison of BayesFactor against other packages ======================================================== This R markdown file runs a series of tests to ensure that the BayesFactor package is giving correct answers, and can gracefully handle probable input. ```{r message=FALSE,warning=FALSE} library(arm) library(lme4) ``` ANOVA ---------- First we generate some data. ```{r} # Number of participants N <- 20 sig2 <- 1 sig2ID <- 1 # 3x3x3 design, with participant as random factor effects <- expand.grid(A = c("A1","A2","A3"), B = c("B1","B2","B3"), C = c("C1","C2","C3"), ID = paste("Sub",1:N,sep="") ) Xdata <- model.matrix(~ A*B*C + ID, data=effects) beta <- matrix(c(50, -.2,.2, 0,0, .1,-.1, rnorm(N-1,0,sqrt(sig2ID)), 0,0,0,0, -.1,.1,.1,-.1, 0,0,0,0, 0,0,0,0,0,0,0,0), ncol=1) effects$y = rnorm(Xdata%*%beta,Xdata%*%beta,sqrt(sig2)) ``` ```{r} # Typical repeated measures ANOVA summary(fullaov <- aov(y ~ A*B*C + Error(ID/(A*B*C)),data=effects)) ``` We can plot the data with standard errors: ```{r fig.width=10,fig.height=4} mns <- tapply(effects$y,list(effects$A,effects$B,effects$C),mean) stderr = sqrt((sum(resid(fullaov[[3]])^2)/fullaov[[3]]$df.resid)/N) par(mfrow=c(1,3),cex=1.1) for(i in 1:3){ matplot(mns[,,i],xaxt='n',typ='b',xlab="A",main=paste("C",i), ylim=range(mns)+c(-1,1)*stderr,ylab="y") axis(1,at=1:3,lab=1:3) segments(1:3 + mns[,,i]*0,mns[,,i] + stderr,1:3 + mns[,,i]*0,mns[,,i] - stderr,col=rgb(0,0,0,.3)) } ``` ### Bayes factor Compute the Bayes factors, while testing the Laplace approximation ```{r} t.is = system.time(bfs.is <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID") ) t.la = system.time(bfs.la <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID", method = "laplace") ) ``` ```{r fig.width=6,fig.height=6} t.is t.la plot(log(extractBF(sort(bfs.is))$bf),log(extractBF(sort(bfs.la))$bf), xlab="Default Sampler",ylab="Laplace approximation", pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2) abline(0,1) bfs.is ``` Comparison to lmer and arm ------ We can use samples from the posterior distribution to compare `BayesFactor` with `lmer` and `arm`. ```{r message=FALSE} chains <- lmBF(y ~ A + B + C + ID, data=effects, whichRandom = "ID", posterior=TRUE, iterations=10000) lmerObj <- lmer(y ~ A + B + C + (1|ID), data=effects) # Use arm function sim() to sample from posterior chainsLmer = sim(lmerObj,n.sims=10000) ``` Compare estimates of variance ```{r} BF.sig2 <- chains[,colnames(chains)=="sig2"] AG.sig2 <- (chainsLmer@sigma)^2 qqplot(log(BF.sig2),log(AG.sig2),pch=21,bg=rgb(0,0,1,.2), col=NULL,asp=TRUE,cex=1,xlab="BayesFactor samples", ylab="arm samples",main="Posterior samples of\nerror variance") abline(0,1) ``` Compare estimates of participant effects: ```{r} AG.raneff <- chainsLmer@ranef$ID[,,1] BF.raneff <- chains[,grep('ID-',colnames(chains),fixed='TRUE')] plot(colMeans(BF.raneff),colMeans(AG.raneff),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Random effect posterior means") abline(0,1) ``` Compare estimates of fixed effects: ```{r tidy=FALSE} AG.fixeff <- chainsLmer@fixef BF.fixeff <- chains[,1:10] # Adjust AG results from reference cell to sum to 0 Z = c(1, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3) dim(Z) = c(7,10) Z = t(Z) AG.fixeff2 = t(Z%*%t(AG.fixeff)) ## Our grand mean has heavier tails qqplot(BF.fixeff[,1],AG.fixeff2[,1],pch=21,bg=rgb(0,0,1,.2),col=NULL,asp=TRUE,cex=1,xlab="BayesFactor estimate",ylab="arm estimate",main="Grand mean posterior samples") abline(0,1) plot(colMeans(BF.fixeff[,-1]),colMeans(AG.fixeff2[,-1]),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Fixed effect posterior means") abline(0,1) ## Compare posterior standard deviations BFsd = apply(BF.fixeff[,-1],2,sd) AGsd = apply(AG.fixeff2[,-1],2,sd) plot(sort(AGsd/BFsd),pch=21,bg=rgb(0,0,1,.2),col="black",cex=1.2,ylab="Ratio of posterior standard deviations (arm/BF)",xlab="Fixed effect index") ## AG estimates are slightly larger, consistent with sig2 estimates ## probably due to prior ``` Another comparison with lmer ----------- We begin by loading required packages... ```{r message=FALSE,warning=FALSE} library(languageR) library(xtable) ``` ...and creating the data set to analyze. ```{r} data(primingHeidPrevRT) primingHeidPrevRT$lRTmin1 <- log(primingHeidPrevRT$RTmin1) ###Frequentist lr4 <- lmer(RT ~ Condition + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime + ResponseToPrime*RTtoPrime +BaseFrequency ,primingHeidPrevRT) # Get rid rid of some outlying response times INDOL <- which(scale(resid(lr4)) < 2.5) primHeidOL <- primingHeidPrevRT[INDOL,] ``` The first thing we have to do is center the continuous variables. This is done automatically by lmBF(), as required by Liang et al. (2008). This, of course, changes the definition of the intercept. ```{r} # Center continuous variables primHeidOL$BaseFrequency <- primHeidOL$BaseFrequency - mean(primHeidOL$BaseFrequency) primHeidOL$lRTmin1 <- primHeidOL$lRTmin1 - mean(primHeidOL$lRTmin1) primHeidOL$RTtoPrime <- primHeidOL$RTtoPrime - mean(primHeidOL$RTtoPrime) ``` Now we perform both analyses on the same data, and place the fixed effect estimates for both packages into their own vectors. ```{r} # LMER lr4b <- lmer( RT ~ Condition + ResponseToPrime + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL) # BayesFactor B5out <- lmBF( RT ~ Condition + ResponseToPrime + Word + Subject + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL , whichRandom = c("Word", "Subject"), posterior = TRUE, iteration = 50000,columnFilter=c("Word","Subject")) lmerEff <- fixef(lr4b) bfEff <- colMeans(B5out[,1:10]) ``` `lmer` uses a "reference cell" parameterization, rather than imposing sum-to-0 constraints. We can tell what the reference cell is by looking at the parameter names. ```{r results='asis'} print(xtable(cbind("lmer fixed effects"=names(lmerEff))), type='html') ``` Notice what's missing: for the categorical parameters, we are missing `Conditionbaseheid` and `ResponseToPrimecorrect`. For the slope parameters, we are missing `ResponseToPrimecorrect:RTtoPrime`. The missing effects tell us what the reference cells are. Since the reference cell parameterization is just a linear transformation of the sum-to-0 parameterization, we can create a matrix that allows us to move from one to the other. We call this $10 \times 7$ matrix `Z`. It takes the 7 "reference-cell" parameters from `lmer` and maps them into the 10 linearly constrained parameters from `lmBF`. The first row of `Z` transforms the intercept (reference cell) to the grand mean (sum-to-0). We have to add half of the two fixed effects back into the intercept. The second and third row divide the totl effect of `Condition` into two equal parts, one for `baseheid` and one for `heid`. Rows four and five do the same for `ResponseToPrime`. The slopes that do not enter into interactions are fine as they are; however, `ResponseToPrimecorrect:RTtoPrime` serves as our reference cell for the `ResponseToPrime:RTtoPrime` interaction. We treat these slopes analogously to the grand mean; we take `RTtoPrime` and add half the `ResponseToPrimeincorrect:RTtoPrime` effect to it, to make it a grand mean slope. The last two rows divide up the `ResponseToPrimeincorrect:RTtoPrime` effect between `ResponseToPrimeincorrect:RTtoPrime` and `ResponseToPrimecorrect:RTtoPrime`. ```{r tidy=FALSE} # Adjust lmer results from reference cell to sum to 0 Z = c(1, 1/2, 1/2, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0,-1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1/2, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2) dim(Z) = c(7,10) Z = t(Z) # Do reparameterization by pre-multimplying the parameter vector by Z reparLmer <- Z %*% matrix(lmerEff,ncol=1) # put results in data.frame for comparison sideBySide <- data.frame(BayesFactor=bfEff,lmer=reparLmer) ``` We can look at them side by side for comparison: ```{r results='asis'} print(xtable(sideBySide,digits=4), type='html') ``` ...and plot them: ```{r} # Notice Bayesian shrinkage par(cex=1.5) plot(sideBySide[-1,],pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2, main="fixed effects\n (excluding grand mean)") abline(0,1, lty=2) ``` The results are quite close to one another, with a bit of Bayesian shrinkage. ------- *This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/inst/doc/manual.Rmd0000644000176200001440000017651313274102703016133 0ustar liggesusers Fork me on GitHub ![BayesFactor logo](extra/logo.png) ------ Using the 'BayesFactor' package, version 0.9.2+ =============================== Richard D. Morey -----------------
BayesFactor on facebook Find us on facebook
BayesFactor blog Follow the BayesFactor blog
Share via
share on facebook tweet BayesFactor submit to reddit submit to google plus share by email ---- Stable version: [CRAN page](https://cran.r-project.org/package=BayesFactor) - [Package NEWS (including version changes)](https://CRAN.R-project.org/package=BayesFactor/NEWS) Development version: [Development page](https://github.com/richarddmorey/BayesFactor) - [Development package NEWS](https://github.com/richarddmorey/BayesFactor/blob/master/pkg/BayesFactor/NEWS)
fork on github on github
### Table of Contents * Introductory material * [Getting help](#help) * [Introduction](#intro) * [Loading the package](#loading) * [Useful functions](#functions) * Performing analyses * [One-sample (and two-sample paired), and manipulating Bayes factor objects](#onesample) * [Two independent samples](#twosample) * [Meta-analytic t tests (0.9.8+)](#metat) * [ANOVA, fixed-effects](#fixed) * [ANOVA, mixed models (including repeated measures)](#mixed) * [Regression](#regression) * [General linear models: mixing continuous and categorical covariates](#glm) * [Linear correlations](#lincor) * [Tests of single proportions (0.9.9+)](#proptest) * [Contingency Tables (0.9.9+)](#ctables) * Additional tips and tricks (0.9.4+) * [Testing restrictions on linear models: generalTestBF()](#generalTestBF) * [Saving time: Pre-culling Bayes factor objects](#preculltricks) * [Saving memory: Thinning and filtering MCMC chains](#mcmctricks) * [Fine-tuning of prior scales (0.9.12-2+)](#priorscales) * [References](#references) ### Getting help * [Help forums](https://forum.cogsci.nl/index.php?p=/categories/jasp-bayesfactor) * [Bug reports](https://github.com/richarddmorey/BayesFactor/issues?state=open) * [Developer email (richarddmorey at gmail.com)](mailto:richarddmorey@gmail.com) ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ``` ### Introduction The `BayesFactor` package enables the computation of Bayes factors in standard designs, such as one- and two- sample designs, ANOVA designs, and regression. The Bayes factors are based on work spread across several papers. This document is designed to show users how to compute Bayes factors using the package by example. It is not designed to present the models used in the comparisons in detail; for that, see the `BayesFactor` help and especially the references listed in this manual. Complete references are given at the [end of this document](#references). If you need help or think you've found a bug, please use the links at the top of this document to contact the developers. When asking a question or reporting a bug, please send example code and data, the exact errors you're seeing (a cut-and-paste from the R console will work) and instructions for reproducing it. Also, report the output of `BFInfo()` and `sessionInfo()`, and let us know what operating system you're running. ### Loading the package The `BayesFactor` package must be installed and loaded before it can be used. Installing the package can be done in several ways and will not be covered here. Once it is installed, use the `library` function to load it: ```{r message=FALSE} library(BayesFactor) ``` ```{r echo=FALSE,message=FALSE,results='hide'} options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ``` This command will make the `BayesFactor` package ready to use. ### Some useful functions The table below lists some of the functions in the `BayesFactor` package that will be demonstrated in this manual. For more complete help on the use of these functions, see the corresponding `help()` page in R. Function | Description -------------------------|------------- `ttestBF` | Bayes factors for one- and two- sample designs `anovaBF` | Bayes factors comparing many ANOVA models `regressionBF` | Bayes factors comparing many linear regression models `generalTestBF` | Bayes factors for all restrictions on a full model (0.9.4+) `lmBF` | Bayes factors for specific linear models (ANOVA or regression) `correlationBF` | Bayes factors for linear correlations `proportionBF` | Bayes factors for tests of single proportions `contingencyTableBF` | Bayes factors for contingency tables `posterior` | Sample from the posterior distribution of the numerator of a Bayes factor object `recompute` | Recompute a Bayes factor or MCMC chain, possibly increasing the precision of the estimate `compare` | Compare two models; typically used to compare two models in `BayesFactor` MCMC objects #### Functions to manipulate Bayes factor objects The t test section below has examples showing how to manipulate Bayes factor objects, but all these functions will work with Bayes factors generated from any function in the `BayesFactor` package. Function | Description -------------------------|------------ `/` | Divide two Bayes factor objects to create new model comparisons, or invert with `1/` `t` | "Flip" (transpose) a Bayes factor object `c` | Concatenate two Bayes factor objects together, assuming they have the same denominator `[` | Use indexing to select a subset of the Bayes factors `plot` | plot a Bayes factor object `sort` | Sort a Bayes factor object `is.na` | Determine whether a Bayes factor object contains missing values `head`,`tail` | Return the `n` highest or lowest Bayes factor in an object `max`, `min` | Return the highest or lowest Bayes factor in an object `which.max`,`which.min` | Return the index of the highest or lowest Bayes factor `as.vector` | Convert to a simple vector (denominator will be lost!) `as.data.frame` | Convert to data.frame (denominator will be lost!) ### One- and two-sample designs (t tests) The `ttestBF` function is used to obtain Bayes factors corresponding to tests of a single sample's mean, or tests that two independent samples have the same mean. #### One-sample tests (and paired) We use the `sleep` data set in R to demonstrate a one-sample t test. This is a paired design; for details about the data set, see `?sleep`. One way of analyzing these data is to compute difference scores by subtracting a participant's score in one condition from their score in the other: ```{r onesampdata} data(sleep) ## Compute difference scores diffScores = sleep$extra[1:10] - sleep$extra[11:20] ## Traditional two-tailed t test t.test(diffScores) ``` We can do a Bayesian version of this analysis using the `ttestBF` function, which performs the "JZS" t test described by [Rouder, Speckman, Sun, Morey, and Iverson (2009)](#Rouderttest). In this model, the true standardized difference $latex \delta=(\mu-\mu_0)/\sigma_\epsilon$ is assumed to be 0 under the null hypothesis, and \(\text{Cauchy}(\text{scale}=r)\) under the alternative. The default \(r\) scale in `BayesFactor` for t tests is \(\sqrt{2}/2\). See `?ttestBF` for more details. ```{r onesampt} bf = ttestBF(x = diffScores) ## Equivalently: ## bf = ttestBF(x = sleep$extra[1:10],y=sleep$extra[11:20], paired=TRUE) bf ``` The `bf` object contains the Bayes factor, and shows the numerator and denominator models for the Bayes factor comparison. In our case, the Bayes factor for the comparison of the alternative versus the null is `r as.vector(bf)`. After the Bayes factor is a proportional error estimate on the Bayes factor. There are a number of operations we can perform on our Bayes factor, such as taking the reciprocal: ```{r recip} 1 / bf ``` or sampling from the posterior of the numerator model: ```{r tsamp} chains = posterior(bf, iterations = 1000) summary(chains) ``` The `posterior` function returns a object of type `BFmcmc`, which inherits the methods of the `mcmc` class from the [`coda` package](https://cran.r-project.org/package=coda). We can thus use `summary`, `plot`, and other useful methods on the result of `posterior`. If we were unhappy with the number of iterations we sampled for `chains`, we can `recompute` with more iterations, and then `plot` the results: ```{r tsamplplot,fig.width=10} chains2 = recompute(chains, iterations = 10000) plot(chains2[,1:2]) ``` Directional hypotheses can also be tested with `ttestBF` ([Morey & Rouder, 2011](#Moreyarea)). The argument `nullInterval` can be passed as a vector of length 2, and defines an interval to compare to the point null. If null interval is defined, _two_ Bayes factors are returned: the Bayes factor of the null interval against the alternative, and the Bayes factor of the _complement_ of the interval to the point null. Suppose, for instance, we wanted to test the one-sided hypotheses that \(\delta<0\) versus the point null. We set `nullInterval` to `c(-Inf,0)`: ```{r onesamptinterval} bfInterval = ttestBF(x = diffScores, nullInterval=c(-Inf,0)) bfInterval ``` We may not be interested in tests against the point null. If we are interested in the Bayes factor test that \(\delta<0\) versus \(\delta>0\) we can compute it using the result above. Since the object contains two Bayes factors, both with the same denominator, and $$ \left.\frac{A}{C}\middle/\frac{B}{C}\right. = \frac{A}{B}, $$ we can divide the two Bayes factors in `bfInferval` to obtain the desired test: ```{r onesampledivide} bfInterval[1] / bfInterval[2] ``` The Bayes factor is about 340. When we have multiple Bayes factors that all have the same denominator, we can concatenate them into one object using the `c` function. Since `bf` and `bfInterval` both share the point null denominator, we can do this: ```{r onesampcat} allbf = c(bf, bfInterval) allbf ``` The object `allbf` now contains three Bayes factors, all of which share the same denominator. If you try to concatenate Bayes factors that do _not_ share the same denominator, `BayesFactor` will return an error. When you have a Bayes factor object with several numerators, there are several interesting ways to manipulate them. For instance, we can plot the Bayes factor object to obtain a graphical representation of the Bayes factors: ```{r plotonesamp,fig.width=10,fig.height=5} plot(allbf) ``` We can also divide a Bayes factor object by itself — or by a subset of itself — to obtain pairwise comparisons: ```{r onesamplist} bfmat = allbf / allbf bfmat ``` The resulting object is of type `BFBayesFactorList`, and is a list of Bayes factor comparisons all of the same numerators compared to different denominators. The resulting matrix can be subsetted to return individual Bayes factor objects, or new `BFBayesFactorList`s: ```{r onesamplist2} bfmat[,2] bfmat[1,] ``` and they can also be transposed: ```{r onesamplist3} bfmat[,1:2] t(bfmat[,1:2]) ``` If these values are desired in matrix form, the `as.matrix` function can be used to obtain a matrix. #### Two-sample test (independent groups) The `ttestBF` function can also be used to compute Bayes factors in the two sample case as well. We use the `chickwts` data set to demonstrate the two-sample t test. The `chickwts` data set has six groups, but we reduce it to two for the demonstration. ```{r twosampledata} data(chickwts) ## Restrict to two groups chickwts = chickwts[chickwts$feed %in% c("horsebean","linseed"),] ## Drop unused factor levels chickwts$feed = factor(chickwts$feed) ## Plot data plot(weight ~ feed, data = chickwts, main = "Chick weights") ``` Chick weight appears to be affected by the feed type. ```{r} ## traditional t test t.test(weight ~ feed, data = chickwts, var.eq=TRUE) ``` We can also compute the corresponding Bayes factor. There are two ways of specifying a two-sample test: the formula interface and through the `x` and `y` arguments. We show the formula interface here: ```{r twosamplet} ## Compute Bayes factor bf = ttestBF(formula = weight ~ feed, data = chickwts) bf ``` As before, we can sample from the posterior distribution for the numerator model: ```{r twosampletsamp,fig.width=10} chains = posterior(bf, iterations = 10000) plot(chains[,2]) ``` Note that the samples assume an (equivalent) ANOVA model; see `?ttestBF` and for notes on the differences in interpretation of the \(r\) scale parameter between the two models. ### Meta-analytic t tests (0.9.8+) Rouder and Morey (2011; [link](#RouderMetat)) discuss a meta-analytic extension of the $t$ test, whereby multiple $t$ statistics, along with their corresponding sample sizes, are combined in a single meta-analytic analysis. The $t$ statistics are assumed to arise from a a common effect size $\delta$. The prior for the effect size $\delta$ is the same as that for the $t$ tests described above. The `meta.ttestBF` function is used to perform meta-analytic $t$ tests. It requires as input a vector of $t$ statistics, and one or two vectors of sample sizes (arguments `n1` and `n2`). For a set of one-sample $t$ statistics, `n1` should be provided; for two-sample analyses, both `n1` and `n2` should be provided. As an example, we will replicate the analysis of Rouder & Morey (2011), using $t$ statistics from Bem (2010; see Rouder & Morey for reference). We begin by defining the one-sample $t$ statistics and sample sizes: ```{r bemdata} ## Bem's t statistics from four selected experiments t = c(-.15, 2.39, 2.42, 2.43) N = c(100, 150, 97, 99) ``` Rouder and Morey opted for a one-sided analysis, and used an $r$ scale parameter of 1 (instead of the current default in `BayesFactor` of $\sqrt{2}/2$). ```{r bemanalysis1} bf = meta.ttestBF(t=t, n1=N, nullInterval=c(0,Inf), rscale=1) bf ``` Notice that as above, the analysis yields a Bayes factor for our selected interval against the null, as well as the Bayes factor for the complement of the interval against the null. We can also sample from the posterior distribution of the standardized effect size $\delta$, as above, using the `posterior` function: ```{r bemposterior,fig.width=10} ## Do analysis again, without nullInterval restriction bf = meta.ttestBF(t=t, n1=N, rscale=1) ## Obtain posterior samples chains = posterior(bf, iterations = 10000) plot(chains) ``` Notice that the posterior samples will respect the `nullInterval` argument if given; in order to get unrestricted samples, perform an analysis with no interval restriction and pass it to the `posterior` function. See `?meta.ttestBF` for more information. ### ANOVA The `BayesFactor` package has two main functions that allow the comparison of models with factors as predictors (ANOVA): `anovaBF`, which computes several model estimates at once, and `lmBF`, which computes one comparison at a time. We begin by demonstrating a 3x2 fixed-effect ANOVA using the `ToothGrowth` data set. For details about the data set, see `?ToothGrowth`. #### Fixed-effects ANOVA The `ToothGrowth` data set contains three columns: `len`, the dependent variable, each of which is the length of a guinea pig's tooth after treatment with Vitamin C; `supp`, which is the supplement type (orange juice or ascorbic acid); and `dose`, which is the amount of Vitamin C administered. ```{r fixeddata,fig.width=10,fig.height=5} data(ToothGrowth) ## Example plot from ?ToothGrowth coplot(len ~ dose | supp, data = ToothGrowth, panel = panel.smooth, xlab = "ToothGrowth data: length vs dose, given type of supplement") ## Treat dose as a factor ToothGrowth$dose = factor(ToothGrowth$dose) levels(ToothGrowth$dose) = c("Low", "Medium", "High") summary(aov(len ~ supp*dose, data=ToothGrowth)) ``` There appears to be a large effect of the dosage, a small effect of the supplement type, and perhaps a hint of an interaction. The `anovaBF` function will compute the Bayes factors of all models against the intercept-only model; by default, it will choose the subset of all models in which which an interaction can only be included if all constituent effects or interactions are included (argument `whichModels` is set to `withmain`, indicating that interactions can only enter in with their main effects). However, this setting can be changed, as we will demonstrate. First, we show the default behavior. ```{r } bf = anovaBF(len ~ supp*dose, data=ToothGrowth) bf ``` The function will build the requested models from the terms included in the right-hand side of the formula; we could have specified the sum of the two terms, and we would have gotten the same models. The Bayes factor analysis is consistent with the classical ANOVA analysis; the favored model is the full model, with both main effects and the two-way interaction. Suppose we were interested in comparing the two main-effects model and the full model to the `dose`-only model. We could use indexing and division, along with the `plot` function, to see a graphical representation of these comparisons: ```{r fixedbf,fig.width=10,fig.height=5} plot(bf[3:4] / bf[2]) ``` The model with the main effect of `supp` and the `supp:dose` interaction is preferred quite strongly over the `dose`-only model. There are a number of other options for how to select subsets of models to test. The `whichModels` argument to `anovaBF` controls which subsets are tested. As described previously, the default is `withmain`, where interactions are only allowed if all constituent sub-effects are included. The other three options currently available are `all`, which tests all models; `top`, which includes the full model and all models that can be formed by removing one interaction or main effect; and `bottom`, which adds single effects one at a time to the null model. The argument `whichModels='all'` should be used with caution: a three-way ANOVA model will contain \(2^{2^3-1}-1 = 127\) model comparisons; a four-way ANOVA, \(2^{2^4-1}-1 = 32767\) models, and a five-way ANOVA just over 2.1 billion models. Depending on the speed of your computer, a four-way ANOVA may take several hours to a day, but a five-way ANOVA is probably not feasible. One alternative is `whichModels='top'`, which reduces the number of comparisons to \(2^k-1\), where \(k\) is the number of factors, which is manageable. In orthogonal designs, one can construct tests of each main effect or interaction by comparing the full model to the model with all effects except the one of interest: ```{r } bf = anovaBF(len ~ supp*dose, data=ToothGrowth, whichModels="top") bf ``` Note that all of the Bayes factors are less than 1, indicating that removing any effect from the full model is deleterious. Another way we can reduce the number of models tested is simply to test only specific models of interest. In the example above, for instance, we might want to compare the model with the interaction to the model with only the main effects, if our effect of interest was the interaction. We can do this with the `lmBF` function. ```{r} bfMainEffects = lmBF(len ~ supp + dose, data = ToothGrowth) bfInteraction = lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth) ## Compare the two models bf = bfInteraction / bfMainEffects bf ``` The model with the interaction effect is preferred by a factor of about 3. Suppose that we were unhappy with the ~`r round(extractBF(bf)$error*100,1)`% proportional error on the Bayes factor `bf`. `anovaBF` and `lmBF` use Monte Carlo integration to estimate the Bayes factors. The default number of Monte Carlo samples is 10,000 but this can be increased. We could use the `recompute` to reduce the error. The `recompute` function performs the sampling required to build the Bayes factor object again: ```{r} newbf = recompute(bf, iterations = 500000) newbf ``` The proportional error is now below 1%. As before, we can use MCMC methods to estimate parameters through the `posterior` function: ```{r} ## Sample from the posterior of the full model chains = posterior(bfInteraction, iterations = 10000) ## 1:13 are the only "interesting" parameters summary(chains[,1:13]) ``` And we can plot the posteriors of some selected effects: ```{r} plot(chains[,4:6]) ``` #### Mixed models (including repeated measures) In order to demonstrate the analysis of mixed models using `BayesFactor`, we will load the `puzzles` data set, which is part of the `BayesFactor` package. See `?puzzles` for details. The data set consists of four columns: `RT` the dependent variable, which is the number of seconds that it took to complete a puzzle; `ID` which is a participant identifier; and `shape` and `color`, which are two factors that describe the type of puzzle solved. `shape` and `color` each have two levels, and each of 12 participants completed puzzles within combination of `shape` and `color`. The design is thus 2x2 factorial within-subjects. We first load the data, then perform a traditional within-subjects ANOVA. ```{r } data(puzzles) ``` ```{r puzzlesplot,fig.width=7,fig.height=5,echo=FALSE} ## plot the data aovObj = aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles) matplot(t(matrix(puzzles$RT,12,4)),ty='b',pch=19,lwd=1,lty=1,col=rgb(0,0,0,.2), ylab="Completion time", xlab="Condition",xaxt='n') axis(1,at=1:4,lab=c("round&mono","square&mono","round&color","square&color")) mns = tapply(puzzles$RT,list(puzzles$color,puzzles$shape),mean)[c(2,4,1,3)] points(1:4,mns,pch=22,col="red",bg=rgb(1,0,0,.6),cex=2) # within-subject standard error, uses MSE from ANOVA stderr = sqrt(sum(aovObj[[5]]$residuals^2)/11)/sqrt(12) segments(1:4,mns + stderr,1:4,mns - stderr,col="red") ``` (Code for plot omitted) Individual circles joined by lines show participants; red squares/lines show the means and within-subject standard errors. From the plot, there appear to be main effects of `color` and shape, but no interaction. ```{r} summary(aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles)) ``` The classical ANOVA appears to corroborate the impression from the plot. In order to compute the Bayes factor, we must tell `anovaBF` that `ID` is an additive effect on top of the other effects (as is typically assumed) and is a random factor. The `anovaBF` call below shows how this is done: ```{r tidy=FALSE} bf = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID") ``` We alert `anovaBF` to the random factor using the `whichRandom` argument. `whichRandom` should contain a character vector with the names of all random factors in it. All other factors are assumed to be fixed. The `anovaBF` will find all the fixed effects in the formula, and compute the Bayes factor for the subset of combinations determined by the `whichModels` argument (see the previous section). Note that `anovaBF` does not test random factors; they are assumed to be nuisance factors. The null model in a test with random factors is not the intercept-only model; it is the model containing the random effects. The Bayes factor object `bf` thus now contains Bayes factors comparing various combinations of the fixed effects and an additive effect of `ID` against a denominator containing only `ID`: ```{r} bf ``` The main effects model is preferred against all models. We can plot the Bayes factor object to obtain a graphical representation of the model comparisons: ```{r testplot,fig.width=10,fig.height=5} plot(bf) ``` Because the `anovaBF` function does not test random factors, we must use `lmBF` to build such tests. Doing so is straightforward. Suppose that we wished to test the random effect `ID` in the `puzzles` example. We might compare the full model `shape + color + shape:color + ID` to the same model without `ID`: ```{r} bfWithoutID = lmBF(RT ~ shape*color, data = puzzles) bfWithoutID ``` But notice that the denominator model is the intercept-only model; the denominator in the previous analysis was the `ID` only model. We need to compare the model with no `ID` effect to the model with only `ID`: ```{r} bfOnlyID = lmBF(RT ~ ID, whichRandom="ID",data = puzzles) bf2 = bfWithoutID / bfOnlyID bf2 ``` Since our `bf` object and `bf2` object now have the same denominator, we can concatenate them into one Bayes factor object: ```{r} bfall = c(bf,bf2) ``` and we can compare them by dividing: ```{r} bf[4] / bf2 ``` The model with `ID` is preferred by a factor of over 1 million, which is not surprising. Any model that is a combination of fixed and random factors, including interations between fixed and random factors, can be constructed and tested with `lmBF`. `anovaBF` is designed to be a convenience function as is therefore somewhat limited in flexibility with respect to the models types it can test; however, because random effects are often nuisance effects, we believe `anovaBF` will be sufficient for most researchers' use. ### Linear regression Model comparison in multiple linear regression using `BayesFactor` is done via the approach of [Liang, Paulo, Molina, Clyde, and Berger (2008)](#Liangetal). Further discussion can be found in [Rouder & Morey (in press)](#Rouderregression). To demonstrate Bayes factor model comparison in a linear regression context, we use the `attitude` data set in R. See `?attitude`. The `attitude` consists of the dependent variable `rating`, along with 6 predictors. We can use `BayesFactor` to compute the Bayes factors for many models simultaneously, or single Bayes factors against the model containing no predictors. ```{r regressData} data(attitude) ## Traditional multiple regression analysis lmObj = lm(rating ~ ., data = attitude) summary(lmObj) ``` The period (`.`) is shorthand for all remaining columns, besides `rating`. The predictors `complaints` and `learning` appear most stongly related to the dependent variable, especially `complaints`. In order to compute the Bayes factors for many model comparisons at onces, we use the `regressionBF` function. The most obvious set of all model comparisons is all possible additive models, which is returned by default: ```{r regressAll} bf = regressionBF(rating ~ ., data = attitude) length(bf) ``` The object `bf` now contains \(2^p-1\), or `r length(bf)`, model comparisons. Large numbers of comparisons can get unweildy, so we can use the functions built into R to manipulate the Bayes factor object. ```{r regressSelect} ## Choose a specific model bf["privileges + learning + raises + critical + advance"] ## Best 6 models head(bf, n=6) ## Worst 4 models tail(bf, n=4) ``` ```{r regressSelectwhichmax,eval=FALSE} ## which model index is the best? which.max(bf) ``` ```{r regressSelectwhichmaxFake,echo=FALSE} ## which model index is the best? BayesFactor::which.max(bf) ``` ```{r regressSelect2} ## Compare the 5 best models to the best bf2 = head(bf) / max(bf) bf2 plot(bf2) ``` The model preferred by Bayes factor is the `complaints`-only model, followed by the `complaints + learning` model, as might have been expected by the classical analysis. We might also be interested in comparing the most complex model to all models that can be formed by removing a single covariate, or, similarly, comparing the intercept-only model to all models that can be formed by added a covariate. These comparisons can be done by setting the `whichModels` argument to `'top'` and `'bottom'`, respectively. For example, for testing against the most complex model: ```{r regresstop, fig.width=10, fig.height=5} bf = regressionBF(rating ~ ., data = attitude, whichModels = "top") ## The seventh model is the most complex bf plot(bf) ``` With all other covariates in the model, the model containing `complaints` is preferred to the model not containing `complaints` by a factor of almost 80. The model containing `learning`, is only barely favored to the one without (a factor of about 1.3). A similar "bottom-up" test can be done, by setting `whichModels` to `'bottom'`. ```{r regressbottom, fig.width=10, fig.height=5} bf = regressionBF(rating ~ ., data = attitude, whichModels = "bottom") plot(bf) ``` The mismatch between the tests of all models, the "top-down" test, and the "bottom-up" test shows that the covariates share variance with one another. As always, whether these tests are interpretable or useful will depend on the data at hand. In cases where it is desired to only compare a small number of models, the `lmBF` function can be used. Consider the case that we wish to compare the model containing only `complaints` to the model containing `complaints` and `learning`: ```{r lmregress1} complaintsOnlyBf = lmBF(rating ~ complaints, data = attitude) complaintsLearningBf = lmBF(rating ~ complaints + learning, data = attitude) ## Compare the two models complaintsOnlyBf / complaintsLearningBf ``` The `complaints`-only model is slightly preferred. As with the other Bayes factors, it is possible to sample from the posterior distribution of a particular model under consideration. If we wanted to sample from the posterior distribution of the `complaints + learning` model, we could use the `posterior` function: ```{r lmposterior} chains = posterior(complaintsLearningBf, iterations = 10000) summary(chains) ``` Compare these to the corresponding results from the classical regression analysis: ```{r lmregressclassical} summary(lm(rating ~ complaints + learning, data = attitude)) ``` The results are quite similar, apart from the intercept. This is due to the Bayesian model centering the covariates before analysis, so the `mu` parameter is the mean of $y$ rather than the expected value of the response variable when all uncentered covariates are equal to 0. General linear models: mixing continuous and categorical covariates -------- The `anovaBF` and `regressionBF` functions are convenience functions designed to test several hypotheses of a particular type at once. Neither function allows the mixing of continuous and categorical covariates. If it is desired to test a model including both kinds of covariates, `lmBF` function must be used. We will continue the `ToothGrowth` example, this time without converting `dose` to a categorical variable. Instead, we will model the logarithm of the dose. ```{r echo=FALSE,results='hide'} rm(ToothGrowth) ``` ```{r GLMdata} data(ToothGrowth) # model log2 of dose instead of dose directly ToothGrowth$dose = log2(ToothGrowth$dose) # Classical analysis for comparison lmToothGrowth <- lm(len ~ supp + dose + supp:dose, data=ToothGrowth) summary(lmToothGrowth) ``` The classical analysis, presented for comparison, reveals extremely low p values for the effects of the supplement type and of the dose, but the interaction p value is more moderate, at about 0.03. We can use the `lmBF` function to compute the Bayes factors for all models of interest against the null model, which in this case is the intercept-only model. We then concatenate them into a single Bayes factor object for convenience. ```{r GLMs} full <- lmBF(len ~ supp + dose + supp:dose, data=ToothGrowth) noInteraction <- lmBF(len ~ supp + dose, data=ToothGrowth) onlyDose <- lmBF(len ~ dose, data=ToothGrowth) onlySupp <- lmBF(len ~ supp, data=ToothGrowth) allBFs <- c(full, noInteraction, onlyDose, onlySupp) allBFs ``` The highest two Bayes factors belong to the full model and the model with no interaction. We can directly compute the Bayes factor for the simpler model with no interaction against the full model: ```{r GLMs2} full / noInteraction ``` The evidence here is clearly equivocal. We can also use the `posterior` function to compute parameter estimates. ```{r GLMposterior1} chainsFull <- posterior(full, iterations = 10000) # summary of the "interesting" parameters summary(chainsFull[,1:7]) ``` The left panel of the figure below shows the data and linear fits. The green points represent guinea pigs given the orange juice supplement (OJ); red points represent guinea pigs given the vitamin C supplement. The solid lines show the posterior means from the Bayesian model; the dashed lines show the classical least-squares fit when applied to each supplement separately. The fits are quite close. ```{r GLMposterior2,results='hide',echo=FALSE} chainsNoInt <- posterior(noInteraction, iterations = 10000) ``` ```{r GLMplot,echo=FALSE,fig.width=10, fig.height=5} ToothGrowth$dose <- ToothGrowth$dose - mean(ToothGrowth$dose) cmeans <- colMeans(chainsFull)[1:6] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] + c(-1, 1) * cmeans[5] par(cex=1.8, mfrow=c(1,2)) plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps[1],col=2) abline(a=ints[2],b=slps[2],col=3) axis(1,at=-1:1,lab=2^(-1:1)) dataVC <- ToothGrowth[ToothGrowth$supp=="VC",] dataOJ <- ToothGrowth[ToothGrowth$supp=="OJ",] lmVC <- lm(len ~ dose, data=dataVC) lmOJ <- lm(len ~ dose, data=dataOJ) abline(lmVC,col=2,lty=2) abline(lmOJ,col=3,lty=2) mtext("Interaction",3,.1,adj=1,cex=1.3) # Do single slope cmeans <- colMeans(chainsNoInt)[1:4] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps,col=2) abline(a=ints[2],b=slps,col=3) axis(1,at=-1:1,lab=2^(-1:1)) mtext("No interaction",3,.1,adj=1,cex=1.3) ``` Because the no-interaction model fares so well against the interaction model, it may be instructive to examine the fit of the no-interaction model. We sample from the no-interaction model with the `posterior` function: ```{r eval=FALSE} chainsNoInt <- posterior(noInteraction, iterations = 10000) # summary of the "interesting" parameters summary(chainsNoInt[,1:5]) ``` ```{r echo=FALSE} summary(chainsNoInt[,1:5]) ``` The right panel of the figure above shows the fit of the no-interaction model to the data. This model appears to account for the data satisfactorily. Though the moderate p value of the classical result might lead us to reject the no-interaction model, the Bayes factor and the visual fit appear to agree that the evidence is equivocal at best. We have now analyzed the `ToothGrowth` data using both ANOVA (with `dose` as a factor) and regression (with `dose` as a continuous covariate). We may wish to compare the two approaches. We first create a column of the data with `dose` as a factor, then use `anovaBF`: ```{r} ToothGrowth$doseAsFactor <- factor(ToothGrowth$dose) levels(ToothGrowth$doseAsFactor) <- c(.5,1,2) aovBFs <- anovaBF(len ~ doseAsFactor + supp + doseAsFactor:supp, data = ToothGrowth) ``` Because all models we've considered are compared to the null intercept-only model, we can concatenate the `aovBFs` object with the Bayes factors we previously computed in this section: ```{r} allBFs <- c(aovBFs, full, noInteraction, onlyDose) ## eliminate the supp-only model, since it performs so badly allBFs <- allBFs[-1] ## Compare to best model allBFs / max(allBFs) ``` Two of the models score essentially equally well in terms of Bayes factors: `supp + dose + supp:dose` and `supp + dose`, suggesting that the interaction adds little. The Bayes factors where dose is treated as a factor are all worse than when dose is treated as a continuous covariate. This is likely due to a the added flexibility allowed by including more parameters. Plotting the Bayes factors shows how large the differences are: ```{r GLMplot2,echo=FALSE,fig.width=10, fig.height=5} plot(allBFs / max(allBFs)) ``` #### Linear correlation (0.9.12-4+) Ly, Verhagen, and Wagenmakers (2015; [link](#LyCor)) present a Bayes factor test for linear correlation. The `BayesFactor` package allows the computing of the Bayes factor and sampling from the posterior of the Bayes factor. Note that the model and priors are somewhat different from those used in the linear regression models presented above; further discussion can be found in Ly et al. We demonstrate the use of the `correlationBF` function using Fisher's `iris` data set built into `R`. See the help (`?iris` in R) for more details. We will focus on the correlation between `Sepal.Length` and `Sepal.Width`. First, we create a scatterplot. ```{r} plot(Sepal.Width ~ Sepal.Length, data = iris) abline(lm(Sepal.Width ~ Sepal.Length, data = iris), col = "red") ``` There does not appear to be a substantial correlation between these two variables. We can compute a classical test of the correlation using `R`'s `cor.test` function: ```{r} cor.test(y = iris$Sepal.Length, x = iris$Sepal.Width) ``` The $p$ value is nonsignificant at typical $\alpha$ levels, and the point estimate is not terribly impressive at -0.12. To compute the corresponding Bayes factor test, we use the `correlationBF` function (note the default prior scale). ```{r} bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) bf ``` As would be expected from the middling $p$ value in the classical test, the Bayes factor test shows little evidence either way (about `r round(as.vector(1/bf),1)` in favor of the null). If we'd like to estimate the correlation on the assumption that it is non-zero, we can sample from the posterior distribution using the `posterior` function. ```{r} samples = posterior(bf, iterations = 10000) ``` The important parameter is `rho`, the estimate of the true linear correlation. ```{r} summary(samples) ``` The posterior mean and credible interval for `rho` are very close to the point estimate and confidence interval obtained from `cor.test`. We can also plot the full posterior distribution, if we like: ```{r} plot(samples[,"rho"]) ``` ### Tests of single proportions (0.9.9+) The default test for a proportion assumes that all observations were independent with fixed probability $\pi$. The rule for stopping can be fixed $N$ ([binomial sampling](http://en.wikipedia.org/wiki/Binomial_distribution)) or a fixed number of successes ([negative binomial sampling](http://en.wikipedia.org/wiki/Negative_binomial_distribution)); unlike a significance test, the Bayes factor does not depend on the stopping rule. For the Bayes factor test of a single proportion, there are two hypotheses; the null hypothesis assumes that the probability $\pi$ is a fixed, known value $p$; under the alternative, the log-odds corresponding to $\pi$, denoted $\omega = \log(\pi/(1-\pi))$, has a logistic distribution centered on the log-odds corresponding to the null value $p$ (denoted $\omega_0 = \log(p/(1-p))$: \[ \omega \sim \mbox{logistic}(\mbox{mean}=\omega_0, \mbox{scale}=r) \] The default prior $r$ scale is 1/2. The figure below shows the prior distribution assuming the null hypothesis $p=0.5$, for the three named prior scale settings $r$ ("medium", "wide", and "ultrawide"). The default is "medium": ```{r propprior,echo=FALSE,fig.width=10, fig.height=5} p0 = .5 rnames = c("medium","wide","ultrawide") r = sapply(rnames,function(rname) BayesFactor:::rpriorValues("proptest",,rname)) leg_names = paste(rnames," (r=",round(r,3), ")", sep="") omega = seq(-5,5,len=100) pp = dlogis(omega,qlogis(p0),r[1]) plot(omega,pp, col="black", typ = 'l', lty=1, lwd=2, ylab="Prior density", xlab=expression(paste("True log odds ", omega)), yaxt='n') pp = dlogis(omega,qlogis(p0),r[2]) lines(omega, pp, col = "red",lty=1, lwd=2) pp = dlogis(omega,qlogis(p0),r[3]) lines(omega, pp, col = "blue",lty=1,lwd=2) axis(3,at = -2:2 * 2, labels=round(plogis(-2:2*2),2)) mtext(expression(paste("True probability ", pi)),3,2,adj=.5) legend(-5,.5,legend = leg_names, col=c("black","red","blue"), lwd=2,lty=1) ``` The following example is taken from `?binom.test`, which cites [Conover (1971)](#Conover). > Under (the assumption of) simple Mendelian inheritance, a cross between plants of two particular genotypes produces progeny 1/4 of which are "dwarf" and 3/4 of which are "giant", respectively. In an experiment to determine if this assumption is reasonable, a cross results in progeny having 243 dwarf and 682 giant plants. If "giant" is taken as success, the null hypothesis is that $p = 3/4$ and the alternative that $p \neq 3/4$. ```{r} bf = proportionBF( 682, 682 + 243, p = 3/4) 1 / bf ``` The Bayes factor favors the null hypothesis by a factor of about 7 (which is not surprising given that the observed proportion is 73.7%). In contrast, the best we can say about the classical result is that it is not statistically "significant": ```{r} binom.test(682, 682 + 243, p = 3/4) ``` Using the `posterior` function, we can draw samples from the posterior distribution of the true log odds and true probability and plot the estimate of the posterior. ```{r proppost,fig.width=10, fig.height=5} chains = posterior(bf, iterations = 10000) plot(chains[,"p"], main = "Posterior of true probability\nof 'giant' progeny") ``` ### Contingency tables (0.9.9+) The `BayesFactor` package implements versions of [Gunel and Dickey's (1974)](#GunelDickey) contingency table Bayes factor tests. Bayes factors for contingency tests are computed using the `contingencyTableBF` function. The necessary arguments are a matrix of cell frequencies and details about the sampling plan that produced the data. Here, we provide an example analysis of [Hraba and Grant's (1970)](#HrabaGrant) data, included as part of the `BayesFactor` package as the `raceDolls` data set. 71 white children and 89 black children from Lincoln, Nebraska were offered two dolls, one of whose "race" was the same as the child's and one that was different (either white or black). The children were then asked to select one of the dolls, with prompts such as "Give me the doll that is a nice doll." 50 of the 71 white children (70%) selected the white doll, while 48 of the 89 black children (54%) selected the black doll. These data are shown in the table below: ```{r results='asis', echo=FALSE} data(raceDolls) kable(raceDolls) ``` We can perform a Bayes factor analysis using the `contingencyTableBF` function: ```{r} bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") bf ``` Here we used `sampleType="indepMulti"` and `fixedMargin="cols"` to specify that the columns are assumed to be sampled as independent multinomials with their total fixed. See the help at `?contingencyTableBF` for more details about possible sampling plans and the priors. The Bayes factor in favor of the alternative that the factors are not independent is just shy of 2, which is not very much evidence against the null hypothesis. For comparison, consider the results classical chi-square test, with continuity correction: ```{r} chisq.test(raceDolls) ``` The classical test is just barely statistically significant. We can also use the `posterior` function to estimate the difference in probabilities of selecing a doll of the same race between white and black children, assuming the non-independence alternative: ```{r} chains = posterior(bf, iterations = 10000) ``` For the independent multinomial sampling plan, the chains will contain the individual cell probabilities and the marginal column probabilities. We first need to compute the conditional probabilities from the results: ```{r} sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"] sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"] ``` ...and then plot the MCMC estimate of the difference: ```{r ctablechains,fig.width=10, fig.height=5} plot(mcmc(sameRaceGivenWhite - sameRaceGivenBlack), main = "Increase in probability of child picking\nsame race doll (white - black)") ``` For more information, see `?contingencyTableBF`. Additional tips and tricks (0.9.4+) --------- In this section, tricks to help save time and memory are described. These tricks work with version BayesFactor version 0.9.4+, unless otherwise indicated. ### Testing restrictions on linear models: generalTestBF The convienience functions `anovaBF` and `regressionBF` are specifically designed for cetagorical and continuous covariates respectively, and have limitations that make those functions easier to use. For instance, `anovaBF` cannot incorporate continuous covariates, and treats random effects as untested nuissance parameters. The `regressionBF` on the other hand, being strictly for multiple regression, cannot incorporate categorical covariates. These functions exist for particular purposes, since guessing what model comparisons a user wants in general is difficult. The `lmBF` function, on the other hand, can handle any model but is limited to a single model comparison: the specified model against the intercept-only model. The `generalTestBF` function allows the testing of groups of models (like `anovaBF` and `regressionBF`) but can handle any kind of model (like `lmBF`). Users specify a full model, and `generalTestBF` successively removes terms from that model and tests the resulting submodels. For example, using the `puzzles` data set described above: ```{r} data(puzzles) puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID") puzzleGenBF ``` The resulting 9 models are the full model, plus the models that can be built by removing a single term at a time from the full model. By default, the `generalTestBF` function will not eliminate a term that is involved in a higher-order interaction (for instance, we will not remove `shape` unless the `shape:color` interaction is also removed); this behavior can be modified through the `whichModels` argument. It is often the case that some terms are nuisance terms that we would like to always keep in the model. For instance, `ID` in the `puzzles` data set is a participant effect; we would not generally consider models without a participant effect to be plausible. We can use the `neverExclude` argument to the function to specify a set of search terms (technically, [extended regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html)) that, if matched, will specify that the term is always to be kept, and never excluded. To keep the `ID` term: ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ``` The function now only considers models that contain `ID`. In some cases — especially when variable names are short, or a term to be kept is part of an interaction term that can be eliminated — we need to be careful in specifying search terms using `neverExclude`. For instance, suppose we are interested in testing the `ID:shape` interaction ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ``` The `shape:ID` interaction is never eliminated, because it matches the `ID` search term from `neverExclude`. [Regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html) are useful here. There are special characters representing the beginning and ending of a string (`^` and `$`, respectively) that we can use to construct a regular expression that will match `ID` but not `shape:ID`: ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="^ID$") puzzleGenBF ``` The `shape:ID` interaction term is now eliminated in some models, because it does not match `"^ID$"`. Multiple terms may be provided to `neverExclude` by providing a character vector; terms which match any element in the vector will always be included in model comparisons. ### Saving time: Pre-culling Bayes factor objects In cases where the default analysis produces many models to compare, the sampling approach to computing Bayes factors can be time consuming. The `BayesFactor` package identifies situations where sampling is not needed and thus saves time, but any model in which there is more than one categorical factor or a mix of categorical and continuous predictors will require sampling. When a default analysis produces many models that are not of interest, much of the time spent sampling may be wasted. The main functions in the `BayesFactor` package include the `noSample` argument which, if true, will prevent sampling. If a Bayes factor can be computed without sampling, the package will compute it, returning `NA` for Bayes factors that would require sampling. Continuing using the `puzzles` dataset: ```{r} puzzleCullBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", noSample=TRUE,whichModels='all') puzzleCullBF ``` Here we use `whichModels='all'` for demonstration, in order to obtain more possible model comparisons. Notice that several of the Bayes factors were computable without sampling, and are reported. The others have missing values, because the Bayes factor would have required sampling to compute. For now, we can separate the missing and non-missing Bayes factors in separate variables. This is made easy by the `is.na` method for BayesFactor objects: ```{r} missing = puzzleCullBF[ is.na(puzzleCullBF) ] done = puzzleCullBF[ !is.na(puzzleCullBF) ] missing ``` The variable `missing` now contains all models for which we lack a Bayes factor. At this point, we decide which of the Bayes factors we would like to compute. We can do this in any way we like: we could simple specify a subset, like `missing[1:3]` or we could do something more complicated. Here, we will include based on the model formula, using the R function `grepl` ([?grepl](http://stat.ethz.ch/R-manual/R-devel/library/base/html/grep.html)). Suppose we only wanted models that did not include *both* `shape` and `color`. First, we obtain the names of the models in `missing`, and then test the names to see if they match our restriction with `grepl`. We can use the result to restrict the models to compare to only those of interest. ```{r} # get the names of the numerator models missingModels = names(missing)$numerator # search them to see if they contain "shape" or "color" - # results are logical vectors containsShape = grepl("shape",missingModels) containsColor = grepl("color",missingModels) # anything that does not contain "shape" and "color" containsOnlyOne = !(containsShape & containsColor) # restrict missing to only those of interest missingOfInterest = missing[containsOnlyOne] missingOfInterest ``` We have restricted our set down to `r length(missingOfInterest)` items from `r length(missing)` items. We can now use `recompute` to compute the missing Bayes factors: ```{r} # recompute the Bayes factors for the missing models of interest sampledBayesFactors = recompute(missingOfInterest) sampledBayesFactors # Add them together with our other Bayes factors, already computed: completeBayesFactors = c(done, sampledBayesFactors) completeBayesFactors ``` Note that we're still left with one model that contains both `shape` and `color`, because it was computed without sampling. Assuming that we were not interested in any model containing both `shape` and `color`, however, we may have saved considerable time by not sampling to estimate their Bayes factors. The `noSample` argument will also work with the sampling of posteriors. This is especially useful, for instance, if one would like to know what order the MCMC chain results will be output in before sampling. ### Saving memory: Thinning and filtering MCMC chains Modern computer systems, which have many gigabytes of RAM, contain sufficient memory to perform analyses of moderate scale using the `BayesFactor` package. Some systems — particularly older 32-bit systems — are limited in the amount of memory that can address. Posterior sampling can create output that is hundreds of megabytes in size. If a user conducts several of these analyses, R may not have sufficient memory to store the results. Consider, for instance, an analysis with 100 participants, 100 items, and two fixed effects with 3 levels each. We include all main effects in the model, as well as all two-way interactions (excluding the participant by item interaction). This results in 619 parameters. Because each number stored in an MCMC chain uses 8 bytes of memory, each iterations of the chain uses 8*619=4952 bytes. If a user then requests a 100,000 iteration MCMC chain — a large, but not unreasonably, sized MCMC chain — the resulting object will use about 500Mb of memory. This is most of the memory available to the default installation of R on a 32-bit Windows system. Even if a computer has a lot of memory, many of the parameters may not be interesting to the analyst. The participant and item effects, for instance, may be nuisance variation. If a user is not interested in the estimates, it is a waste of memory to include them in the MCMC chain. The `BayesFactor` package includes several methods for reducing the size of MCMC chains: column filtering and chain thinning. Column filtering ensures that certain parameters do not appear in the output; thinning reduces the length of MCMC chains by only keeping some of the iterations. #### Column filtering Consider again the `puzzles` data set. We begin by sampling from the MCMC chain of the model with the main effect of `shape` and `color`, along with their interaction, plus a participant effect: ```{r} data(puzzles) # Get MCMC chains corresponding to "full" model # We prevent sampling so we can see the parameter names # iterations argument is necessary, but not used fullModel = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3) fullModel ``` Notice that the participant effects, which are often regarded as nuisance, are included in the chain. These parameters double the size of the MCMC object; if we are not interested in the parameter values, we could eliminate them from the output for a considerable savings. This does not mean, however, that the parameters are not estimated; they will still be used by `BayesFactor`, but will not be reported. To do this, we pass the `columnFilter` argument to the sampler, which surpresses output of any columns that arise from a term matched by an element in `columnFilter.` ```{r} fullModelFiltered = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3,columnFilter="ID") fullModelFiltered ``` Like the `neverExclude` argument discussed [above](#generalTestBF), the `columnFilter` argument is a character vector of [extended regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html). If a model term is matched by a search term in `columnFilter`, then all columns for term are eliminated from the MCMC output. Remember that `"ID"` will match anything containing letters `ID`; it would, for instance, also eliminate terms `GID` and `ID:shape`, if they existed. See the [manual section on `generalTestBF`](#generalTestBF) for details about how to use specific regular expressions to avoid eliminating columns by accident. #### Chain thinning MCMC chains are characterized by the fact that successive iterations are correlated with one another: that is, they are not indepenedent samples from the posterior distribution. To see this, we sample from the posterior of the full model and plot the results: ```{r} # Sample 10000 iterations, eliminating ID columns chains = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, posterior = TRUE, iterations=10000,columnFilter="ID") ``` The figure below shows the first 1000 iterations of the MCMC chain for a selected parameter (left), and the *autocorrelation function* [[CRAN](http://stat.ethz.ch/R-manual/R-patched/library/stats/html/acf.html) / [Wikipedia](http://en.wikipedia.org/wiki/Autocorrelation)] for the same parameter (right). ```{r acfplot,fig.width=10,fig.height=5,echo=FALSE} par(mfrow=c(1,2)) plot(as.vector(chains[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chains[,"shape-round"]) ``` The autocorrelation here is minimal, which will be the case in general for chains from the `BayesFactor` package. If we wanted to reduce it even further, we might consider *thinning* the chain: that is, keeping only every \(k\) iterations. Thinning throws away information, and is generally not necessary or recommended; however, if memory is at a premium, we might prefer storing nearly independent samples to storing somewhat dependent samples. The autocorrelation plot shows that the autocorrelation is reduced to 0 after 2 iterations. To get nearly independent samples, then, we could thin to every \(k=2\) iterations using the `thin` argument: ```{r} chainsThinned = recompute(chains, iterations=20000, thin=2) # check size of MCMC chain dim(chainsThinned) ``` Notice that we are left with 10,000 iterations, instead of the 20,000 we sampled, because half were thinned. The figure below shows the resulting MCMC chain and autocorrelation functions. The MCMC chain does not visually look very different, because the autocorrelation was minimal in the first place. However, the autocorrelation function no longer shows autocorrelation from one iteration to the next, implying that we have obtained 10,000 nearly independent samples. ```{r acfplot2,fig.width=10,fig.height=5,echo=FALSE} par(mfrow=c(1,2)) plot(as.vector(chainsThinned[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chainsThinned[,"shape-round"]) ``` ### Fine-tuning of prior scales (0.9.12-2+) Previous to version `0.9.12-2`, it was only possible to change the priors on a per-effect-type basis; ie, fixed effects all had the same prior scale, random effects had a different prior scale, and slopes had third prior scale. As of `0.9.12-2`, it is possible to change the prior on a per-effect basis for fixed and random effects (slopes still share a common prior, due to the use of the Liang et al. hyper-g priors for the slopes). This is accomplished via the `rscaleEffects` argument to `lmBF`, `anovaBF`, and `generalTestBF`. The `rscaleEffects` argument is a named vector. The names correspond to the effect you'd for which you'd like to set the prior, and the value is the prior scale value. Any settings in `rscaleEffects` will override the settings in `rscaleFixed` and `rscaleRandom`; if no settings are found in `rscaleEffects`, then the settings in `rscaleFixed` and `rscaleRandom` are used. We can demonstrate using the `puzzles` data set. Suppose we prefer a prior on the `color` main effect of $r=1$, a prior twice as wide as the default in `rscaleFixed`, $r=.5$. We set the prior scale for `color` using the `rscaleEffects` argument: ```{r tidy=FALSE} newprior.bf = anovaBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID",rscaleEffects = c( color = 1 )) newprior.bf ``` The other fixed effects, `shape` and `shape:color`, retain the prior scale of $r=.5$ from `rscaleFixed`. Compare these Bayes factors to the ones with in the [mixed modeling](#mixed) section above. References --------- Conover, W. J. (1971), Practical nonparametric statistics. New York: John Wiley & Sons. Pages 97–104. Gunel, E. and Dickey, J. (1974) Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557. ([JSTOR](http://www.jstor.org/stable/2334738)) Hraba, J. and Grant, G. (1970). Black is Beautiful: A reexamination of racial preference and identification. Journal of Personality and Social Psychology, 16, 398-402. [psychnet.apa.org](http://psycnet.apa.org/psycinfo/1971-03987-001) Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 ([Publisher](https://www.tandfonline.com/doi/abs/10.1198/016214507000001337)) Morey, R. D. and Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, pp. 406-419 ([Publisher](http://psycnet.apa.org/buy/2011-15467-001)) Morey, R. D. and Rouder, J. N. and Pratte, M. S. and Speckman, P. L. (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. Journal of Mathematical Psychology, 55, pp. 368-378 ([Publisher](https://www.sciencedirect.com/science/article/pii/S0022249611000666)) Rouder, J. N. and Morey, R. D. (2013) Default Bayes Factors for Model Selection in Regression, Multivariate Behavioral Research, 47, pp. 877-903 ([Publisher](https://www.tandfonline.com/doi/abs/10.1080/00273171.2012.734737)) Rouder, J. N. and Morey, R. D. and Speckman, P. L. and Province, J. M. (2012), Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology, 56, pp. 356–374 ([Publisher](https://www.sciencedirect.com/science/article/pii/S0022249612000806)) Rouder, J. N. and Speckman, P. L. and Sun, D. and Morey, R. D. and Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin and Review, 16, pp. 225-237 ([Publisher](https://link.springer.com/article/10.3758/PBR.16.2.225)) Rouder, J. N. and Morey, R. D. (2011). A Bayes Factor Meta-Analysis of Bem's ESP Claim. Psychonomic Bulletin & Review 18, pp. 682-689 ([Publisher](https://link.springer.com/article/10.3758%2Fs13423-011-0088-7)) Ly, A., Verhagen, A. J. & Wagenmakers, E.-J. (2015). Harold Jeffreys's Default Bayes Factor Hypothesis Tests: Explanation, Extension, and Application in Psychology. Journal of Mathematical Psychology ([Publisher](http://dx.doi.org/10.1016/j.jmp.2015.06.004)) -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/inst/doc/manual.R0000644000176200001440000004506713277750601015622 0ustar liggesusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ## ----message=FALSE------------------------------------------------------- library(BayesFactor) ## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ## ----onesampdata--------------------------------------------------------- data(sleep) ## Compute difference scores diffScores = sleep$extra[1:10] - sleep$extra[11:20] ## Traditional two-tailed t test t.test(diffScores) ## ----onesampt------------------------------------------------------------ bf = ttestBF(x = diffScores) ## Equivalently: ## bf = ttestBF(x = sleep$extra[1:10],y=sleep$extra[11:20], paired=TRUE) bf ## ----recip--------------------------------------------------------------- 1 / bf ## ----tsamp--------------------------------------------------------------- chains = posterior(bf, iterations = 1000) summary(chains) ## ----tsamplplot,fig.width=10--------------------------------------------- chains2 = recompute(chains, iterations = 10000) plot(chains2[,1:2]) ## ----onesamptinterval---------------------------------------------------- bfInterval = ttestBF(x = diffScores, nullInterval=c(-Inf,0)) bfInterval ## ----onesampledivide----------------------------------------------------- bfInterval[1] / bfInterval[2] ## ----onesampcat---------------------------------------------------------- allbf = c(bf, bfInterval) allbf ## ----plotonesamp,fig.width=10,fig.height=5------------------------------- plot(allbf) ## ----onesamplist--------------------------------------------------------- bfmat = allbf / allbf bfmat ## ----onesamplist2-------------------------------------------------------- bfmat[,2] bfmat[1,] ## ----onesamplist3-------------------------------------------------------- bfmat[,1:2] t(bfmat[,1:2]) ## ----twosampledata------------------------------------------------------- data(chickwts) ## Restrict to two groups chickwts = chickwts[chickwts$feed %in% c("horsebean","linseed"),] ## Drop unused factor levels chickwts$feed = factor(chickwts$feed) ## Plot data plot(weight ~ feed, data = chickwts, main = "Chick weights") ## ------------------------------------------------------------------------ ## traditional t test t.test(weight ~ feed, data = chickwts, var.eq=TRUE) ## ----twosamplet---------------------------------------------------------- ## Compute Bayes factor bf = ttestBF(formula = weight ~ feed, data = chickwts) bf ## ----twosampletsamp,fig.width=10----------------------------------------- chains = posterior(bf, iterations = 10000) plot(chains[,2]) ## ----bemdata------------------------------------------------------------- ## Bem's t statistics from four selected experiments t = c(-.15, 2.39, 2.42, 2.43) N = c(100, 150, 97, 99) ## ----bemanalysis1-------------------------------------------------------- bf = meta.ttestBF(t=t, n1=N, nullInterval=c(0,Inf), rscale=1) bf ## ----bemposterior,fig.width=10------------------------------------------- ## Do analysis again, without nullInterval restriction bf = meta.ttestBF(t=t, n1=N, rscale=1) ## Obtain posterior samples chains = posterior(bf, iterations = 10000) plot(chains) ## ----fixeddata,fig.width=10,fig.height=5--------------------------------- data(ToothGrowth) ## Example plot from ?ToothGrowth coplot(len ~ dose | supp, data = ToothGrowth, panel = panel.smooth, xlab = "ToothGrowth data: length vs dose, given type of supplement") ## Treat dose as a factor ToothGrowth$dose = factor(ToothGrowth$dose) levels(ToothGrowth$dose) = c("Low", "Medium", "High") summary(aov(len ~ supp*dose, data=ToothGrowth)) ## ------------------------------------------------------------------------ bf = anovaBF(len ~ supp*dose, data=ToothGrowth) bf ## ----fixedbf,fig.width=10,fig.height=5----------------------------------- plot(bf[3:4] / bf[2]) ## ------------------------------------------------------------------------ bf = anovaBF(len ~ supp*dose, data=ToothGrowth, whichModels="top") bf ## ------------------------------------------------------------------------ bfMainEffects = lmBF(len ~ supp + dose, data = ToothGrowth) bfInteraction = lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth) ## Compare the two models bf = bfInteraction / bfMainEffects bf ## ------------------------------------------------------------------------ newbf = recompute(bf, iterations = 500000) newbf ## ------------------------------------------------------------------------ ## Sample from the posterior of the full model chains = posterior(bfInteraction, iterations = 10000) ## 1:13 are the only "interesting" parameters summary(chains[,1:13]) ## ------------------------------------------------------------------------ plot(chains[,4:6]) ## ------------------------------------------------------------------------ data(puzzles) ## ----puzzlesplot,fig.width=7,fig.height=5,echo=FALSE--------------------- ## plot the data aovObj = aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles) matplot(t(matrix(puzzles$RT,12,4)),ty='b',pch=19,lwd=1,lty=1,col=rgb(0,0,0,.2), ylab="Completion time", xlab="Condition",xaxt='n') axis(1,at=1:4,lab=c("round&mono","square&mono","round&color","square&color")) mns = tapply(puzzles$RT,list(puzzles$color,puzzles$shape),mean)[c(2,4,1,3)] points(1:4,mns,pch=22,col="red",bg=rgb(1,0,0,.6),cex=2) # within-subject standard error, uses MSE from ANOVA stderr = sqrt(sum(aovObj[[5]]$residuals^2)/11)/sqrt(12) segments(1:4,mns + stderr,1:4,mns - stderr,col="red") ## ------------------------------------------------------------------------ summary(aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles)) ## ----tidy=FALSE---------------------------------------------------------- bf = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID") ## ------------------------------------------------------------------------ bf ## ----testplot,fig.width=10,fig.height=5---------------------------------- plot(bf) ## ------------------------------------------------------------------------ bfWithoutID = lmBF(RT ~ shape*color, data = puzzles) bfWithoutID ## ------------------------------------------------------------------------ bfOnlyID = lmBF(RT ~ ID, whichRandom="ID",data = puzzles) bf2 = bfWithoutID / bfOnlyID bf2 ## ------------------------------------------------------------------------ bfall = c(bf,bf2) ## ------------------------------------------------------------------------ bf[4] / bf2 ## ----regressData--------------------------------------------------------- data(attitude) ## Traditional multiple regression analysis lmObj = lm(rating ~ ., data = attitude) summary(lmObj) ## ----regressAll---------------------------------------------------------- bf = regressionBF(rating ~ ., data = attitude) length(bf) ## ----regressSelect------------------------------------------------------- ## Choose a specific model bf["privileges + learning + raises + critical + advance"] ## Best 6 models head(bf, n=6) ## Worst 4 models tail(bf, n=4) ## ----regressSelectwhichmax,eval=FALSE------------------------------------ # ## which model index is the best? # which.max(bf) ## ----regressSelectwhichmaxFake,echo=FALSE-------------------------------- ## which model index is the best? BayesFactor::which.max(bf) ## ----regressSelect2------------------------------------------------------ ## Compare the 5 best models to the best bf2 = head(bf) / max(bf) bf2 plot(bf2) ## ----regresstop, fig.width=10, fig.height=5------------------------------ bf = regressionBF(rating ~ ., data = attitude, whichModels = "top") ## The seventh model is the most complex bf plot(bf) ## ----regressbottom, fig.width=10, fig.height=5--------------------------- bf = regressionBF(rating ~ ., data = attitude, whichModels = "bottom") plot(bf) ## ----lmregress1---------------------------------------------------------- complaintsOnlyBf = lmBF(rating ~ complaints, data = attitude) complaintsLearningBf = lmBF(rating ~ complaints + learning, data = attitude) ## Compare the two models complaintsOnlyBf / complaintsLearningBf ## ----lmposterior--------------------------------------------------------- chains = posterior(complaintsLearningBf, iterations = 10000) summary(chains) ## ----lmregressclassical-------------------------------------------------- summary(lm(rating ~ complaints + learning, data = attitude)) ## ----echo=FALSE,results='hide'------------------------------------------- rm(ToothGrowth) ## ----GLMdata------------------------------------------------------------- data(ToothGrowth) # model log2 of dose instead of dose directly ToothGrowth$dose = log2(ToothGrowth$dose) # Classical analysis for comparison lmToothGrowth <- lm(len ~ supp + dose + supp:dose, data=ToothGrowth) summary(lmToothGrowth) ## ----GLMs---------------------------------------------------------------- full <- lmBF(len ~ supp + dose + supp:dose, data=ToothGrowth) noInteraction <- lmBF(len ~ supp + dose, data=ToothGrowth) onlyDose <- lmBF(len ~ dose, data=ToothGrowth) onlySupp <- lmBF(len ~ supp, data=ToothGrowth) allBFs <- c(full, noInteraction, onlyDose, onlySupp) allBFs ## ----GLMs2--------------------------------------------------------------- full / noInteraction ## ----GLMposterior1------------------------------------------------------- chainsFull <- posterior(full, iterations = 10000) # summary of the "interesting" parameters summary(chainsFull[,1:7]) ## ----GLMposterior2,results='hide',echo=FALSE----------------------------- chainsNoInt <- posterior(noInteraction, iterations = 10000) ## ----GLMplot,echo=FALSE,fig.width=10, fig.height=5----------------------- ToothGrowth$dose <- ToothGrowth$dose - mean(ToothGrowth$dose) cmeans <- colMeans(chainsFull)[1:6] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] + c(-1, 1) * cmeans[5] par(cex=1.8, mfrow=c(1,2)) plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps[1],col=2) abline(a=ints[2],b=slps[2],col=3) axis(1,at=-1:1,lab=2^(-1:1)) dataVC <- ToothGrowth[ToothGrowth$supp=="VC",] dataOJ <- ToothGrowth[ToothGrowth$supp=="OJ",] lmVC <- lm(len ~ dose, data=dataVC) lmOJ <- lm(len ~ dose, data=dataOJ) abline(lmVC,col=2,lty=2) abline(lmOJ,col=3,lty=2) mtext("Interaction",3,.1,adj=1,cex=1.3) # Do single slope cmeans <- colMeans(chainsNoInt)[1:4] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps,col=2) abline(a=ints[2],b=slps,col=3) axis(1,at=-1:1,lab=2^(-1:1)) mtext("No interaction",3,.1,adj=1,cex=1.3) ## ----eval=FALSE---------------------------------------------------------- # chainsNoInt <- posterior(noInteraction, iterations = 10000) # # # summary of the "interesting" parameters # summary(chainsNoInt[,1:5]) ## ----echo=FALSE---------------------------------------------------------- summary(chainsNoInt[,1:5]) ## ------------------------------------------------------------------------ ToothGrowth$doseAsFactor <- factor(ToothGrowth$dose) levels(ToothGrowth$doseAsFactor) <- c(.5,1,2) aovBFs <- anovaBF(len ~ doseAsFactor + supp + doseAsFactor:supp, data = ToothGrowth) ## ------------------------------------------------------------------------ allBFs <- c(aovBFs, full, noInteraction, onlyDose) ## eliminate the supp-only model, since it performs so badly allBFs <- allBFs[-1] ## Compare to best model allBFs / max(allBFs) ## ----GLMplot2,echo=FALSE,fig.width=10, fig.height=5---------------------- plot(allBFs / max(allBFs)) ## ------------------------------------------------------------------------ plot(Sepal.Width ~ Sepal.Length, data = iris) abline(lm(Sepal.Width ~ Sepal.Length, data = iris), col = "red") ## ------------------------------------------------------------------------ cor.test(y = iris$Sepal.Length, x = iris$Sepal.Width) ## ------------------------------------------------------------------------ bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) bf ## ------------------------------------------------------------------------ samples = posterior(bf, iterations = 10000) ## ------------------------------------------------------------------------ summary(samples) ## ------------------------------------------------------------------------ plot(samples[,"rho"]) ## ----propprior,echo=FALSE,fig.width=10, fig.height=5--------------------- p0 = .5 rnames = c("medium","wide","ultrawide") r = sapply(rnames,function(rname) BayesFactor:::rpriorValues("proptest",,rname)) leg_names = paste(rnames," (r=",round(r,3), ")", sep="") omega = seq(-5,5,len=100) pp = dlogis(omega,qlogis(p0),r[1]) plot(omega,pp, col="black", typ = 'l', lty=1, lwd=2, ylab="Prior density", xlab=expression(paste("True log odds ", omega)), yaxt='n') pp = dlogis(omega,qlogis(p0),r[2]) lines(omega, pp, col = "red",lty=1, lwd=2) pp = dlogis(omega,qlogis(p0),r[3]) lines(omega, pp, col = "blue",lty=1,lwd=2) axis(3,at = -2:2 * 2, labels=round(plogis(-2:2*2),2)) mtext(expression(paste("True probability ", pi)),3,2,adj=.5) legend(-5,.5,legend = leg_names, col=c("black","red","blue"), lwd=2,lty=1) ## ------------------------------------------------------------------------ bf = proportionBF( 682, 682 + 243, p = 3/4) 1 / bf ## ------------------------------------------------------------------------ binom.test(682, 682 + 243, p = 3/4) ## ----proppost,fig.width=10, fig.height=5--------------------------------- chains = posterior(bf, iterations = 10000) plot(chains[,"p"], main = "Posterior of true probability\nof 'giant' progeny") ## ----results='asis', echo=FALSE------------------------------------------ data(raceDolls) kable(raceDolls) ## ------------------------------------------------------------------------ bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") bf ## ------------------------------------------------------------------------ chisq.test(raceDolls) ## ------------------------------------------------------------------------ chains = posterior(bf, iterations = 10000) ## ------------------------------------------------------------------------ sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"] sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"] ## ----ctablechains,fig.width=10, fig.height=5----------------------------- plot(mcmc(sameRaceGivenWhite - sameRaceGivenBlack), main = "Increase in probability of child picking\nsame race doll (white - black)") ## ------------------------------------------------------------------------ data(puzzles) puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID") puzzleGenBF ## ------------------------------------------------------------------------ puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ## ------------------------------------------------------------------------ puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ## ------------------------------------------------------------------------ puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="^ID$") puzzleGenBF ## ------------------------------------------------------------------------ puzzleCullBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", noSample=TRUE,whichModels='all') puzzleCullBF ## ------------------------------------------------------------------------ missing = puzzleCullBF[ is.na(puzzleCullBF) ] done = puzzleCullBF[ !is.na(puzzleCullBF) ] missing ## ------------------------------------------------------------------------ # get the names of the numerator models missingModels = names(missing)$numerator # search them to see if they contain "shape" or "color" - # results are logical vectors containsShape = grepl("shape",missingModels) containsColor = grepl("color",missingModels) # anything that does not contain "shape" and "color" containsOnlyOne = !(containsShape & containsColor) # restrict missing to only those of interest missingOfInterest = missing[containsOnlyOne] missingOfInterest ## ------------------------------------------------------------------------ # recompute the Bayes factors for the missing models of interest sampledBayesFactors = recompute(missingOfInterest) sampledBayesFactors # Add them together with our other Bayes factors, already computed: completeBayesFactors = c(done, sampledBayesFactors) completeBayesFactors ## ------------------------------------------------------------------------ data(puzzles) # Get MCMC chains corresponding to "full" model # We prevent sampling so we can see the parameter names # iterations argument is necessary, but not used fullModel = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3) fullModel ## ------------------------------------------------------------------------ fullModelFiltered = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3,columnFilter="ID") fullModelFiltered ## ------------------------------------------------------------------------ # Sample 10000 iterations, eliminating ID columns chains = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, posterior = TRUE, iterations=10000,columnFilter="ID") ## ----acfplot,fig.width=10,fig.height=5,echo=FALSE------------------------ par(mfrow=c(1,2)) plot(as.vector(chains[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chains[,"shape-round"]) ## ------------------------------------------------------------------------ chainsThinned = recompute(chains, iterations=20000, thin=2) # check size of MCMC chain dim(chainsThinned) ## ----acfplot2,fig.width=10,fig.height=5,echo=FALSE----------------------- par(mfrow=c(1,2)) plot(as.vector(chainsThinned[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chainsThinned[,"shape-round"]) ## ----tidy=FALSE---------------------------------------------------------- newprior.bf = anovaBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID",rscaleEffects = c( color = 1 )) newprior.bf BayesFactor/inst/doc/index.R0000644000176200001440000000022313277750550015440 0ustar liggesusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) BayesFactor/inst/doc/manual.html0000644000176200001440002036634413277750602016374 0ustar liggesusers Using the 'BayesFactor' package, version 0.9.2+

Fork me on GitHub

BayesFactor logo


Using the 'BayesFactor' package, version 0.9.2+

Richard D. Morey

BayesFactor on facebook Find us on facebook
BayesFactor blog Follow the BayesFactor blog

Share via
share on facebook tweet BayesFactor submit to reddit submit to google plus share by email


Stable version: CRAN page - Package NEWS (including version changes)

Development version: Development page - Development package NEWS

fork on github on github

Table of Contents

Getting help

Introduction

The BayesFactor package enables the computation of Bayes factors in standard designs, such as one- and two- sample designs, ANOVA designs, and regression. The Bayes factors are based on work spread across several papers. This document is designed to show users how to compute Bayes factors using the package by example. It is not designed to present the models used in the comparisons in detail; for that, see the BayesFactor help and especially the references listed in this manual. Complete references are given at the end of this document.

If you need help or think you've found a bug, please use the links at the top of this document to contact the developers. When asking a question or reporting a bug, please send example code and data, the exact errors you're seeing (a cut-and-paste from the R console will work) and instructions for reproducing it. Also, report the output of BFInfo() and sessionInfo(), and let us know what operating system you're running.

Loading the package

The BayesFactor package must be installed and loaded before it can be used. Installing the package can be done in several ways and will not be covered here. Once it is installed, use the library function to load it:

library(BayesFactor)

This command will make the BayesFactor package ready to use.

Some useful functions

The table below lists some of the functions in the BayesFactor package that will be demonstrated in this manual. For more complete help on the use of these functions, see the corresponding help() page in R.

Function Description
ttestBF Bayes factors for one- and two- sample designs
anovaBF Bayes factors comparing many ANOVA models
regressionBF Bayes factors comparing many linear regression models
generalTestBF Bayes factors for all restrictions on a full model (0.9.4+)
lmBF Bayes factors for specific linear models (ANOVA or regression)
correlationBF Bayes factors for linear correlations
proportionBF Bayes factors for tests of single proportions
contingencyTableBF Bayes factors for contingency tables
posterior Sample from the posterior distribution of the numerator of a Bayes factor object
recompute Recompute a Bayes factor or MCMC chain, possibly increasing the precision of the estimate
compare Compare two models; typically used to compare two models in BayesFactor MCMC objects

Functions to manipulate Bayes factor objects

The t test section below has examples showing how to manipulate Bayes factor objects, but all these functions will work with Bayes factors generated from any function in the BayesFactor package.

Function Description
/ Divide two Bayes factor objects to create new model comparisons, or invert with 1/
t “Flip” (transpose) a Bayes factor object
c Concatenate two Bayes factor objects together, assuming they have the same denominator
[ Use indexing to select a subset of the Bayes factors
plot plot a Bayes factor object
sort Sort a Bayes factor object
is.na Determine whether a Bayes factor object contains missing values
head,tail Return the n highest or lowest Bayes factor in an object
max, min Return the highest or lowest Bayes factor in an object
which.max,which.min Return the index of the highest or lowest Bayes factor
as.vector Convert to a simple vector (denominator will be lost!)
as.data.frame Convert to data.frame (denominator will be lost!)

One- and two-sample designs (t tests)

The ttestBF function is used to obtain Bayes factors corresponding to tests of a single sample's mean, or tests that two independent samples have the same mean.

One-sample tests (and paired)

We use the sleep data set in R to demonstrate a one-sample t test. This is a paired design; for details about the data set, see ?sleep. One way of analyzing these data is to compute difference scores by subtracting a participant's score in one condition from their score in the other:

data(sleep)

## Compute difference scores
diffScores = sleep$extra[1:10] - sleep$extra[11:20]

## Traditional two-tailed t test
t.test(diffScores)
## 
##  One Sample t-test
## 
## data:  diffScores
## t = -4, df = 9, p-value = 0.003
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  -2.46 -0.70
## sample estimates:
## mean of x 
##     -1.58

We can do a Bayesian version of this analysis using the ttestBF function, which performs the “JZS” t test described by Rouder, Speckman, Sun, Morey, and Iverson (2009). In this model, the true standardized difference \( \delta=(\mu-\mu_0)/\sigma_\epsilon\) is assumed to be 0 under the null hypothesis, and \(\text{Cauchy}(\text{scale}=r)\) under the alternative. The default \(r\) scale in BayesFactor for t tests is \(\sqrt{2}/2\). See ?ttestBF for more details.

bf = ttestBF(x = diffScores)
## Equivalently:
## bf = ttestBF(x = sleep$extra[1:10],y=sleep$extra[11:20], paired=TRUE)
bf
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707 : 17.3 ±0%
## 
## Against denominator:
##   Null, mu = 0 
## ---
## Bayes factor type: BFoneSample, JZS

The bf object contains the Bayes factor, and shows the numerator and denominator models for the Bayes factor comparison. In our case, the Bayes factor for the comparison of the alternative versus the null is 17.259. After the Bayes factor is a proportional error estimate on the Bayes factor.

There are a number of operations we can perform on our Bayes factor, such as taking the reciprocal:

1 / bf
## Bayes factor analysis
## --------------
## [1] Null, mu=0 : 0.0579 ±0%
## 
## Against denominator:
##   Alternative, r = 0.707106781186548, mu =/= 0 
## ---
## Bayes factor type: BFoneSample, JZS

or sampling from the posterior of the numerator model:

chains = posterior(bf, iterations = 1000)
summary(chains)
## 
## Iterations = 1:1000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 1000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##        Mean     SD Naive SE Time-series SE
## mu    -1.42  0.436   0.0138         0.0154
## sig2   2.02  1.157   0.0366         0.0395
## delta -1.11  0.427   0.0135         0.0162
## g      6.26 58.623   1.8538         1.8538
## 
## 2. Quantiles for each variable:
## 
##         2.5%    25%   50%    75%  97.5%
## mu    -2.289 -1.705 -1.43 -1.141 -0.597
## sig2   0.744  1.270  1.69  2.446  5.223
## delta -1.973 -1.383 -1.08 -0.813 -0.347
## g      0.176  0.592  1.13  2.928 33.734

The posterior function returns a object of type BFmcmc, which inherits the methods of the mcmc class from the coda package. We can thus use summary, plot, and other useful methods on the result of posterior. If we were unhappy with the number of iterations we sampled for chains, we can recompute with more iterations, and then plot the results:

chains2 = recompute(chains, iterations = 10000)
plot(chains2[,1:2])

plot of chunk tsamplplot

Directional hypotheses can also be tested with ttestBF (Morey & Rouder, 2011). The argument nullInterval can be passed as a vector of length 2, and defines an interval to compare to the point null. If null interval is defined, two Bayes factors are returned: the Bayes factor of the null interval against the alternative, and the Bayes factor of the complement of the interval to the point null.

Suppose, for instance, we wanted to test the one-sided hypotheses that \(\delta<0\) versus the point null. We set nullInterval to c(-Inf,0):

bfInterval = ttestBF(x = diffScores, nullInterval=c(-Inf,0))
bfInterval
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707 -Inf<d<0    : 34.4  ±0%
## [2] Alt., r=0.707 !(-Inf<d<0) : 0.101 ±0.06%
## 
## Against denominator:
##   Null, mu = 0 
## ---
## Bayes factor type: BFoneSample, JZS

We may not be interested in tests against the point null. If we are interested in the Bayes factor test that \(\delta<0\) versus \(\delta>0\) we can compute it using the result above. Since the object contains two Bayes factors, both with the same denominator, and \[ \left.\frac{A}{C}\middle/\frac{B}{C}\right. = \frac{A}{B}, \] we can divide the two Bayes factors in bfInferval to obtain the desired test:

bfInterval[1] / bfInterval[2]
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707 -Inf<d<0 : 341 ±0.06%
## 
## Against denominator:
##   Alternative, r = 0.707106781186548, mu =/= 0 !(-Inf<d<0) 
## ---
## Bayes factor type: BFoneSample, JZS

The Bayes factor is about 340.

When we have multiple Bayes factors that all have the same denominator, we can concatenate them into one object using the c function. Since bf and bfInterval both share the point null denominator, we can do this:

allbf = c(bf, bfInterval)
allbf
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707             : 17.3  ±0%
## [2] Alt., r=0.707 -Inf<d<0    : 34.4  ±0%
## [3] Alt., r=0.707 !(-Inf<d<0) : 0.101 ±0.06%
## 
## Against denominator:
##   Null, mu = 0 
## ---
## Bayes factor type: BFoneSample, JZS

The object allbf now contains three Bayes factors, all of which share the same denominator. If you try to concatenate Bayes factors that do not share the same denominator, BayesFactor will return an error.

When you have a Bayes factor object with several numerators, there are several interesting ways to manipulate them. For instance, we can plot the Bayes factor object to obtain a graphical representation of the Bayes factors:

plot(allbf)

plot of chunk plotonesamp

We can also divide a Bayes factor object by itself — or by a subset of itself — to obtain pairwise comparisons:

bfmat = allbf / allbf
bfmat
##                            denominator
## numerator                   Alt., r=0.707 Alt., r=0.707 -Inf<d<0
##   Alt., r=0.707                   1.00000                0.50146
##   Alt., r=0.707 -Inf<d<0          1.99416                1.00000
##   Alt., r=0.707 !(-Inf<d<0)       0.00584                0.00293
##                            denominator
## numerator                   Alt., r=0.707 !(-Inf<d<0)
##   Alt., r=0.707                                   171
##   Alt., r=0.707 -Inf<d<0                          341
##   Alt., r=0.707 !(-Inf<d<0)                         1

The resulting object is of type BFBayesFactorList, and is a list of Bayes factor comparisons all of the same numerators compared to different denominators. The resulting matrix can be subsetted to return individual Bayes factor objects, or new BFBayesFactorLists:

bfmat[,2]
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707             : 0.501   ±0%
## [2] Alt., r=0.707 -Inf<d<0    : 1       ±0%
## [3] Alt., r=0.707 !(-Inf<d<0) : 0.00293 ±0.06%
## 
## Against denominator:
##   Alternative, r = 0.707106781186548, mu =/= 0 -Inf<d<0 
## ---
## Bayes factor type: BFoneSample, JZS
bfmat[1,]
##                denominator
## numerator       Alt., r=0.707 Alt., r=0.707 -Inf<d<0
##   Alt., r=0.707             1                  0.501
##                denominator
## numerator       Alt., r=0.707 !(-Inf<d<0)
##   Alt., r=0.707                       171

and they can also be transposed:

bfmat[,1:2]
##                            denominator
## numerator                   Alt., r=0.707 Alt., r=0.707 -Inf<d<0
##   Alt., r=0.707                   1.00000                0.50146
##   Alt., r=0.707 -Inf<d<0          1.99416                1.00000
##   Alt., r=0.707 !(-Inf<d<0)       0.00584                0.00293
t(bfmat[,1:2])
##                         denominator
## numerator                Alt., r=0.707 Alt., r=0.707 -Inf<d<0
##   Alt., r=0.707                   1.00                  0.501
##   Alt., r=0.707 -Inf<d<0          1.99                  1.000
##                         denominator
## numerator                Alt., r=0.707 !(-Inf<d<0)
##   Alt., r=0.707                                171
##   Alt., r=0.707 -Inf<d<0                       341

If these values are desired in matrix form, the as.matrix function can be used to obtain a matrix.

Two-sample test (independent groups)

The ttestBF function can also be used to compute Bayes factors in the two sample case as well. We use the chickwts data set to demonstrate the two-sample t test. The chickwts data set has six groups, but we reduce it to two for the demonstration.

data(chickwts)

## Restrict to two groups
chickwts = chickwts[chickwts$feed %in% c("horsebean","linseed"),]
## Drop unused factor levels
chickwts$feed = factor(chickwts$feed)

## Plot data
plot(weight ~  feed, data = chickwts, main = "Chick weights")

plot of chunk twosampledata

Chick weight appears to be affected by the feed type.

## traditional t test
t.test(weight ~ feed, data = chickwts, var.eq=TRUE)
## 
##  Two Sample t-test
## 
## data:  weight by feed
## t = -3, df = 20, p-value = 0.008
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -100.2  -16.9
## sample estimates:
## mean in group horsebean   mean in group linseed 
##                     160                     219

We can also compute the corresponding Bayes factor. There are two ways of specifying a two-sample test: the formula interface and through the x and y arguments. We show the formula interface here:

## Compute Bayes factor
bf = ttestBF(formula = weight ~ feed, data = chickwts)
bf
## Bayes factor analysis
## --------------
## [1] Alt., r=0.707 : 5.98 ±0%
## 
## Against denominator:
##   Null, mu1-mu2 = 0 
## ---
## Bayes factor type: BFindepSample, JZS

As before, we can sample from the posterior distribution for the numerator model:

chains = posterior(bf, iterations = 10000)
plot(chains[,2])

plot of chunk twosampletsamp

Note that the samples assume an (equivalent) ANOVA model; see ?ttestBF and for notes on the differences in interpretation of the \(r\) scale parameter between the two models.

Meta-analytic t tests (0.9.8+)

Rouder and Morey (2011; link) discuss a meta-analytic extension of the \(t\) test, whereby multiple \(t\) statistics, along with their corresponding sample sizes, are combined in a single meta-analytic analysis. The \(t\) statistics are assumed to arise from a a common effect size \(\delta\). The prior for the effect size \(\delta\) is the same as that for the \(t\) tests described above.

The meta.ttestBF function is used to perform meta-analytic \(t\) tests. It requires as input a vector of \(t\) statistics, and one or two vectors of sample sizes (arguments n1 and n2). For a set of one-sample \(t\) statistics, n1 should be provided; for two-sample analyses, both n1 and n2 should be provided.

As an example, we will replicate the analysis of Rouder & Morey (2011), using \(t\) statistics from Bem (2010; see Rouder & Morey for reference). We begin by defining the one-sample \(t\) statistics and sample sizes:

## Bem's t statistics from four selected experiments
t = c(-.15, 2.39, 2.42, 2.43)
N = c(100, 150, 97, 99)

Rouder and Morey opted for a one-sided analysis, and used an \(r\) scale parameter of 1 (instead of the current default in BayesFactor of \(\sqrt{2}/2\)).

bf = meta.ttestBF(t=t, n1=N, nullInterval=c(0,Inf), rscale=1)
bf
## Bayes factor analysis
## --------------
## [1] Alt., r=1 0<d<Inf    : 38.7    ±0%
## [2] Alt., r=1 !(0<d<Inf) : 0.00803 ±0.56%
## 
## Against denominator:
##   Null, d = 0 
## ---
## Bayes factor type: BFmetat, JZS

Notice that as above, the analysis yields a Bayes factor for our selected interval against the null, as well as the Bayes factor for the complement of the interval against the null.

We can also sample from the posterior distribution of the standardized effect size \(\delta\), as above, using the posterior function:

## Do analysis again, without nullInterval restriction
bf = meta.ttestBF(t=t, n1=N, rscale=1)

## Obtain posterior samples
chains = posterior(bf, iterations = 10000)
## Independent-candidate M-H acceptance rate: 98%
plot(chains)

plot of chunk bemposterior

Notice that the posterior samples will respect the nullInterval argument if given; in order to get unrestricted samples, perform an analysis with no interval restriction and pass it to the posterior function.

See ?meta.ttestBF for more information.

ANOVA

The BayesFactor package has two main functions that allow the comparison of models with factors as predictors (ANOVA): anovaBF, which computes several model estimates at once, and lmBF, which computes one comparison at a time. We begin by demonstrating a 3x2 fixed-effect ANOVA using the ToothGrowth data set. For details about the data set, see ?ToothGrowth.

Fixed-effects ANOVA

The ToothGrowth data set contains three columns: len, the dependent variable, each of which is the length of a guinea pig's tooth after treatment with Vitamin C; supp, which is the supplement type (orange juice or ascorbic acid); and dose, which is the amount of Vitamin C administered.

data(ToothGrowth)

## Example plot from ?ToothGrowth

coplot(len ~ dose | supp, data = ToothGrowth, panel = panel.smooth,
       xlab = "ToothGrowth data: length vs dose, given type of supplement")

plot of chunk fixeddata

## Treat dose as a factor
ToothGrowth$dose = factor(ToothGrowth$dose)
levels(ToothGrowth$dose) = c("Low", "Medium", "High")

summary(aov(len ~ supp*dose, data=ToothGrowth))
##             Df Sum Sq Mean Sq F value  Pr(>F)    
## supp         1    205     205   15.57 0.00023 ***
## dose         2   2426    1213   92.00 < 2e-16 ***
## supp:dose    2    108      54    4.11 0.02186 *  
## Residuals   54    712      13                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

There appears to be a large effect of the dosage, a small effect of the supplement type, and perhaps a hint of an interaction. The anovaBF function will compute the Bayes factors of all models against the intercept-only model; by default, it will choose the subset of all models in which which an interaction can only be included if all constituent effects or interactions are included (argument whichModels is set to withmain, indicating that interactions can only enter in with their main effects). However, this setting can be changed, as we will demonstrate. First, we show the default behavior.

bf = anovaBF(len ~ supp*dose, data=ToothGrowth)
bf
## Bayes factor analysis
## --------------
## [1] supp                    : 1.2      ±0.01%
## [2] dose                    : 4.98e+12 ±0%
## [3] supp + dose             : 2.92e+14 ±1.58%
## [4] supp + dose + supp:dose : 7.44e+14 ±1.01%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The function will build the requested models from the terms included in the right-hand side of the formula; we could have specified the sum of the two terms, and we would have gotten the same models.

The Bayes factor analysis is consistent with the classical ANOVA analysis; the favored model is the full model, with both main effects and the two-way interaction. Suppose we were interested in comparing the two main-effects model and the full model to the dose-only model. We could use indexing and division, along with the plot function, to see a graphical representation of these comparisons:

plot(bf[3:4] / bf[2])

plot of chunk fixedbf

The model with the main effect of supp and the supp:dose interaction is preferred quite strongly over the dose-only model.

There are a number of other options for how to select subsets of models to test. The whichModels argument to anovaBF controls which subsets are tested. As described previously, the default is withmain, where interactions are only allowed if all constituent sub-effects are included. The other three options currently available are all, which tests all models; top, which includes the full model and all models that can be formed by removing one interaction or main effect; and bottom, which adds single effects one at a time to the null model.

The argument whichModels='all' should be used with caution: a three-way ANOVA model will contain \(2^{2^3-1}-1 = 127\) model comparisons; a four-way ANOVA, \(2^{2^4-1}-1 = 32767\) models, and a five-way ANOVA just over 2.1 billion models. Depending on the speed of your computer, a four-way ANOVA may take several hours to a day, but a five-way ANOVA is probably not feasible.

One alternative is whichModels='top', which reduces the number of comparisons to \(2^k-1\), where \(k\) is the number of factors, which is manageable. In orthogonal designs, one can construct tests of each main effect or interaction by comparing the full model to the model with all effects except the one of interest:

bf = anovaBF(len ~ supp*dose, data=ToothGrowth, whichModels="top")
bf
## Bayes factor top-down analysis
## --------------
## When effect is omitted from supp + dose + supp:dose , BF is...
## [1] Omit dose:supp : 0.385    ±3.32%
## [2] Omit dose      : 7.11e-16 ±12.2%
## [3] Omit supp      : 0.011    ±4.17%
## 
## Against denominator:
##   len ~ supp + dose + supp:dose 
## ---
## Bayes factor type: BFlinearModel, JZS

Note that all of the Bayes factors are less than 1, indicating that removing any effect from the full model is deleterious.

Another way we can reduce the number of models tested is simply to test only specific models of interest. In the example above, for instance, we might want to compare the model with the interaction to the model with only the main effects, if our effect of interest was the interaction. We can do this with the lmBF function.

bfMainEffects = lmBF(len ~ supp + dose, data = ToothGrowth)
bfInteraction = lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth)
## Compare the two models
bf = bfInteraction / bfMainEffects
bf
## Bayes factor analysis
## --------------
## [1] supp + dose + supp:dose : 2.79 ±2.51%
## 
## Against denominator:
##   len ~ supp + dose 
## ---
## Bayes factor type: BFlinearModel, JZS

The model with the interaction effect is preferred by a factor of about 3.

Suppose that we were unhappy with the ~2.5% proportional error on the Bayes factor bf. anovaBF and lmBF use Monte Carlo integration to estimate the Bayes factors. The default number of Monte Carlo samples is 10,000 but this can be increased. We could use the recompute to reduce the error. The recompute function performs the sampling required to build the Bayes factor object again:

newbf = recompute(bf, iterations = 500000)
newbf
## Bayes factor analysis
## --------------
## [1] supp + dose + supp:dose : 2.74 ±0.51%
## 
## Against denominator:
##   len ~ supp + dose 
## ---
## Bayes factor type: BFlinearModel, JZS

The proportional error is now below 1%.

As before, we can use MCMC methods to estimate parameters through the posterior function:

## Sample from the posterior of the full model
chains = posterior(bfInteraction, iterations = 10000)
## 1:13 are the only "interesting" parameters
summary(chains[,1:13])
## 
## Iterations = 1:10000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 10000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##                         Mean    SD Naive SE Time-series SE
## mu                    18.819 0.487  0.00487        0.00487
## supp-OJ                1.679 0.488  0.00488        0.00549
## supp-VC               -1.679 0.488  0.00488        0.00549
## dose-Low              -8.069 0.683  0.00683        0.00705
## dose-Medium            0.910 0.680  0.00680        0.00666
## dose-High              7.159 0.684  0.00684        0.00710
## supp:dose-OJ.&.Low     0.562 0.603  0.00603        0.00616
## supp:dose-OJ.&.Medium  0.822 0.621  0.00621        0.00723
## supp:dose-OJ.&.High   -1.384 0.663  0.00663        0.00833
## supp:dose-VC.&.Low    -0.562 0.603  0.00603        0.00616
## supp:dose-VC.&.Medium -0.822 0.621  0.00621        0.00723
## supp:dose-VC.&.High    1.384 0.663  0.00663        0.00833
## sig2                  14.039 2.772  0.02772        0.03260
## 
## 2. Quantiles for each variable:
## 
##                         2.5%    25%    50%    75%  97.5%
## mu                    17.880 18.492 18.817 19.142 19.765
## supp-OJ                0.719  1.356  1.679  2.002  2.647
## supp-VC               -2.647 -2.002 -1.679 -1.356 -0.719
## dose-Low              -9.421 -8.516 -8.073 -7.608 -6.746
## dose-Medium           -0.418  0.457  0.904  1.370  2.234
## dose-High              5.808  6.696  7.167  7.615  8.516
## supp:dose-OJ.&.Low    -0.613  0.160  0.552  0.945  1.766
## supp:dose-OJ.&.Medium -0.354  0.404  0.801  1.223  2.093
## supp:dose-OJ.&.High   -2.740 -1.825 -1.365 -0.920 -0.154
## supp:dose-VC.&.Low    -1.766 -0.945 -0.552 -0.160  0.613
## supp:dose-VC.&.Medium -2.093 -1.223 -0.801 -0.404  0.354
## supp:dose-VC.&.High    0.154  0.920  1.365  1.825  2.740
## sig2                   9.625 12.062 13.692 15.615 20.373

And we can plot the posteriors of some selected effects:

plot(chains[,4:6])

plot of chunk unnamed-chunk-10

Mixed models (including repeated measures)

In order to demonstrate the analysis of mixed models using BayesFactor, we will load the puzzles data set, which is part of the BayesFactor package. See ?puzzles for details. The data set consists of four columns: RT the dependent variable, which is the number of seconds that it took to complete a puzzle; ID which is a participant identifier; and shape and color, which are two factors that describe the type of puzzle solved. shape and color each have two levels, and each of 12 participants completed puzzles within combination of shape and color. The design is thus 2x2 factorial within-subjects.

We first load the data, then perform a traditional within-subjects ANOVA.

data(puzzles)

plot of chunk puzzlesplot

(Code for plot omitted) Individual circles joined by lines show participants; red squares/lines show the means and within-subject standard errors. From the plot, there appear to be main effects of color and shape, but no interaction.

summary(aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles))
## 
## Error: ID
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 11    226    20.6               
## 
## Error: ID:shape
##           Df Sum Sq Mean Sq F value Pr(>F)  
## shape      1   12.0   12.00    7.54  0.019 *
## Residuals 11   17.5    1.59                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: ID:color
##           Df Sum Sq Mean Sq F value Pr(>F)   
## color      1   12.0   12.00    13.9 0.0033 **
## Residuals 11    9.5    0.86                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: ID:shape:color
##             Df Sum Sq Mean Sq F value Pr(>F)
## shape:color  1    0.0    0.00       0      1
## Residuals   11   30.5    2.77

The classical ANOVA appears to corroborate the impression from the plot. In order to compute the Bayes factor, we must tell anovaBF that ID is an additive effect on top of the other effects (as is typically assumed) and is a random factor. The anovaBF call below shows how this is done:

bf = anovaBF(RT ~ shape*color + ID, data = puzzles, 
             whichRandom="ID")

We alert anovaBF to the random factor using the whichRandom argument. whichRandom should contain a character vector with the names of all random factors in it. All other factors are assumed to be fixed. The anovaBF will find all the fixed effects in the formula, and compute the Bayes factor for the subset of combinations determined by the whichModels argument (see the previous section). Note that anovaBF does not test random factors; they are assumed to be nuisance factors. The null model in a test with random factors is not the intercept-only model; it is the model containing the random effects. The Bayes factor object bf thus now contains Bayes factors comparing various combinations of the fixed effects and an additive effect of ID against a denominator containing only ID:

bf
## Bayes factor analysis
## --------------
## [1] shape + ID                       : 2.81 ±0.91%
## [2] color + ID                       : 2.81 ±0.83%
## [3] shape + color + ID               : 11.9 ±3%
## [4] shape + color + shape:color + ID : 4.23 ±2.2%
## 
## Against denominator:
##   RT ~ ID 
## ---
## Bayes factor type: BFlinearModel, JZS

The main effects model is preferred against all models. We can plot the Bayes factor object to obtain a graphical representation of the model comparisons:

plot(bf)

plot of chunk testplot

Because the anovaBF function does not test random factors, we must use lmBF to build such tests. Doing so is straightforward. Suppose that we wished to test the random effect ID in the puzzles example. We might compare the full model shape + color + shape:color + ID to the same model without ID:

bfWithoutID = lmBF(RT ~ shape*color, data = puzzles)
bfWithoutID
## Bayes factor analysis
## --------------
## [1] shape * color : 0.143 ±1.14%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

But notice that the denominator model is the intercept-only model; the denominator in the previous analysis was the ID only model. We need to compare the model with no ID effect to the model with only ID:

bfOnlyID = lmBF(RT ~ ID, whichRandom="ID",data = puzzles)
bf2 = bfWithoutID / bfOnlyID
bf2
## Bayes factor analysis
## --------------
## [1] shape * color : 1.28e-06 ±1.14%
## 
## Against denominator:
##   RT ~ ID 
## ---
## Bayes factor type: BFlinearModel, JZS

Since our bf object and bf2 object now have the same denominator, we can concatenate them into one Bayes factor object:

bfall = c(bf,bf2)

and we can compare them by dividing:

bf[4] / bf2
## Bayes factor analysis
## --------------
## [1] shape + color + shape:color + ID : 3307085 ±2.48%
## 
## Against denominator:
##   RT ~ shape * color 
## ---
## Bayes factor type: BFlinearModel, JZS

The model with ID is preferred by a factor of over 1 million, which is not surprising.

Any model that is a combination of fixed and random factors, including interations between fixed and random factors, can be constructed and tested with lmBF. anovaBF is designed to be a convenience function as is therefore somewhat limited in flexibility with respect to the models types it can test; however, because random effects are often nuisance effects, we believe anovaBF will be sufficient for most researchers' use.

Linear regression

Model comparison in multiple linear regression using BayesFactor is done via the approach of Liang, Paulo, Molina, Clyde, and Berger (2008). Further discussion can be found in Rouder & Morey (in press). To demonstrate Bayes factor model comparison in a linear regression context, we use the attitude data set in R. See ?attitude. The attitude consists of the dependent variable rating, along with 6 predictors. We can use BayesFactor to compute the Bayes factors for many models simultaneously, or single Bayes factors against the model containing no predictors.

data(attitude)

## Traditional multiple regression analysis
lmObj = lm(rating ~ ., data = attitude)
summary(lmObj)
## 
## Call:
## lm(formula = rating ~ ., data = attitude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -10.942  -4.356   0.316   5.543  11.599 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  10.7871    11.5893    0.93   0.3616    
## complaints    0.6132     0.1610    3.81   0.0009 ***
## privileges   -0.0731     0.1357   -0.54   0.5956    
## learning      0.3203     0.1685    1.90   0.0699 .  
## raises        0.0817     0.2215    0.37   0.7155    
## critical      0.0384     0.1470    0.26   0.7963    
## advance      -0.2171     0.1782   -1.22   0.2356    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.07 on 23 degrees of freedom
## Multiple R-squared:  0.733,  Adjusted R-squared:  0.663 
## F-statistic: 10.5 on 6 and 23 DF,  p-value: 1.24e-05

The period (.) is shorthand for all remaining columns, besides rating. The predictors complaints and learning appear most stongly related to the dependent variable, especially complaints. In order to compute the Bayes factors for many model comparisons at onces, we use the regressionBF function. The most obvious set of all model comparisons is all possible additive models, which is returned by default:

bf = regressionBF(rating ~ ., data = attitude)
length(bf)
## [1] 63

The object bf now contains \(2^p-1\), or 63, model comparisons. Large numbers of comparisons can get unweildy, so we can use the functions built into R to manipulate the Bayes factor object.

## Choose a specific model
bf["privileges + learning + raises + critical + advance"]
## Bayes factor analysis
## --------------
## [1] privileges + learning + raises + critical + advance : 51 ±0%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS
## Best 6 models
head(bf, n=6)
## Bayes factor analysis
## --------------
## [1] complaints                      : 417939 ±0.01%
## [2] complaints + learning           : 207272 ±0%
## [3] complaints + learning + advance : 88042  ±0%
## [4] complaints + raises             : 77499  ±0%
## [5] complaints + privileges         : 75015  ±0%
## [6] complaints + advance            : 72760  ±0%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS
## Worst 4 models
tail(bf, n=4)
## Bayes factor analysis
## --------------
## [1] privileges + critical + advance : 0.645 ±0%
## [2] critical                        : 0.449 ±0%
## [3] advance                         : 0.447 ±0%
## [4] critical + advance              : 0.239 ±0.01%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS
## which model index is the best?
which.max(bf)
## complaints 
##          1
## Compare the 5 best models to the best
bf2 = head(bf) / max(bf)
bf2
## Bayes factor analysis
## --------------
## [1] complaints                      : 1     ±0%
## [2] complaints + learning           : 0.496 ±0.01%
## [3] complaints + learning + advance : 0.211 ±0.01%
## [4] complaints + raises             : 0.185 ±0.01%
## [5] complaints + privileges         : 0.179 ±0.01%
## [6] complaints + advance            : 0.174 ±0.01%
## 
## Against denominator:
##   rating ~ complaints 
## ---
## Bayes factor type: BFlinearModel, JZS
plot(bf2)

plot of chunk regressSelect2

The model preferred by Bayes factor is the complaints-only model, followed by the complaints + learning model, as might have been expected by the classical analysis.

We might also be interested in comparing the most complex model to all models that can be formed by removing a single covariate, or, similarly, comparing the intercept-only model to all models that can be formed by added a covariate. These comparisons can be done by setting the whichModels argument to 'top' and 'bottom', respectively. For example, for testing against the most complex model:

bf = regressionBF(rating ~ ., data = attitude, whichModels = "top")
## The seventh model is the most complex
bf
## Bayes factor top-down analysis
## --------------
## When effect is omitted from complaints + privileges + learning + raises + critical + advance , BF is...
## [1] Omit advance    : 1.73   ±0%
## [2] Omit critical   : 3.23   ±0%
## [3] Omit raises     : 3.13   ±0%
## [4] Omit learning   : 0.727  ±0%
## [5] Omit privileges : 2.92   ±0%
## [6] Omit complaints : 0.0231 ±0%
## 
## Against denominator:
##   rating ~ complaints + privileges + learning + raises + critical + advance 
## ---
## Bayes factor type: BFlinearModel, JZS
plot(bf)

plot of chunk regresstop

With all other covariates in the model, the model containing complaints is preferred to the model not containing complaints by a factor of almost 80. The model containing learning, is only barely favored to the one without (a factor of about 1.3).

A similar “bottom-up” test can be done, by setting whichModels to 'bottom'.

bf = regressionBF(rating ~ ., data = attitude, whichModels = "bottom")
plot(bf)

plot of chunk regressbottom

The mismatch between the tests of all models, the “top-down” test, and the “bottom-up” test shows that the covariates share variance with one another. As always, whether these tests are interpretable or useful will depend on the data at hand.

In cases where it is desired to only compare a small number of models, the lmBF function can be used. Consider the case that we wish to compare the model containing only complaints to the model containing complaints and learning:

complaintsOnlyBf = lmBF(rating ~ complaints, data = attitude) 
complaintsLearningBf = lmBF(rating ~ complaints + learning, data = attitude) 
## Compare the two models
complaintsOnlyBf / complaintsLearningBf
## Bayes factor analysis
## --------------
## [1] complaints : 2.02 ±0.01%
## 
## Against denominator:
##   rating ~ complaints + learning 
## ---
## Bayes factor type: BFlinearModel, JZS

The complaints-only model is slightly preferred.

As with the other Bayes factors, it is possible to sample from the posterior distribution of a particular model under consideration. If we wanted to sample from the posterior distribution of the complaints + learning model, we could use the posterior function:

chains = posterior(complaintsLearningBf, iterations = 10000)
summary(chains)
## 
## Iterations = 1:10000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 10000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##              Mean     SD Naive SE Time-series SE
## mu         64.619  1.305  0.01305        0.01305
## complaints  0.609  0.127  0.00127        0.00133
## learning    0.201  0.139  0.00139        0.00139
## sig2       52.019 15.768  0.15768        0.19387
## g           1.972  7.349  0.07349        0.07611
## 
## 2. Quantiles for each variable:
## 
##               2.5%    25%    50%    75%  97.5%
## mu         62.0398 63.758 64.627 65.487 67.171
## complaints  0.3572  0.526  0.610  0.694  0.856
## learning   -0.0749  0.110  0.202  0.293  0.472
## sig2       29.6847 41.015 49.551 59.708 90.126
## g           0.1672  0.457  0.840  1.679  9.252

Compare these to the corresponding results from the classical regression analysis:

summary(lm(rating ~ complaints + learning, data = attitude))
## 
## Call:
## lm(formula = rating ~ complaints + learning, data = attitude)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -11.56  -5.73   0.67   6.53  10.36 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    9.871      7.061    1.40     0.17    
## complaints     0.644      0.118    5.43  9.6e-06 ***
## learning       0.211      0.134    1.57     0.13    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.82 on 27 degrees of freedom
## Multiple R-squared:  0.708,  Adjusted R-squared:  0.686 
## F-statistic: 32.7 on 2 and 27 DF,  p-value: 6.06e-08

The results are quite similar, apart from the intercept. This is due to the Bayesian model centering the covariates before analysis, so the mu parameter is the mean of \(y\) rather than the expected value of the response variable when all uncentered covariates are equal to 0.

General linear models: mixing continuous and categorical covariates

The anovaBF and regressionBF functions are convenience functions designed to test several hypotheses of a particular type at once. Neither function allows the mixing of continuous and categorical covariates. If it is desired to test a model including both kinds of covariates, lmBF function must be used. We will continue the ToothGrowth example, this time without converting dose to a categorical variable. Instead, we will model the logarithm of the dose.

data(ToothGrowth)

# model log2 of dose instead of dose directly
ToothGrowth$dose = log2(ToothGrowth$dose)

# Classical analysis for comparison
lmToothGrowth <- lm(len ~ supp + dose + supp:dose, data=ToothGrowth)
summary(lmToothGrowth)
## 
## Call:
## lm(formula = len ~ supp + dose + supp:dose, data = ToothGrowth)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -7.543 -2.492 -0.503  2.712  7.857 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   20.663      0.679   30.43  < 2e-16 ***
## suppVC        -3.700      0.960   -3.85   0.0003 ***
## dose           6.415      0.832    7.71  2.3e-10 ***
## suppVC:dose    2.665      1.176    2.27   0.0274 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.72 on 56 degrees of freedom
## Multiple R-squared:  0.776,  Adjusted R-squared:  0.764 
## F-statistic: 64.5 on 3 and 56 DF,  p-value: <2e-16

The classical analysis, presented for comparison, reveals extremely low p values for the effects of the supplement type and of the dose, but the interaction p value is more moderate, at about 0.03. We can use the lmBF function to compute the Bayes factors for all models of interest against the null model, which in this case is the intercept-only model. We then concatenate them into a single Bayes factor object for convenience.

full <- lmBF(len ~ supp + dose + supp:dose, data=ToothGrowth)
noInteraction <- lmBF(len ~ supp + dose, data=ToothGrowth)
onlyDose <- lmBF(len ~ dose, data=ToothGrowth)
onlySupp <- lmBF(len ~ supp, data=ToothGrowth)

allBFs <- c(full, noInteraction, onlyDose, onlySupp)
allBFs
## Bayes factor analysis
## --------------
## [1] supp + dose + supp:dose : 1.58e+15 ±1.08%
## [2] supp + dose             : 1.49e+15 ±1.33%
## [3] dose                    : 2.77e+13 ±0.01%
## [4] supp                    : 1.2      ±0.01%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The highest two Bayes factors belong to the full model and the model with no interaction. We can directly compute the Bayes factor for the simpler model with no interaction against the full model:

full / noInteraction
## Bayes factor analysis
## --------------
## [1] supp + dose + supp:dose : 1.06 ±1.72%
## 
## Against denominator:
##   len ~ supp + dose 
## ---
## Bayes factor type: BFlinearModel, JZS

The evidence here is clearly equivocal. We can also use the posterior function to compute parameter estimates.

chainsFull <- posterior(full, iterations = 10000)

# summary of the "interesting" parameters
summary(chainsFull[,1:7])
## 
## Iterations = 1:10000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 10000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##                      Mean    SD Naive SE Time-series SE
## mu                  18.81 0.500  0.00500        0.00500
## supp-OJ              1.68 0.501  0.00501        0.00546
## supp-VC             -1.68 0.501  0.00501        0.00546
## dose-dose            7.62 0.609  0.00609        0.00627
## supp:dose-OJ.&.dose -1.32 0.596  0.00596        0.00596
## supp:dose-VC.&.dose  1.32 0.596  0.00596        0.00596
## sig2                14.70 2.900  0.02900        0.03299
## 
## 2. Quantiles for each variable:
## 
##                       2.5%    25%   50%    75%  97.5%
## mu                  17.830 18.481 18.82 19.145 19.784
## supp-OJ              0.711  1.345  1.68  2.019  2.664
## supp-VC             -2.664 -2.019 -1.68 -1.345 -0.711
## dose-dose            6.428  7.209  7.61  8.029  8.816
## supp:dose-OJ.&.dose -2.503 -1.713 -1.32 -0.923 -0.117
## supp:dose-VC.&.dose  0.117  0.923  1.32  1.713  2.503
## sig2                10.113 12.627 14.35 16.376 21.180

The left panel of the figure below shows the data and linear fits. The green points represent guinea pigs given the orange juice supplement (OJ); red points represent guinea pigs given the vitamin C supplement. The solid lines show the posterior means from the Bayesian model; the dashed lines show the classical least-squares fit when applied to each supplement separately. The fits are quite close.

plot of chunk GLMplot

Because the no-interaction model fares so well against the interaction model, it may be instructive to examine the fit of the no-interaction model. We sample from the no-interaction model with the posterior function:

chainsNoInt <- posterior(noInteraction, iterations = 10000)

# summary of the "interesting" parameters
summary(chainsNoInt[,1:5])
## 
## Iterations = 1:10000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 10000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##            Mean    SD Naive SE Time-series SE
## mu        18.81 0.508  0.00508        0.00508
## supp-OJ    1.67 0.511  0.00511        0.00568
## supp-VC   -1.67 0.511  0.00511        0.00568
## dose-dose  7.66 0.631  0.00631        0.00631
## sig2      15.67 3.060  0.03060        0.03395
## 
## 2. Quantiles for each variable:
## 
##             2.5%   25%   50%   75%  97.5%
## mu        17.830 18.47 18.81 19.15 19.812
## supp-OJ    0.692  1.32  1.67  2.01  2.692
## supp-VC   -2.692 -2.01 -1.67 -1.32 -0.692
## dose-dose  6.445  7.23  7.65  8.07  8.921
## sig2      10.832 13.50 15.26 17.41 22.690

The right panel of the figure above shows the fit of the no-interaction model to the data. This model appears to account for the data satisfactorily. Though the moderate p value of the classical result might lead us to reject the no-interaction model, the Bayes factor and the visual fit appear to agree that the evidence is equivocal at best.

We have now analyzed the ToothGrowth data using both ANOVA (with dose as a factor) and regression (with dose as a continuous covariate). We may wish to compare the two approaches. We first create a column of the data with dose as a factor, then use anovaBF:

ToothGrowth$doseAsFactor <- factor(ToothGrowth$dose)
levels(ToothGrowth$doseAsFactor) <- c(.5,1,2)

aovBFs <- anovaBF(len ~ doseAsFactor + supp + doseAsFactor:supp, data = ToothGrowth)

Because all models we've considered are compared to the null intercept-only model, we can concatenate the aovBFs object with the Bayes factors we previously computed in this section:

allBFs <- c(aovBFs, full, noInteraction, onlyDose)

## eliminate the supp-only model, since it performs so badly
allBFs <- allBFs[-1]

## Compare to best model
allBFs / max(allBFs)
## Bayes factor analysis
## --------------
## [1] doseAsFactor                            : 0.00315 ±1.08%
## [2] supp + doseAsFactor                     : 0.182   ±2.51%
## [3] supp + doseAsFactor + supp:doseAsFactor : 0.488   ±2.02%
## [4] supp + dose + supp:dose                 : 1       ±0%
## [5] supp + dose                             : 0.939   ±1.72%
## [6] dose                                    : 0.0175  ±1.08%
## 
## Against denominator:
##   len ~ supp + dose + supp:dose 
## ---
## Bayes factor type: BFlinearModel, JZS

Two of the models score essentially equally well in terms of Bayes factors: supp + dose + supp:dose and supp + dose, suggesting that the interaction adds little. The Bayes factors where dose is treated as a factor are all worse than when dose is treated as a continuous covariate. This is likely due to a the added flexibility allowed by including more parameters. Plotting the Bayes factors shows how large the differences are:

plot of chunk GLMplot2

Linear correlation (0.9.12-4+)

Ly, Verhagen, and Wagenmakers (2015; link) present a Bayes factor test for linear correlation. The BayesFactor package allows the computing of the Bayes factor and sampling from the posterior of the Bayes factor. Note that the model and priors are somewhat different from those used in the linear regression models presented above; further discussion can be found in Ly et al.

We demonstrate the use of the correlationBF function using Fisher's iris data set built into R. See the help (?iris in R) for more details. We will focus on the correlation between Sepal.Length and Sepal.Width.

First, we create a scatterplot.

plot(Sepal.Width ~ Sepal.Length, data = iris)
abline(lm(Sepal.Width ~ Sepal.Length, data = iris), col = "red")

plot of chunk unnamed-chunk-24

There does not appear to be a substantial correlation between these two variables. We can compute a classical test of the correlation using R's cor.test function:

cor.test(y = iris$Sepal.Length, x = iris$Sepal.Width)
## 
##  Pearson's product-moment correlation
## 
## data:  iris$Sepal.Width and iris$Sepal.Length
## t = -1, df = 100, p-value = 0.2
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.2727  0.0435
## sample estimates:
##    cor 
## -0.118

The \(p\) value is nonsignificant at typical \(\alpha\) levels, and the point estimate is not terribly impressive at -0.12.

To compute the corresponding Bayes factor test, we use the correlationBF function (note the default prior scale).

bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
bf
## Bayes factor analysis
## --------------
## [1] Alt., r=0.333 : 0.509 ±0%
## 
## Against denominator:
##   Null, rho = 0 
## ---
## Bayes factor type: BFcorrelation, Jeffreys-beta*

As would be expected from the middling \(p\) value in the classical test, the Bayes factor test shows little evidence either way (about 2 in favor of the null).

If we'd like to estimate the correlation on the assumption that it is non-zero, we can sample from the posterior distribution using the posterior function.

samples = posterior(bf, iterations = 10000)
## Independent-candidate M-H acceptance rate: 96%

The important parameter is rho, the estimate of the true linear correlation.

summary(samples)
## 
## Iterations = 1:10000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 10000 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##        Mean     SD Naive SE Time-series SE
## rho  -0.111 0.0789 0.000789       0.000824
## zeta -0.112 0.0803 0.000803       0.000839
## 
## 2. Quantiles for each variable:
## 
##        2.5%    25%    50%     75%  97.5%
## rho  -0.260 -0.165 -0.111 -0.0576 0.0454
## zeta -0.266 -0.166 -0.112 -0.0577 0.0454

The posterior mean and credible interval for rho are very close to the point estimate and confidence interval obtained from cor.test.

We can also plot the full posterior distribution, if we like:

plot(samples[,"rho"])

plot of chunk unnamed-chunk-29

Tests of single proportions (0.9.9+)

The default test for a proportion assumes that all observations were independent with fixed probability \(\pi\). The rule for stopping can be fixed \(N\) (binomial sampling) or a fixed number of successes (negative binomial sampling); unlike a significance test, the Bayes factor does not depend on the stopping rule.

For the Bayes factor test of a single proportion, there are two hypotheses; the null hypothesis assumes that the probability \(\pi\) is a fixed, known value \(p\); under the alternative, the log-odds corresponding to \(\pi\), denoted \(\omega = \log(\pi/(1-\pi))\), has a logistic distribution centered on the log-odds corresponding to the null value \(p\) (denoted \(\omega_0 = \log(p/(1-p))\): \[ \omega \sim \mbox{logistic}(\mbox{mean}=\omega_0, \mbox{scale}=r) \] The default prior \(r\) scale is ½. The figure below shows the prior distribution assuming the null hypothesis \(p=0.5\), for the three named prior scale settings \(r\) (“medium”, “wide”, and “ultrawide”). The default is “medium”:

plot of chunk propprior

The following example is taken from ?binom.test, which cites Conover (1971).

Under (the assumption of) simple Mendelian inheritance, a cross between plants of two particular genotypes produces progeny ¼ of which are “dwarf” and ¾ of which are “giant”, respectively. In an experiment to determine if this assumption is reasonable, a cross results in progeny having 243 dwarf and 682 giant plants. If “giant” is taken as success, the null hypothesis is that \(p = ¾\) and the alternative that \(p \neq ¾\).

bf = proportionBF( 682, 682 + 243, p = 3/4)
1 / bf
## Bayes factor analysis
## --------------
## [1] Null, p=0.75 : 7.27 ±0.01%
## 
## Against denominator:
##   Alternative, p0 = 0.75, r = 0.5, p =/= p0 
## ---
## Bayes factor type: BFproportion, logistic

The Bayes factor favors the null hypothesis by a factor of about 7 (which is not surprising given that the observed proportion is 73.7%). In contrast, the best we can say about the classical result is that it is not statistically “significant”:

binom.test(682, 682 + 243, p = 3/4)
## 
##  Exact binomial test
## 
## data:  682 and 682 + 243
## number of successes = 700, number of trials = 900, p-value = 0.4
## alternative hypothesis: true probability of success is not equal to 0.75
## 95 percent confidence interval:
##  0.708 0.765
## sample estimates:
## probability of success 
##                  0.737

Using the posterior function, we can draw samples from the posterior distribution of the true log odds and true probability and plot the estimate of the posterior.

chains = posterior(bf, iterations = 10000)
## Independent-candidate M-H acceptance rate: 97%
plot(chains[,"p"], main = "Posterior of true probability\nof 'giant' progeny")

plot of chunk proppost

Contingency tables (0.9.9+)

The BayesFactor package implements versions of Gunel and Dickey's (1974) contingency table Bayes factor tests. Bayes factors for contingency tests are computed using the contingencyTableBF function. The necessary arguments are a matrix of cell frequencies and details about the sampling plan that produced the data.

Here, we provide an example analysis of Hraba and Grant's (1970) data, included as part of the BayesFactor package as the raceDolls data set. 71 white children and 89 black children from Lincoln, Nebraska were offered two dolls, one of whose “race” was the same as the child's and one that was different (either white or black). The children were then asked to select one of the dolls, with prompts such as “Give me the doll that is a nice doll.” 50 of the 71 white children (70%) selected the white doll, while 48 of the 89 black children (54%) selected the black doll. These data are shown in the table below:

White child Black child
Same-race doll 50 48
Different-race doll 21 41

We can perform a Bayes factor analysis using the contingencyTableBF function:

bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols")
bf
## Bayes factor analysis
## --------------
## [1] Non-indep. (a=1) : 1.81 ±0%
## 
## Against denominator:
##   Null, independence, a = 1 
## ---
## Bayes factor type: BFcontingencyTable, independent multinomial

Here we used sampleType="indepMulti" and fixedMargin="cols" to specify that the columns are assumed to be sampled as independent multinomials with their total fixed. See the help at ?contingencyTableBF for more details about possible sampling plans and the priors.

The Bayes factor in favor of the alternative that the factors are not independent is just shy of 2, which is not very much evidence against the null hypothesis. For comparison, consider the results classical chi-square test, with continuity correction:

chisq.test(raceDolls)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  raceDolls
## X-squared = 4, df = 1, p-value = 0.05

The classical test is just barely statistically significant.

We can also use the posterior function to estimate the difference in probabilities of selecing a doll of the same race between white and black children, assuming the non-independence alternative:

chains = posterior(bf, iterations = 10000)

For the independent multinomial sampling plan, the chains will contain the individual cell probabilities and the marginal column probabilities. We first need to compute the conditional probabilities from the results:

sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"]
sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"]

…and then plot the MCMC estimate of the difference:

plot(mcmc(sameRaceGivenWhite - sameRaceGivenBlack), main = "Increase in probability of child picking\nsame race doll (white - black)")

plot of chunk ctablechains

For more information, see ?contingencyTableBF.

Additional tips and tricks (0.9.4+)

In this section, tricks to help save time and memory are described. These tricks work with version BayesFactor version 0.9.4+, unless otherwise indicated.

Testing restrictions on linear models: generalTestBF

The convienience functions anovaBF and regressionBF are specifically designed for cetagorical and continuous covariates respectively, and have limitations that make those functions easier to use. For instance, anovaBF cannot incorporate continuous covariates, and treats random effects as untested nuissance parameters. The regressionBF on the other hand, being strictly for multiple regression, cannot incorporate categorical covariates. These functions exist for particular purposes, since guessing what model comparisons a user wants in general is difficult. The lmBF function, on the other hand, can handle any model but is limited to a single model comparison: the specified model against the intercept-only model.

The generalTestBF function allows the testing of groups of models (like anovaBF and regressionBF) but can handle any kind of model (like lmBF). Users specify a full model, and generalTestBF successively removes terms from that model and tests the resulting submodels. For example, using the puzzles data set described above:

data(puzzles)

puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID")

puzzleGenBF
## Bayes factor analysis
## --------------
## [1] shape                            : 0.611   ±0.01%
## [2] color                            : 0.611   ±0.01%
## [3] shape + color                    : 0.382   ±0.83%
## [4] shape + color + shape:color      : 0.134   ±2.18%
## [5] ID                               : 111517  ±0%
## [6] shape + ID                       : 318608  ±1.12%
## [7] color + ID                       : 312963  ±0.93%
## [8] shape + color + ID               : 1320210 ±2.27%
## [9] shape + color + shape:color + ID : 509046  ±7.21%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The resulting 9 models are the full model, plus the models that can be built by removing a single term at a time from the full model. By default, the generalTestBF function will not eliminate a term that is involved in a higher-order interaction (for instance, we will not remove shape unless the shape:color interaction is also removed); this behavior can be modified through the whichModels argument.

It is often the case that some terms are nuisance terms that we would like to always keep in the model. For instance, ID in the puzzles data set is a participant effect; we would not generally consider models without a participant effect to be plausible. We can use the neverExclude argument to the function to specify a set of search terms (technically, extended regular expressions) that, if matched, will specify that the term is always to be kept, and never excluded. To keep the ID term:

puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", neverExclude="ID")

puzzleGenBF
## Bayes factor analysis
## --------------
## [1] shape + ID                       : 318624  ±1.25%
## [2] color + ID                       : 315164  ±1.09%
## [3] shape + color + ID               : 1287049 ±2.7%
## [4] shape + color + shape:color + ID : 465008  ±1.99%
## [5] ID                               : 111517  ±0%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The function now only considers models that contain ID. In some cases — especially when variable names are short, or a term to be kept is part of an interaction term that can be eliminated — we need to be careful in specifying search terms using neverExclude. For instance, suppose we are interested in testing the ID:shape interaction

puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="ID")

puzzleGenBF
## Bayes factor analysis
## --------------
## [1] color + shape + ID + shape:ID               : 174461 ±2.88%
## [2] color + color:shape + shape + ID + shape:ID : 63932  ±2.28%
## [3] shape + ID + shape:ID                       : 28761  ±1.09%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The shape:ID interaction is never eliminated, because it matches the ID search term from neverExclude. Regular expressions are useful here. There are special characters representing the beginning and ending of a string (^ and $, respectively) that we can use to construct a regular expression that will match ID but not shape:ID:

puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="^ID$")

puzzleGenBF
## Bayes factor analysis
## --------------
## [1] shape + ID                                  : 310892  ±0.73%
## [2] color + ID                                  : 313151  ±0.98%
## [3] shape + color + ID                          : 1610764 ±19.8%
## [4] shape + color + shape:color + ID            : 454583  ±1.56%
## [5] shape + shape:ID + ID                       : 28852   ±0.95%
## [6] shape + color + shape:ID + ID               : 169313  ±1.25%
## [7] shape + color + shape:color + shape:ID + ID : 63199   ±2.38%
## [8] ID                                          : 111517  ±0%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The shape:ID interaction term is now eliminated in some models, because it does not match "^ID$". Multiple terms may be provided to neverExclude by providing a character vector; terms which match any element in the vector will always be included in model comparisons.

Saving time: Pre-culling Bayes factor objects

In cases where the default analysis produces many models to compare, the sampling approach to computing Bayes factors can be time consuming. The BayesFactor package identifies situations where sampling is not needed and thus saves time, but any model in which there is more than one categorical factor or a mix of categorical and continuous predictors will require sampling. When a default analysis produces many models that are not of interest, much of the time spent sampling may be wasted.

The main functions in the BayesFactor package include the noSample argument which, if true, will prevent sampling. If a Bayes factor can be computed without sampling, the package will compute it, returning NA for Bayes factors that would require sampling. Continuing using the puzzles dataset:

puzzleCullBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", noSample=TRUE,whichModels='all')

puzzleCullBF
## Bayes factor analysis
## --------------
## [1] shape                             : 0.611  ±0.01%
## [2] color                             : 0.611  ±0.01%
## [3] ID                                : 111517 ±0%
## [4] shape:color                       : 0.287  ±0.02%
## [5] shape + color                     : NA     ±NA%
## [6] shape + ID                        : NA     ±NA%
## [7] shape + shape:color               : NA     ±NA%
## [8] color + ID                        : NA     ±NA%
## [9] color + shape:color               : NA     ±NA%
## [10] ID + shape:color                 : NA     ±NA%
## [11] shape + color + ID               : NA     ±NA%
## [12] shape + color + shape:color      : NA     ±NA%
## [13] shape + ID + shape:color         : NA     ±NA%
## [14] color + ID + shape:color         : NA     ±NA%
## [15] shape + color + ID + shape:color : NA     ±NA%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

Here we use whichModels='all' for demonstration, in order to obtain more possible model comparisons. Notice that several of the Bayes factors were computable without sampling, and are reported. The others have missing values, because the Bayes factor would have required sampling to compute.

For now, we can separate the missing and non-missing Bayes factors in separate variables. This is made easy by the is.na method for BayesFactor objects:

missing = puzzleCullBF[ is.na(puzzleCullBF) ]
done = puzzleCullBF[ !is.na(puzzleCullBF) ]

missing
## Bayes factor analysis
## --------------
## [1] shape + color                     : NA ±NA%
## [2] shape + ID                        : NA ±NA%
## [3] shape + shape:color               : NA ±NA%
## [4] color + ID                        : NA ±NA%
## [5] color + shape:color               : NA ±NA%
## [6] ID + shape:color                  : NA ±NA%
## [7] shape + color + ID                : NA ±NA%
## [8] shape + color + shape:color       : NA ±NA%
## [9] shape + ID + shape:color          : NA ±NA%
## [10] color + ID + shape:color         : NA ±NA%
## [11] shape + color + ID + shape:color : NA ±NA%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

The variable missing now contains all models for which we lack a Bayes factor. At this point, we decide which of the Bayes factors we would like to compute. We can do this in any way we like: we could simple specify a subset, like missing[1:3] or we could do something more complicated. Here, we will include based on the model formula, using the R function grepl (?grepl). Suppose we only wanted models that did not include both shape and color. First, we obtain the names of the models in missing, and then test the names to see if they match our restriction with grepl. We can use the result to restrict the models to compare to only those of interest.

# get the names of the numerator models
missingModels = names(missing)$numerator

# search them to see if they contain "shape" or "color" - 
# results are logical vectors
containsShape = grepl("shape",missingModels)
containsColor = grepl("color",missingModels)

# anything that does not contain "shape" and "color"
containsOnlyOne = !(containsShape & containsColor)

# restrict missing to only those of interest
missingOfInterest = missing[containsOnlyOne]

missingOfInterest
## Bayes factor analysis
## --------------
## [1] shape + ID : NA ±NA%
## [2] color + ID : NA ±NA%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

We have restricted our set down to 2 items from 11 items. We can now use recompute to compute the missing Bayes factors:

# recompute the Bayes factors for the missing models of interest
sampledBayesFactors = recompute(missingOfInterest)

sampledBayesFactors
## Bayes factor analysis
## --------------
## [1] shape + ID : 317471 ±0.95%
## [2] color + ID : 316296 ±2.53%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS
# Add them together with our other Bayes factors, already computed:
completeBayesFactors = c(done, sampledBayesFactors)

completeBayesFactors
## Bayes factor analysis
## --------------
## [1] shape       : 0.611  ±0.01%
## [2] color       : 0.611  ±0.01%
## [3] ID          : 111517 ±0%
## [4] shape:color : 0.287  ±0.02%
## [5] shape + ID  : 317471 ±0.95%
## [6] color + ID  : 316296 ±2.53%
## 
## Against denominator:
##   Intercept only 
## ---
## Bayes factor type: BFlinearModel, JZS

Note that we're still left with one model that contains both shape and color, because it was computed without sampling. Assuming that we were not interested in any model containing both shape and color, however, we may have saved considerable time by not sampling to estimate their Bayes factors.

The noSample argument will also work with the sampling of posteriors. This is especially useful, for instance, if one would like to know what order the MCMC chain results will be output in before sampling.

Saving memory: Thinning and filtering MCMC chains

Modern computer systems, which have many gigabytes of RAM, contain sufficient memory to perform analyses of moderate scale using the BayesFactor package. Some systems — particularly older 32-bit systems — are limited in the amount of memory that can address. Posterior sampling can create output that is hundreds of megabytes in size. If a user conducts several of these analyses, R may not have sufficient memory to store the results.

Consider, for instance, an analysis with 100 participants, 100 items, and two fixed effects with 3 levels each. We include all main effects in the model, as well as all two-way interactions (excluding the participant by item interaction). This results in 619 parameters. Because each number stored in an MCMC chain uses 8 bytes of memory, each iterations of the chain uses 8*619=4952 bytes. If a user then requests a 100,000 iteration MCMC chain — a large, but not unreasonably, sized MCMC chain — the resulting object will use about 500Mb of memory. This is most of the memory available to the default installation of R on a 32-bit Windows system. Even if a computer has a lot of memory, many of the parameters may not be interesting to the analyst. The participant and item effects, for instance, may be nuisance variation. If a user is not interested in the estimates, it is a waste of memory to include them in the MCMC chain.

The BayesFactor package includes several methods for reducing the size of MCMC chains: column filtering and chain thinning. Column filtering ensures that certain parameters do not appear in the output; thinning reduces the length of MCMC chains by only keeping some of the iterations.

Column filtering

Consider again the puzzles data set. We begin by sampling from the MCMC chain of the model with the main effect of shape and color, along with their interaction, plus a participant effect:

data(puzzles)

# Get MCMC chains corresponding to "full" model
# We prevent sampling so we can see the parameter names
# iterations argument is necessary, but not used
fullModel = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3)

fullModel
## Object of class "mcmc"
## Markov Chain Monte Carlo (MCMC) output:
## Start = 1 
## End = 2 
## Thinning interval = 1 
##      mu shape-round shape-square color-color color-monochromatic ID-1 ID-2
## [1,] NA          NA           NA          NA                  NA   NA   NA
## [2,] NA          NA           NA          NA                  NA   NA   NA
##      ID-3 ID-4 ID-5 ID-6 ID-7 ID-8 ID-9 ID-10 ID-11 ID-12
## [1,]   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA
## [2,]   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA
##      shape:color-round.&.color shape:color-round.&.monochromatic
## [1,]                        NA                                NA
## [2,]                        NA                                NA
##      shape:color-square.&.color shape:color-square.&.monochromatic sig2
## [1,]                         NA                                 NA   NA
## [2,]                         NA                                 NA   NA
##      g_shape g_color g_ID g_shape:color
## [1,]      NA      NA   NA            NA
## [2,]      NA      NA   NA            NA
## ---
##  Model:
## Type: BFlinearModel, JZS
## RT ~ shape + color + shape:color + ID 
## Data types:
## ID :  fixed 
## shape :  fixed 
## color :  fixed

Notice that the participant effects, which are often regarded as nuisance, are included in the chain. These parameters double the size of the MCMC object; if we are not interested in the parameter values, we could eliminate them from the output for a considerable savings. This does not mean, however, that the parameters are not estimated; they will still be used by BayesFactor, but will not be reported.

To do this, we pass the columnFilter argument to the sampler, which surpresses output of any columns that arise from a term matched by an element in columnFilter.

fullModelFiltered = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3,columnFilter="ID")

fullModelFiltered
## Object of class "mcmc"
## Markov Chain Monte Carlo (MCMC) output:
## Start = 1 
## End = 2 
## Thinning interval = 1 
##      mu shape-round shape-square color-color color-monochromatic
## [1,] NA          NA           NA          NA                  NA
## [2,] NA          NA           NA          NA                  NA
##      shape:color-round.&.color shape:color-round.&.monochromatic
## [1,]                        NA                                NA
## [2,]                        NA                                NA
##      shape:color-square.&.color shape:color-square.&.monochromatic sig2
## [1,]                         NA                                 NA   NA
## [2,]                         NA                                 NA   NA
##      g_shape g_color g_ID g_shape:color
## [1,]      NA      NA   NA            NA
## [2,]      NA      NA   NA            NA
## ---
##  Model:
## Type: BFlinearModel, JZS
## RT ~ shape + color + shape:color + ID 
## Data types:
## ID :  fixed 
## shape :  fixed 
## color :  fixed

Like the neverExclude argument discussed above, the columnFilter argument is a character vector of extended regular expressions. If a model term is matched by a search term in columnFilter, then all columns for term are eliminated from the MCMC output. Remember that "ID" will match anything containing letters ID; it would, for instance, also eliminate terms GID and ID:shape, if they existed. See the manual section on generalTestBF for details about how to use specific regular expressions to avoid eliminating columns by accident.

Chain thinning

MCMC chains are characterized by the fact that successive iterations are correlated with one another: that is, they are not indepenedent samples from the posterior distribution. To see this, we sample from the posterior of the full model and plot the results:

# Sample 10000 iterations, eliminating ID columns
chains = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, posterior = TRUE, iterations=10000,columnFilter="ID")

The figure below shows the first 1000 iterations of the MCMC chain for a selected parameter (left), and the autocorrelation function [CRAN / Wikipedia] for the same parameter (right).

plot of chunk acfplot

The autocorrelation here is minimal, which will be the case in general for chains from the BayesFactor package. If we wanted to reduce it even further, we might consider thinning the chain: that is, keeping only every \(k\) iterations. Thinning throws away information, and is generally not necessary or recommended; however, if memory is at a premium, we might prefer storing nearly independent samples to storing somewhat dependent samples.

The autocorrelation plot shows that the autocorrelation is reduced to 0 after 2 iterations. To get nearly independent samples, then, we could thin to every \(k=2\) iterations using the thin argument:

chainsThinned = recompute(chains, iterations=20000, thin=2)

# check size of MCMC chain
dim(chainsThinned)
## [1] 10000    26

Notice that we are left with 10,000 iterations, instead of the 20,000 we sampled, because half were thinned. The figure below shows the resulting MCMC chain and autocorrelation functions. The MCMC chain does not visually look very different, because the autocorrelation was minimal in the first place. However, the autocorrelation function no longer shows autocorrelation from one iteration to the next, implying that we have obtained 10,000 nearly independent samples.

plot of chunk acfplot2

Fine-tuning of prior scales (0.9.12-2+)

Previous to version 0.9.12-2, it was only possible to change the priors on a per-effect-type basis; ie, fixed effects all had the same prior scale, random effects had a different prior scale, and slopes had third prior scale. As of 0.9.12-2, it is possible to change the prior on a per-effect basis for fixed and random effects (slopes still share a common prior, due to the use of the Liang et al. hyper-g priors for the slopes). This is accomplished via the rscaleEffects argument to lmBF, anovaBF, and generalTestBF.

The rscaleEffects argument is a named vector. The names correspond to the effect you'd for which you'd like to set the prior, and the value is the prior scale value. Any settings in rscaleEffects will override the settings in rscaleFixed and rscaleRandom; if no settings are found in rscaleEffects, then the settings in rscaleFixed and rscaleRandom are used.

We can demonstrate using the puzzles data set. Suppose we prefer a prior on the color main effect of \(r=1\), a prior twice as wide as the default in rscaleFixed, \(r=.5\). We set the prior scale for color using the rscaleEffects argument:

newprior.bf = anovaBF(RT ~ shape + color + shape:color + ID, data = puzzles,
                           whichRandom = "ID",rscaleEffects = c( color = 1 ))

newprior.bf
## Bayes factor analysis
## --------------
## [1] shape + ID                       : 2.8  ±0.75%
## [2] color + ID                       : 2.14 ±1.74%
## [3] shape + color + ID               : 8.97 ±1.66%
## [4] shape + color + shape:color + ID : 3.36 ±2.18%
## 
## Against denominator:
##   RT ~ ID 
## ---
## Bayes factor type: BFlinearModel, JZS

The other fixed effects, shape and shape:color, retain the prior scale of \(r=.5\) from rscaleFixed. Compare these Bayes factors to the ones with in the mixed modeling section above.

References

Conover, W. J. (1971), Practical nonparametric statistics. New York: John Wiley & Sons. Pages 97–104.

Gunel, E. and Dickey, J. (1974) Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557. (JSTOR)

Hraba, J. and Grant, G. (1970). Black is Beautiful: A reexamination of racial preference and identification. Journal of Personality and Social Psychology, 16, 398-402. psychnet.apa.org

Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 (Publisher)

Morey, R. D. and Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, pp. 406-419 (Publisher)

Morey, R. D. and Rouder, J. N. and Pratte, M. S. and Speckman, P. L. (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. Journal of Mathematical Psychology, 55, pp. 368-378 (Publisher)

Rouder, J. N. and Morey, R. D. (2013) Default Bayes Factors for Model Selection in Regression, Multivariate Behavioral Research, 47, pp. 877-903 (Publisher)

Rouder, J. N. and Morey, R. D. and Speckman, P. L. and Province, J. M. (2012), Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology, 56, pp. 356–374 (Publisher)

Rouder, J. N. and Speckman, P. L. and Sun, D. and Morey, R. D. and Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin and Review, 16, pp. 225-237 (Publisher)

Rouder, J. N. and Morey, R. D. (2011). A Bayes Factor Meta-Analysis of Bem's ESP Claim. Psychonomic Bulletin & Review 18, pp. 682-689 (Publisher)

Ly, A., Verhagen, A. J. & Wagenmakers, E.-J. (2015). Harold Jeffreys's Default Bayes Factor Hypothesis Tests: Explanation, Extension, and Application in Psychology. Journal of Mathematical Psychology (Publisher)


Social media icons by Lokas Software.

This document was compiled with version 0.9.12-4.2 of BayesFactor (R version 3.5.0 (2018-04-23) on x86_64-apple-darwin15.6.0).

BayesFactor/inst/doc/odds_probs.Rmd0000644000176200001440000001145213274042462017007 0ustar liggesusers Fork me on GitHub ![BayesFactor logo](extra/logo.png) ------ Odds and probabilities using BayesFactor =============================== Richard D. Morey -----------------
BayesFactor on facebook Find us on facebook
BayesFactor blog Follow the BayesFactor blog
Share via
share on facebook tweet BayesFactor submit to reddit submit to google plus share by email ---- ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) options(digits=3) require(graphics) set.seed(2) ``` ```{r message=FALSE,results='hide',echo=FALSE} library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ``` The Bayes factor is only one part of Bayesian model comparison. The Bayes factor represents the relative evidence between two models -- that is, the change in the model odds due to the data -- but the odds are what are being changed. For any two models ${\cal M}_0$ and ${\cal M}_1$ and data $y$, \[ \frac{P({\cal M}_1\mid y)}{P({\cal M}_0\mid y)} = \frac{P(y \mid {\cal M}_1)}{P(y\mid{\cal M}_0)} \times\frac{P({\cal M}_1)}{P({\cal M}_0)}; \] that is, the posterior odds are equal to the Bayes factor times the prior odds. Further, these odds can be converted to probabilities, if we assume that all the models sum to known probability. ### Prior odds with BayesFactor ```{r} data(puzzles) bf = anovaBF(RT ~ shape*color + ID, whichRandom = "ID", data = puzzles) bf ``` With the addition of `BFodds` objects, we can compute prior and posterior odds. A prior odds object can be created from the structure of an existing BayesFactor object: ```{r} prior.odds = newPriorOdds(bf, type = "equal") prior.odds ``` For now, the only type of prior odds is "equal". However, we can change the prior odds to whatever we like with the `priorOdds` function: ```{r} priorOdds(prior.odds) <- c(4,3,2,1) prior.odds ``` ### Posterior odds with BayesFactor We can multiply the prior odds by the Bayes factor to obtain posterior odds: ```{r} post.odds = prior.odds * bf post.odds ``` ### Prior/posterior probabilities with BayesFactor Odds objects can be converted to probabilities: ```{r} post.prob = as.BFprobability(post.odds) post.prob ``` By default the probabilities sum to 1, but we can change this by renormalizing. Note that this normalizing constant is arbitrary, but it can be helpful to set it to specific values. ```{r} post.prob / .5 ``` In addition, we can select subsets of the probabilities, and the normalizing constant is adjusted to the sum of the model probabilities: ```{r} post.prob[1:3] ``` ...which can, in turn, be renormalized: ```{r} post.prob[1:3] / 1 ``` In the future, the ability to filter these objects will be added, as well as model averaging based on posterior probabilities and samples. -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/inst/doc/odds_probs.R0000644000176200001440000000255513277750603016500 0ustar liggesusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) options(digits=3) require(graphics) set.seed(2) ## ----message=FALSE,results='hide',echo=FALSE----------------------------- library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ## ------------------------------------------------------------------------ data(puzzles) bf = anovaBF(RT ~ shape*color + ID, whichRandom = "ID", data = puzzles) bf ## ------------------------------------------------------------------------ prior.odds = newPriorOdds(bf, type = "equal") prior.odds ## ------------------------------------------------------------------------ priorOdds(prior.odds) <- c(4,3,2,1) prior.odds ## ------------------------------------------------------------------------ post.odds = prior.odds * bf post.odds ## ------------------------------------------------------------------------ post.prob = as.BFprobability(post.odds) post.prob ## ------------------------------------------------------------------------ post.prob / .5 ## ------------------------------------------------------------------------ post.prob[1:3] ## ------------------------------------------------------------------------ post.prob[1:3] / 1 BayesFactor/inst/include/0000755000176200001440000000000013277750604015067 5ustar liggesusersBayesFactor/inst/include/BayesFactor_RcppExports.h0000644000176200001440000000464013274042462022010 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_BayesFactor_RCPPEXPORTS_H_GEN_ #define RCPP_BayesFactor_RCPPEXPORTS_H_GEN_ #include #include namespace BayesFactor { using namespace Rcpp; namespace { void validateSignature(const char* sig) { Rcpp::Function require = Rcpp::Environment::base_env()["require"]; require("BayesFactor", Rcpp::Named("quietly") = true); typedef int(*Ptr_validate)(const char*); static Ptr_validate p_validate = (Ptr_validate) R_GetCCallable("BayesFactor", "_BayesFactor_RcppExport_validate"); if (!p_validate(sig)) { throw Rcpp::function_not_exported( "C++ function with signature '" + std::string(sig) + "' not found in BayesFactor"); } } } inline NumericVector genhypergeo_series_pos(NumericVector U, NumericVector L, NumericVector z, const double tol, const int maxiter, const bool check_mod, const bool check_conds, const bool polynomial) { typedef SEXP(*Ptr_genhypergeo_series_pos)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); static Ptr_genhypergeo_series_pos p_genhypergeo_series_pos = NULL; if (p_genhypergeo_series_pos == NULL) { validateSignature("NumericVector(*genhypergeo_series_pos)(NumericVector,NumericVector,NumericVector,const double,const int,const bool,const bool,const bool)"); p_genhypergeo_series_pos = (Ptr_genhypergeo_series_pos)R_GetCCallable("BayesFactor", "_BayesFactor_genhypergeo_series_pos"); } RObject rcpp_result_gen; { RNGScope RCPP_rngScope_gen; rcpp_result_gen = p_genhypergeo_series_pos(Shield(Rcpp::wrap(U)), Shield(Rcpp::wrap(L)), Shield(Rcpp::wrap(z)), Shield(Rcpp::wrap(tol)), Shield(Rcpp::wrap(maxiter)), Shield(Rcpp::wrap(check_mod)), Shield(Rcpp::wrap(check_conds)), Shield(Rcpp::wrap(polynomial))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); } } #endif // RCPP_BayesFactor_RCPPEXPORTS_H_GEN_ BayesFactor/inst/include/BayesFactor.h0000644000176200001440000000041213036477055017436 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_BayesFactor_H_GEN_ #define RCPP_BayesFactor_H_GEN_ #include "BayesFactor_RcppExports.h" #endif // RCPP_BayesFactor_H_GEN_ BayesFactor/tests/0000755000176200001440000000000012452540640013620 5ustar liggesusersBayesFactor/tests/run-all.R0000644000176200001440000000010312452540640015307 0ustar liggesuserslibrary(testthat) library(BayesFactor) test_package("BayesFactor")BayesFactor/src/0000755000176200001440000000000013277750604013256 5ustar liggesusersBayesFactor/src/linearRegGibbsRcpp.cpp0000644000176200001440000000644413277750604017476 0ustar liggesusers#include "progress.h" #include "bfcommon.h" #include #include using namespace Rcpp; using Eigen::MatrixXd; using Eigen::Map; using Eigen::Lower; // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::export]] NumericMatrix GibbsLinearRegRcpp(const int iterations, const NumericVector y, const NumericMatrix X, const double r, const double sig2start, const bool nullModel, const int progress, const Function callback, const double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); const Map Xm(as >(X)); const int P = X.ncol(); const int N = y.size(); int i = 0, j = 0; NumericMatrix XcolMeans(1, P); MatrixXd Sigma(MatrixXd(P, P).setZero()); MatrixXd beta(MatrixXd(P, 1).setZero()); MatrixXd XtCny(MatrixXd(P, 1).setZero()); MatrixXd mu(MatrixXd(P, 1).setZero()); MatrixXd Cny(MatrixXd(N, 1).setZero()); MatrixXd yResid(MatrixXd(N, 1).setZero()); MatrixXd CnX(MatrixXd(N, P).setZero()); const MatrixXd XtXoN(MatrixXd(P, P).setZero(). selfadjointView().rankUpdate(Xm.adjoint(), 1 / (1.0*N) )); double g=1, sig2 = sig2start, SSq=0, meanY = mean(y), SSq_temp = 0; const double sumy2 = sum(y * y); for( i = 0 ; i < X.ncol() ; i++ ){ XcolMeans(0, i) = sum( X( _, i) ) / ( N * 1.0 ); } // compute centered values for( i = 0 ; i < N ; i++ ){ Cny(i) = y(i) - meanY; for( j = 0 ; j < P ; j++){ CnX(i, j) = X(i, j) - XcolMeans(0, j); } } XtCny = Xm.transpose() * Cny; const MatrixXd XtCnX(MatrixXd(P, P).setZero(). selfadjointView().rankUpdate(CnX.adjoint())); // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, P + 2); // Start Gibbs sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // Sample beta if(!nullModel){ Sigma = ( XtCnX + ( XtXoN / g ) ) / sig2; Sigma = Sigma.llt().solve(MatrixXd::Identity(P,P)); mu = ( Sigma / sig2 ) * XtCny; beta = random_multivariate_normal( mu, Sigma ); SSq_temp = ( beta.transpose() * XtXoN * beta )(0,0); SSq = SSq_temp / g; yResid = Cny - Xm * beta; SSq += ( yResid.transpose() * yResid )(0,0); }else{ SSq_temp = 0; SSq = sumy2; } // Sample sig2 sig2 = 1 / Rf_rgamma( ( N + P*(!nullModel) ) / 2, 2 / SSq ); // Sample g if(nullModel){ g = NA_REAL; }else{ SSq = SSq_temp / sig2 + r*r; g = 1/Rf_rgamma( 0.5 * ( P*(!nullModel) + 1 ) , 2 / SSq ); } // Copy samples to chain for( j = 0 ; j < P ; j++ ) chains(i, j) = beta(j, 0); chains(i, P) = sig2; chains(i, P + 1) = g; } return chains; } BayesFactor/src/bfcommon.h0000644000176200001440000000561113277750604015232 0ustar liggesusers#ifndef BFCOMMON_HPP_ #define BFCOMMON_HPP_ #include using namespace Rcpp; int RcppCallback(time_t *last, Rcpp::Function cb, double progress, double callbackInterval); double dinvgamma1_Rcpp(const double x, const double a, const double b); double ddinvgamma1_Rcpp(const double x, const double a, const double b); double d2dinvgamma1_Rcpp(const double x, const double a, const double b); double log_determinant_pos_def(Eigen::MatrixXd A); List jzs_log_marginal_posterior_logg(const NumericVector q, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX0, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const int incCont, const bool limit, const NumericVector limits, const int which); double jzs_mc_marg_like(const NumericVector g, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont); double jzs_mc_marg_like2(const NumericVector g, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix XtCny, const IntegerVector gMap, const NumericMatrix priorX, const double logDetPriorX, const int incCont); double jzs_importance_marg_like(const NumericVector q, const NumericVector mu, const NumericVector sig, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont); double jzs_importance_marg_like2(const NumericVector q, const NumericVector mu, const NumericVector sig, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix XtCny, const NumericVector rscale, const IntegerVector gMap, const NumericMatrix priorX, const double logDetPriorX, const int incCont); // sign function // from http://stackoverflow.com/questions/1903954/is-there-a-standard-sign-function-signum-sgn-in-c-c template int sgn(T val) { return (T(0) < val) - (val < T(0)); } double log1pExp(double x); double logExpXplusExpY( const double x, const double y ); double logExpXminusExpY( const double x, const double y ); Eigen::MatrixXd random_multivariate_normal(const Eigen::MatrixXd mu, const Eigen::MatrixXd Sigma); NumericVector genhypergeo_series_pos( NumericVector U, NumericVector L, NumericVector z, const double tol, const int maxiter, const bool check_mod, const bool check_conds, const bool polynomial); #endif //BFCOMMON_HPP_ BayesFactor/src/logSummaryStats.cpp0000644000176200001440000000262413277750604017144 0ustar liggesusers#include "bfcommon.h" #include "logRepresentedReal.h" using namespace Rcpp; // Welford's method // http://www.johndcook.com/blog/standard_deviation/ // [[Rcpp::export]] List logSummaryStats(NumericVector x) { int N = x.size(), i=0; bool seenNA = false; NumericVector retM(1, NA_REAL); NumericVector retS(1, NA_REAL); NumericVector retCumu( N == 0 ? 1 : N, NA_REAL); List ret; ret = List::create(Rcpp::Named("logMean") = retM, Rcpp::Named("logVar") = retS, Rcpp::Named("cumLogMean") = retCumu); // Ensure that for N=0 and N=1 we return something meaningful if( N == 0 ) return ret; logRepresentedReal oldM; logRepresentedReal M = logRepresentedReal(x[0], 1); logRepresentedReal S = logRepresentedReal(0, 0); logRepresentedReal thisX; seenNA = R_IsNA( x[0] ); retM(0) = x[0]; retS(0) = R_NegInf; retCumu(0) = x[0]; if(N == 1) return ret; for( i = 1; i < N; i++ ){ oldM = M; seenNA = R_IsNA( x[i] ); if(seenNA) break; thisX = logRepresentedReal( x[i], 1); M = oldM + ( thisX - oldM) / double(i + 1); S = S + ( thisX - oldM ) * ( thisX - M ); retCumu(i) = M.modulo(); } retM(0) = seenNA ? NA_REAL : M.modulo(); retS(0) = seenNA ? NA_REAL : S.modulo() - log(N - 1.0); return ret; } BayesFactor/src/logRepresentedReal.cpp0000644000176200001440000001016013277750604017546 0ustar liggesusers#include "bfcommon.h" #include "logRepresentedReal.h" using namespace Rcpp; // double sum overload logRepresentedReal logRepresentedReal::operator+(const double right) const { if( right == 0.0) return *this; return *this + logRepresentedReal( std::log(std::abs(right)), sgn(right) ); } // double minus overload logRepresentedReal logRepresentedReal::operator-(const double right) const { if( right == 0.0) return *this; return *this + logRepresentedReal( std::log(std::abs(right)), -sgn(right) ); } // Sum overload logRepresentedReal logRepresentedReal::operator+(const logRepresentedReal& right) const { logRepresentedReal result; if( isZero() ) return right; if( right.isZero() ) return *this; double x1m = modulo(); int x1s = sign(); double x2m = right.modulo(); int x2s = right.sign(); if( x1s == -1 && x2s == -1 ){ result = this->negative() + right.negative(); return result.negative(); } if( x1s == 1 && x2s == -1 ){ return *this - right.negative(); } if( x1s == -1 && x2s == 1 ){ return right - this->negative(); } // Both are positive result = logRepresentedReal( logExpXplusExpY( x1m, x2m ), 1 ); return result; } logRepresentedReal logRepresentedReal::operator-(const logRepresentedReal& right) const { logRepresentedReal result; if( isZero() ) return right.negative(); if( right.isZero() ) return *this; double x1m = modulo(); int x1s = sign(); double x2m = right.modulo(); int x2s = right.sign(); if( x1s == -1 && x2s == -1 ){ return this->abs().negative() + right.abs(); } if( x1s == 1 && x2s == -1 ){ return *this + right.negative(); } if( x1s == -1 && x2s == 1 ){ result = right + this->negative(); return result.negative(); } // Both are positive if( *this > right ){ return logRepresentedReal( logExpXminusExpY(x1m, x2m), 1 ); }else if( *this < right ){ return logRepresentedReal( logExpXminusExpY(x2m, x1m) , -1); } // They must be equal; return 0. return logRepresentedReal( 0, 0 ); } logRepresentedReal logRepresentedReal::operator*(const logRepresentedReal& right) const { return logRepresentedReal( this->modulo() + right.modulo(), this->sign() * right.sign() ); } logRepresentedReal logRepresentedReal::operator/(const logRepresentedReal& right) const { return logRepresentedReal( this->modulo() - right.modulo(), this->sign() * right.sign() ); } logRepresentedReal logRepresentedReal::operator*(const double right) const { return logRepresentedReal( this->modulo() + std::log(std::abs(right)), this->sign() * sgn(right) ); } logRepresentedReal logRepresentedReal::operator/(const double right) const { return logRepresentedReal( this->modulo() - std::log(std::abs(right)), this->sign() * sgn(right) ); } bool logRepresentedReal::operator==(const logRepresentedReal& right) const { // Both are zero if( this->isZero() && right.isZero() ) { return true; } // One is zero (but not both) if( this->isZero() || right.isZero() ) { return false; } // Signs are different if( this->sign() != right.sign() ) { return false; } // Modulos are different if( this->modulo() != right.modulo() ) { return false; } return true; } bool logRepresentedReal::operator>(const logRepresentedReal& right) const { // Both are equal if( *this == right ) { return false; } // signs are different if( this->sign() > right.sign() ) { return true; } if( this->sign() < right.sign() ) { return false; } // Both are positive if( this->sign() > 0){ return this->modulo() > right.modulo(); } // If we're here, both must be negative. return this->modulo() < right.modulo(); } bool logRepresentedReal::operator<(const logRepresentedReal& right) const { return right > *this; } bool logRepresentedReal::operator<=(const logRepresentedReal& right) const { return !(*this > right); } bool logRepresentedReal::operator>=(const logRepresentedReal& right) const { return !(*this < right); } BayesFactor/src/logUtility.cpp0000644000176200001440000000172113277750604016130 0ustar liggesusers#include "bfcommon.h" using namespace Rcpp; // return log(1 + exp(x)), preventing cancellation and overflow */ // From http://www.codeproject.com/KB/recipes/avoiding_overflow.aspx // [[Rcpp::export]] double log1pExp(double x) { const double LOG_DBL_EPSILON = log(DBL_EPSILON); const double LOG_ONE_QUARTER = log(0.25); if (x > -LOG_DBL_EPSILON) { // log(exp(x) + 1) == x to machine precision return x; } else if (x > LOG_ONE_QUARTER) { return log( 1.0 + exp(x) ); } else { // Prevent loss of precision that would result from adding small argument to 1. return log1p( exp(x) ); } } // Compute log(exp(x) + exp(y)) // [[Rcpp::export]] double logExpXplusExpY( const double x, const double y ) { return x + log1pExp( y - x ); } // Compute log(exp(x) - exp(y)) // [[Rcpp::export]] double logExpXminusExpY( const double x, const double y ) { return x + Rf_pexp( x - y, 1, true, true ); } BayesFactor/src/corr.cpp0000644000176200001440000001166713277750604014742 0ustar liggesusers#include #include "bfcommon.h" #include "progress.h" using namespace Rcpp; double aFunc(const double rho, const int n, const double r, const bool hg_checkmod, const int hg_iter) { NumericVector U(2, (n-1)*0.5); NumericVector L(1, .5); NumericVector z(1, r * r * rho * rho); double hyper_term = genhypergeo_series_pos(U, L, z, hg_checkmod, hg_iter, 0, 0, 0)[0]; return ( ( n - 1 ) * 0.5 ) * log1p( -(rho*rho) ) + hyper_term; } double bFunc(const double rho, int const n, const double r, const bool hg_checkmod, const int hg_iter) { NumericVector U(2, n*0.5); NumericVector L(1, 1.5); NumericVector z(1, r * r * rho * rho); double hyper_term = genhypergeo_series_pos(U, L, z, hg_checkmod, hg_iter, 0, 0, 0)[0]; double log_term = 2 * ( lgamma(n*0.5) - lgamma((n-1)*0.5) ) + (n-1) * 0.5 * log1p( -(rho*rho) ) + log(2.0); return r * rho * exp( log_term + hyper_term ); } // [[Rcpp::export]] double hFunc(const double rho, const int n, const double r, const bool hg_checkmod, const int hg_iter) { return log( exp( aFunc(rho, n, r, hg_checkmod, hg_iter) ) + bFunc(rho, n, r, hg_checkmod, hg_iter) ); } // [[Rcpp::export]] double jeffreys_approx_corr(const double rho, const int n, const double r) { return 0.5*(n - 1) * log1p( -(rho*rho) ) - (n - 1 - 0.5)*log1p( -(rho*r) ); } double corrtest_like_Rcpp(double zeta, NumericVector r, NumericVector n, double a_prior, double b_prior, bool approx, const bool hg_checkmod, const int hg_iter) { int i; double rho = tanh( zeta ); double logdens = Rf_dbeta( (rho+1.0)/2.0, a_prior, b_prior, 1) + log1p( -(rho*rho) ); for( i = 0; i < r.size() ; i++ ){ if( approx ){ logdens += jeffreys_approx_corr( rho, n[i], r[i] ); }else{ logdens += hFunc( rho, n[i], r[i], hg_checkmod, hg_iter ); } } return logdens; } // [[Rcpp::export]] NumericMatrix metropCorrRcpp_jeffreys(NumericVector r, NumericVector n, double a_prior, double b_prior, bool approx, int iterations, bool doInterval, NumericVector intervalz, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); int i = 0; double Ubounds[2]; NumericVector fish_z = 0.5*log( ( 1 + r ) / ( 1 - r ) ); double candidate, z, trans_zeta; bool inInterval, valid_zeta = true; // For intervals if( doInterval){ if( intervalz.size() == 0){ doInterval = false; }else if( intervalz.size() != 2 ){ Rcpp::stop("Incorrect number of interval points specified."); } } // starting values double fish_z0 = sum ( fish_z * ( n - 2 ) ) / sum( n - 2 ); double fish_sd = sqrt( 1 / sum( n - 2 ) ); double zeta = fish_z0; // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, 2); if(nullModel){ std::fill(chains.begin(), chains.end(), 0); return chains; } if(doInterval){ Ubounds[0] = Rf_pnorm5( intervalz[0], fish_z0, fish_sd, 1, 0 ); Ubounds[1] = Rf_pnorm5( intervalz[1], fish_z0, fish_sd, 1, 0 ); } // Start sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample delta if(doInterval){ if(intervalCompl){ candidate = Rf_runif(0, Ubounds[0] + 1 - Ubounds[1]); if( candidate > Ubounds[0]) candidate = candidate - Ubounds[0] + Ubounds[1]; }else{ candidate = Rf_runif(Ubounds[0], Ubounds[1]); } candidate = Rf_qnorm5(candidate, fish_z0, fish_sd, 1, 0 ); }else{ candidate = Rf_rnorm( fish_z0, fish_sd ); } // Metropolis-Hastings step z = corrtest_like_Rcpp(candidate, r, n, a_prior, b_prior, approx, 0, 2000) - corrtest_like_Rcpp(zeta, r, n, a_prior, b_prior, approx, 0, 2000) + Rf_dnorm4(zeta, fish_z0, fish_sd, 1) - Rf_dnorm4(candidate, fish_z0, fish_sd, 1); if(doInterval){ trans_zeta = Rf_pnorm5(zeta, fish_z0, fish_sd, 1, 0 ); inInterval = ( Ubounds[0] > trans_zeta ) && ( Ubounds[1] < trans_zeta ); if( (inInterval && intervalCompl) || (!inInterval && !intervalCompl) ) valid_zeta = false; } if( ( Rf_rexp(1) > -z ) || !valid_zeta ){ zeta = candidate; } // copy to chains chains(i, 1) = zeta; chains(i, 0) = tanh(zeta); } // end sampler colnames(chains) = CharacterVector::create("rho", "zeta"); return chains; } BayesFactor/src/interrupts.h0000644000176200001440000000142713277750604015652 0ustar liggesusers/* * Check for user interruption in C++ code interrupting execution of the current code * * This code has been written by Simon Urbanek * I took it from the R-devel mailing list * in the thread "[Rd] Interrupting C++ code execution" * The mail is dated: 25 april 2011 * * It allows to check for user interruption without * leaving the c++ function that calls it. * * Potential drawbacks according to its author: * The problem with it is that it will eat all errors, even if they were not yours * (e.g. those resulting from events triggered the event loop), so I would not recommend it for general use. * * Taken from CRAN package RcppProgress 0.1 */ #ifndef _RcppProgress_INTERRUPTS_HPP #define _RcppProgress_INTERRUPTS_HPP #include bool checkInterrupt(); #endif BayesFactor/src/progress.h0000644000176200001440000000476113277750604015303 0ustar liggesusers/* * progress.h * * A Front-end class for InterruptableProgressMonitor. * * Author: karl.forner@gmail.com * Small edits: richarddmorey@gmail.com * Taken from CRAN package RcppProgress 0.1 * */ #ifndef _RcppProgress_PROGRESS_HPP #define _RcppProgress_PROGRESS_HPP #include "interruptable_progress_monitor.h" class Progress { public: /** * Main constructor * * @param max the expected number of tasks to perform * @param display_progress whether to display a progress bar in the console */ Progress(unsigned long max, bool display_progress = true) { if ( _monitor_singleton != 0) { // something is wrong, two simultaneous Progress monitoring /*error("ERROR: there is already an InterruptableProgressMonitor instance defined");*/ } _monitor_singleton = new InterruptableProgressMonitor(max, display_progress); } ~Progress() { if ( monitor().is_display_on() && ! monitor().is_aborted() ) monitor().end_display(); delete _monitor_singleton; _monitor_singleton = 0; } public: // ==== USER INTERFACE ===== /** * increment the current progress. * * This method should preferably be used intead of update in a OpenMP context. * * Iff called by the master thread, it will also update the display if needed * * @param amount the number of newly performed tasks to report * * @return false iff the computation is aborted */ bool increment(unsigned long amount=1) { return monitor().increment(amount); } /** * set the current progress indicator * * Iff called by the master thread, it will also update the display if needed * * @param current the total number of performed tasks so far (by all threads) * * @return false iff the computation is aborted */ bool update(unsigned long current) { return monitor().update(current); } /** * return if the computation has been aborted. * N.B: do not perform any check by itselfd */ bool is_aborted() const { return monitor().is_aborted(); } /** * check that the no interruption has been requested and return the current status * * Iff called by the master thread, it will check for R-user level interruption. * * @return true iff the computation is aborted */ static bool check_abort() { return monitor().check_abort(); } public: // ==== OTHER PUBLIC INTERFACE ===== static InterruptableProgressMonitor& monitor() { return *_monitor_singleton; } private: // ===== INSTANCE VARIABLES static InterruptableProgressMonitor* _monitor_singleton; }; extern InterruptableProgressMonitor* Progress; #endif BayesFactor/src/progress.cpp0000644000176200001440000000044413277750604015630 0ustar liggesusers/* * progress.cpp * * A Front-end class for InterruptableProgressMonitor. * * Author: karl.forner@gmail.com * Small edits: richarddmorey@gmail.com * Taken from CRAN package RcppProgress 0.1 * */ #include "progress.h" InterruptableProgressMonitor* Progress::_monitor_singleton = 0; BayesFactor/src/interruptable_progress_monitor.h0000644000176200001440000001276113277750604022011 0ustar liggesusers/* * interruptable_progress_monitor.hpp * * A class that monitor the progress of computations: * - can display a progress bar * - can handle user (R user level) or programmatic abortion * - can be used in OpenMP loops * * Author: karl.forner@gmail.com * Small edits: richarddmorey@gmail.com * Taken from CRAN package RcppProgress 0.1 */ #ifndef _RcppProgress_INTERRUPTABLE_PROGRESS_MONITOR_HPP #define _RcppProgress_INTERRUPTABLE_PROGRESS_MONITOR_HPP #include "bfcommon.h" #include "interrupts.h" #ifdef _OPENMP #include #endif using namespace Rcpp; class InterruptableProgressMonitor { public: // ====== LIFECYCLE ===== /** * Main constructor * * @param max the expected number of tasks to perform * @param display_progress whether to display a progress bar in the console */ InterruptableProgressMonitor(unsigned long max = 1, bool display_progress = true) { reset(max, display_progress); display_progress_bar(); } ~InterruptableProgressMonitor() { } public: // ===== ACCESSORS/SETTERS ===== void set_display_status(bool on) { _display_progress = on; } bool is_display_on() const { return _display_progress; } unsigned long get_max() const { return _max; } bool is_aborted() const { return _abort; } public: // ===== PBLIC MAIN INTERFACE ===== /** * increment the current progress. * * Iff called by the master thread, it will also update the display if needed * * @param amount the number of newly performed tasks to report * * @return false iff the computation is aborted */ bool increment(unsigned long amount=1) { if ( is_aborted() ) return false; return is_master() ? update_master(_current + amount) : atomic_increment(amount); } /** * set the current progress indicator * * Iff called by the master thread, it will also update the display if needed * * @param current the total number of performed tasks so far (by all threads) * * @return false iff the computation is aborted */ bool update(unsigned long current) { if ( is_aborted() ) return false; return is_master() ? update_master(current) : atomic_update(current); } /** * check that the no interruption has been requested and return the current status * * Iff called by the master thread, it will check for R-user level interruption. * * @return true iff the computation is aborted */ bool check_abort() { if ( is_aborted() ) return true; if ( is_master() ) { check_user_interrupt_master(); update_display(); } return is_aborted(); } /** * request computation abortion */ void abort() { #pragma omp critical _abort = true; } /** * return true iff the thread is the master. * In case of non-OpenMP loop, always return true */ bool is_master() const { #ifdef _OPENMP return omp_get_thread_num() == 0; #else return true; #endif } public: // ===== methods for MASTER thread ===== /** * set the current progress indicator and update the progress bar display if needed. * * * @param current the total number of performed tasks * * @return false iff the computation is aborted */ bool update_master(unsigned long current) { // try to make it as fast as possible unsigned long last = _current; _current = current; if ( (current - last)*100 > _max ) update_display(); return ! is_aborted(); } void check_user_interrupt_master() { if ( !is_aborted() && checkInterrupt() ) { //REprintf("detected User interruption...\n"); abort(); } } public: // ===== methods for non-MASTER threads ===== bool atomic_increment(unsigned long amount=1) { #pragma omp atomic _current+=amount; return ! is_aborted(); } bool atomic_update(unsigned long current) { #pragma omp critical _current=current; return ! is_aborted(); } public: // ===== methods related to DISPLAY, should not be called directly ===== void update_display() { if ( !is_display_on() ) return; int nb_ticks = _compute_nb_ticks(_current) - _compute_nb_ticks(_last_displayed); if (nb_ticks > 0) { _last_displayed = _current; _display_ticks(nb_ticks); } if ( _current >= _max ) end_display(); } void end_display() { if ( !is_display_on() ) return; if ( ! is_aborted() ) { // compute the remaining ticks and display them int remaining = 50 - _compute_nb_ticks(_last_displayed); _display_ticks(remaining); } REprintf("|\n"); } void display_progress_bar() { if ( !is_display_on() ) return; REprintf("0% 10 20 30 40 50 60 70 80 90 100%\n"); REprintf("|----|----|----|----|----|----|----|----|----|----|\n"); } protected: // ==== other instance methods ===== int _compute_nb_ticks(unsigned long current) { return current * 50 / _max; } void _display_ticks(int nb) { for (int i = 0; i < nb; ++i) REprintf("*"); } /** * reset the monitor. * * Currently not really useful * * @param max the expected number of tasks to perform * @param display_progress whether to display a progress bar in the console * */ void reset(unsigned long max = 1, bool display_progress = true) { _max = max; if ( _max <= 0 ) _max = 1; _last_displayed = _current = 0; _display_progress = display_progress; _abort = false; } private: // ===== INSTANCE VARIABLES ==== unsigned long _max; // the nb of tasks to perform unsigned long _current; // the current nb of tasks performed unsigned long _last_displayed; // the nb of tasks last displayed bool _abort; // whether the process should abort bool _display_progress; // whether to display the progress bar }; #endif BayesFactor/src/jzs_marg_like.cpp0000644000176200001440000000746313277750604016614 0ustar liggesusers#include "bfcommon.h" #include using namespace Rcpp; using Eigen::MatrixXd; using Eigen::Map; // [[Rcpp::depends(RcppEigen)]] double jzs_mc_marg_like(const NumericVector g, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont) { double ans = 0, sumInvGammaDens = 0; const NumericVector q = log(g); const NumericVector limits(2); const int nGs = g.size(); int i = 0; // The jzs_log_marginal_posterior_logg function adds // this in, but we don't need it so substract it back out for( i = 0 ; i < nGs ; i++ ){ sumInvGammaDens += dinvgamma1_Rcpp(g(i), 0.5, rscale(i) * rscale(i) / 2); } // Warning: this function already has the null likelihood built in. ans = ( jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, false, limits, 0) )["d0g"]; // substract sum(q) for the log transformation return ans - sum(q) - sumInvGammaDens + .5*logDetPriorX; } double jzs_mc_marg_like2(const NumericVector g, const double sumSq, const int N, const NumericMatrix XtCnX0, const NumericMatrix XtCny0, const IntegerVector gMap, const NumericMatrix priorX, const double logDetPriorX, const int incCont) { int P = XtCnX0.ncol(); const MatrixXd XtCnX(as >(XtCnX0)); MatrixXd W( XtCnX ); MatrixXd WInvXtCny( MatrixXd(P, 1).setZero() ); const MatrixXd XtCny( as >(XtCny0) ); double ldetS = 0, ldetW, top, bottom1, bottom2, q = 0; int i, j; ldetS += -logDetPriorX; for( i = 0 ; i < incCont ; i++ ){ ldetS += log( g( gMap(i) ) ); for( j = 0 ; j <= i ; j++ ){ W( i, j ) += priorX( i, j ) / g( gMap( i ) ); } } for( i = incCont ; i < P ; i++ ) { ldetS += log( g( gMap( i ) ) ); W( i, i ) += 1 / g( gMap( i ) ); } ldetW = -log_determinant_pos_def( W ); WInvXtCny = W.llt().solve( XtCny ); for( i = 0 ; i < P ; i++ ) q += XtCny( i, 0 ) * WInvXtCny( i, 0 ); top = 0.5 * ldetW; bottom1 = 0.5 * (N - 1) * log1p( -q / sumSq ); bottom2 = 0.5 * ldetS; return(top - bottom1 - bottom2); } double jzs_importance_marg_like2(const NumericVector q, const NumericVector mu, const NumericVector sig, const double sumSq, const int N, const NumericMatrix XtCnX0, const NumericMatrix XtCny0, const NumericVector rscale, const IntegerVector gMap, const NumericMatrix priorX, const double logDetPriorX, const int incCont) { const int nGs = q.size(); const NumericVector g = exp(q); double sumNormDens = 0, sumInvGammaDens = 0; int i = 0; for( i = 0 ; i < nGs ; i++ ){ sumNormDens += Rf_dnorm4(q(i), mu(i), sig(i), 1); sumInvGammaDens += dinvgamma1_Rcpp(g(i), 0.5, rscale(i) * rscale(i) / 2); } return jzs_mc_marg_like2(g, sumSq, N, XtCnX0, XtCny0, gMap, priorX, logDetPriorX, incCont) + sumInvGammaDens - sumNormDens + sum(q); } double jzs_importance_marg_like(const NumericVector q, const NumericVector mu, const NumericVector sig, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont) { double ans = 0, sumNormDens = 0; const NumericVector limits(2); const int nGs = q.size(); int i = 0; for( i = 0 ; i < nGs ; i++ ){ sumNormDens += Rf_dnorm4(q(i), mu(i), sig(i), 1); } // Warning: this function already has the null likelihood built in. ans = ( jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, false, limits, 0) )["d0g"]; // substract sum(q) for the log transformation return ans - sumNormDens + .5*logDetPriorX; } BayesFactor/src/logRepresentedReal.h0000644000176200001440000000471413277750604017223 0ustar liggesusers#ifndef _RcppBayesFactor_LOGREAL_HPP #define _RcppBayesFactor_LOGREAL_HPP #include #include "bfcommon.h" class logRepresentedReal { int s; double m; public: logRepresentedReal() { s = NA_INTEGER; m = NA_REAL; } logRepresentedReal(double mod, int sign ) { if ( std::abs(sign) > 1 ) // invalid sign Rcpp::stop("ERROR: sign must be -1, 0, or 1."); if( !R_FINITE(mod) && sgn(mod)==-1 ){ sign = 0; } if( sign == 0 ){ mod = R_NegInf; } s = sign; m = mod; } public: // ==== USER INTERFACE ===== const int sign() const { return s; } const double modulo() const { return m; } const double log() const { if( s == 1 ){ return m; }else if(s == 0){ return R_NegInf; }else if(s == -1){ return NA_REAL; } Rcpp::stop("ERROR: Invalid sign in logRepresentedReal."); return(NA_REAL); }; logRepresentedReal abs() const { return logRepresentedReal(m, 1 ); } logRepresentedReal negative() const { return logRepresentedReal(m, -s ); } logRepresentedReal reciprocal() const { return logRepresentedReal(-m, s); } logRepresentedReal pow( int e ) const { if( e == 0 ){ logRepresentedReal( 0, 1 ); } if( !e%2 ){ logRepresentedReal( e * m, 1 ); } return logRepresentedReal( e * m, s ); } logRepresentedReal pow( double e ) const { if( e == 0 ){ logRepresentedReal( 0, 1 ); } return logRepresentedReal( e * m, s ); } bool isZero() const { if( ( !R_FINITE(m) && sgn(m)==-1 ) | (s == 0) ){ return true; }else{ return false; } } operator double() { return s * exp(m); } logRepresentedReal operator+(const logRepresentedReal& right) const; logRepresentedReal operator-(const logRepresentedReal& right) const; logRepresentedReal operator*(const logRepresentedReal& right) const; logRepresentedReal operator/(const logRepresentedReal& right) const; logRepresentedReal operator+(const double right) const; logRepresentedReal operator-(const double right) const; logRepresentedReal operator*(const double right) const; logRepresentedReal operator/(const double right) const; bool operator==(const logRepresentedReal& right) const; bool operator>(const logRepresentedReal& right) const; bool operator<(const logRepresentedReal& right) const; bool operator<=(const logRepresentedReal& right) const; bool operator>=(const logRepresentedReal& right) const; }; #endif BayesFactor/src/dinvgamma.cpp0000644000176200001440000000204313277750604015724 0ustar liggesusers#include "bfcommon.h" using namespace Rcpp; // [[Rcpp::depends(Rcpp)]] /* * dinvgamma1_Rcpp: log density of the inverse gamma distribution * dinvgamma1_logx_Rcpp: log density of the inverse gamma distribution, as a function of log(x) * ddinvgamma1_Rcpp: first derivative of the log density of the inverse gamma distribution * d2dinvgamma1_Rcpp: second derivative of the log density of the inverse gamma distribution */ // [[Rcpp::export]] double dinvgamma1_Rcpp(const double x, const double a, const double b){ return a * log( b ) - lgamma( a ) - ( a + 1 ) * log( x ) - b / x ; } // [[Rcpp::export]] double dinvgamma1_logx_Rcpp(const double x, const double a, const double b){ return a * log( b ) - lgamma( a ) - ( a + 1 ) * x - b * exp( -x ) ; } // [[Rcpp::export]] double ddinvgamma1_Rcpp(const double x, const double a, const double b){ return -( a + 1 ) / x + b / ( x * x ) ; } // [[Rcpp::export]] double d2dinvgamma1_Rcpp(const double x, const double a, const double b){ return ( a + 1 ) / ( x * x ) - 2 * b / (x * x * x) ; } BayesFactor/src/rmvnorm.cpp0000644000176200001440000000066513277750604015471 0ustar liggesusers#include "bfcommon.h" using namespace Rcpp; // [[Rcpp::depends(RcppEigen)]] Eigen::MatrixXd random_multivariate_normal(const Eigen::MatrixXd mu, const Eigen::MatrixXd Sigma) { int P = mu.rows(), i = 0; Eigen::MatrixXd y(Eigen::MatrixXd(P, 1).setZero()); Eigen::MatrixXd z(Eigen::MatrixXd(P, 1).setZero()); for( i = 0 ; i < P ; i++ ) z(i, 0) = Rf_rnorm( 0, 1 ); y = mu + Sigma.llt().matrixL() * z; return y; } BayesFactor/src/ttestRcpp.cpp0000644000176200001440000001400213277750604015747 0ustar liggesusers#include "progress.h" #include #include "bfcommon.h" using namespace Rcpp; // [[Rcpp::export]] NumericMatrix gibbsOneSampleRcpp(double ybar, double s2, int N, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); int i = 0, whichInterval = 0, signAgree = 1; double meanMu, varMu, scaleSig2, scaleg; double shapeSig2 = 0.5 * N + 0.5 * (!nullModel); double sumy2 = (N - 1) * s2 + N * pow(ybar, 2); double rscaleSq = pow(rscale, 2); double intLower = 0, intUpper = 1, areaLower, areaUpper; // For intervals if( doInterval){ signAgree = (interval[0] * interval[1]) >= 0; if( interval.size() == 0){ doInterval = false; }else if( interval.size() != 2 ){ Rcpp::stop("Incorrect number of interval points specified."); } } // starting values double mu = ybar, sig2 = s2, g = pow(ybar, 2) / s2 + 1; if(nullModel) mu = 0; // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, 4); // Start Gibbs sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample mu varMu = sig2 / ( 1.0 * N + 1/g ); meanMu = ybar * N * varMu / sig2; if(doInterval && !nullModel){ if( !intervalCompl ){ // Interval as given intLower = Rf_pnorm5( sqrt(sig2) * interval[0], meanMu, sqrt(varMu), 1, 0 ); intUpper = Rf_pnorm5( sqrt(sig2) * interval[1], meanMu, sqrt(varMu), 1, 0 ); }else{ // Complement of interval // Compute area of both sides and choose one areaLower = Rf_pnorm5( sqrt(sig2) * interval[0], meanMu, sqrt(varMu), 1, 1 ); areaUpper = Rf_pnorm5( sqrt(sig2) * interval[1], meanMu, sqrt(varMu), 0, 1 ); whichInterval = Rf_rlogis( areaUpper - areaLower, 1 ) > 0; // Sample from chosen side if(whichInterval){ intLower = Rf_pnorm5( sqrt(sig2) * interval[1], meanMu, sqrt(varMu), 1, 0 ); intUpper = 1; }else{ intLower = 0; intUpper = Rf_pnorm5( sqrt(sig2) * interval[0], meanMu, sqrt(varMu), 1, 0 ); } } mu = Rf_runif(intLower, intUpper); mu = Rf_qnorm5( mu, meanMu, sqrt(varMu), 1, 0 ); }else{ // no interval if(nullModel){ mu = 0; }else{ mu = Rf_rnorm( meanMu, sqrt(varMu) ); } } // sample sig2 scaleSig2 = 0.5 * ( sumy2 - 2.0 * N * ybar * mu ); if( !nullModel ) scaleSig2 += (N + 1/g)*pow(mu,2)/2; if(doInterval && !nullModel){ if( !intervalCompl){ // Interval as given if( signAgree ){ // signs of endpoints of interval agree - lower and upper bound intLower = Rf_pgamma( pow( interval[0] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); intUpper = Rf_pgamma( pow( interval[1] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ // signs of endpoints of interval do not agree - no lower bound intLower = 0; if( mu >= 0 ){ intUpper = Rf_pgamma( pow( interval[1] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ intUpper = Rf_pgamma( pow( interval[0] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } }else{ // Complement of interval if( signAgree ){ // Signs of interval end points agree if( (mu * interval[0]) < 0){ // Unrestricted sampling intLower = 0; intUpper = 1; }else{ // Compute area of both sides and choose one areaLower = Rf_pgamma( pow( interval[0] / mu, 2), shapeSig2, 1/scaleSig2, 1, 1 ); areaUpper = Rf_pgamma( pow( interval[1] / mu, 2), shapeSig2, 1/scaleSig2, 0, 1 ); whichInterval = Rf_rlogis( areaUpper - areaLower, 1 ) > 0; // Sample from chosen side if(whichInterval){ intLower = Rf_pgamma( pow( interval[1] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); intUpper = 1; }else{ intLower = 0; intUpper = Rf_pgamma( pow( interval[0] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } }else{ // signs of endpoints of interval do not agree - no upper bound intUpper = 1; if(mu >= 0){ intLower = Rf_pgamma( pow( interval[1] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ intLower = Rf_pgamma( pow( interval[0] / mu, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } } // end doInterval sig2 = Rf_runif(intLower, intUpper); sig2 = 1 / Rf_qgamma( sig2, shapeSig2, 1/scaleSig2, 1, 0 ); }else{ // No interval sig2 = 1 / Rf_rgamma( shapeSig2, 1/scaleSig2 ); } // sample g if(nullModel){ g = NA_REAL; }else{ scaleg = 0.5 * ( pow(mu,2) / sig2 + rscaleSq ); g = 1 / Rf_rgamma( 0.5 * (1 + !nullModel), 1/scaleg ); } // copy to chains chains(i, 0) = mu; chains(i, 1) = sig2; chains(i, 2) = mu / sqrt( sig2 ); chains(i, 3) = g; } // end Gibbs sampler return chains; } BayesFactor/src/jzs_bf_samplers.cpp0000644000176200001440000001345213277750604017152 0ustar liggesusers#include "progress.h" #include "bfcommon.h" #include using namespace Rcpp; using Eigen::MatrixXd; using Eigen::Map; using Eigen::Lower; // [[Rcpp::depends(RcppEigen)]] void jzs_mc_sampler(NumericVector *logsamples, const int iterations, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont, const int progress, const Function callback, const double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); const int nGs = gMapCounts.size(); NumericVector g(nGs); int i = 0, j = 0, P = XtCnX.nrow(); NumericMatrix XtCny( P, 1 ); for( i = 0 ; i < P ; i++ ) XtCny( i, 0 ) = CnytCnX( 0, i ); // create progress bar class Progress p(iterations, (bool) progress); // Sampler for( i = 0 ; i < iterations ; i++) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // do sampling for( j = 0 ; j < nGs ; j++ ){ g(j) = 1 / Rf_rgamma( 0.5, 2.0 / ( rscale(j) * rscale(j) ) ); } (*logsamples)(i) = jzs_mc_marg_like2(g, sumSq, N, XtCnX, XtCny, gMap, priorX, logDetPriorX, incCont); //(*logsamples)(i) = jzs_mc_marg_like(g, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, logDetPriorX, incCont); } } void jzs_importance_sampler(NumericVector *logsamples, const int iterations, const NumericVector mu, const NumericVector sig, const double sumSq, const int N, const NumericMatrix XtCnX, const NumericMatrix CnytCnX, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const double logDetPriorX, const int incCont, const int progress, const Function callback, const double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); const int nGs = gMapCounts.size(); NumericVector q(nGs); int i = 0, j = 0, P = XtCnX.nrow(); NumericMatrix XtCny( P, 1 ); for( i = 0 ; i < P ; i++ ) XtCny( i, 0 ) = CnytCnX( 0, i ); // create progress bar class Progress p(iterations, (bool) progress); // Sampler for( i = 0 ; i < iterations ; i++) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // do sampling for( j = 0 ; j < nGs ; j++ ){ q(j) = Rf_rnorm( mu(j), sig(j) ); } (*logsamples)(i) = jzs_importance_marg_like2(q, mu, sig, sumSq, N, XtCnX, XtCny, rscale, gMap, priorX, logDetPriorX, incCont); //(*logsamples)(i) = jzs_importance_marg_like(q, mu, sig, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, logDetPriorX, incCont); } } // [[Rcpp::export]] NumericVector jzs_sampler(const int iterations, const NumericVector y, const NumericMatrix X, const NumericVector rscale, const IntegerVector gMap, const int incCont, const NumericVector importanceMu, const NumericVector importanceSig, const int progress, const Function callback, const double callbackInterval, const int which) { // which = 0 for mc sampler // which = 1 for importance sampler int i = 0, j = 0; const int N = X.nrow(); const int P = X.ncol(); const double ybar = mean(y); double sumSq = 0, logDetPriorX = 0; NumericVector logsamples( iterations ); // gMapCounts is not needed for the sampler, but we need to pass something. NumericVector gMapCounts( max(gMap) + 1 ); NumericMatrix priorX(incCont, incCont); NumericMatrix CnX(N, P); NumericMatrix CnytCnX(1, P); NumericVector Cny(N); NumericVector XcolMeans(P); // Compute mean of each column of design matrix for( i = 0 ; i < P ; i++ ) { XcolMeans(i) = mean( X( _, i ) ); } // Compute centered matrices for( i = 0 ; i < N ; i++ ) { Cny(i) = y(i) - ybar; sumSq += Cny(i) * Cny(i); for( j = 0 ; j < P ; j++ ) { CnX(i,j) = X(i,j) - XcolMeans(j); } } MatrixXd XtCnX(MatrixXd(P,P).setZero().selfadjointView().rankUpdate( MatrixXd((as >(CnX))).transpose())); // Construct prior cov matrix for continuous covariates from X if(incCont){ for( i = 0 ; i < incCont ; i++ ){ for( j = 0 ; j <= i ; j++ ){ priorX(i,j) = sum( CnX( _ , i) * CnX( _ , j) ) / N; priorX(j,i) = priorX(i,j); } } logDetPriorX = log_determinant_pos_def(MatrixXd((as >(priorX)))); } // Compute t(Cy) %*% CX CnytCnX = wrap(MatrixXd((as >(Cny))).transpose() * MatrixXd((as >(CnX)))); if( which == 0 ){ // mc sampler jzs_mc_sampler(&logsamples, iterations, sumSq, N, wrap(XtCnX), CnytCnX, rscale, gMap, gMapCounts, priorX, logDetPriorX, incCont, progress, callback, callbackInterval); }else if( which == 1 ){ // importance sampler jzs_importance_sampler(&logsamples, iterations, importanceMu, importanceSig, sumSq, N, wrap(XtCnX), CnytCnX, rscale, gMap, gMapCounts, priorX, logDetPriorX, incCont, progress, callback, callbackInterval); }else{ Rcpp::stop("Invalid sampler specified."); } return logsamples; } BayesFactor/src/RcppCallback.cpp0000644000176200001440000000062013277750604016301 0ustar liggesusers#include #include "bfcommon.h" using namespace Rcpp; int RcppCallback(time_t *last, Rcpp::Function cb, double progress, double callbackInterval) { IntegerVector callbackResult(1); time_t now = time(NULL); if( difftime( now , *last ) > callbackInterval ){ callbackResult = cb( progress ); *last = now; return callbackResult[0]; }else{ return (int) 0; } } BayesFactor/src/interrupts.cpp0000644000176200001440000000173113277750604016203 0ustar liggesusers/* * Check for user interruption in C++ code interrupting execution of the current code * * This code has been written by Simon Urbanek * I took it from the R-devel mailing list * in the thread "[Rd] Interrupting C++ code execution" * The mail is dated: 25 april 2011 * * It allows to check for user interruption without * leaving the c++ function that calls it. * * Potential drawbacks according to its author: * The problem with it is that it will eat all errors, even if they were not yours * (e.g. those resulting from events triggered the event loop), so I would not recommend it for general use. * * Taken from CRAN package RcppProgress 0.1 */ #include "interrupts.h" #include #include "bfcommon.h" using namespace Rcpp; static void chkIntFn(void *dummy) { R_CheckUserInterrupt(); } // this will call the above in a top-level context so it won't longjmp-out of your context bool checkInterrupt() { return (R_ToplevelExec(chkIntFn, NULL) == FALSE); } BayesFactor/src/metattest.cpp0000644000176200001440000000747113277750604016005 0ustar liggesusers#include "progress.h" #include #include "bfcommon.h" double meta_t_like_Rcpp(double delta, Rcpp::NumericVector t, Rcpp::NumericVector n, Rcpp::NumericVector df, double rscale); using namespace Rcpp; // [[Rcpp::export]] NumericMatrix metropMetaTRcpp(NumericVector t, NumericVector n1, NumericVector n2, bool twoSample, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); int i = 0; double Ubounds[2]; double candidate, z, transDelta; bool inInterval, validDelta = true; NumericVector d(clone(t)); NumericVector eff_n(clone(n1)); NumericVector nu(clone(n1)); // For intervals if( doInterval){ if( interval.size() == 0){ doInterval = false; }else if( interval.size() != 2 ){ Rcpp::stop("Incorrect number of interval points specified."); } } // effective sample size and degrees of freedom if(twoSample){ eff_n = n1 * n2 / (n1 + n2); nu = n1 + n2 - 2.0; }else{ eff_n = n1; nu = n1 - 1.0; } // starting values for( i = 0 ; i < t.size() ; i++ ){ d[i] = d[i] / sqrt( eff_n[i] ); } double delta0 = sum( d * eff_n ) / sum( eff_n ) ; double delta_sd = 1 / sqrt( sum( eff_n ) ); double delta = delta0; // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, 1); if(nullModel) return chains; if(doInterval){ Ubounds[0] = Rf_pnorm5( interval[0], delta0, delta_sd, 1, 0 ); Ubounds[1] = Rf_pnorm5( interval[1], delta0, delta_sd, 1, 0 ); } // Start sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample delta if(doInterval){ if(intervalCompl){ candidate = Rf_runif(0, Ubounds[0] + 1 - Ubounds[1]); if( candidate > Ubounds[0]) candidate = candidate - Ubounds[0] + Ubounds[1]; }else{ candidate = Rf_runif(Ubounds[0], Ubounds[1]); } candidate = Rf_qnorm5(candidate, delta0, delta_sd, 1, 0 ); }else{ candidate = Rf_rnorm( delta0, delta_sd ); } // Metropolis-Hastings step z = meta_t_like_Rcpp(candidate, t, eff_n, nu, rscale) - meta_t_like_Rcpp(delta, t, eff_n, nu, rscale) + Rf_dnorm4(delta, delta0, delta_sd, 1) - Rf_dnorm4(candidate, delta0, delta_sd, 1); if(doInterval){ transDelta = Rf_pnorm5(delta, delta0, delta_sd, 1, 0 ); inInterval = ( Ubounds[0] > transDelta ) && ( Ubounds[1] < transDelta ); if( (inInterval && intervalCompl) || (!inInterval && !intervalCompl) ) validDelta = false; } if( ( Rf_rexp(1) > -z ) || !validDelta ){ delta = candidate; } // copy to chains chains(i, 0) = delta; } // end sampler return chains; } double meta_t_like_Rcpp(double delta, NumericVector t, NumericVector n, NumericVector df, double rscale) { int i; double logdens = Rf_dcauchy( delta, 0, rscale, 1); for( i = 0; i < t.size() ; i++ ){ logdens += Rf_dnt( t[i], df[i], delta*sqrt(n[i]), 1); } return logdens; } BayesFactor/src/ttestIndepRcpp.cpp0000644000176200001440000001567213277750604016745 0ustar liggesusers#include "progress.h" #include #include "bfcommon.h" using namespace Rcpp; // [[Rcpp::export]] NumericMatrix gibbsTwoSampleRcpp(NumericVector ybar, NumericVector s2, NumericVector N, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); int i = 0, whichInterval = 0, signAgree = 1; double meanMu, varMu, meanBeta, varBeta, scaleSig2, scaleg; double shapeSig2 = 0.5 * sum(N) + 0.5 * (!nullModel); double rscaleSq = pow(rscale, 2); double intLower = 0, intUpper = 1, areaLower, areaUpper; // For intervals if( doInterval){ signAgree = (interval[0] * interval[1]) >= 0; if( interval.size() == 0){ doInterval = false; }else if( interval.size() != 2 ){ Rcpp::stop("Incorrect number of interval points specified."); } } // starting values double sumy1 = N[0] * ybar[0]; double sumy2 = N[1] * ybar[1]; double sumy1Sq = (N[0] - 1) * s2[0] + N[0] * pow(ybar[0], 2); double sumy2Sq = (N[1] - 1) * s2[1] + N[1] * pow(ybar[1], 2); double sumySq = sumy1Sq + sumy2Sq; double sumy = sumy1 + sumy2; double diffy = N[1] * ybar[1] - N[0] * ybar[0]; double sumN = sum(N) * 1.0; double diffN = ( N[0] - N[1] ) * 1.0; double mu = sumy / sum(N); double beta = ybar[1] - ybar[0]; double sig2 = ( s2[0] * (N[0] - 1) + s2[1] * (N[1] - 1) ) / ( sum(N) - 2 ); double g = pow(beta, 2) / sig2 + 1; if(nullModel) beta = 0; // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, 5); // Start Gibbs sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample mu meanMu = (sumy + ( N[0] - N[1] ) * beta / 2) / sumN ; varMu = sig2 / sumN; mu = Rf_rnorm( meanMu, sqrt(varMu) ); // sample beta varBeta = sig2 / ( sumN/4 + 1/g ); meanBeta = varBeta / sig2 * ( (sumy2 - sumy1) + mu * ( diffN ) ) / 2; if(doInterval && !nullModel){ if( !intervalCompl ){ // Interval as given intLower = Rf_pnorm5( sqrt(sig2) * interval[0], meanBeta, sqrt(varBeta), 1, 0 ); intUpper = Rf_pnorm5( sqrt(sig2) * interval[1], meanBeta, sqrt(varBeta), 1, 0 ); }else{ // Complement of interval // Compute area of both sides and choose one areaLower = Rf_pnorm5( sqrt(sig2) * interval[0], meanBeta, sqrt(varBeta), 1, 1 ); areaUpper = Rf_pnorm5( sqrt(sig2) * interval[1], meanBeta, sqrt(varBeta), 0, 1 ); whichInterval = Rf_rlogis( areaUpper - areaLower, 1 ) > 0; // Sample from chosen side if(whichInterval){ intLower = Rf_pnorm5( sqrt(sig2) * interval[1], meanBeta, sqrt(varBeta), 1, 0 ); intUpper = 1; }else{ intLower = 0; intUpper = Rf_pnorm5( sqrt(sig2) * interval[0], meanBeta, sqrt(varBeta), 1, 0 ); } } beta = Rf_runif(intLower, intUpper); beta = Rf_qnorm5( beta, meanBeta, sqrt(varBeta), 1, 0 ); }else{ // no interval if(nullModel){ beta = 0; }else{ beta = Rf_rnorm( meanBeta, sqrt(varBeta) ); } } // end sample beta // sample sig2 scaleSig2 = 0.5 * ( sumySq - 2.0 * mu * sumy - beta * diffy + N[0] * pow(mu - beta/2, 2) + N[1] * pow(mu + beta/2, 2) ); if(!nullModel) scaleSig2 += pow(beta, 2) / g / 2; if(doInterval && !nullModel){ if( !intervalCompl){ // Interval as given if( signAgree ){ // signs of endpoints of interval agree - lower and upper bound intLower = Rf_pgamma( pow( interval[0] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); intUpper = Rf_pgamma( pow( interval[1] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ // signs of endpoints of interval do not agree - no lower bound intLower = 0; if( beta >= 0 ){ intUpper = Rf_pgamma( pow( interval[1] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ intUpper = Rf_pgamma( pow( interval[0] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } }else{ // Complement of interval if( signAgree ){ // Signs of interval end points agree if( (beta * interval[0]) < 0){ // Unrestricted sampling intLower = 0; intUpper = 1; }else{ // Compute area of both sides and choose one areaLower = Rf_pgamma( pow( interval[0] / beta, 2), shapeSig2, 1/scaleSig2, 1, 1 ); areaUpper = Rf_pgamma( pow( interval[1] / beta, 2), shapeSig2, 1/scaleSig2, 0, 1 ); whichInterval = Rf_rlogis( areaUpper - areaLower, 1 ) > 0; // Sample from chosen side if(whichInterval){ intLower = Rf_pgamma( pow( interval[1] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); intUpper = 1; }else{ intLower = 0; intUpper = Rf_pgamma( pow( interval[0] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } }else{ // signs of endpoints of interval do not agree - no upper bound intUpper = 1; if(beta >= 0){ intLower = Rf_pgamma( pow( interval[1] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); }else{ intLower = Rf_pgamma( pow( interval[0] / beta, 2), shapeSig2, 1/scaleSig2, 1, 0 ); } } } // end doInterval sig2 = Rf_runif(intLower, intUpper); sig2 = 1 / Rf_qgamma( sig2, shapeSig2, 1/scaleSig2, 1, 0 ); }else{ // No interval sig2 = 1 / Rf_rgamma( shapeSig2, 1/scaleSig2 ); } // end sample sig2 // sample g scaleg = 0.5 * ( pow(beta,2) / sig2 + rscaleSq ); if(nullModel){ g = NA_REAL; }else{ g = 1 / Rf_rgamma( 0.5 * (1 + !nullModel), 1/scaleg ); } // copy to chains chains(i, 0) = mu; chains(i, 1) = beta; chains(i, 2) = sig2; chains(i, 3) = beta / sqrt( sig2 ); chains(i, 4) = g; } // end Gibbs sampler return chains; } BayesFactor/src/genhypergeo_series_pos.cpp0000644000176200001440000000365313277750604020540 0ustar liggesusers// [[Rcpp::interfaces(r, cpp)]] #define _USE_MATH_DEFINES #include #include "bfcommon.h" using namespace Rcpp; bool isgood( NumericVector s, NumericVector t, double tol) { int i=0; for( i=0 ; i < t.size() ; i++){ if(t[i] != NA_REAL) if ( ( logExpXminusExpY( s[i], t[i] ) - t[i] ) > log(tol) ) return 0; } return 1; } // [[Rcpp::export]] NumericVector genhypergeo_series_pos( NumericVector U, NumericVector L, NumericVector z, const double tol, const int maxiter, const bool check_mod, const bool check_conds, const bool polynomial) { NumericVector fac( z.size() ); NumericVector temp( z.size() ); NumericVector series( z.size() ); LogicalVector greater( z.size() ); int i=0,j=0; if(check_conds){ if(is_true(any(U<0)) || is_true(any(L<0)) || is_true(any(z<0))){ stop("All arguments must be positive."); } } if(check_mod){ if( U.size() > (L.size()+1) ){ greater = abs(z)>0; } else if(U.size() > L.size()) { greater = abs(z)>1; } else { greater = abs(z)<0; } if( is_true( Rcpp::all(greater) ) ){ return(z * NA_REAL); }else{ for( i = 0 ; i < z.size() ; i++){ if( greater[i] ) z[i] = NA_REAL; } } } if(maxiter==0){ return z*0+fac; } for ( i = 0; i < maxiter; i++ ) { fac = fac + sum(log( U + i) ) - sum( log( L + i ) ) + log(z) - log( i + 1.0 ); for( j = 0 ; j < z.size() ; j++ ){ series[j] = logExpXplusExpY( temp[j], fac[j] ); } if ( isgood( series, temp , tol ) ){ return series; } temp = clone(series); } if(polynomial){ return series; }else{ Rcpp::warning("Series not converged."); return z * NA_REAL; } } BayesFactor/src/jzs_Gauss_approx_aov.cpp0000644000176200001440000001035013277750604020167 0ustar liggesusers#include "bfcommon.h" using namespace Rcpp; using Eigen::MatrixXd; using Eigen::VectorXd; using Eigen::Map; using Eigen::Lower; // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::export]] Rcpp::List jzs_log_marginal_posterior_logg(const NumericVector q, const double sumSq, const int N, const NumericMatrix XtCnX0, const NumericMatrix CnytCnX0, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const int incCont, const bool limit, const NumericVector limits, const int which) { const int P = XtCnX0.ncol(); const int nGs = q.size(); double d0g = NA_REAL; int i = 0, j = 0; const NumericVector g = exp(q); if( nGs != rscale.size() ){ Rcpp::stop("length mismatch: q and r"); } if( nGs != gMapCounts.size() ){ Rcpp::stop("length mismatch: q and gMapCount"); } NumericVector d1g(nGs, NA_REAL); NumericVector d2g(nGs, NA_REAL); NumericVector ddensg(nGs, 0.0); NumericVector tempVec1(nGs, 0.0); NumericVector tempVec2(nGs, 0.0); NumericVector tempVec3(nGs, 0.0); NumericVector tempVec4(nGs, 0.0); MatrixXd VgInv(MatrixXd(P, P).setZero()); const MatrixXd XtCnX(as >(XtCnX0)); const MatrixXd CnytCnX(as >(CnytCnX0)); MatrixXd gInv( XtCnX ); MatrixXd CnytCnXVg(MatrixXd(1, P).setZero()); MatrixXd CnytCnXVg2(MatrixXd(1, P).setZero()); MatrixXd VgInv2(MatrixXd(P, P)); double logDetVg, yXVXy, sumLogg = 0, sumInvGammaDens = 0; if( ( P == 1 ) && incCont ){ Rcpp::stop("Inappropriate use of Gaussian approximation with single column, continuous X."); } if( limit ){ for( i = 0; i < nGs ; i++ ){ if( ( q(i) < limits(0) ) | ( q(i) > limits(1) ) ){ return Rcpp::List::create(Rcpp::Named("d0g") = -INFINITY, Rcpp::Named("d1g") = wrap(d1g), Rcpp::Named("d2g") = wrap(d2g));; } } } // Build g matrix for( i = incCont ; i < P ; i++ ){ sumLogg += q( gMap(i) ); gInv(i,i) += 1 / g( gMap(i) ); } if(incCont){ // Continuous covariates included if( priorX.nrow() != incCont ) Rcpp::stop("priorX matrix size does not match argument incCont."); if( priorX.nrow() != priorX.ncol() ) Rcpp::stop("priorX matrix must be square."); for( i = 0; i < incCont ; i++ ){ sumLogg += q( gMap(i) ); for( j = 0 ; j <= i ; j++ ){ gInv(i,j) += priorX(i,j) / g(gMap(i)); } } } VgInv = gInv.selfadjointView().llt().solve(MatrixXd::Identity(P, P)); CnytCnXVg = CnytCnX * VgInv; yXVXy = ( CnytCnXVg * CnytCnX.transpose() )(0,0); if(which == 0 || which == -1){ // (log) marginal posterior logDetVg = -log_determinant_pos_def( VgInv ); for( i = 0 ; i < nGs ; i++ ){ sumInvGammaDens += dinvgamma1_Rcpp(g(i), 0.5, rscale(i) * rscale(i) / 2); } d0g = -0.5 * sumLogg - 0.5 * logDetVg - 0.5*(N-1)*log1p( -yXVXy/sumSq ) + sumInvGammaDens + sum(q); } if(which > 0 || which == -1){ // first derivative of log for( i = 0 ; i < nGs ; i++ ){ ddensg(i) = g(i) * ddinvgamma1_Rcpp(g(i), 0.5, rscale(i) * rscale(i) / 2); } for( i = 0 ; i < P ; i++ ){ tempVec1( gMap(i) ) += VgInv.diagonal()(i) / g( gMap(i) ); tempVec2( gMap(i) ) += CnytCnXVg(0, i) * CnytCnXVg(0, i) / g( gMap(i) ) / (sumSq - yXVXy); } d1g = -0.5 * gMapCounts + 0.5 * tempVec1 + 0.5*(N-1) * tempVec2 + ddensg + 1.0; } if(which > 1 || which == -1){ // second derivative CnytCnXVg2 = CnytCnXVg * VgInv; VgInv2 = MatrixXd(P, P).setZero().selfadjointView().rankUpdate(VgInv); for( i = 0 ; i < nGs ; i++ ){ ddensg(i) = g(i) * g(i) * d2dinvgamma1_Rcpp(g(i), 0.5, rscale(i) * rscale(i) / 2); } for( i = 0 ; i < P ; i++ ){ tempVec3( gMap(i) ) += VgInv2.diagonal()(i) / ( g( gMap(i) ) * g( gMap(i) ) ); tempVec4( gMap(i) ) += CnytCnXVg(0, i) * CnytCnXVg2(0, i) / ( g( gMap(i) ) * g( gMap(i) ) * (sumSq - yXVXy) ); } d2g = d1g + 0.5 * gMapCounts - 1.0 + ddensg + 0.5 * (tempVec3 - 2*tempVec1) + 0.5*(N-1) * ( tempVec2 * tempVec2 - 2*tempVec2 + 2*tempVec4 ); } return Rcpp::List::create(Rcpp::Named("d0g") = d0g, Rcpp::Named("d1g") = d1g, Rcpp::Named("d2g") = d2g); } BayesFactor/src/RcppExports.cpp0000644000176200001440000006522313277750604016263 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include "../inst/include/BayesFactor.h" #include #include #include #include using namespace Rcpp; // hFunc double hFunc(const double rho, const int n, const double r, const bool hg_checkmod, const int hg_iter); RcppExport SEXP _BayesFactor_hFunc(SEXP rhoSEXP, SEXP nSEXP, SEXP rSEXP, SEXP hg_checkmodSEXP, SEXP hg_iterSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type rho(rhoSEXP); Rcpp::traits::input_parameter< const int >::type n(nSEXP); Rcpp::traits::input_parameter< const double >::type r(rSEXP); Rcpp::traits::input_parameter< const bool >::type hg_checkmod(hg_checkmodSEXP); Rcpp::traits::input_parameter< const int >::type hg_iter(hg_iterSEXP); rcpp_result_gen = Rcpp::wrap(hFunc(rho, n, r, hg_checkmod, hg_iter)); return rcpp_result_gen; END_RCPP } // jeffreys_approx_corr double jeffreys_approx_corr(const double rho, const int n, const double r); RcppExport SEXP _BayesFactor_jeffreys_approx_corr(SEXP rhoSEXP, SEXP nSEXP, SEXP rSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type rho(rhoSEXP); Rcpp::traits::input_parameter< const int >::type n(nSEXP); Rcpp::traits::input_parameter< const double >::type r(rSEXP); rcpp_result_gen = Rcpp::wrap(jeffreys_approx_corr(rho, n, r)); return rcpp_result_gen; END_RCPP } // metropCorrRcpp_jeffreys NumericMatrix metropCorrRcpp_jeffreys(NumericVector r, NumericVector n, double a_prior, double b_prior, bool approx, int iterations, bool doInterval, NumericVector intervalz, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval); RcppExport SEXP _BayesFactor_metropCorrRcpp_jeffreys(SEXP rSEXP, SEXP nSEXP, SEXP a_priorSEXP, SEXP b_priorSEXP, SEXP approxSEXP, SEXP iterationsSEXP, SEXP doIntervalSEXP, SEXP intervalzSEXP, SEXP intervalComplSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type r(rSEXP); Rcpp::traits::input_parameter< NumericVector >::type n(nSEXP); Rcpp::traits::input_parameter< double >::type a_prior(a_priorSEXP); Rcpp::traits::input_parameter< double >::type b_prior(b_priorSEXP); Rcpp::traits::input_parameter< bool >::type approx(approxSEXP); Rcpp::traits::input_parameter< int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< bool >::type doInterval(doIntervalSEXP); Rcpp::traits::input_parameter< NumericVector >::type intervalz(intervalzSEXP); Rcpp::traits::input_parameter< bool >::type intervalCompl(intervalComplSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< int >::type progress(progressSEXP); Rcpp::traits::input_parameter< Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(metropCorrRcpp_jeffreys(r, n, a_prior, b_prior, approx, iterations, doInterval, intervalz, intervalCompl, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // dinvgamma1_Rcpp double dinvgamma1_Rcpp(const double x, const double a, const double b); RcppExport SEXP _BayesFactor_dinvgamma1_Rcpp(SEXP xSEXP, SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type a(aSEXP); Rcpp::traits::input_parameter< const double >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(dinvgamma1_Rcpp(x, a, b)); return rcpp_result_gen; END_RCPP } // dinvgamma1_logx_Rcpp double dinvgamma1_logx_Rcpp(const double x, const double a, const double b); RcppExport SEXP _BayesFactor_dinvgamma1_logx_Rcpp(SEXP xSEXP, SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type a(aSEXP); Rcpp::traits::input_parameter< const double >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(dinvgamma1_logx_Rcpp(x, a, b)); return rcpp_result_gen; END_RCPP } // ddinvgamma1_Rcpp double ddinvgamma1_Rcpp(const double x, const double a, const double b); RcppExport SEXP _BayesFactor_ddinvgamma1_Rcpp(SEXP xSEXP, SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type a(aSEXP); Rcpp::traits::input_parameter< const double >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(ddinvgamma1_Rcpp(x, a, b)); return rcpp_result_gen; END_RCPP } // d2dinvgamma1_Rcpp double d2dinvgamma1_Rcpp(const double x, const double a, const double b); RcppExport SEXP _BayesFactor_d2dinvgamma1_Rcpp(SEXP xSEXP, SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type a(aSEXP); Rcpp::traits::input_parameter< const double >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(d2dinvgamma1_Rcpp(x, a, b)); return rcpp_result_gen; END_RCPP } // genhypergeo_series_pos NumericVector genhypergeo_series_pos(NumericVector U, NumericVector L, NumericVector z, const double tol, const int maxiter, const bool check_mod, const bool check_conds, const bool polynomial); static SEXP _BayesFactor_genhypergeo_series_pos_try(SEXP USEXP, SEXP LSEXP, SEXP zSEXP, SEXP tolSEXP, SEXP maxiterSEXP, SEXP check_modSEXP, SEXP check_condsSEXP, SEXP polynomialSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericVector >::type U(USEXP); Rcpp::traits::input_parameter< NumericVector >::type L(LSEXP); Rcpp::traits::input_parameter< NumericVector >::type z(zSEXP); Rcpp::traits::input_parameter< const double >::type tol(tolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const bool >::type check_mod(check_modSEXP); Rcpp::traits::input_parameter< const bool >::type check_conds(check_condsSEXP); Rcpp::traits::input_parameter< const bool >::type polynomial(polynomialSEXP); rcpp_result_gen = Rcpp::wrap(genhypergeo_series_pos(U, L, z, tol, maxiter, check_mod, check_conds, polynomial)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } RcppExport SEXP _BayesFactor_genhypergeo_series_pos(SEXP USEXP, SEXP LSEXP, SEXP zSEXP, SEXP tolSEXP, SEXP maxiterSEXP, SEXP check_modSEXP, SEXP check_condsSEXP, SEXP polynomialSEXP) { SEXP rcpp_result_gen; { Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = PROTECT(_BayesFactor_genhypergeo_series_pos_try(USEXP, LSEXP, zSEXP, tolSEXP, maxiterSEXP, check_modSEXP, check_condsSEXP, polynomialSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { UNPROTECT(1); Rf_onintr(); } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); UNPROTECT(1); Rf_error(CHAR(rcpp_msgSEXP_gen)); } UNPROTECT(1); return rcpp_result_gen; } // jzs_sampler NumericVector jzs_sampler(const int iterations, const NumericVector y, const NumericMatrix X, const NumericVector rscale, const IntegerVector gMap, const int incCont, const NumericVector importanceMu, const NumericVector importanceSig, const int progress, const Function callback, const double callbackInterval, const int which); RcppExport SEXP _BayesFactor_jzs_sampler(SEXP iterationsSEXP, SEXP ySEXP, SEXP XSEXP, SEXP rscaleSEXP, SEXP gMapSEXP, SEXP incContSEXP, SEXP importanceMuSEXP, SEXP importanceSigSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP, SEXP whichSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< const NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type X(XSEXP); Rcpp::traits::input_parameter< const NumericVector >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< const IntegerVector >::type gMap(gMapSEXP); Rcpp::traits::input_parameter< const int >::type incCont(incContSEXP); Rcpp::traits::input_parameter< const NumericVector >::type importanceMu(importanceMuSEXP); Rcpp::traits::input_parameter< const NumericVector >::type importanceSig(importanceSigSEXP); Rcpp::traits::input_parameter< const int >::type progress(progressSEXP); Rcpp::traits::input_parameter< const Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< const double >::type callbackInterval(callbackIntervalSEXP); Rcpp::traits::input_parameter< const int >::type which(whichSEXP); rcpp_result_gen = Rcpp::wrap(jzs_sampler(iterations, y, X, rscale, gMap, incCont, importanceMu, importanceSig, progress, callback, callbackInterval, which)); return rcpp_result_gen; END_RCPP } // jzs_log_marginal_posterior_logg Rcpp::List jzs_log_marginal_posterior_logg(const NumericVector q, const double sumSq, const int N, const NumericMatrix XtCnX0, const NumericMatrix CnytCnX0, const NumericVector rscale, const IntegerVector gMap, const NumericVector gMapCounts, const NumericMatrix priorX, const int incCont, const bool limit, const NumericVector limits, const int which); RcppExport SEXP _BayesFactor_jzs_log_marginal_posterior_logg(SEXP qSEXP, SEXP sumSqSEXP, SEXP NSEXP, SEXP XtCnX0SEXP, SEXP CnytCnX0SEXP, SEXP rscaleSEXP, SEXP gMapSEXP, SEXP gMapCountsSEXP, SEXP priorXSEXP, SEXP incContSEXP, SEXP limitSEXP, SEXP limitsSEXP, SEXP whichSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const NumericVector >::type q(qSEXP); Rcpp::traits::input_parameter< const double >::type sumSq(sumSqSEXP); Rcpp::traits::input_parameter< const int >::type N(NSEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type XtCnX0(XtCnX0SEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type CnytCnX0(CnytCnX0SEXP); Rcpp::traits::input_parameter< const NumericVector >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< const IntegerVector >::type gMap(gMapSEXP); Rcpp::traits::input_parameter< const NumericVector >::type gMapCounts(gMapCountsSEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type priorX(priorXSEXP); Rcpp::traits::input_parameter< const int >::type incCont(incContSEXP); Rcpp::traits::input_parameter< const bool >::type limit(limitSEXP); Rcpp::traits::input_parameter< const NumericVector >::type limits(limitsSEXP); Rcpp::traits::input_parameter< const int >::type which(whichSEXP); rcpp_result_gen = Rcpp::wrap(jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX0, CnytCnX0, rscale, gMap, gMapCounts, priorX, incCont, limit, limits, which)); return rcpp_result_gen; END_RCPP } // jzs_Gibbs NumericMatrix jzs_Gibbs(const int iterations, const NumericVector y, const NumericMatrix X, const NumericVector rscale, const double sig2start, const IntegerVector gMap, const NumericVector gMapCounts, const int incCont, bool nullModel, const IntegerVector ignoreCols, const int thin, const int progress, const Function callback, const double callbackInterval); RcppExport SEXP _BayesFactor_jzs_Gibbs(SEXP iterationsSEXP, SEXP ySEXP, SEXP XSEXP, SEXP rscaleSEXP, SEXP sig2startSEXP, SEXP gMapSEXP, SEXP gMapCountsSEXP, SEXP incContSEXP, SEXP nullModelSEXP, SEXP ignoreColsSEXP, SEXP thinSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< const NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type X(XSEXP); Rcpp::traits::input_parameter< const NumericVector >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< const double >::type sig2start(sig2startSEXP); Rcpp::traits::input_parameter< const IntegerVector >::type gMap(gMapSEXP); Rcpp::traits::input_parameter< const NumericVector >::type gMapCounts(gMapCountsSEXP); Rcpp::traits::input_parameter< const int >::type incCont(incContSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< const IntegerVector >::type ignoreCols(ignoreColsSEXP); Rcpp::traits::input_parameter< const int >::type thin(thinSEXP); Rcpp::traits::input_parameter< const int >::type progress(progressSEXP); Rcpp::traits::input_parameter< const Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< const double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(jzs_Gibbs(iterations, y, X, rscale, sig2start, gMap, gMapCounts, incCont, nullModel, ignoreCols, thin, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // GibbsLinearRegRcpp NumericMatrix GibbsLinearRegRcpp(const int iterations, const NumericVector y, const NumericMatrix X, const double r, const double sig2start, const bool nullModel, const int progress, const Function callback, const double callbackInterval); RcppExport SEXP _BayesFactor_GibbsLinearRegRcpp(SEXP iterationsSEXP, SEXP ySEXP, SEXP XSEXP, SEXP rSEXP, SEXP sig2startSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< const NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< const NumericMatrix >::type X(XSEXP); Rcpp::traits::input_parameter< const double >::type r(rSEXP); Rcpp::traits::input_parameter< const double >::type sig2start(sig2startSEXP); Rcpp::traits::input_parameter< const bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< const int >::type progress(progressSEXP); Rcpp::traits::input_parameter< const Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< const double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(GibbsLinearRegRcpp(iterations, y, X, r, sig2start, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // log_determinant_pos_def double log_determinant_pos_def(Eigen::MatrixXd A); RcppExport SEXP _BayesFactor_log_determinant_pos_def(SEXP ASEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Eigen::MatrixXd >::type A(ASEXP); rcpp_result_gen = Rcpp::wrap(log_determinant_pos_def(A)); return rcpp_result_gen; END_RCPP } // logSummaryStats List logSummaryStats(NumericVector x); RcppExport SEXP _BayesFactor_logSummaryStats(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(logSummaryStats(x)); return rcpp_result_gen; END_RCPP } // log1pExp double log1pExp(double x); RcppExport SEXP _BayesFactor_log1pExp(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(log1pExp(x)); return rcpp_result_gen; END_RCPP } // logExpXplusExpY double logExpXplusExpY(const double x, const double y); RcppExport SEXP _BayesFactor_logExpXplusExpY(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(logExpXplusExpY(x, y)); return rcpp_result_gen; END_RCPP } // logExpXminusExpY double logExpXminusExpY(const double x, const double y); RcppExport SEXP _BayesFactor_logExpXminusExpY(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(logExpXminusExpY(x, y)); return rcpp_result_gen; END_RCPP } // metropMetaTRcpp NumericMatrix metropMetaTRcpp(NumericVector t, NumericVector n1, NumericVector n2, bool twoSample, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval); RcppExport SEXP _BayesFactor_metropMetaTRcpp(SEXP tSEXP, SEXP n1SEXP, SEXP n2SEXP, SEXP twoSampleSEXP, SEXP rscaleSEXP, SEXP iterationsSEXP, SEXP doIntervalSEXP, SEXP intervalSEXP, SEXP intervalComplSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type t(tSEXP); Rcpp::traits::input_parameter< NumericVector >::type n1(n1SEXP); Rcpp::traits::input_parameter< NumericVector >::type n2(n2SEXP); Rcpp::traits::input_parameter< bool >::type twoSample(twoSampleSEXP); Rcpp::traits::input_parameter< double >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< bool >::type doInterval(doIntervalSEXP); Rcpp::traits::input_parameter< NumericVector >::type interval(intervalSEXP); Rcpp::traits::input_parameter< bool >::type intervalCompl(intervalComplSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< int >::type progress(progressSEXP); Rcpp::traits::input_parameter< Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(metropMetaTRcpp(t, n1, n2, twoSample, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // metropProportionRcpp NumericMatrix metropProportionRcpp(NumericVector y, NumericVector n, double p0, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval); RcppExport SEXP _BayesFactor_metropProportionRcpp(SEXP ySEXP, SEXP nSEXP, SEXP p0SEXP, SEXP rscaleSEXP, SEXP iterationsSEXP, SEXP doIntervalSEXP, SEXP intervalSEXP, SEXP intervalComplSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type n(nSEXP); Rcpp::traits::input_parameter< double >::type p0(p0SEXP); Rcpp::traits::input_parameter< double >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< bool >::type doInterval(doIntervalSEXP); Rcpp::traits::input_parameter< NumericVector >::type interval(intervalSEXP); Rcpp::traits::input_parameter< bool >::type intervalCompl(intervalComplSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< int >::type progress(progressSEXP); Rcpp::traits::input_parameter< Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(metropProportionRcpp(y, n, p0, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // gibbsTwoSampleRcpp NumericMatrix gibbsTwoSampleRcpp(NumericVector ybar, NumericVector s2, NumericVector N, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval); RcppExport SEXP _BayesFactor_gibbsTwoSampleRcpp(SEXP ybarSEXP, SEXP s2SEXP, SEXP NSEXP, SEXP rscaleSEXP, SEXP iterationsSEXP, SEXP doIntervalSEXP, SEXP intervalSEXP, SEXP intervalComplSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type ybar(ybarSEXP); Rcpp::traits::input_parameter< NumericVector >::type s2(s2SEXP); Rcpp::traits::input_parameter< NumericVector >::type N(NSEXP); Rcpp::traits::input_parameter< double >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< bool >::type doInterval(doIntervalSEXP); Rcpp::traits::input_parameter< NumericVector >::type interval(intervalSEXP); Rcpp::traits::input_parameter< bool >::type intervalCompl(intervalComplSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< int >::type progress(progressSEXP); Rcpp::traits::input_parameter< Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(gibbsTwoSampleRcpp(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // gibbsOneSampleRcpp NumericMatrix gibbsOneSampleRcpp(double ybar, double s2, int N, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval); RcppExport SEXP _BayesFactor_gibbsOneSampleRcpp(SEXP ybarSEXP, SEXP s2SEXP, SEXP NSEXP, SEXP rscaleSEXP, SEXP iterationsSEXP, SEXP doIntervalSEXP, SEXP intervalSEXP, SEXP intervalComplSEXP, SEXP nullModelSEXP, SEXP progressSEXP, SEXP callbackSEXP, SEXP callbackIntervalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type ybar(ybarSEXP); Rcpp::traits::input_parameter< double >::type s2(s2SEXP); Rcpp::traits::input_parameter< int >::type N(NSEXP); Rcpp::traits::input_parameter< double >::type rscale(rscaleSEXP); Rcpp::traits::input_parameter< int >::type iterations(iterationsSEXP); Rcpp::traits::input_parameter< bool >::type doInterval(doIntervalSEXP); Rcpp::traits::input_parameter< NumericVector >::type interval(intervalSEXP); Rcpp::traits::input_parameter< bool >::type intervalCompl(intervalComplSEXP); Rcpp::traits::input_parameter< bool >::type nullModel(nullModelSEXP); Rcpp::traits::input_parameter< int >::type progress(progressSEXP); Rcpp::traits::input_parameter< Function >::type callback(callbackSEXP); Rcpp::traits::input_parameter< double >::type callbackInterval(callbackIntervalSEXP); rcpp_result_gen = Rcpp::wrap(gibbsOneSampleRcpp(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return rcpp_result_gen; END_RCPP } // validate (ensure exported C++ functions exist before calling them) static int _BayesFactor_RcppExport_validate(const char* sig) { static std::set signatures; if (signatures.empty()) { signatures.insert("NumericVector(*genhypergeo_series_pos)(NumericVector,NumericVector,NumericVector,const double,const int,const bool,const bool,const bool)"); } return signatures.find(sig) != signatures.end(); } // registerCCallable (register entry points for exported C++ functions) RcppExport SEXP _BayesFactor_RcppExport_registerCCallable() { R_RegisterCCallable("BayesFactor", "_BayesFactor_genhypergeo_series_pos", (DL_FUNC)_BayesFactor_genhypergeo_series_pos_try); R_RegisterCCallable("BayesFactor", "_BayesFactor_RcppExport_validate", (DL_FUNC)_BayesFactor_RcppExport_validate); return R_NilValue; } static const R_CallMethodDef CallEntries[] = { {"_BayesFactor_hFunc", (DL_FUNC) &_BayesFactor_hFunc, 5}, {"_BayesFactor_jeffreys_approx_corr", (DL_FUNC) &_BayesFactor_jeffreys_approx_corr, 3}, {"_BayesFactor_metropCorrRcpp_jeffreys", (DL_FUNC) &_BayesFactor_metropCorrRcpp_jeffreys, 13}, {"_BayesFactor_dinvgamma1_Rcpp", (DL_FUNC) &_BayesFactor_dinvgamma1_Rcpp, 3}, {"_BayesFactor_dinvgamma1_logx_Rcpp", (DL_FUNC) &_BayesFactor_dinvgamma1_logx_Rcpp, 3}, {"_BayesFactor_ddinvgamma1_Rcpp", (DL_FUNC) &_BayesFactor_ddinvgamma1_Rcpp, 3}, {"_BayesFactor_d2dinvgamma1_Rcpp", (DL_FUNC) &_BayesFactor_d2dinvgamma1_Rcpp, 3}, {"_BayesFactor_genhypergeo_series_pos", (DL_FUNC) &_BayesFactor_genhypergeo_series_pos, 8}, {"_BayesFactor_jzs_sampler", (DL_FUNC) &_BayesFactor_jzs_sampler, 12}, {"_BayesFactor_jzs_log_marginal_posterior_logg", (DL_FUNC) &_BayesFactor_jzs_log_marginal_posterior_logg, 13}, {"_BayesFactor_jzs_Gibbs", (DL_FUNC) &_BayesFactor_jzs_Gibbs, 14}, {"_BayesFactor_GibbsLinearRegRcpp", (DL_FUNC) &_BayesFactor_GibbsLinearRegRcpp, 9}, {"_BayesFactor_log_determinant_pos_def", (DL_FUNC) &_BayesFactor_log_determinant_pos_def, 1}, {"_BayesFactor_logSummaryStats", (DL_FUNC) &_BayesFactor_logSummaryStats, 1}, {"_BayesFactor_log1pExp", (DL_FUNC) &_BayesFactor_log1pExp, 1}, {"_BayesFactor_logExpXplusExpY", (DL_FUNC) &_BayesFactor_logExpXplusExpY, 2}, {"_BayesFactor_logExpXminusExpY", (DL_FUNC) &_BayesFactor_logExpXminusExpY, 2}, {"_BayesFactor_metropMetaTRcpp", (DL_FUNC) &_BayesFactor_metropMetaTRcpp, 13}, {"_BayesFactor_metropProportionRcpp", (DL_FUNC) &_BayesFactor_metropProportionRcpp, 12}, {"_BayesFactor_gibbsTwoSampleRcpp", (DL_FUNC) &_BayesFactor_gibbsTwoSampleRcpp, 12}, {"_BayesFactor_gibbsOneSampleRcpp", (DL_FUNC) &_BayesFactor_gibbsOneSampleRcpp, 12}, {"_BayesFactor_RcppExport_registerCCallable", (DL_FUNC) &_BayesFactor_RcppExport_registerCCallable, 0}, {NULL, NULL, 0} }; RcppExport void R_init_BayesFactor(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } BayesFactor/src/proportion.cpp0000644000176200001440000000703013277750604016175 0ustar liggesusers#include "progress.h" #include #include "bfcommon.h" double proptest_like_Rcpp(double lo, Rcpp::NumericVector y, Rcpp::NumericVector n, double p, double rscale); using namespace Rcpp; // [[Rcpp::export]] NumericMatrix metropProportionRcpp(NumericVector y, NumericVector n, double p0, double rscale, int iterations, bool doInterval, NumericVector interval, bool intervalCompl, bool nullModel, int progress, Function callback, double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); int i = 0; double Ubounds[2], mu = log( p0 / ( 1 - p0 ) ); double candidate, z, trans_lo; bool inInterval, valid_lo = true; // For intervals if( doInterval){ if( interval.size() == 0){ doInterval = false; }else if( interval.size() != 2 ){ Rcpp::stop("Incorrect number of interval points specified."); } } // starting values double ln_p0 = log( sum(y) + 1.0 ) - log( sum(n) + 2.0 ); double lo0 = Rf_qlogis( ln_p0, 0, 1, 1, 1 ); double lo_sd = exp ( 0.5 * ( ln_p0 + Rf_pexp( -ln_p0, 1, 1, 1 ) - log( sum(n) + 2.0 ) - 2 * Rf_dlogis( lo0, 0, 1, 1 ) ) ); double lo = lo0; // create progress bar class Progress p(iterations, (bool) progress); // Create matrix for chains NumericMatrix chains(iterations, 1); if(nullModel){ std::fill(chains.begin(), chains.end(), mu); return chains; } if(doInterval){ Ubounds[0] = Rf_pnorm5( interval[0], lo0, lo_sd, 1, 0 ); Ubounds[1] = Rf_pnorm5( interval[1], lo0, lo_sd, 1, 0 ); } // Start sampler for( i = 0 ; i < iterations ; i++ ) { // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample delta if(doInterval){ if(intervalCompl){ candidate = Rf_runif(0, Ubounds[0] + 1 - Ubounds[1]); if( candidate > Ubounds[0]) candidate = candidate - Ubounds[0] + Ubounds[1]; }else{ candidate = Rf_runif(Ubounds[0], Ubounds[1]); } candidate = Rf_qnorm5(candidate, lo0, lo_sd, 1, 0 ); }else{ candidate = Rf_rnorm( lo0, lo_sd ); } // Metropolis-Hastings step z = proptest_like_Rcpp(candidate, y, n, mu, rscale) - proptest_like_Rcpp(lo, y, n, mu, rscale) + Rf_dnorm4(lo, lo0, lo_sd, 1) - Rf_dnorm4(candidate, lo0, lo_sd, 1); if(doInterval){ trans_lo = Rf_pnorm5(lo, lo0, lo_sd, 1, 0 ); inInterval = ( Ubounds[0] > trans_lo ) && ( Ubounds[1] < trans_lo ); if( (inInterval && intervalCompl) || (!inInterval && !intervalCompl) ) valid_lo = false; } if( ( Rf_rexp(1) > -z ) || !valid_lo ){ lo = candidate; } // copy to chains chains(i, 0) = lo; } // end sampler return chains; } double proptest_like_Rcpp(double lo, NumericVector y, NumericVector n, double mu, double rscale) { int i; double theta = 1 / ( 1 + exp(-lo) ); double logdens = Rf_dlogis( lo, mu, rscale, 1); for( i = 0; i < y.size() ; i++ ){ logdens += Rf_dbinom( y[i], n[i], theta, 1); } return logdens; } BayesFactor/src/logDeterminant.cpp0000644000176200001440000000042513277750604016737 0ustar liggesusers#include using namespace Rcpp; using Eigen::MatrixXd; using Eigen::VectorXd; // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::export]] double log_determinant_pos_def(Eigen::MatrixXd A) { const VectorXd Dvec(A.ldlt().vectorD()); return Dvec.array().log().sum(); } BayesFactor/src/jzs_Gibbs.cpp0000644000176200001440000001062613277750604015703 0ustar liggesusers#include "progress.h" #include "bfcommon.h" #include using namespace Rcpp; using Eigen::MatrixXd; using Eigen::Map; using Eigen::Lower; // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::export]] NumericMatrix jzs_Gibbs(const int iterations, const NumericVector y, const NumericMatrix X, const NumericVector rscale, const double sig2start, const IntegerVector gMap, const NumericVector gMapCounts, const int incCont, bool nullModel, const IntegerVector ignoreCols, const int thin, const int progress, const Function callback, const double callbackInterval) { RNGScope scope; // setting last_cb to the beginning of the epoch // ensures that the callback is called once, first time_t last_cb = static_cast(int(0)); const int N = X.nrow(); const int P = X.ncol() - 1; if(P != gMap.size()) Rcpp::stop("Design matrix size / gMap mismatch; ncol(X) should be length(gMap)+1"); const int nGs = gMapCounts.size(); const int nPars = P + 2 + nGs; const int nOutputPars = nPars - sum(ignoreCols); const int effectiveIterations = iterations / thin; const double ybar = mean(y); int i = 0, j = 0, k = 0, colCounter = 0, rowCounter = 0; const Map Xm(as >(X)); const Map ym(as >(y)); const MatrixXd XtX( MatrixXd( P + 1, P + 1 ).setZero().selfadjointView().rankUpdate( Xm.transpose() ) ); NumericMatrix chains( effectiveIterations, nOutputPars ); NumericVector g(nGs, 1.0); NumericVector SSqG(nGs, 0.0); double sig2 = sig2start, SSq = 0; MatrixXd beta( MatrixXd( P + 1, 1 ).setZero() ); MatrixXd yResid( MatrixXd( N, 1 ).setZero() ); MatrixXd Sigma( XtX.selfadjointView() ); MatrixXd Xty( Xm.transpose() * ym ); MatrixXd mu( MatrixXd( P + 1, 1 ).setZero() ); // create progress bar class Progress p(iterations, (bool) progress); for( i = 0 ; i < iterations ; i++ ){ //Gibbs sampler // Check interrupt if (Progress::check_abort() ) Rcpp::stop("Operation cancelled by interrupt."); p.increment(); // update progress // Check callback if( RcppCallback( &last_cb, callback, ( 1000.0 * ( i + 1 ) ) / iterations, callbackInterval) ) Rcpp::stop("Operation cancelled by callback function."); // sample beta if(nullModel){ // all beta except grand mean are 0 beta( 0, 0 ) = Rf_rnorm( ybar, sqrt( sig2 / N ) ); for( j = 1 ; j < N ; j++ ) yResid( j, 0 ) = ym( j, 0 ) - beta( 0, 0 ); }else{ // null is false Sigma = XtX.selfadjointView(); // This only creates the lower triangle. for( j = 0; j < P ; j++ ){ if(j < incCont){ Sigma( j + 1, j + 1 ) += XtX( j + 1, j + 1 ) / N / g( gMap(j) ) ; for( k = 0; k < j; k++ ){ Sigma( j + 1, k + 1 ) += XtX( j + 1, k + 1 ) / N / g( gMap(j) ); } }else{ Sigma( j + 1, j + 1 ) += 1/g( gMap(j) ); } } Sigma = sig2 * Sigma.selfadjointView().llt().solve( MatrixXd::Identity( P + 1, P + 1 ) ); mu = Sigma * Xty / sig2; beta = random_multivariate_normal( mu, Sigma ); yResid = ym - Xm * beta; SSqG = SSqG * 0.0; if(incCont){ SSqG( gMap(0) ) += ( beta.block(1,0,incCont,1).transpose() * XtX.block(1, 1, incCont, incCont) * beta.block(1, 0, incCont, 1) )(0,0) / N; } for( j = incCont ; j < P ; j++ ){ SSqG( gMap(j) ) += beta( j + 1, 0 ) * beta( j + 1, 0 ); } } // sample sig2 SSq = ( yResid.transpose() * yResid )(0,0); if(!nullModel) SSq += sum(SSqG / g); sig2 = 1 / Rf_rgamma( 0.5 * ( N + P*(!nullModel) ), 2 / SSq ); // sample g for( j = 0 ; j < nGs ; j++ ){ if(nullModel){ g(j) = NA_REAL; }else{ g(j) = 1 / Rf_rgamma( 0.5 * ( gMapCounts(j)*(!nullModel) + 1 ) , 2 / ( SSqG(j)/sig2 + rscale(j)*rscale(j) ) ); } } // copy to chain if(!(i % thin)){ colCounter = 0; chains( rowCounter, 0 ) = beta( 0, 0 ); for( j = 0 ; j < P ; j++ ){ // beta parameters if( !ignoreCols( j ) ){ // ignore filtered parameters chains( rowCounter, ++colCounter ) = beta( j + 1 , 0 ); } } chains( rowCounter, ++colCounter ) = sig2; for( j = 0 ; j < nGs ; j++ ){ // copy g parameters chains( rowCounter, ++colCounter ) = g(j); } rowCounter++; } } // end Gibbs sampler return chains; } BayesFactor/NAMESPACE0000644000176200001440000000643113274042462013703 0ustar liggesusersuseDynLib(BayesFactor) export(logMeanExpLogs, logCumMeanExpLogs, BFInfo, ttest.tstat, oneWayAOV.Fstat, linearReg.R2stat, nWayAOV, ttestBF, lmBF, regressionBF, anovaBF, BFManual, as.BFBayesFactor, as.BFprobability, generalTestBF, meta.ttestBF, proportionBF, contingencyTableBF, enumerateGeneralModels, logSummaryStats, newPriorOdds, "priorOdds<-", "priorLogodds<-", correlationBF) importFrom(methods, show) importFrom(utils, head) importFrom(utils, tail) importFrom(graphics, plot) importFrom(utils, packageDescription) importFrom(Rcpp, evalCpp) importFrom(gtools, rdirichlet) importFrom(MatrixModels, model.Matrix) import(mvtnorm, pbapply, stringr, coda, Matrix) importFrom("graphics", "abline", "axis", "barplot", "par", "segments", "text") importFrom("methods", ".hasSlot", "S3Part", "S3Part<-", "as", "is", "new", "slot", "slot<-", "slotNames") importFrom("stats", "aov", "dbinom", "dnorm", "dt", "formula", "integrate", "lm", "nlm", "optim", "pcauchy", "plogis", "pt", "qlogis", "rgamma", "sd", "t.test", "terms", "var", "dlogis") importFrom("utils", "combn", "setTxtProgressBar", "txtProgressBar", "vignette") importFrom("stats", "cor", "dbeta", "pbeta", "pnorm") exportClasses("BFmodel", "BFBayesFactor","BFlinearModel", "BFodds") exportClasses("BFBayesFactorList", "BFoneSample","BFindepSample","BFcontingencyTable") exportMethods("extractBF","compare","t","recompute","posterior","which.min","which.max","is.na","model.matrix") exportMethods("extractOdds", "extractProbabilities","filterBF") S3method("is.na","BFBayesFactor") S3method("c","BFBayesFactor") S3method("plot","BFBayesFactor") S3method("head","BFBayesFactor") S3method("tail","BFBayesFactor") S3method("min","BFBayesFactor") S3method("max","BFBayesFactor") S3method("which.min","BFBayesFactor") S3method("which.max","BFBayesFactor") S3method("sort","BFBayesFactor") S3method("as.data.frame","BFBayesFactor") S3method("as.vector","BFBayesFactor") S3method("names","BFBayesFactor") S3method("length","BFBayesFactor") S3method("t","BFBayesFactor") S3method("as.matrix", "BFBayesFactorList") S3method("as.vector", "BFBayesFactorList") S3method("as.mcmc", "BFmcmc") S3method("as.matrix", "BFmcmc") S3method("as.data.frame", "BFmcmc") S3method("as.BFBayesFactor", "BFBayesFactorTop") S3method("plot","BFBayesFactorTop") S3method("sort","BFBayesFactorTop") S3method("length","BFBayesFactorTop") S3method("as.BFBayesFactor", "BFodds") S3method("as.BFprobability", "BFodds") S3method("c","BFodds") S3method("length","BFodds") S3method("head","BFodds") S3method("tail","BFodds") S3method("min","BFodds") S3method("max","BFodds") S3method("which.min","BFodds") S3method("which.max","BFodds") S3method("sort","BFodds") S3method("as.data.frame","BFodds") S3method("as.vector","BFodds") S3method("names","BFodds") S3method("head","BFprobability") S3method("tail","BFprobability") S3method("min","BFprobability") S3method("max","BFprobability") S3method("which.min","BFprobability") S3method("which.max","BFprobability") S3method("sort","BFprobability") S3method("as.data.frame","BFprobability") S3method("as.vector","BFprobability") S3method("names","BFprobability") S3method("length","BFprobability") S3method("sum","BFprobability") BayesFactor/NEWS0000644000176200001440000002374513274334457013202 0ustar liggesusers CHANGES IN BayesFactor VERSION 0.9.12-4.2 CHANGES * Fixed issue preventing Solaris compilation (affected 0.9.12-4 and 0.9.12-4.1) CHANGES IN BayesFactor VERSION 0.9.12-4 CHANGES * Fixed issue with numerical integration in proportionBF with large N * New function correlationBF - implements Jeffreys' correlation Bayes factor tests * Fixed rare bug that prevented sampling posteriors in some circumstances * Sampling regression models now provides estimate intercept. This may break some old code if you were referring to columns by number instead of name. * Fixed bug preventing recompute() from working in some cases. * Replaced Matrix::cBind (deprecated) with cbind CHANGES IN BayesFactor VERSION 0.9.12-2 CHANGES * Added feature allowing fine-tuning of priors on a per-effect basis: see new argument rscaleEffects of lmBF, anovaBF, and generalTestBF * Fixed bug that disallowed logical indexing of probability objects * Fixed minor typos in documentation * Fixed bug causing regression Bayes factors to fail for very small R^2 * Fixed bug disallowing expansion of dot (.) in generalTestBF model specifications * Fixed bug preventing cancelling of all analyses with interrupt * Restricted contingency prior to values >=1 * All BFmodel objects have additional "analysis" slot giving details of analysis CHANGES IN BayesFactor VERSION 0.9.11-1 CHANGES * Fixed memory bug causing importance sampling to fail. CHANGES IN BayesFactor VERSION 0.9.11 CHANGES * Added support for prior/posterior odds and probabilities. See the new vignette for details. * Added approximation for t test in case of large t * Made some error messages clearer * Use callbacks at least once in all cases * Fix bug preventing continuous interactions from showing in regression Gibbs sampler * Removed unexported function oneWayAOV.Gibbs(), and related C functions, due to redundancy * gMap from model.matrix is now 0-indexed vector (for compatibility with C functions) * substantial changes to backend, to Rcpp and RcppEigen for speed * removed redundant struc argument from nWayAOV (use gMap instead) CHANGES IN BayesFactor VERSION 0.9.10-2 CHANGES * Removed "see also" to package BAS, due to its being archived CHANGES IN BayesFactor VERSION 0.9.10-1 CHANGES * Fixed issue causing Solaris build to fail CHANGES IN BayesFactor VERSION 0.9.10 CHANGES * Fixed bug in model enumeration code in generalTestBF (affected "withmain" analyses with neverExclude argument) * Various bug fixes * Analyses are more error tolerant (problem analyses will yield NA in BayesFactor object) * Fixed some typos in citation information * Improved numerical stability of proportional error estimates CHANGES IN BayesFactor VERSION 0.9.9 CHANGES * Added "simple" argument to ttest.tstat, oneWayAOV.Fstat, and linearReg.R2stat; when TRUE, return only the Bayes factor (not the log BF and error) * When sampling Bayes factors, recompute() now increases the precision of BayesFactor objects, rather than simply recomputing them. Precision from new samples is added * Added test for single proportion; see proportionBF() * Added support for contingency tables; see contingencyBF() * Added Hraba and Grant (1970) data set; see ?raceDolls * Added model.matrix method for BayesFactor objects; allows for extracting the design matrix used for an analysis * recompute() now has multicore and callback support, as intended * Refactored t test and meta-t test code * Moved many backend functions to Rcpp from R C API * t test samplers now sample from interval null hypotheses and point null hypotheses where appropriate * fixed bug in in meta t test sampler which wouldn't allow sampling small numbers of MCMC samples CHANGES IN BayesFactor VERSION 0.9.8 CHANGES * Fixed bugs in model enumeration code * Fixed bug leading to wrong computation of number of covariate when interactions between continuous variables were included * Corrected typos/old information in the documentation * Fixed a memory allocation bug that affected computing Bayes factors with lots of data * Added meta-analytic Bayes factor for t tests (see meta.ttestBF) * Fixed bug in ttestBF that yielded Bayes factor of NaN for very extreme posterior interval probabilities * Fixed several bugs causing infinite integrals; generally improved integration * Added check to ensure no missing data before analyses * Added callbacks for access by third-party interfaces CHANGES IN BayesFactor VERSION 0.9.7 CHANGES * Fixed a bug causing posterior sampling of t test to fail when data was defined as integer type * Fixed a bug causing a two-way interaction to sometimes not be included in 3-way ANOVA analyses * Reworked model enumeration code to be more efficient and faster; 4-way analyses no longer take a long time to build * Moved 'methods' to Depends so that Rscript will work without the user having to explicitly load the package methods CHANGES IN BayesFactor VERSION 0.9.6 CHANGES * Fixed a bug causing Bayes factors to evaluate to NA when matrix inversion fails (very rare) * Fixed a bug causing computation to fail if importance sampling fails in nWayAOV. Uses method="simple" as a fallback. * Fixed a bug where quadrature failed for large F values in unbalanced one-way ANOVA designs * Data frame for linear model analyses now get modified: character columns are converted to factors, and factors are re-factor()ed to get rid of levels with no observations * Increased prior scales in one-sample t test by a factor of sqrt(2), in order to be consistent with the two-sample t test for the same effect size and effective sample size * Added vignette with prior checks to show consistency across methods * Added vignette with comparisons of BayesFactor results to arm/lme4 CHANGES IN BayesFactor VERSION 0.9.5 CHANGES * Minor bug fixes * Changed back to new R 3.0 vignette building (and moved files to vignettes directory) * Restricted to R >= 3.0.0 CHANGES IN BayesFactor VERSION 0.9.4 CHANGES * Fixed bug in sampling of posteriors in linear models * Fixed bug computing the Bayes factor of unbalanced one-way ANOVA with two levels - caused function to fail * Fixed occasional problem where optimization for the importance sampler would fail, giving a numerically singular matrix * Fixed problem where extremely rare large or small g values from the sampler would cause the Bayes factor to be NA (again, creating a singular numerically singular matrix). These very rare samples are now disregarded. * Added global option to turn progress bars on or off; use options(BFprogress = TRUE) or options(BFprogress = FALSE) * Added MCMC chain thinning to nWayAOV - to use, pass "thin" argument to posterior() or lmBF() * Added MCMC chain column filtering, useful for low memory systems. To use, pass "columnFilter" argument to posterior() or lmBF(). See the help for posterior() for more details. * Added function generalTestBF(), which allows testing of restrictions on a full model in a manner similar to regressionBF() and anovaBF(). * Added "noSample" argument to many functions. These will disable time-consuming sampling, and return an object of the same structure as if sampling had been done. This allows for the culling of BayesFactor objects and preplanning chain analyses before sampling * Added is.na() method for BFBayesFactor objects. When combined with recompute() and noSample (see above), this allows one to create lists of models with missing Bayes factors, remove uninteresting models, then recompute only the missing ones CHANGES IN BayesFactor VERSION 0.9.3 CHANGES * Restricted to R 3.0.0 (due to vignette compilation). CHANGES IN BayesFactor VERSION 0.9.2 CHANGES * Full support for linear models: continuous and categorical covariates can now be included in the same model using lmBF() * Minor changes to the BayesFactor output to make it clearer * Fixed display of very large and very small Bayes factors; no longer will display read something like "Inf (2%)" or the like * Clearer labels on MCMC output * When error is missing from the BayesFactor object, plot prints "?" next to the bar to indicate no error estimate is available * Default prior scale setting changed for continuous covariates; scale now defaults to sqrt(2)/4, which corresponds to the ANOVA "medium" setting (and will give the same Bayes factor in special cases where they should) * Default prior scale setting in one-sample t changed to 1/2 (it was erroneously changed to sqrt(2)/2). Two-sample t test default setting remains the same, at sqrt(2)/2 * Added new prior scale settings for random effects; default to "nuisance", which is the same as the old default (r=1) * New prior scale setting: "ultrawide" * Fixed bug with BFManual() which caused it not to start if dynamic help had not been started yet * When doing an Bayes factor analysis that requires sampling, the new default setting (method="auto") will automatically try to select the best sampler for you so that you get the most efficient samples. CHANGES IN BayesFactor VERSION 0.9.1 CHANGES * Vignette compilation changed for compatibility with R 3.0.0 CHANGES IN BayesFactor VERSION 0.9.0 CHANGES * New S4 classes representing Bayes factors, models, and MCMC chains. The output of all functions will now be objects of these classes * Error estimates are now given for all Bayes factor outputs * To accomodate the new system for creating and manipulating Bayes factors, the main function names have all changed. ANOVA is done via anovaBF(), multiple regression is done via regressionBF() and both can be done through lmBF() * Posterior sampling is supported by calling the new posterior() method on Bayes factor objects. The result is an BayesFactor MCMC object, which inherits methods for for mcmc objects from the coda class * New recompute() method will allow the reestimation of Bayes factors (for Bayes factor objects) and restimation of posteriors (for BayesFactor MCMC objects) * New cleaned-up code base BayesFactor/data/0000755000176200001440000000000012452540640013367 5ustar liggesusersBayesFactor/data/puzzles.rda0000644000176200001440000000055512452540640015600 0ustar liggesusers‹ÍRÍNÂ@–REM|ÒÖÿ‡"x%¸nJ &m[ЄèQf-Ód'VíÄ&ßÎ7»3Óù›øSÏžÚ @\àÙDj <`Aeg¹Þl¢0h^é7Ä9ÂŒ· ¿Áˆ$˜ú˜é>³Vø?q§|'˜<Ü™NÒÓÿ×ø,Ê›þÇóö™Îí«êã~\™÷8èQéñáói!Úˆâ¡Ç¨G|Š8ûöƺµ£ð=ŒpÛàò뵸m¸D<"×DnˆÜ¹#rOäÈã×)™[2%Ó "™Q.e†s¬TŠlÇfP¢&Ž_—-òC¥‚ÊOÕ:™QÙÙÛZ¦aaÚ$ÓŸ›R·Èc7¥&¾oJ ",´Pz±JT°HU,W¯Á_zcîW"ãöË¢5œ¼{öÉ0[Èehf`†ê¦ê£OátÿÅ<Ï?+²²gr%ûó]ŠÌ`·Ù†Ú BayesFactor/data/raceDolls.rda0000644000176200001440000000024412452540640015767 0ustar liggesusers‹ r‰0âŠàb```b`fdd`b2Y˜€# 'æ,JLNuÉÏÉ)ªáÉ:x2€ƒ)”ö€Ò. ªÌ)™¹@Šl£(á*ÉKÌMZÁ U#¦!ò|Á@I]CR€.Š »d¦¥¥¥æ• I¡jäÏÈ,IUHÎÈÌI 9å$&gC…þ0EO—jBayesFactor/R/0000755000176200001440000000000013277750604012670 5ustar liggesusersBayesFactor/R/meta.ttestBF.R0000644000176200001440000001225713043077372015315 0ustar liggesusers##' This function computes mata-analytic Bayes factors, or samples from the posterior, for ##' one- and two-sample designs where multiple t values have been observed. ##' ##' The Bayes factor provided by \code{meta.ttestBF} tests the null hypothesis that ##' the true effect size (or alternatively, the noncentrality parameters) underlying a ##' set of t statistics is 0. Specifically, the Bayes factor compares two ##' hypotheses: that the standardized effect size is 0, or that the standardized ##' effect size is not 0. Note that there is assumed to be a single, common effect size ##' \eqn{\delta}{delta} underlying all t statistics. For one-sample tests, the standardized effect size is ##' \eqn{(\mu-\mu_0)/\sigma}{(mu-mu0)/sigma}; for two sample tests, the ##' standardized effect size is \eqn{(\mu_2-\mu_1)/\sigma}{(mu2-mu1)/sigma}. ##' ##' A Cauchy prior is placed on the standardized effect size. ##' The \code{rscale} argument controls the scale of the prior distribution, ##' with \code{rscale=1} yielding a standard Cauchy prior. See the help for ##' \code{\link{ttestBF}} and the references below for more details. ##' ##' The Bayes factor is computed via Gaussian quadrature. Posterior samples are ##' drawn via independent-candidate Metropolis-Hastings. ##' @title Function for Bayesian analysis of one- and two-sample designs ##' @param t a vector of t statistics ##' @param n1 a vector of sample sizes for the first (or only) condition ##' @param n2 a vector of sample sizes. If \code{NULL}, a one-sample design is assumed ##' @param nullInterval optional vector of length 2 containing lower and upper bounds of ##' an interval hypothesis to test, in standardized units ##' @param rscale prior scale. A number of preset values can be given as ##' strings; see Details. ##' @param posterior if \code{TRUE}, return samples from the posterior instead ##' of Bayes factor ##' @param callback callback function for third-party interfaces ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor} containing the computed model comparisons is ##' returned. If \code{nullInterval} is defined, then two Bayes factors will ##' be computed: The Bayes factor for the interval against the null hypothesis ##' that the standardized effect is 0, and the corresponding Bayes factor for ##' the compliment of the interval. ##' ##' If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, ##' containing MCMC samples from the posterior is returned. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @references Morey, R. D. & Rouder, J. N. (2011). Bayes Factor Approaches for Testing ##' Interval Null Hypotheses. Psychological Methods, 16, 406-419 ##' ##' Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. ##' (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. ##' Psychonomic Bulletin & Review, 16, 225-237 ##' ##' Rouder, J. N. & Morey, R. D. (2011). A Bayes Factor Meta-Analysis of Bem's ESP Claim. ##' Psychonomic Bulletin & Review, 18, 682-689 ##' @note To obtain the same Bayes factors as Rouder and Morey (2011), ##' change the prior scale to 1. ##' @examples ##' ## Bem's (2010) data (see Rouder & Morey, 2011) ##' t=c(-.15,2.39,2.42,2.43) ##' N=c(100,150,97,99) ##' ##' ## Using rscale=1 and one-sided test to be ##' ## consistent with Rouder & Morey (2011) ##' bf = meta.ttestBF(t, N, rscale=1, nullInterval=c(0, Inf)) ##' bf[1] ##' ##' ## plot posterior distribution of delta, assuming alternative ##' ## turn off progress bar for example ##' samples = posterior(bf[1], iterations = 1000, progress = FALSE) ##' ## Note that posterior() respects the nullInterval ##' plot(samples) ##' summary(samples) ##' @seealso \code{\link{ttestBF}} meta.ttestBF <- function(t, n1, n2 = NULL, nullInterval = NULL, rscale="medium", posterior=FALSE, callback = function(...) as.integer(0), ...) { rscale = rpriorValues(ifelse(is.null(n2),"ttestOne","ttestTwo"),,rscale) hypNames = makeMetaTtestHypothesisNames(rscale, nullInterval) data = data.frame(t=t,n1=n1) if(!is.null(n2)) data$n2 = n2 if(!is.null(nullInterval)){ nullInterval = range(nullInterval) if(identical(nullInterval,c(-Inf,Inf))){ nullInterval = NULL } } mod1 = BFmetat(type = "JZS", identifier = list(formula = "delta =/= 0", nullInterval = nullInterval), prior=list(rscale=rscale, nullInterval = nullInterval), shortName = hypNames$shortName, longName = hypNames$longName ) if(posterior) return(posterior(mod1, data = data, callback = callback, ...)) bf1 = compare(numerator = mod1, data = data) if(!is.null(nullInterval)){ mod2 = mod1 attr(mod2@identifier$nullInterval, "complement") = TRUE attr(mod2@prior$nullInterval, "complement") = TRUE hypNames = makeMetaTtestHypothesisNames(rscale, mod2@identifier$nullInterval) mod2@shortName = hypNames$shortName mod2@longName = hypNames$longName bf2 = compare(numerator = mod2, data = data) return(c(bf1, bf2)) }else{ return(c(bf1)) } } BayesFactor/R/ttestBF.R0000644000176200001440000001515213043077372014365 0ustar liggesusers##' This function computes Bayes factors, or samples from the posterior, for ##' one- and two-sample designs. ##' ##' The Bayes factor provided by \code{ttestBF} tests the null hypothesis that ##' the mean (or mean difference) of a normal population is \eqn{\mu_0}{mu0} ##' (argument \code{mu}). Specifically, the Bayes factor compares two ##' hypotheses: that the standardized effect size is 0, or that the standardized ##' effect size is not 0. For one-sample tests, the standardized effect size is ##' \eqn{(\mu-\mu_0)/\sigma}{(mu-mu0)/sigma}; for two sample tests, the ##' standardized effect size is \eqn{(\mu_2-\mu_1)/\sigma}{(mu2-mu1)/sigma}. ##' ##' A noninformative Jeffreys prior is placed on the variance of the normal ##' population, while a Cauchy prior is placed on the standardized effect size. ##' The \code{rscale} argument controls the scale of the prior distribution, ##' with \code{rscale=1} yielding a standard Cauchy prior. See the references ##' below for more details. ##' ##' For the \code{rscale} argument, several named values are recognized: ##' "medium", "wide", and "ultrawide". These correspond ##' to \eqn{r} scale values of \eqn{\sqrt{2}/2}{sqrt(2)/2}, 1, and \eqn{\sqrt{2}}{sqrt(2)} ##' respectively. ##' ##' The Bayes factor is computed via Gaussian quadrature. ##' @title Function for Bayesian analysis of one- and two-sample designs ##' @param x a vector of observations for the first (or only) group ##' @param y a vector of observations for the second group (or condition, for ##' paired) ##' @param formula for independent-group designs, a (optional) formula ##' describing the model ##' @param mu for one-sample and paired designs, the null value of the mean (or ##' mean difference) ##' @param nullInterval optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in standardized units ##' @param paired if \code{TRUE}, observations are paired ##' @param data for use with \code{formula}, a data frame containing all the ##' data ##' @param rscale prior scale. A number of preset values can be given as ##' strings; see Details. ##' @param posterior if \code{TRUE}, return samples from the posterior instead ##' of Bayes factor ##' @param callback callback function for third-party interfaces ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor} containing the computed model comparisons is ##' returned. If \code{nullInterval} is defined, then two Bayes factors will ##' be computed: The Bayes factor for the interval against the null hypothesis ##' that the standardized effect is 0, and the corresponding Bayes factor for ##' the compliment of the interval. ##' ##' If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, ##' containing MCMC samples from the posterior is returned. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @references Morey, R. D., Rouder, J. N., Pratte, M. S., & Speckman, P. L. ##' (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. ##' Journal of Mathematical Psychology, 55, 368-378 ##' ##' Morey, R. D. \& Rouder, J. N. (2011). Bayes Factor Approaches for Testing ##' Interval Null Hypotheses. Psychological Methods, 16, 406-419 ##' ##' Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. ##' (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. ##' Psychonomic Bulletin & Review, 16, 225-237 ##' ##' Perception and Cognition Lab (University of Missouri): Bayes factor ##' calculators. \url{http://pcl.missouri.edu/bayesfactor} ##' @note The default priors have changed from 1 to \eqn{\sqrt{2}/2}. The ##' factor of \eqn{\sqrt{2}} is to be consistent ##' with Morey et al. (2011) and ##' Rouder et al. (2012), and the factor of \eqn{1/2} in both is to better scale the ##' expected effect sizes; the previous scaling put more weight on larger ##' effect sizes. To obtain the same Bayes factors as Rouder et al. (2009), ##' change the prior scale to 1. ##' @examples ##' ## Sleep data from t test example ##' data(sleep) ##' plot(extra ~ group, data = sleep) ##' ##' ## paired t test ##' ttestBF(x = sleep$extra[sleep$group==1], y = sleep$extra[sleep$group==2], paired=TRUE) ##' ##' ## Sample from the corresponding posterior distribution ##' samples = ttestBF(x = sleep$extra[sleep$group==1], ##' y = sleep$extra[sleep$group==2], paired=TRUE, ##' posterior = TRUE, iterations = 1000) ##' plot(samples[,"mu"]) ##' @seealso \code{\link{integrate}}, \code{\link{t.test}} ttestBF <- function(x = NULL, y = NULL, formula = NULL, mu = 0, nullInterval = NULL, paired = FALSE, data = NULL, rscale="medium", posterior=FALSE, callback = function(...) as.integer(0), ...){ data <- marshallTibble(data) if(!is.null(x) & !is.null(formula)) stop("Only one of x or formula should be defined.") if(!is.null(x) | !is.null(y)) if(any(is.na(c(x,y))) | any(is.infinite(c(x,y)))) stop("x or y must not contain missing or infinite values.") if(!is.null(nullInterval)){ nullInterval = range(nullInterval) if(identical(nullInterval,c(-Inf,Inf))){ nullInterval = NULL } } checkCallback(callback,as.integer(0)) if( (is.null(formula) & is.null(y)) | (!is.null(y) & paired) ){ # one sample if(paired){ # check that the two vectors have same length if(length(x)!=length(y)) stop("Length of x and y must be the same if paired=TRUE.") x = x - y } return( ttestBF_oneSample(x = x, mu = mu, nullInterval = nullInterval, rscale = rscale, posterior = posterior, callback = callback, ... ) ) } if(!is.null(y) & !paired){ # Two-sample; create formula if(!is.null(data) | !is.null(formula)) stop("Do not specify formula or data if x and y are specified.") data = data.frame(y = c(x,y), group = factor(c(rep("x",length(x)),rep("y",length(y)))) ) formula = y ~ group } if(!is.null(formula)){ # Two-sample if(paired) stop("Cannot use 'paired' with formula.") if(is.null(data)) stop("'data' needed for formula.") if(mu != 0) stop("Use of nonzero null hypothesis not implemented for independent samples test.") return(ttestBF_indepSample(formula = formula, data = data, mu = mu, nullInterval = nullInterval, rscale = rscale, posterior = posterior, callback = callback, ... )) }else{ stop("Insufficient arguments to perform t test.") } } BayesFactor/R/logMean.R0000644000176200001440000000400613043077372014370 0ustar liggesusers#'Functions to compute the logarithm of the mean (and cumulative means) of #'vectors of logarithms #' #'Given a vector of numeric values of real values represented in log form, #'\code{logMeanExpLogs} computes the logarithm of the mean of the #'(exponentiated) values. \code{logCumMeanExpLogs} computes the logarithm of #'the cumulative mean. #' #'Given a vector of values of log values \var{v}, one could compute #'\code{log(mean(exp(v)))} in R. However, exponentiating and summing will cause #'a loss of precision, and possibly an overflow. These functions use the #'identity \deqn{\log(e^a + e^b) = a + \log(1+e^{b-a})}{log(e^a + e^b) = a + #'log[ 1 + e^(b-a) ]} and the method of computing \eqn{\log(1+e^x)}{log(1+e^x)} #'that avoids overflow (see the references). The code is written in C for very #'fast computations. #' #'@aliases logMeanExpLogs logCumMeanExpLogs logSummaryStats #'@param v A vector of (log) values #'@return \code{logMeanExpLogs} returns a single value, #'\code{logCumMeanExpLogs} returns a vector of values of the same length as #'\var{v}, and \code{logSummaryStats} returns a list of the #'log mean, log variance, and cumulative log means. #'@author Richard D. Morey (\email{richarddmorey@@gmail.com}) #'@references For details of the approximation of \eqn{\log(1+e^x)}{log(1+e^x)} #'used to prevent loss of precision, see #'\url{http://www.codeproject.com/Articles/25294/Avoiding-Overflow-Underflow-and-Loss-of-Precision} and #'\url{http://www.johndcook.com/blog/standard_deviation/}. #'@keywords arith misc #'@examples #' #'# Sample 100 values #'y = log(rexp(100,1)) #' #'# These will give the same value, #'# since e^y is "small" #'logMeanExpLogs(y) #'log(mean(exp(y))) #' #'# We can make e^x overflow by multiplying #'# e^y by e^1000 #'largeVals = y + 1000 #' #'# This will return 1000 + log(mean(exp(y))) #'logMeanExpLogs(largeVals) #' #'# This will overflow #'log(mean(exp(largeVals))) #' logMeanExpLogs = function(v) { logSummaryStats(v)$logMean } logCumMeanExpLogs = function(v) { logSummaryStats(v)$cumLogMean } BayesFactor/R/nWayAOV.R0000644000176200001440000002473213063264537014305 0ustar liggesusers##' Computes a single Bayes factor, or samples from the posterior, for an ANOVA ##' model defined by a design matrix ##' ##' This function is not meant to be called by end-users, although ##' technically-minded users can call this function for flexibility beyond what ##' the other functions in this package provide. See \code{\link{lmBF}} for a ##' user-friendly front-end to this function. Details about the priors can be ##' found in the help for \code{\link{anovaBF}} and the references therein. ##' ##' Argument \code{gMap} provides a way of grouping columns of ##' the design matrix as a factor; the effects in each group will share a common ##' \eqn{g} parameter. \code{gMap} should be a vector of the same length as the number of ##' nonconstant rows in \code{X}. It will contain all integers from 0 to ##' \eqn{N_g-1}{Ng-1}, where \eqn{N_g}{Ng} is the total number of \eqn{g} ##' parameters. Each element of \code{gMap} specifies the group to which that ##' column belongs. ##' ##' If all columns belonging to a group are adjacent, \code{struc} can instead ##' be used to compactly represent the groupings. \code{struc} is a vector of ##' length \eqn{N_g}{Ng}. Each element specifies the number columns in the ##' group. ##' ##' The vector \code{rscale} should be of length \eqn{N_g}{Ng}, and contain the ##' prior scales of the standardized effects. See Rouder et al. (2012) for more ##' details and the help for \code{\link{anovaBF}} for some typical values. ##' ##' The method used to estimate the Bayes factor depends on the \code{method} ##' argument. "simple" is most accurate for small to moderate sample sizes, and ##' uses the Monte Carlo sampling method described in Rouder et al. (2012). ##' "importance" uses an importance sampling algorithm with an importance ##' distribution that is multivariate normal on log(g). "laplace" does not ##' sample, but uses a Laplace approximation to the integral. It is expected to ##' be more accurate for large sample sizes, where MC sampling is slow. If ##' \code{method="auto"}, then an initial run with both samplers is done, and ##' the sampling method that yields the least-variable samples is chosen. The ##' number of initial test iterations is determined by ##' \code{options(BFpretestIterations)}. ##' ##' If posterior samples are requested, the posterior is sampled with a Gibbs ##' sampler. ##' @title Use ANOVA design matrix to compute Bayes factors or sample posterior ##' @param y vector of observations ##' @param X design matrix whose number of rows match \code{length(y)}. ##' @param gMap vector grouping the columns of \code{X} (see Details). ##' @param rscale a vector of prior scale(s) of appropriate length (see ##' Details). ##' @param iterations Number of Monte Carlo samples used to estimate Bayes ##' factor or posterior ##' @param progress if \code{TRUE}, show progress with a text progress bar ##' @param callback callback function for third-party interfaces ##' @param gibbs will be deprecated. See \code{posterior} ##' @param posterior if \code{TRUE}, return samples from the posterior using ##' Gibbs sampling, instead of the Bayes factor ##' @param ignoreCols if \code{NULL} and \code{posterior=TRUE}, all parameter ##' estimates are returned in the MCMC object. If not \code{NULL}, a vector of ##' length P-1 (where P is number of columns in the design matrix) giving which ##' effect estimates to ignore in output ##' @param thin MCMC chain to every \code{thin} iterations. Default of 1 means ##' no thinning. Only used if \code{posterior=TRUE} ##' @param method the integration method (only valid if \code{posterior=FALSE}); one ##' of "simple", "importance", "laplace", or "auto" ##' @param continuous either FALSE if no continuous covariates are included, or ##' a logical vector of length equal to number of columns of X indicating ##' which columns of the design matrix represent continuous covariates ##' @param noSample if \code{TRUE}, do not sample, instead returning NA. This is ##' intended to be used with functions generating and testing many models at one time, ##' such as \code{\link{anovaBF}} ##' @return If \code{posterior} is \code{FALSE}, a vector of length 2 containing ##' the computed log(e) Bayes factor (against the intercept-only null), along ##' with a proportional error estimate on the Bayes factor. Otherwise, an ##' object of class \code{mcmc}, containing MCMC samples from the posterior is ##' returned. ##' @note Argument \code{struc} has been deprecated. Use \code{gMap}, which is the \code{\link{inverse.rle}} of \code{struc}, ##' minus 1. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}), Jeffery N. ##' Rouder (\email{rouderj@@missouri.edu}) ##' @seealso See \code{\link{lmBF}} for the user-friendly front end to this ##' function; see \code{\link{regressionBF}} and \code{anovaBF} for testing ##' many regression or ANOVA models simultaneously. ##' @references Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., ##' (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical ##' Psychology. 56. p. 356-374. ##' @examples ##' ## Classical example, taken from t.test() example ##' ## Student's sleep data ##' data(sleep) ##' plot(extra ~ group, data = sleep) ##' ##' ## traditional ANOVA gives a p value of 0.00283 ##' summary(aov(extra ~ group + Error(ID/group), data = sleep)) ##' ##' ## Build design matrix ##' group.column <- rep(1/c(-sqrt(2),sqrt(2)),each=10) ##' subject.matrix <- model.matrix(~sleep$ID - 1,data=sleep$ID) ##' ## Note that we include no constant column ##' X <- cbind(group.column, subject.matrix) ##' ##' ## (log) Bayes factor of full model against grand-mean only model ##' bf.full <- nWayAOV(y = sleep$extra, X = X, gMap = c(0,rep(1,10)), rscale=c(.5,1)) ##' exp(bf.full[['bf']]) ##' ##' ## Compare with lmBF result (should be about the same, give or take 1%) ##' bf.full2 <- lmBF(extra ~ group + ID, data = sleep, whichRandom = "ID") ##' bf.full2 nWayAOV<- function(y, X, gMap, rscale, iterations = 10000, progress = getOption('BFprogress', interactive()), callback = function(...) as.integer(0), gibbs = NULL, posterior = FALSE, ignoreCols=NULL, thin=1, method="auto", continuous=FALSE, noSample = FALSE) { if(!is.numeric(y)) stop("y must be numeric.") if(!is.numeric(X)) stop("X must be numeric.") if(!is.function(callback)) stop("Invalid callback.") if(!is.null(gibbs)){ warning("Argument 'gibbs' to nWayAOV will soon be deprecated. Use 'posterior' instead.") posterior = gibbs } N = length(y) X = matrix( X, nrow=N ) constantCols = apply(X,2,function(v) length(unique(v)))==1 & !apply(X,2,function(v) all(v==0)) if( sum(constantCols) > 0 ) { X = X[,-which(constantCols)] warning( sum(constantCols)," constant columns removed from X." ) } P = ncol(X) if(!is.null(gMap)){ if(length(gMap) != P) stop("Invalid gMap argument. length(gMap) must be the the same as the number of parameters (excluding intercept): ",sum(gMap)," != ",P) if( !all(0:max(gMap) %in% unique(gMap)) ) stop("Invalid gMap argument: no index can be skipped.") nGs = as.integer(max(gMap) + 1) }else{ stop("gMap must be defined.") } if(is.null(ignoreCols)) ignoreCols = rep(0,P) if(length(rscale)!=nGs){ stop("Length of rscale vector wrong. Was ", length(rscale), " and should be ", nGs,".") } # Rearrange design matrix if continuous columns are included # We will undo this later if chains have to be returned if(!identical(continuous,FALSE)){ if(all(continuous) & !posterior){ #### If all covariates are continuous, we want to use Gaussian quadrature. Cy = matrix(y - mean(y), ncol=1) CX = t(t(X) - colMeans(X)) R2 = t(Cy)%*%CX%*%solve(t(CX)%*%CX)%*%t(CX)%*%Cy / (t(Cy)%*%Cy) bf = linearReg.R2stat(N=N,p=ncol(CX),R2=R2,rscale=rscale) return(bf) } if(length(continuous) != P) stop("argument continuous must have same length as number of predictors") if(length(unique(gMap[continuous]))!=1) stop("gMap for continuous predictors don't all point to same g value") # Sort chains so that continuous covariates are together, and first sortX = order(!continuous) revSortX = order(sortX) X = X[,sortX] gMap = gMap[sortX] ignoreCols = ignoreCols[sortX] continuous = continuous[sortX] incCont = sum(continuous) }else{ revSortX = sortX = 1:ncol(X) incCont = as.integer(0) } # What if we can use quadrature? if(nGs==1 & !posterior & all(!continuous)) return(singleGBayesFactor(y,X,rscale,gMap, incCont)) if(posterior) return(nWayAOV.Gibbs(y, X, gMap, rscale, iterations, incCont, sortX, revSortX, progress, ignoreCols, thin, continuous, noSample, callback)) if(!noSample){ if(method %in% c("simple","importance","auto")){ return(doNwaySampling(method, y, X, rscale, iterations, gMap, incCont, progress, callback)) }else if(method=="laplace"){ bf = laplaceAOV(y,X,rscale,gMap,incCont) return(list(bf = bf, properror=NA, method="laplace")) }else{ stop("Unknown method specified.") } } return(list(bf = NA, properror=NA, method=NA)) } nWayAOV.Gibbs = function(y, X, gMap, rscale, iterations, incCont, sortX, revSortX, progress, ignoreCols, thin, continuous, noSample, callback) { P = ncol(X) nGs = as.integer( max(gMap) + 1 ) # Check thinning to make sure number is reasonable if( (thin<1) | (thin>(iterations/3)) ) stop("MCMC thin parameter cannot be less than 1 or greater than iterations/3. Was:", thin) if(!identical(continuous,FALSE)){ if(length(continuous) != P) stop("argument continuous must have same length as number of predictors") if(length(unique(gMap[continuous]))!=1) stop("gMap for continuous predictors don't all point to same g value") } nOutputPars = sum(1-ignoreCols) if(noSample){ # Return structure of chains chains = matrix(NA,2,nOutputPars + 2 + nGs) }else{ chains = jzs_Gibbs(iterations, y, cbind(1,X), rscale, 1, gMap, table(gMap), incCont, FALSE, as.integer(ignoreCols), as.integer(thin), as.logical(progress), callback, 1) } chains = mcmc(chains) # Unsort the chains if we had continuous covariates if(incCont){ # Account for ignored columns when resorting revSort = 1+order(sortX[!ignoreCols]) chains[,1 + 1:nOutputPars] = chains[,revSort] labels = c("mu",paste("beta",1:P,sep="_")[!ignoreCols[revSortX]],"sig2",paste("g",1:nGs,sep="_")) }else{ labels = c("mu",paste("beta",1:P,sep="_")[!ignoreCols],"sig2",paste("g",1:nGs,sep="_")) } colnames(chains) = labels return(chains) } BayesFactor/R/methods-BFBayesFactor.R0000644000176200001440000003133413043077372017065 0ustar liggesusers # constructor BFBayesFactor <- function(numerator, denominator, bayesFactor, data){ names(numerator) = rownames(bayesFactor) new("BFBayesFactor", numerator = numerator, denominator = denominator, bayesFactor = bayesFactor, data = data, version = BFInfo(FALSE)) } setValidity("BFBayesFactor", function(object){ if( length(object@numerator) != nrow(object@bayesFactor)) return("Number of numerator models does not equal number of Bayes factors.") numeratorsAreBFs = sapply(object@numerator,function(el) inherits(el,"BFmodel")) if( any(!numeratorsAreBFs)) return("Some numerators are not BFmodel objects.") # check numerators all have same data types as denominator dataTypeDenom = object@denominator@dataTypes dataTypesEqual = unlist(lapply(object@numerator, function(model, compType) model@dataTypes %com% compType, compType=dataTypeDenom)) if( any(!dataTypesEqual)) return("Data types are not equal across models.") typeDenom = object@denominator@type typesEqual = unlist(lapply(object@numerator, function(model, compType) identical(model@type, compType), compType=typeDenom)) if( any(!typesEqual)) return("Model types are not equal across models.") classDenom = class(object@denominator) typesEqual = unlist(lapply(object@numerator, function(model, compType) identical(class(model), compType), compType=classDenom)) if( any(!typesEqual)) return("Model classes are not equal across models.") # Check to see that Bayes factor data frame has required columns if( !all(colnames(object@bayesFactor) %in% c("bf", "error", "time", "code")) ) return("Object does not have required columns (bf, error, time, code).") return(TRUE) }) #' @rdname recompute-methods #' @aliases recompute,BFBayesFactor-method setMethod("recompute", "BFBayesFactor", function(x, progress = getOption('BFprogress', interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...){ modelList = c(x@numerator,x@denominator) if(multicore){ callback = function(...) as.integer(0) message("Note: Progress bars and callbacks are suppressed when running multicore.") if( !suppressMessages( requireNamespace("doMC", quietly = TRUE) ) ){ stop("Required package (doMC) missing for multicore functionality.") } doMC::registerDoMC() if(foreach::getDoParWorkers()==1){ warning("Multicore specified, but only using 1 core. Set options(cores) to something >1.") } bfs = foreach::"%dopar%"( foreach::foreach(gIndex=modelList, .options.multicore=mcoptions), compare(numerator = gIndex, data = x@data, ...) ) }else{ # No multicore checkCallback(callback,as.integer(0)) bfs = NULL myCallback <- function(prgs){ frac <- (i - 1 + prgs/1000)/length(modelList) ret <- callback(frac*1000) return(as.integer(ret)) } if(progress){ pb = txtProgressBar(min = 0, max = length(modelList), style = 3) }else{ pb = NULL } for(i in 1:length(modelList)){ oneModel <- compare(numerator = modelList[[i]], data = x@data, progress=FALSE, callback=myCallback, ...) if(inherits(pb,"txtProgressBar")) setTxtProgressBar(pb, i) bfs = c(bfs,oneModel) } if(inherits(pb,"txtProgressBar")) close(pb) checkCallback(callback,as.integer(1000)) } joined = do.call("c", bfs) numerators = joined[ 1:(length(joined)-1) ] denominator = joined[ length(joined) ] return(numerators / denominator) }) #' @rdname BFBayesFactor-class #' @name /,numeric,BFBayesFactor-method #' @param e1 Numerator of the ratio #' @param e2 Denominator of the ratio setMethod('/', signature("numeric", "BFBayesFactor"), function(e1, e2){ if( (e1 == 1) & (length(e2)==1) ){ numer = e2@numerator[[1]] denom = list(e2@denominator) bf_df = e2@bayesFactor rownames(bf_df) = denom[[1]]@shortName bf_df$bf = -bf_df$bf bfobj = BFBayesFactor(numerator=denom, denominator=numer, bayesFactor=bf_df, data=e2@data) return(bfobj) }else if( e1 != 1 ){ stop("Dividend must be 1 (to take reciprocal).") }else if( length(e2)>1 ){ allNum = as(e2,"list") BFlist = BFBayesFactorList(lapply(allNum, function(num) 1 / num)) } } ) #' @rdname BFBayesFactor-class #' @name /,BFBayesFactor,BFBayesFactor-method setMethod('/', signature("BFBayesFactor", "BFBayesFactor"), function(e1, e2){ if( !(e1@denominator %same% e2@denominator) ) stop("Bayes factors have different denominator models; they cannot be compared.") if( !identical(e1@data, e2@data) ) stop("Bayes factors were computed using different data; they cannot be compared.") if( (length(e2)==1) ){ errorEst = sqrt(e1@bayesFactor$error^2 + e2@bayesFactor$error^2) bfs = data.frame(bf=e1@bayesFactor$bf - e2@bayesFactor$bf, error = errorEst, time = date(), code = randomString(length(e1))) rownames(bfs) = rownames(e1@bayesFactor) # when bayes factors were computed at the same time or for the same model, # they must be exactly equal (no error) sameModel <- sapply(e1@numerator, function(num, den) num %same% den, den = e2@numerator[[1]]) sameCode <- as.character(e1@bayesFactor$code) == as.character(e2@bayesFactor$code) bfs[ sameModel | sameCode, "error" ] = 0 bfs[ sameModel | sameCode, "bf" ] = 0 newbf = BFBayesFactor(numerator=e1@numerator, denominator=e2@numerator[[1]], bayesFactor=bfs, data = e1@data) return(newbf) }else{ allDenom = as(e2,"list") BFlist = BFBayesFactorList(lapply(allDenom, function(denom, num) num / denom, num = e1)) return(BFlist) } } ) setMethod('show', "BFBayesFactor", function(object){ cat("Bayes factor analysis\n--------------\n") bfs = extractBF(object, logbf=TRUE) bfs$bf = sapply(bfs$bf, expString) indices = paste("[",1:nrow(bfs),"]",sep="") # pad model names nms = paste(indices,rownames(bfs),sep=" ") maxwidth = max(nchar(nms)) nms = str_pad(nms,maxwidth,side="right",pad=" ") # pad Bayes factors maxwidth = max(nchar(bfs$bf)) bfString = str_pad(bfs$bf,maxwidth,side="right",pad=" ") for(i in 1:nrow(bfs)){ cat(nms[i]," : ",bfString[i]," \u00B1",round(bfs$error[i]*100,2),"%\n",sep="") } cat("\nAgainst denominator:\n") cat(" ",object@denominator@longName,"\n") cat("---\nBayes factor type: ",class(object@denominator)[1],", ",object@denominator@type,"\n\n",sep="") }) setMethod('summary', "BFBayesFactor", function(object){ show(object) }) #' @rdname BFBayesFactor-class #' @name [,BFBayesFactor,index,missing,missing-method #' @param x BFBayesFactor object #' @param i indices indicating elements to extract #' @param j unused for BFBayesFactor objects #' @param drop unused #' @param ... further arguments passed to related methods setMethod("[", signature(x = "BFBayesFactor", i = "index", j = "missing", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 2){ newbf = x x@numerator = x@numerator[i, drop=FALSE] x@bayesFactor = x@bayesFactor[i, ,drop=FALSE] }else stop("invalid nargs()= ",na) return(x) }) #' @rdname extractBF-methods #' @aliases extractBF,BFBayesFactor-method setMethod("extractBF", "BFBayesFactor", function(x, logbf = FALSE, onlybf = FALSE){ x = x@bayesFactor if(!logbf) x$bf = exp(x$bf) if(onlybf) x = x$bf return(x) }) #' @rdname BFBayesFactor-class #' @name t,BFBayesFactor-method setMethod('t', "BFBayesFactor", function(x){ return(t.BFBayesFactor(x)) }) setAs("BFBayesFactor", "data.frame", function( from, to ){ as.data.frame.BFBayesFactor(from) }) setAs("BFBayesFactor" , "list", function ( from , to ){ vec = vector(mode = "list", length = length(from) ) for(i in 1:length(from)) vec[[i]] = from[i] return(vec) }) setAs("BFBayesFactor", "vector", function( from, to ){ as.vector.BFBayesFactor(from) }) #' @rdname BFBayesFactor-class #' @name which.max,BFBayesFactor-method setMethod("which.max", "BFBayesFactor", function(x) which.max.BFBayesFactor(x) ) #' @rdname BFBayesFactor-class #' @name which.min,BFBayesFactor-method setMethod("which.min", "BFBayesFactor", function(x) which.min.BFBayesFactor(x) ) #' @rdname BFBayesFactor-class #' @name is.na,BFBayesFactor-method setMethod("is.na", "BFBayesFactor", function(x) is.na.BFBayesFactor(x) ) #' @rdname BFBayesFactor-class #' @name *,BFBayesFactor,BFodds-method setMethod('*', signature("BFBayesFactor", "BFodds"), function(e1, e2){ return(e2 * e1) } ) ###### # S3 ###### ##' This function coerces objects to the BFBayesFactor class ##' ##' Function to coerce objects to the BFBayesFactor class ##' ##' Currently, this function will only work with objects of class ##' \code{BFBayesFactorTop}, which are output from the functions \code{anovaBF} ##' and \code{regressionBF} when the \code{whichModels} argument is set to ##' \code{'top'} ##' @title Function to coerce objects to the BFBayesFactor class ##' @param object an object of appropriate class (for now, BFBayesFactorTop) ##' @return An object of class \code{BFBayesFactor} ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @export ##' @keywords misc ##' @seealso \code{\link{regressionBF}}, \code{anovaBF} whose output is ##' appropriate for use with this function when \code{whichModels='top'} as.BFBayesFactor <- function(object) UseMethod("as.BFBayesFactor") is.na.BFBayesFactor <- function(x){ return(is.na(x@bayesFactor$bf)) } names.BFBayesFactor <- function(x) { num <- sapply(x@numerator, function(el) el@shortName) den <- x@denominator@shortName return(list(numerator=num,denominator=den)) } length.BFBayesFactor <- function(x) nrow(x@bayesFactor) # See http://www-stat.stanford.edu/~jmc4/classInheritance.pdf sort.BFBayesFactor <- function(x, decreasing = FALSE, ...){ ord = order(x@bayesFactor$bf, decreasing = decreasing) return(x[ord]) } max.BFBayesFactor <- function(..., na.rm=FALSE){ joinedbf = do.call('c',list(...)) el <- head(joinedbf, n=1) return(el) } min.BFBayesFactor <- function(..., na.rm=FALSE){ joinedbf = do.call('c',list(...)) el <- tail(joinedbf, n=1) return(el) } which.max.BFBayesFactor <- function(x){ index = which.max(x@bayesFactor$bf) names(index) = rownames(x@bayesFactor)[index] return(index) } which.min.BFBayesFactor <- function(x){ index = which.min(x@bayesFactor$bf) names(index) = rownames(x@bayesFactor)[index] return(index) } t.BFBayesFactor <- function(x){ 1/x } head.BFBayesFactor <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x, decreasing=TRUE) return(x[1:n]) } tail.BFBayesFactor <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x) return(x[n:1])} as.data.frame.BFBayesFactor <- function(x, row.names = NULL, optional=FALSE,...){ df = x@bayesFactor df$bf = exp(df$bf) return(df) } as.vector.BFBayesFactor <- function(x, mode = "any"){ if( !(mode %in% c("any", "numeric"))) stop("Cannot coerce to mode ", mode) v = exp(x@bayesFactor$bf) names(v) = rownames(x@bayesFactor) return(v) } c.BFBayesFactor <- function(..., recursive = FALSE) { z = list(...) if(length(z)==1) return(z[[1]]) correctClass = unlist(lapply(z, function(object) inherits(object,"BFBayesFactor"))) if(any(!correctClass)) stop("Cannot concatenate Bayes factor with non-Bayes factor.") dataAndDenoms = lapply(z, function(object){list(den = object@denominator, dat = object@data)}) sameInfo = unlist(lapply(dataAndDenoms[-1], function(el, cmp){ sameType = el$dat %com% cmp$dat sameType = ifelse(length(sameType)>0,sameType,TRUE) (el$den %same% cmp$den) & sameType }, cmp=dataAndDenoms[[1]])) if(any(!sameInfo)) stop("Cannot concatenate Bayes factors with different denominator models or data.") numerators = unlist(lapply(z, function(object){object@numerator}),recursive=FALSE, use.names=FALSE) bfs = lapply(z, function(object){object@bayesFactor}) df_rownames = unlist(lapply(z, function(object){rownames(object@bayesFactor)})) df_rownames = make.unique(df_rownames, sep=" #") bfs = do.call("rbind",bfs) rownames(bfs) = df_rownames bf = BFBayesFactor(numerator=numerators, denominator=z[[1]]@denominator, bayesFactor=bfs, data = z[[1]]@data) } BayesFactor/R/anovaBF.R0000644000176200001440000002746513043077372014340 0ustar liggesusers ##' This function computes Bayes factors for all main-effects and interaction ##' contrasts in an ANOVA design. ##' ##' Models, priors, and methods of computation are provided in Rouder et al. ##' (2012). ##' ##' The ANOVA model for a vector of observations \eqn{y} is \deqn{ y = \mu + X_1 ##' \theta_1 + \ldots + X_p\theta_p +\epsilon,} where ##' \eqn{\theta_1,\ldots,\theta_p} are vectors of main-effect and interaction ##' effects, \eqn{X_1,\ldots,X_p} are corresponding design matrices, and ##' \eqn{\epsilon} is a vector of zero-centered noise terms with variance ##' \eqn{\sigma^2}. Zellner and Siow (1980) inspired g-priors are placed on ##' effects, but with a separate g-prior parameter for each covariate: ##' \deqn{\theta_1~N(0,g_1\sigma^2), \ldots, \theta_p~N(0,g_p \sigma^2).} A ##' Jeffries prior is placed on \eqn{\mu} and \eqn{\sigma^2}. Independent ##' scaled inverse-chi-square priors with one degree of freedom are placed on ##' \eqn{g_1,\ldots,g_p}. The square-root of the scale for g's corresponding to ##' fixed and random effects is given by \code{rscaleFixed} and ##' \code{rscaleRandom}, respectively. ##' ##' When a factor is treated as random, there are as many main effect terms in ##' the vector \eqn{\theta} as levels. When a factor is treated as fixed, the ##' sums-to-zero linear constraint is enforced by centering the corresponding ##' design matrix, and there is one fewer main effect terms as levels. The ##' Cornfield-Tukey model of interactions is assumed. Details are provided in ##' Rouder et al. (2012) ##' ##' Bayes factors are computed by integrating the likelihood with respect to the ##' priors on parameters. The integration of all parameters except ##' \eqn{g_1,\ldots,g_p} may be expressed in closed-form; the integration of ##' \eqn{g_1,\ldots,g_p} is performed through Monte Carlo sampling, and ##' \code{iterations} is the number of iterations used to estimate the Bayes ##' factor. ##' ##' \code{anovaBF} computes Bayes factors for either all submodels or select ##' submodels missing a single main effect or covariate, depending on the ##' argument \code{whichModels}. If no random factors are specified, the null ##' model assumed by \code{anovaBF} is the grand-mean only model. If random ##' factors are specified, the null model is the model with an additive model on ##' all random factors, plus a grand mean. Thus, \code{anovaBF} does not ##' currently test random factors. Testing random factors is possible with ##' \code{\link{lmBF}}. ##' ##' The argument \code{whichModels} controls which models are tested. Possible ##' values are 'all', 'withmain', 'top', and 'bottom'. Setting ##' \code{whichModels} to 'all' will test all models that can be created by ##' including or not including a main effect or interaction. 'top' will test all ##' models that can be created by removing or leaving in a main effect or ##' interaction term from the full model. 'bottom' creates models by adding ##' single factors or interactions to the null model. 'withmain' will test all ##' models, with the constraint that if an interaction is included, the ##' corresponding main effects are also included. ##' ##' For the \code{rscaleFixed} and \code{rscaleRandom} arguments, several named ##' values are recognized: "medium", "wide", and "ultrawide", corresponding to ##' \eqn{r} scale values of 1/2, \eqn{\sqrt{2}/2}{sqrt(2)/2}, and 1, ##' respectively. In addition, \code{rscaleRandom} can be set to the "nuisance", ##' which sets \eqn{r=1} (and is thus equivalent to "ultrawide"). The "nuisance" ##' setting is for medium-to-large-sized effects assumed to be in the data but ##' typically not of interest, such as variance due to participants. ##' @title Function to compute Bayes factors for ANOVA designs ##' @param formula a formula containing all factors to include in the analysis ##' (see Examples) ##' @param data a data frame containing data for all factors in the formula ##' @param whichRandom a character vector specifying which factors are random ##' @param whichModels which set of models to compare; see Details ##' @param iterations How many Monte Carlo simulations to generate, if relevant ##' @param progress if \code{TRUE}, show progress with a text progress bar ##' @param rscaleFixed prior scale for standardized, reduced fixed effects. A ##' number of preset values can be given as strings; see Details. ##' @param rscaleRandom prior scale for standardized random effects ##' @param rscaleEffects A named vector of prior settings for individual factors, ##' overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names. ##' @param multicore if \code{TRUE} use multiple cores through the \code{doMC} ##' package. Unavailable on Windows. ##' @param method approximation method, if needed. See \code{\link{nWayAOV}} for ##' details. ##' @param noSample if \code{TRUE}, do not sample, instead returning NA. ##' @return An object of class \code{BFBayesFactor}, containing the computed ##' model comparisons ##' @param callback callback function for third-party interfaces ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @export ##' @references Gelman, A. (2005) Analysis of Variance---why it is more ##' important than ever. Annals of Statistics, 33, pp. 1-53. ##' ##' Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) ##' Default Bayes Factors for ANOVA Designs. Journal of Mathematical ##' Psychology. 56. p. 356-374. ##' ##' Zellner, A. and Siow, A., (1980) Posterior Odds Ratios for Selected ##' Regression Hypotheses. In Bayesian Statistics: Proceedings of the First ##' Interanational Meeting held in Valencia (Spain). Bernardo, J. M., ##' Lindley, D. V., and Smith A. F. M. (eds), pp. 585-603. University of ##' Valencia. ##' ##' @note The function \code{anovaBF} will compute Bayes factors for all ##' possible combinations of fixed factors and interactions, against the null ##' hypothesis that \emph{all} effects are 0. The total number of tests ##' computed will be \eqn{2^{2^K - 1}}{2^(2^K - 1)} for \eqn{K} fixed factors. ##' This number increases very quickly with the number of factors. For ##' instance, for a five-way ANOVA, the total number of tests exceeds two ##' billion. Even though each test takes a fraction of a second, the time ##' taken for all tests could exceed your lifetime. An option is included to ##' prevent this: \code{options('BFMaxModels')}, which defaults to 50,000, is ##' the maximum number of models that `anovaBF` will analyze at once. This can ##' be increased by increasing the option value. ##' ##' It is possible to reduce the number of models tested by only testing the ##' most complex model and every restriction that can be formed by removing ##' one factor or interaction using the \code{whichModels} argument. Setting ##' this argument to 'top' reduces the number of tests to \eqn{2^K-1}, which ##' is more manageable. The Bayes factor for each restriction against the most ##' complex model can be interpreted as a test of the removed ##' factor/interaction. Setting \code{whichModels} to 'withmain' will not ##' reduce the number of tests as much as 'top' but the results may be more ##' interpretable, since an interaction is only allowed when all interacting ##' effects (main or interaction) are also included in the model. ##' ##' @examples ##' ## Classical example, taken from t.test() example ##' ## Student's sleep data ##' data(sleep) ##' plot(extra ~ group, data = sleep) ##' ##' ## traditional ANOVA gives a p value of 0.00283 ##' summary(aov(extra ~ group + Error(ID/group), data = sleep)) ##' ##' ## Gives a Bayes factor of about 11.6 ##' ## in favor of the alternative hypothesis ##' anovaBF(extra ~ group + ID, data = sleep, whichRandom = "ID", ##' progress=FALSE) ##' ##' ## Demonstrate top-down testing ##' data(puzzles) ##' result = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", ##' whichModels = 'top', progress=FALSE) ##' result ##' ##' ## In orthogonal designs, the top down Bayes factor can be ##' ## interpreted as a test of the omitted effect ##' @keywords htest ##' @seealso \code{\link{lmBF}}, for testing specific models, and ##' \code{\link{regressionBF}} for the function similar to \code{anovaBF} for ##' linear regression models. anovaBF <- function(formula, data, whichRandom = NULL, whichModels = "withmain", iterations = 10000, progress = getOption('BFprogress', interactive()), rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleEffects = NULL, multicore = FALSE, method="auto", noSample=FALSE, callback=function(...) as.integer(0)) { data <- marshallTibble(data) checkFormula(formula, data, analysis = "anova") # pare whichRandom down to terms that appear in the formula whichRandom <- whichRandom[whichRandom %in% fmlaFactors(formula, data)[-1]] if(all(fmlaFactors(formula, data)[-1] %in% whichRandom)){ # No fixed factors! bf = lmBF(formula, data, whichRandom, rscaleFixed, rscaleRandom, rscaleEffects = rscaleEffects, progress = progress, method = method, noSample = noSample) return(bf) } dataTypes <- createDataTypes(formula, whichRandom, data, analysis = "anova") fmla <- createFixedAnovaModel(dataTypes, formula) models <- enumerateAnovaModels(fmla, whichModels, data) if(length(models)>getOption('BFMaxModels', 50000)) stop("Maximum number of models exceeded (", length(models), " > ",getOption('BFMaxModels', 50000) ,"). ", "The maximum can be increased by changing ", "options('BFMaxModels').") if(length(whichRandom) > 0 ){ models <- lapply(models, addRandomModelPart, dataTypes = dataTypes) models <- c(models, addRandomModelPart(fmla, dataTypes, null=TRUE)) } if(multicore){ message("Note: Progress bars and callbacks are suppressed when running multicore.") if(!requireNamespace("doMC", quietly = TRUE)){ stop("Required package (doMC) missing for multicore functionality.") } doMC::registerDoMC() if(foreach::getDoParWorkers()==1){ warning("Multicore specified, but only using 1 core. Set options(cores) to something >1.") } bfs <- foreach::"%dopar%"( foreach::foreach(gIndex=models, .options.multicore=mcoptions), lmBF(gIndex,data = data, whichRandom = whichRandom, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleEffects = rscaleEffects, iterations = iterations, method=method, progress=FALSE, noSample = noSample) ) }else{ # Single core checkCallback(callback,as.integer(0)) bfs = NULL myCallback <- function(prgs){ frac <- (i - 1 + prgs/1000)/length(models) ret <- callback(frac*1000) return(as.integer(ret)) } if(progress){ pb = txtProgressBar(min = 0, max = length(models), style = 3) }else{ pb = NULL } for(i in 1:length(models)){ oneModel <- lmBF(models[[i]],data = data, whichRandom = whichRandom, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleEffects = rscaleEffects, iterations = iterations, progress = FALSE, method = method, noSample=noSample,callback=myCallback) if(inherits(pb,"txtProgressBar")) setTxtProgressBar(pb, i) bfs = c(bfs,oneModel) } if(inherits(pb,"txtProgressBar")) close(pb) checkCallback(callback,as.integer(1000)) } # combine all the Bayes factors into one BFBayesFactor object bfObj = do.call("c", bfs) # If we have random effects, make those the denominator if(length(whichRandom) > 0) bfObj = bfObj[-length(bfObj)] / bfObj[length(bfObj)] if(whichModels=="top") bfObj = BFBayesFactorTop(bfObj) return(bfObj) } BayesFactor/R/version.R0000644000176200001440000000134213043077372014473 0ustar liggesusers#'Prints the version information for the BayesFactor package #' #'Prints the version, revision, and date information for the BayesFactor package #' #'This function prints the version and revision information for the BayesFactor #'package. #' #'@param print if \code{TRUE}, print version information to the console #'@return \code{BFInfo} returns a character string containing the version and #' revision number of the package.. #'@author Richard D. Morey (\email{richarddmorey@@gmail.com}) #'@keywords misc #'@export BFInfo <- function(print=TRUE) { if(print){ cat("Package BayesFactor\n") cat(packageDescription("BayesFactor")$Version,"\n") } retStr = paste(packageDescription("BayesFactor")$Version) invisible(retStr) } BayesFactor/R/model.matrix.R0000644000176200001440000000467113043077372015421 0ustar liggesusers designMatrix = function(bf, ...){ model = bf@numerator[[1]] if( class(model) != "BFlinearModel" ) stop("Model matrix not defined for this model type.") designMatrixJZS_LM(bf, ...) } designMatrixJZS_LM = function(bf, ...){ model = bf@numerator[[1]] data = bf@data dataTypes = model@dataTypes formula = formula(model@identifier$formula) checkFormula(formula, data, analysis = "lm") factors = fmlaFactors(formula, data)[-1] nFactors = length(factors) if( nFactors == 0 ){ X = matrix(1,nrow(data),1) gMap = c(intercept=NA) }else{ # Remove "as.matrix" when sparse matrix support is added X = as.matrix(fullDesignMatrix(formula, data, dataTypes)) gMap = createGMap(formula, data, dataTypes) X = cbind(1,X) gMap = c(intercept=NA, gMap) } attr(X,"gMap") = gMap return(X) } #' Design matrices for Bayes factor linear models analyses. #' #' This function returns the design matrix used for computation of the Bayes factor #' for the numerator of a \code{BFBayesFactor} object. There must not be more #' than one numerator in the \code{BFBayesFactor} object. #' @param object a BayesFactor object with a single numerator #' @param ... arguments passed to and from related methods #' @return Returns the design matrix for the corresponding model. The 'gMap' attribute of the returned #' matrix contains the mapping from columns of the design matrix to g parameters #' @export #' @docType methods #' @rdname model.matrix-methods #' @aliases model.matrix,BFBayesFactor #' @references Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) #' Default Bayes Factors for ANOVA Designs. Journal of Mathematical #' Psychology. 56. p. 356-374. #' @examples #' ## Gets the design matrix for a simple analysis #' data(sleep) #' #' bf = anovaBF(extra ~ group + ID, data = sleep, whichRandom="ID", progress=FALSE) #' X = model.matrix(bf) #' #' ## Show dimensions of X (should be 20 by 12) #' dim(X) setMethod('model.matrix', signature(object = "BFBayesFactor"), function(object, ...){ if(length(object)>1) stop("Must specify single model.") designMatrix(object, ...) } ) #' @rdname model.matrix-methods #' @aliases model.matrix,BFBayesFactor setMethod('model.matrix', signature(object = "BFBayesFactorTop"), function(object, ...){ if(length(object)>1) stop("Must specify single model.") designMatrix(as.BFBayesFactor(object), ...) } ) BayesFactor/R/ttest_tstat.R0000644000176200001440000000772213043100777015374 0ustar liggesusers##' Using the classical t test statistic for a one- or two-sample design, this ##' function computes the corresponding Bayes factor test. ##' ##' This function can be used to compute the Bayes factor corresponding to a ##' one-sample, a paired-sample, or an independent-groups t test, using the ##' classical t statistic. It can be used when you don't have access to the ##' full data set for analysis by \code{\link{ttestBF}}, but you do have the ##' test statistic. ##' ##' For details about the model, see the help for \code{\link{ttestBF}}, and the ##' references therein. ##' ##' The Bayes factor is computed via Gaussian quadrature. ##' @title Use t statistic to compute Bayes factor for one- and two- sample designs ##' @param t classical t statistic ##' @param n1 size of first group (or only group, for one-sample tests) ##' @param n2 size of second group, for independent-groups tests ##' @param nullInterval optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in standardized units ##' @param rscale numeric prior scale ##' @param complement if \code{TRUE}, compute the Bayes factor against the complement of the interval ##' @param simple if \code{TRUE}, return only the Bayes factor ##' @return If \code{simple} is \code{TRUE}, returns the Bayes factor (against the ##' null). If \code{FALSE}, the function returns a ##' vector of length 3 containing the computed log(e) Bayes factor, ##' along with a proportional error estimate on the Bayes factor and the method used to compute it. ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) and Jeffrey N. ##' Rouder (\email{rouderj@@missouri.edu}) ##' @keywords htest ##' @export ##' @references Morey, R. D. & Rouder, J. N. (2011). Bayes Factor Approaches for ##' Testing Interval Null Hypotheses. Psychological Methods, 16, 406-419 ##' ##' Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. ##' (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. ##' Psychonomic Bulletin & Review, 16, 225-237 ##' @note In version 0.9.9, the behaviour of this function has changed in order to produce more uniform results. In ##' version 0.9.8 and before, this function returned two Bayes factors when \code{nullInterval} was ##' non-\code{NULL}: the Bayes factor for the interval versus the null, and the Bayes factor for the complement of ##' the interval versus the null. Starting in version 0.9.9, in order to get the Bayes factor for the complement, it is required to ##' set the \code{complement} argument to \code{TRUE}, and the function only returns one Bayes factor. ##' @seealso \code{\link{integrate}}, \code{\link{t.test}}; see ##' \code{\link{ttestBF}} for the intended interface to this function, using ##' the full data set. ##' @examples ##' ## Classical example: Student's sleep data ##' data(sleep) ##' plot(extra ~ group, data = sleep) ##' ##' ## t.test() gives a t value of -4.0621 ##' t.test(extra ~ group, data = sleep, paired=TRUE) ##' ## Gives a Bayes factor of about 15 ##' ## in favor of the alternative hypothesis ##' result <- ttest.tstat(t = -4.0621, n1 = 10) ##' exp(result[['bf']]) ttest.tstat=function(t,n1,n2=0,nullInterval=NULL,rscale="medium", complement=FALSE, simple = FALSE) { if(n2){ rscale = rpriorValues("ttestTwo",,rscale) }else{ rscale = rpriorValues("ttestOne",,rscale) } stopifnot(length(t)==1 & length(n1)==1) nu=ifelse(n2==0 | is.null(n2),n1-1,n1+n2-2) n=ifelse(n2==0 | is.null(n2), n1, exp(log(n1)+log(n2)-log(n1+n2)) ) if( (n < 1) | (nu < 1)) stop("not enough observations") if(is.infinite(t)) stop("data are essentially constant") r2=rscale^2 log.marg.like.0= -(nu+1)/2 * log(1+t^2/(nu)) res = list(bf=NA, properror=NA,method=NA) if(is.null(nullInterval)){ BFtry({res = meta.t.bf(t,n,nu,rscale=rscale)}) }else{ BFtry({res = meta.t.bf(t,n,nu,interval=nullInterval,rscale=rscale,complement = complement)}) } if(simple){ return(c(B10=exp(res$bf))) }else{ return(res) } } BayesFactor/R/methods-BFBayesFactorList.R0000644000176200001440000000761412452540640017721 0ustar liggesusers BFBayesFactorList<- function(li){ col_nms = sapply(li,function(el) el@denominator@shortName) names(li) = make.unique(col_nms, sep=" #") new("BFBayesFactorList", li, version=BFInfo(FALSE)) } setValidity("BFBayesFactorList", function(object){ firstNumerator = object[[1]]@numerator sameNumerators = unlist(lapply(object, function(el, firstNumerator) { identical(el@numerator,firstNumerator) }, firstNumerator = firstNumerator)) if(any(!sameNumerators)) return("All numerators in elements of BayesFactorList must be identical") return(TRUE) }) setMethod('show', "BFBayesFactorList", function(object){ print(as(object,"matrix")) }) #' @rdname BFBayesFactorList-class #' @name t,BFBayesFactorList-method #' @param x a BFBayesFactorList object setMethod('t', "BFBayesFactorList", function(x){ return(1/x) }) #' @rdname BFBayesFactorList-class #' @name /,numeric,BFBayesFactorList-method #' @param e1 Numerator of the ratio #' @param e2 Denominator of the ratio setMethod('/', signature("numeric", "BFBayesFactorList"), function(e1, e2){ if( (e1 == 1) & (length(e2[[1]])==1) ){ bflist = lapply(e2,function(el) 1/el) return(do.call('c',bflist)) }else if( e1 != 1 ){ stop("Dividend must be 1 (to take reciprocal).") }else if( length(e2[[1]])>1 ){ vec = vector(mode = "list", length = length(e2[[1]])) for(i in 1:length(e2[[1]])){ vec[[i]] = 1/e2[i,] } bflist = BFBayesFactorList(vec) return(bflist) } } ) #' @rdname BFBayesFactorList-class #' @name [,BFBayesFactorList,index,index,missing-method #' @param i indices specifying rows to extract #' @param j indices specifying columns to extract #' @param drop unused #' @param ... further arguments passed to related methods setMethod("[", signature(x = "BFBayesFactorList", i = "index", j = "index", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 3){ x = x[i,][,j] }else stop("invalid nargs()= ",na) return(x) }) #' @rdname BFBayesFactorList-class #' @name [,BFBayesFactorList,index,missing,missing-method setMethod("[", signature(x = "BFBayesFactorList", i = "index", j = "missing", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 3){ bfs = lapply(x,function(el,i) el[i], i = i) x = BFBayesFactorList(bfs) }else stop("invalid nargs()= ",na) return(x) }) #' @rdname BFBayesFactorList-class #' @name [,BFBayesFactorList,missing,index,missing-method setMethod("[", signature(x = "BFBayesFactorList", i = "missing", j = "index", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 3){ if(length(j)==1){ x = x[[j]] }else if(length(j)>1){ x = as(x, "vector") x = BFBayesFactorList(x[j]) } }else stop("invalid nargs()= ",na) return(x) }) setAs("BFBayesFactorList" , "list", function ( from , to ){ as.vector(from) }) setAs("BFBayesFactorList" , "vector", function ( from , to ){ as.vector(from) }) setAs("BFBayesFactorList" , "matrix", function ( from , to ){ as.matrix(from) }) ## S3 Methods ##### as.vector.BFBayesFactorList <- function(x, mode = "any"){ if( !(mode %in% c("any", "list"))) stop("Cannot coerce to mode ", mode) vec = vector(mode = "list", length = length(x) ) for(i in 1:length(x)) vec[[i]] = x[[i]] names(vec) = names(x) return(vec) } as.matrix.BFBayesFactorList <- function(x,...){ matr <- sapply(x, as.vector) dim(matr) <- c(length(x[[1]]),length(x)) numNames <- rownames(extractBF(x[[1]])) denNames <- names(x) dimnames(matr) = list(numerator=numNames, denominator=denNames) return(as.matrix(matr)) } BayesFactor/R/ttest-informed-JASP.R0000644000176200001440000003106613274042462016511 0ustar liggesuserslibrary(hypergeo) A <- function(t, n, nu, mu.delta, g) { Re(hypergeo::genhypergeo(U = (nu + 1)/2, L = 1/2, z = mu.delta^2*t^2/ (2*(1/n + g)*((1 + n*g)*nu + t^2)))) } B <- function(t, n, nu, mu.delta, g) { out <- mu.delta*t/sqrt(1/2*(1/n + g)*((1 + n*g)*nu + t^2)) * exp(lgamma((nu + 2)/2) - lgamma((nu + 1)/2)) * Re(hypergeo::genhypergeo(U = (nu + 2)/2, L = 3/2, z = mu.delta^2*t^2/ (2*(1/n + g)*((1 + n*g)*nu + t^2)))) return(out) } C <- function(delta, t, n, nu) { Re(hypergeo::genhypergeo(U = (nu + 1)/2, L = 1/2, z = n*t^2*delta^2/(2*(nu + t^2)))) } D <- function(delta, t, n, nu) { out <- t*delta*sqrt(2*n/(nu + t^2))* exp(lgamma((nu + 2)/2) - lgamma((nu + 1)/2))* Re(hypergeo::genhypergeo(U = (nu + 2)/2, L = 3/2, z = n*t^2*delta^2/(2*(nu + t^2)))) return(out) } term_normalprior <- function(t, n, nu, mu.delta, g) { (1 + n*g)^(-1/2) * exp(-mu.delta^2/(2*(1/n + g))) * (1 + t^2/(nu*(1 + n*g)))^(-(nu + 1)/2) * (A(t, n, nu, mu.delta, g) + B(t, n, nu, mu.delta, g)) } integrand <- function(g, t, n, nu, mu.delta, r, kappa) { tmp <- term_normalprior(t = t, n = n, nu = nu, mu.delta = mu.delta, g = g) pg_log <- kappa/2*(2*log(r) + log(kappa/2)) - lgamma(kappa/2) - (kappa/2 + 1)*log(g) - r^2*kappa/(2*g) pg <- exp(pg_log) out <- tmp*pg return(out) } dtss <- function(delta, mu.delta, r, kappa, log = FALSE) { out <- - log(r) + lgamma((kappa + 1)/2) - .5*(log(pi) + log(kappa)) - lgamma(kappa/2) - (kappa + 1)/2 * log(1 + ((delta - mu.delta)/r)^2/kappa) if ( ! log) out <- exp(out) return(out) } posterior_t_tmp <- function(delta, t, ny, nx = NULL, independentSamples = FALSE, prior.location, prior.scale, prior.df, rel.tol = .Machine$double.eps^0.25) { neff <- ifelse(independentSamples, ny*nx/(ny + nx), ny) nu <- ifelse(independentSamples, ny + nx - 2, ny - 1) mu.delta <- prior.location r <- prior.scale kappa <- prior.df numerator <- exp(-neff/2*delta^2)*(1 + t^2/nu)^(-(nu + 1)/2)* (C(delta, t, neff, nu) + D(delta, t, neff, nu))* dtss(delta, mu.delta, r, kappa) denominator <- integrate(integrand, lower = 0, upper = Inf, t = t, n = neff, nu = nu, mu.delta = mu.delta, r = r, kappa = kappa, rel.tol = rel.tol)$value out <- numerator/denominator if ( is.na(out)) out <- 0 return(out) } posterior_t <- Vectorize(posterior_t_tmp, "delta") cdf_t <- function(x, t, ny, nx = NULL, independentSamples = FALSE, prior.location, prior.scale, prior.df) { integrate(posterior_t, lower = -Inf, upper = x, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df)$value } quantile_t <- function(q, t, ny, nx = NULL, independentSamples = FALSE, prior.location, prior.scale, prior.df, tol = 0.0001, max.iter = 100) { # compute quantiles via Newton-Raphson method x.cur <- Inf # get reasonable starting value delta <- seq(-2, 2, length.out = 400) dens <- posterior_t(delta, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) x.new <- delta[which.max(dens)] i <- 1 while (abs(x.cur - x.new) > tol && i < max.iter) { x.cur <- x.new x.new <- x.cur - (cdf_t(x.cur, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) - q)/ posterior_t(x.cur, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) i <- i + 1 } return(x.new) } ciPlusMedian_t <- function(t, ny, nx = NULL, independentSamples = FALSE, prior.location, prior.scale, prior.df, ci = .95, type = "two-sided", tol = 0.0001, max.iter = 100) { lower <- (1 - ci)/2 upper <- ci + (1 - ci)/2 med <- .5 postAreaSmaller0 <- cdf_t(x = 0, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) if (type == "plus-sided") { lower <- postAreaSmaller0 + (1 - postAreaSmaller0)*lower upper <- postAreaSmaller0 + (1 - postAreaSmaller0)*upper med <- postAreaSmaller0 + (1 - postAreaSmaller0)*med } else if (type == "min-sided") { lower <- postAreaSmaller0*lower upper <- postAreaSmaller0*upper med <- postAreaSmaller0*med } ciLower <- quantile_t(lower, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) ciUpper <- quantile_t(upper, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) median <- quantile_t(med, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) return(list(ciLower = ciLower, median = median, ciUpper = ciUpper)) } posterior_normal_tmp <- function(delta, t, ny, nx = NULL, independentSamples = FALSE, prior.mean, prior.variance, rel.tol = .Machine$double.eps^0.25) { neff <- ifelse(independentSamples, ny*nx/(ny + nx), ny) nu <- ifelse(independentSamples, ny + nx - 2, ny - 1) mu.delta <- prior.mean g <- prior.variance numerator <- exp(-neff/2*delta^2)*(1 + t^2/nu)^(-(nu + 1)/2)* (C(delta, t, neff, nu) + D(delta, t, neff, nu))* dnorm(delta, mu.delta, sqrt(g)) denominator <- term_normalprior(t = t, n = neff, nu = nu, mu.delta = mu.delta, g = g) out <- numerator/denominator if ( is.na(out)) out <- 0 return(out) } posterior_normal <- Vectorize(posterior_normal_tmp, "delta") cdf_normal <- function(x, t, ny, nx = NULL, independentSamples = FALSE, prior.mean, prior.variance) { integrate(posterior_normal, lower = -Inf, upper = x, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance)$value } quantile_normal <- function(q, t, ny, nx = NULL, independentSamples = FALSE, prior.mean, prior.variance, tol = 0.0001, max.iter = 100) { # compute quantiles via Newton-Raphson method x.cur <- Inf # get reasonable start value delta <- seq(-2, 2, length.out = 400) dens <- posterior_normal(delta, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) x.new <- delta[which.max(dens)] i <- 1 while (abs(x.cur - x.new) > tol && i < max.iter) { x.cur <- x.new x.new <- x.cur - (cdf_normal(x.cur, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) - q)/ posterior_normal(x.cur, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) i <- i + 1 } return(x.new) } ciPlusMedian_normal <- function(t, ny, nx = NULL, independentSamples = FALSE, prior.mean, prior.variance, ci = .95, type = "two-sided", tol = 0.0001, max.iter = 100) { lower <- (1 - ci)/2 upper <- ci + (1 - ci)/2 med <- .5 postAreaSmaller0 <- cdf_normal(x = 0, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) if (type == "plus-sided") { lower <- postAreaSmaller0 + (1 - postAreaSmaller0)*lower upper <- postAreaSmaller0 + (1 - postAreaSmaller0)*upper med <- postAreaSmaller0 + (1 - postAreaSmaller0)*med } else if (type == "min-sided") { lower <- postAreaSmaller0*lower upper <- postAreaSmaller0*upper med <- postAreaSmaller0*med } ciLower <- quantile_normal(lower, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) ciUpper <- quantile_normal(upper, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) median <- quantile_normal(med, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) return(list(ciLower = ciLower, median = median, ciUpper = ciUpper)) } bf10_t <- function(t, ny, nx = NULL, independentSamples = FALSE, prior.location, prior.scale, prior.df, rel.tol = .Machine$double.eps^0.25) { neff <- ifelse(independentSamples, ny*nx/(ny + nx), ny) nu <- ifelse(independentSamples, ny + nx - 2, ny - 1) mu.delta <- prior.location r <- prior.scale kappa <- prior.df numerator <- integrate(integrand, lower = 0, upper = Inf, t = t, n = neff, nu = nu, mu.delta = mu.delta, r = r, kappa = kappa, rel.tol = rel.tol)$value denominator <- (1 + t^2/nu)^(-(nu + 1)/2) BF10 <- numerator/denominator priorAreaSmaller0 <- integrate(dtss, lower = -Inf, upper = 0, mu.delta = prior.location, r = prior.scale, kappa = prior.df)$value postAreaSmaller0 <- cdf_t(x = 0, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.location = prior.location, prior.scale = prior.scale, prior.df = prior.df) BFmin1 <- postAreaSmaller0/priorAreaSmaller0 BFplus1 <- (1 - postAreaSmaller0)/(1 - priorAreaSmaller0) BFmin0 <- BFmin1 * BF10 BFplus0 <- BFplus1 * BF10 return(list(BF10 = BF10, BFplus0 = BFplus0, BFmin0 = BFmin0)) } bf10_normal <- function(t, ny, nx = NULL, independentSamples = FALSE, prior.mean, prior.variance) { neff <- ifelse(independentSamples, ny*nx/(ny + nx), ny) nu <- ifelse(independentSamples, ny + nx - 2, ny - 1) mu.delta <- prior.mean g <- prior.variance numerator <- term_normalprior(t = t, n = neff, nu = nu, mu.delta = mu.delta, g = g) denominator <- (1 + t^2/nu)^(-(nu + 1)/2) BF10 <- numerator/denominator priorAreaSmaller0 <- pnorm(0, mean = prior.mean, sd = sqrt(prior.variance)) postAreaSmaller0 <- cdf_normal(x = 0, t = t, ny = ny, nx = nx, independentSamples = independentSamples, prior.mean = prior.mean, prior.variance = prior.variance) BFmin1 <- postAreaSmaller0/priorAreaSmaller0 BFplus1 <- (1 - postAreaSmaller0)/(1 - priorAreaSmaller0) BFmin0 <- BFmin1 * BF10 BFplus0 <- BFplus1 * BF10 return(list(BF10 = BF10, BFplus0 = BFplus0, BFmin0 = BFmin0)) } BayesFactor/R/oneWayAOV_Fstat.R0000644000176200001440000000610012577227532015762 0ustar liggesusers ##' Using the classical F test statistic for a balanced one-way design, this function computes the corresponding Bayes factor test. ##' ##' For F statistics computed from balanced one-way designs, this function can ##' be used to compute the Bayes factor testing the model that all group means ##' are not equal to the grand mean, versus the null model that all group means ##' are equal. It can be used when you don't have access to the full data set ##' for analysis by \code{\link{lmBF}}, but you do have the test statistic. ##' ##' For details about the model, see the help for \code{\link{anovaBF}}, and the references therein. ##' ##' The Bayes factor is computed via Gaussian quadrature. ##' @title Use F statistic to compute Bayes factor for balanced one-way designs ##' @param F F statistic from classical ANOVA ##' @param N number of observations per cell or group ##' @param J number of cells or groups ##' @param rscale numeric prior scale ##' @param simple if \code{TRUE}, return only the Bayes factor ##' @return If \code{simple} is \code{TRUE}, returns the Bayes factor (against the ##' intercept-only null). If \code{FALSE}, the function returns a ##' vector of length 3 containing the computed log(e) Bayes factor, ##' along with a proportional error estimate on the Bayes factor and the method used to compute it. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @references Morey, R. D., Rouder, J. N., Pratte, M. S., \& Speckman, P. L. ##' (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. ##' Journal of Mathematical Psychology, 55, 368-378 ##' ##' @note \code{oneWayAOV.Fstat} should only be used with F values obtained from ##' balanced designs. ##' @examples ##' ## Example data "InsectSprays" - see ?InsectSprays ##' require(stats); require(graphics) ##' boxplot(count ~ spray, data = InsectSprays, xlab = "Type of spray", ##' ylab = "Insect count", main = "InsectSprays data", varwidth = TRUE, ##' col = "lightgray") ##' ##' ## Classical analysis (with transformation) ##' classical <- aov(sqrt(count) ~ spray, data = InsectSprays) ##' plot(classical) ##' summary(classical) ##' ##' ## Bayes factor (a very large number) ##' Fvalue <- anova(classical)$"F value"[1] ##' result <- oneWayAOV.Fstat(Fvalue, N=12, J=6) ##' exp(result[['bf']]) ##' @seealso \code{\link{integrate}}, \code{\link{aov}}; see \code{\link{lmBF}} for the intended interface to this function, using the full data set. oneWayAOV.Fstat = function(F, N, J, rscale="medium", simple = FALSE) { rscale = rpriorValues("allNways","fixed",rscale) res = list(bf=NA, properror=NA,method="quadrature") BFtry({ log.const = marginal.g.oneWay(1,F=F,N=N,J=J,rscale=rscale,log=TRUE) integral = integrate(marginal.g.oneWay,lower=0,upper=Inf,F=F,N=N,J=J,rscale=rscale,log.const=log.const) properror = exp(log(integral[[2]]) - log(integral[[1]])) bf = log(integral[[1]]) + log.const res = list(bf=bf, properror=properror, method="quadrature") }) if(simple){ return(c(B10=exp(res[['bf']]))) }else{ return(res) } } BayesFactor/R/checking.R0000644000176200001440000000632713043077372014571 0ustar liggesuserscreateDataTypes <- function(formula, whichRandom, data, analysis){ factors <- rownames(attr(terms(formula, data = data),"factors"))[-1] factors <- unlist(decomposeTerms(factors)) cnames <- colnames(data) # check status of data columns types = sapply(cnames, function(name, data){ ifelse(is.factor(data[,name]), "fixed", "continuous") }, data = data) # restrict to only columns of interest types = types[ names(types) %in% factors ] if(length(types) <1 ) return(c()) if( any(types[ names(types) %in% whichRandom ] == "continuous") ) stop("Nonfactors are specified as random.") if(length(whichRandom)>0) types[ names(types) %in% whichRandom ] = "random" #### check various analysis types ## ANOVA can only accept factors if( any(types=="continuous") & analysis == "anova" ) stop("anovaBF() cannot be used with nonfactor independent variables. Use lmBF(), regressionBF(), or generalTestBF() instead.") ## regression can only accept nonfactors if( any(types %in% c("fixed", "random")) & analysis == "regression" ) stop("regressionBF() cannot be used with factor independent variables. Use lmBF(), anovaBF(), or generalTestBF() instead.") #### End checking analysis types return(types) } checkFormula <- function(formula, data, analysis){ if(length(formula) < 3) stop("LHS of formula must be given.") cnames = colnames(data) dv = stringFromFormula(formula[[2]]) if(!is.numeric(data[,dv])) stop("Dependent variable must be numeric.") if(any(is.na(data[,dv])) | any(is.infinite(data[,dv]))) stop("Dependent variable must not contain missing or infinite values.") factors = fmlaFactors(formula, data) terms = colnames(attr(terms(formula, data = data),"factors")) decom = decomposeTerms(terms) terms = unlist(decom) vars = rownames(attr(terms(formula, data = data),"factors")) vars = unlist(decomposeTerms(vars)) if(any(is.na(data[,vars]))) stop("Predictors must not contain missing values.") if(is.null(factors)) return() if(factors[1] %in% terms) stop("Dependent variable cannot be a predictor.") if(!all(factors %in% cnames)) stop("Some variables missing in data frame.") if(analysis=="regression"){ RHS = stringFromFormula(formula[[3]]) lengths = sapply(decom, length) if (any(lengths > 1)) stop("Interactions not allowed in regressionBF (try generalTestBF).") } if(analysis=="lm" | analysis=="anova" | analysis == "regression" | analysis == "indept") if(attr(terms(formula, data = data),"intercept") == 0) stop("Formula must include intercept.") if(analysis=="indept"){ if( length(decom) > 1 ) stop("Indep. groups t test can only support 1 factor as predictor.") if(length(decom[[1]]) > 1) stop("Interaction terms are not allowed in t test.") if(nlevels(factor(data[,terms])) > 2) stop("Indep. groups t test requires a factor with exactly 2 levels.") } invisible() } checkEffects <- function(effects, data, dataTypes){ if(!all(effects %in% colnames(data))) stop("Term in formula missing in data") if(!all(effects %in% names(dataTypes))) stop("Term in formula missing in dataTypes") # add more checking code here # most importantly, to check consistancy of data factors and dataTypes # no factors should be labeled as continuous, etc } BayesFactor/R/nWayAOV-utility.R0000644000176200001440000003616713274042462016006 0ustar liggesuserssingleGBayesFactor <- function(y,X,rscale,gMap,incCont){ if(ncol(X)==1){ dat = data.frame(y=y,x=as.factor(X[,1])) freqs = table(dat$x) t = t.test(y~x,data=dat, var.eq=TRUE)$statistic bf = ttest.tstat(t=t, n1=freqs[1], n2=freqs[2],rscale=rscale*sqrt(2)) return(bf) }else{ N = length(y) if(!incCont){ priorX = matrix(1,0,0) }else if(incCont == 1){ priorX = matrix(sum(X[,1]^2),1,1) / N }else{ priorX = crossprod(X[,1:incCont]) / N } Cny = matrix(y - mean(y), N) CnX = t(t(X) - colMeans(X)) XtCnX = crossprod(CnX) CnytCnX = crossprod(Cny, CnX) sumSq = var(y) * (N-1) gMapCounts = table(gMap) f1 = Vectorize( function(g, const, ...){ exp(Qg(log(g), ..., limit=FALSE) - log(g) - const) },"g") integral = BFtry({ op = optim(0, Qg, control=list(fnscale=-1),gr=dQg, method="BFGS", sumSq=sumSq,N=N,XtCnX=XtCnX,CnytCnX=CnytCnX, rscale=rscale, gMap=gMap, gMapCounts=gMapCounts,priorX=priorX,incCont=incCont) const = op$value - op$par integrate(f1,0,Inf,sumSq=sumSq,N=N,XtCnX=XtCnX,CnytCnX=CnytCnX,rscale=rscale,gMap=gMap,gMapCounts=gMapCounts,const=const,priorX=priorX,incCont=incCont) }) if(inherits(integral,"try-error")){ return(list(bf = NA, properror = NA, method = "quadrature")) } lbf = log(integral$value) prop.error = exp(log(integral$abs.error) - lbf) return(list(bf = lbf + const, properror = prop.error, method = "quadrature")) } } doNwaySampling<-function(method, y, X, rscale, iterations, gMap, incCont, progress, callback = function(...) as.integer(0)) { goodSamples = NULL simpSamples = NULL impSamples = NULL apx = NULL testNsamples = getOption('BFpretestIterations', 100) testCallback = function(...) callback(0) if(ncol(X)==1) method="simple" if(method=="auto"){ simpSamples = BFtry(jzs_sampler(testNsamples, y, X, rscale, gMap, incCont, NA, NA, FALSE, testCallback, 1, 0)) simpleErr = propErrorEst(simpSamples) logAbsSimpErr = logMeanExpLogs(simpSamples) + log(simpleErr) apx = suppressWarnings(BFtry(gaussianApproxAOV(y,X,rscale,gMap,incCont))) if(inherits(apx,"try-error")){ method="simple" }else{ impSamples = BFtry(jzs_sampler(testNsamples, y, X, rscale, gMap, incCont, apx$mu, apx$sig, FALSE, testCallback, 1, 1)) if(inherits(impSamples, "try-error")){ method="simple" }else{ impErr = propErrorEst(impSamples) logAbsImpErr = logMeanExpLogs(impSamples) + log(impErr) if(is.na(impErr)){ method="simple" }else if(is.na(simpleErr)){ method="importance" }else{ method = ifelse(impErr>simpleErr,"simple","importance") } } } } if(method=="importance"){ if(is.null(apx) | inherits(apx,"try-error")) apx = BFtry(gaussianApproxAOV(y,X,rscale,gMap,incCont)) if(inherits(apx, "try-error")){ method="simple" }else{ goodSamples= BFtry(jzs_sampler(iterations, y, X, rscale, gMap, incCont, apx$mu, apx$sig, progress, callback, 1, 1)) if(inherits(goodSamples,"try-error")){ method="simple" goodSamples = NULL } } } if(method=="simple" | is.null(goodSamples)){ method = "simple" goodSamples = jzs_sampler(iterations, y, X, rscale, gMap, incCont, NA, NA, progress, callback, 1, 0) } if(is.null(goodSamples)){ warning("Unknown sampling method requested (or sampling failed) for nWayAOV") return(list(bf=NA,properror=NA,method=NA)) } if( any(is.na(goodSamples)) ) warning("Some NAs were removed from sampling results: ",sum(is.na(goodSamples))," in total.") bfSamp = goodSamples[!is.na(goodSamples)] n2 = length(bfSamp) bf = logMeanExpLogs(bfSamp) # estimate error properror = propErrorEst(bfSamp) return(list(bf = bf, properror=properror, N = n2, method = method, sampled = TRUE, code = randomString(1))) } createRscales <- function(formula, data, dataTypes, rscaleFixed = NULL, rscaleRandom = NULL, rscaleCont = NULL, rscaleEffects = NULL){ rscaleFixed = rpriorValues("allNways","fixed",rscaleFixed) rscaleRandom = rpriorValues("allNways","random",rscaleRandom) rscaleCont = rpriorValues("regression",,rscaleCont) types = termTypes(formula, data, dataTypes) nFac = sum( (types=="random") | (types=="fixed") ) nCont = any(types=="continuous") * 1 nGs = nFac + nCont rscale = 1:nGs * NA rscaleTypes = rscale if(nCont > 0){ rscaleTypes[nGs] = "continuous" names(rscaleTypes)[nGs] = "continuous" } if(nFac > 0){ facTypes = types[types != "continuous"] rscaleTypes[1:nFac] = facTypes names(rscaleTypes)[1:nFac] = names(facTypes) } names(rscale) = names(rscaleTypes) rscale[rscaleTypes=="continuous"] = rscaleCont rscale[rscaleTypes=="fixed"] = rscaleFixed rscale[rscaleTypes=="random"] = rscaleRandom if( any( names(rscaleEffects) %in% names(types)[types == "continuous"] ) ){ stop("Continuous prior settings set from rscaleEffects; use rscaleCont instead.") #rscaleEffects = rscaleEffects[ !( names(rscaleEffects) %in% names(types)[types == "continuous"] ) ] } if(length(rscaleEffects)>0) rscale[names(rscale) %in% names(rscaleEffects)] = rscaleEffects[names(rscale)[names(rscale) %in% names(rscaleEffects)]] rscale = mapply(rpriorValues,effectType=rscaleTypes, priorType=rscale,MoreArgs = list(modelType="allNways")) return(rscale) } createGMap <- function(formula, data, dataTypes){ factors = fmlaFactors(formula, data)[-1] if(length(factors)<1) return(c()) # Compute number of parameters for each specified column nXcols = numColsForFactor(formula, data, dataTypes) lvls = termLevels(formula, data, nXcols) types = termTypes(formula, data, dataTypes) # each random or fixed group gets a parameter, and all continuous together get 1 nFac = sum( (types=="random") | (types=="fixed") ) nCont = any(types=="continuous") * 1 nGs = nFac + nCont P = sum(lvls) gGroups = inverse.rle(list(lengths=lvls,values=names(lvls))) gMap = 1:P * NA names(gMap) = gGroups gGroupsFac = lvls[types != "continuous"] * 0 + (1:nFac - 1) gMap[types[gGroups] == "continuous"] = nGs - 1 gMap[types[gGroups] != "continuous"] = gGroupsFac[names(gMap[types[gGroups] != "continuous"])] return(gMap) } numColsForFactor <- function(formula, data, dataTypes){ factors = fmlaFactors(formula, data)[-1] sapply(factors, function(el, data, dataTypes){ switch(dataTypes[el], fixed = nlevels(data[,el]) - 1, random = nlevels(data[,el]), continuous = 1 ) }, data = data, dataTypes = dataTypes) } termLevels <- function(formula, data, nXcols){ trms = attr(terms(formula, data = data),"term.labels") sapply(trms, function(term, nXcols){ constit = decomposeTerm(term) prod(nXcols[constit]) }, nXcols = nXcols) } termTypes <- function(formula, data, dataTypes){ trms = attr(terms(formula, data = data),"term.labels") sapply(trms, function(term, dataTypes){ constit = decomposeTerm(term) types = dataTypes[constit] if(any(types=="continuous")) return("continuous") if(any(types=="random")) return("random") return("fixed") }, dataTypes = dataTypes) } fullDesignMatrix <- function(fmla, data, dataTypes){ trms <- attr(terms(fmla, data = data), "term.labels") sparse = any(dataTypes=="random") Xs = lapply(trms,function(trm, data, dataTypes){ oneDesignMatrix(trm, data = data, dataTypes = dataTypes, sparse = sparse) }, data = data, dataTypes = dataTypes) do.call("cbind" ,Xs) } oneDesignMatrix <- function(trm, data, dataTypes, sparse = FALSE) { effects <- unlist(decomposeTerm(trm)) #check to ensure all terms are in data checkEffects(effects, data, dataTypes) if(length(effects) == 1){ b64data <- data colnames(b64data) <- toB64(colnames(b64data)) b64effects <- toB64(effects) b64effect = paste("~",b64effects,"-1") X = model.Matrix(formula(b64effect), data = b64data, sparse = sparse) if(dataTypes[effects] == "fixed"){ X = X %*% fixedFromRandomProjection(ncol(X), sparse = sparse) colnames(X) = paste(effects,"_redu_",1:ncol(X),sep="") } else { colnames(X) = fromB64(colnames(X)) } return(X) }else{ Xs = lapply(effects, function(trm, data, dataTypes, sparse){ trm <- composeTerm(trm) oneDesignMatrix(trm, data = data, dataTypes = dataTypes, sparse = sparse) }, data = data, dataTypes = dataTypes, sparse = sparse) X = Reduce(rowMultiply, x = Xs) return(X) } } design.names.intList <- function(effects, data, dataTypes){ type = dataTypes[ effects[1] ] firstCol = data[ ,effects[1] ] nLevs = nlevels( firstCol ) if(length(effects)==1){ if(type=="random") return(levels(firstCol)) if(type=="fixed") return(0:(nLevs-2)) if(type=="continuous") return(effects) }else{ if(type=="random") return(rowPaste(levels(firstCol), design.names.intList(effects[-1], data, dataTypes) )) if(type=="fixed") return(rowPaste(0:(nLevs-2), design.names.intList(effects[-1], data, dataTypes) )) if(type=="continuous") return( design.names.intList(effects[-1], data, dataTypes) ) #return(rowPaste(0:(nLevs-2), design.names.intList(effects[-1], data, dataTypes) )) } } design.projection.intList <- function(effects, data, dataTypes){ type = dataTypes[ effects[1] ] firstCol = data[ ,effects[1] ] nLevs = nlevels( firstCol ) if(length(effects)==1){ if(type=="random") return(bdiag(diag(nLevs))) if(type=="fixed") return(fixedFromRandomProjection(nLevs)) if(type=="continuous") return(Matrix(1,1,1)) }else{ if(type=="random") return(kronecker(diag(nLevs), design.projection.intList(effects[-1],data, dataTypes) )) if(type=="fixed") return(kronecker(fixedFromRandomProjection(nLevs), design.projection.intList(effects[-1], data, dataTypes) )) if(type=="continuous") return( design.projection.intList(effects[-1], data, dataTypes) ) } } rowPaste = function(v1,v2) { as.vector(t(outer(v1,v2,paste,sep=".&."))) } rowMultiply = function(x, y) { sparse = is(x, "sparseMatrix") | is(y, "sparseMatrix") if(nrow(x) != nrow(y)) stop("Unequal row numbers in row.multiply:", nrow(x),", ",nrow(y)) K = sapply(1:nrow(x), function(n, x, y){ kronecker(x[n,], y[n,]) }, x = x, y = y ) # add names K <- t(Matrix(as.vector(K), ncol = nrow(x), sparse = sparse)) colnames(K) = as.vector(t( outer(colnames(x), colnames(y), function(x,y){ paste(x, y,sep=".&.") }))) return(K) } # Create projection matrix fixedFromRandomProjection <- function(nlevRandom, sparse = FALSE){ centering=diag(nlevRandom)-(1/nlevRandom) S=as.vector((eigen(centering)$vectors)[,1:(nlevRandom-1)]) return(Matrix(S,nrow=nlevRandom, sparse = sparse)) } centerContinuousColumns <- function(data){ mycols = lapply(data,function(colmn){ if(is.factor(colmn)){ return(colmn) }else{ return(colmn - mean(colmn)) } }) df <- data.frame(mycols) colnames(df) <- colnames(data) return(df) } nWayFormula <- function(formula, data, dataTypes, rscaleFixed=NULL, rscaleRandom=NULL, rscaleCont=NULL, rscaleEffects = NULL, posterior=FALSE, columnFilter = NULL, unreduce=TRUE, ...){ checkFormula(formula, data, analysis = "lm") y = data[,stringFromFormula(formula[[2]])] data <- centerContinuousColumns(data) X = fullDesignMatrix(formula, data, dataTypes) # To be removed when sparse matrix support is complete X = as.matrix(X) rscale = createRscales(formula, data, dataTypes, rscaleFixed, rscaleRandom, rscaleCont, rscaleEffects) gMap = createGMap(formula, data, dataTypes) if(any(dataTypes=="continuous")){ continuous = termTypes(formula, data, dataTypes)=="continuous" continuous = continuous[names(gMap)] }else{ continuous = FALSE } ## Determine which columns we will ignore if(is.null(columnFilter)){ ignoreCols = NULL }else{ ignoreCols = filterVectorLogical(columnFilter, names(gMap)) } if(all(ignoreCols) & !is.null(ignoreCols)) stop("Filtering out all chain columns of interest is not allowed.") retVal = nWayAOV(y, X, gMap = gMap, rscale = rscale, posterior = posterior, continuous = continuous, ignoreCols=ignoreCols,...) if(posterior){ retVal <- mcmc(makeChainNeater(retVal, colnames(X), formula, data, dataTypes, gMap, unreduce, continuous, columnFilter)) } return(retVal) } makeLabelList <- function(formula, data, dataTypes, unreduce, columnFilter){ terms = attr(terms(formula, data = data), "term.labels") if(!is.null(columnFilter)) terms = terms[!filterVectorLogical(columnFilter,terms)] if(unreduce) dataTypes[dataTypes == "fixed"] = "random" labelList = lapply(terms, function(term, data, dataTypes){ effects = strsplit(term,":",fixed=TRUE)[[1]] my.names = design.names.intList(effects, data, dataTypes) return(paste(term,"-",my.names,sep="")) }, data = data, dataTypes=dataTypes) # join them all together in one cector unlist(labelList) } unreduceChainPart = function(term, chains, data, dataTypes, gMap, ignoreCols){ effects = strsplit(term,":", fixed = TRUE)[[1]] myCols = names(gMap)==term if(ignoreCols[myCols][1]) return(NULL) # Figure out which columns we need to look at, given that some are missing cumulativeIgnored = sum(ignoreCols[1:which(myCols)[1]]) # How many are ignored up to the one of interest? remappedCols = which(myCols) - cumulativeIgnored chains = chains[, remappedCols, drop = FALSE ] if(any(dataTypes[effects]=="fixed")){ S = design.projection.intList(effects, data, dataTypes) return(chains%*%as.matrix(t(S))) }else{ return(chains) } } ureduceChains = function(chains, formula, data, dataTypes, gMap, ignoreCols){ terms = attr(terms(formula, data = data), "term.labels") unreducedChains = lapply(terms, unreduceChainPart, chains=chains, data = data, dataTypes = dataTypes, gMap = gMap, ignoreCols=ignoreCols) do.call(cbind, unreducedChains) } makeChainNeater <- function(chains, Xnames, formula, data, dataTypes, gMap, unreduce, continuous, columnFilter){ P = length(gMap) nGs = max(gMap) + 1 factors = fmlaFactors(formula, data)[-1] dataTypes = dataTypes[ names(dataTypes) %in% factors ] types = termTypes(formula, data, dataTypes) lastPars = ncol(chains) + (-nGs):0 if(any(continuous)){ gNames = paste("g",c(names(types[types!="continuous"]),"continuous"),sep="_") }else{ gNames = paste("g",names(types), sep="_") } if(is.null(columnFilter)){ ignoreCols = ignoreCols = rep(0,P) }else{ ignoreCols=filterVectorLogical(columnFilter, names(gMap)) } if(!unreduce | !any(dataTypes == "fixed")) { labels = c("mu", Xnames[!ignoreCols], "sig2", gNames) colnames(chains) = labels return(chains) } # Make column names parLabels = makeLabelList(formula, data, dataTypes, unreduce, columnFilter) labels = c("mu", parLabels) betaChains = chains[,1:(ncol(chains)-2-nGs) + 1, drop = FALSE] betaChains = ureduceChains(betaChains, formula, data, dataTypes, gMap, ignoreCols) newChains = cbind(chains[,1],betaChains,chains[,lastPars]) labels = c(labels, "sig2", gNames) colnames(newChains) = labels return(newChains) } BayesFactor/R/methods-BFBayesFactorTop.R0000644000176200001440000000676613043077372017563 0ustar liggesusersBFBayesFactorTop <- function(bf){ if( class(bf@denominator) != "BFlinearModel" ) stop("BFBayesFactorTopcan only be created from linear model objects.") len = sapply(bf@numerator, function(m){ fmla = formula(m@identifier$formula) length(attr(terms(fmla),"term.labels")) }) len_denom = length(attr(terms(formula(bf@denominator@identifier$formula)),"term.labels")) if( all( len < len_denom ) ){ return(new("BFBayesFactorTop", bf)) }else if( any( len > len_denom ) ){ biggest = which(len == max(len)) if(length(biggest) != 1) stop("Could not determine full model.") if(length(bf)==1) return(new("BFBayesFactorTop", 1/bf[biggest])) return(new("BFBayesFactorTop", bf[-biggest]/bf[biggest])) }else{ stop("Could not determine full model.") } } setValidity("BFBayesFactorTop", function(object){ if(class(object@denominator) != "BFlinearModel") return("BFBayesFactorTop objects can only currently be created from BFlinearModel-type models.") omitted = lapply(object@numerator, whichOmitted, full = object@denominator) lens = sapply(omitted, length) if(any(lens != 1)) return("Not all numerators are formed by removing one term from the denominator.") return(TRUE) }) setMethod('show', "BFBayesFactorTop", function(object){ omitted = unlist(lapply(object@numerator, whichOmitted, full = object@denominator)) cat("Bayes factor top-down analysis\n--------------\n") bfs = extractBF(object, logbf=TRUE) bfs$bf = sapply(bfs$bf, expString) indices = paste("[",1:nrow(bfs),"]",sep="") # pad model names nms = omitted maxwidth = max(nchar(nms)) nms = str_pad(nms,maxwidth,side="right",pad=" ") # pad Bayes factors maxwidth = max(nchar(bfs$bf)) bfString = str_pad(bfs$bf,maxwidth,side="right",pad=" ") cat("When effect is omitted from",object@denominator@shortName,", BF is...\n") for(i in 1:nrow(bfs)){ cat(indices[i]," Omit ",nms[i]," : ",bfString[i]," \u00B1",round(bfs$error[i]*100,2),"%\n",sep="") } cat("\nAgainst denominator:\n") cat(" ",object@denominator@longName,"\n") cat("---\nBayes factor type: ",class(object@denominator)[1],", ",object@denominator@type,"\n\n",sep="") }) #' @rdname BFBayesFactor-class #' @name [,BFBayesFactorTop,index,missing,missing-method setMethod("[", signature(x = "BFBayesFactorTop", i = "index", j = "missing", drop = "missing"), function (x, i, j, ..., drop) { x = as(x,"BFBayesFactor") return(BFBayesFactorTop(x[i])) }) setMethod('summary', "BFBayesFactorTop", function(object){ show(object) }) #' @rdname recompute-methods #' @aliases recompute,BFBayesFactor-method setMethod("recompute", "BFBayesFactorTop", function(x, progress = getOption('BFprogress', interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...){ bf = recompute(as.BFBayesFactor(x), progress, multicore, callback, ...) BFBayesFactorTop(bf) }) setAs("BFBayesFactorTop", "BFBayesFactor", function( from, to ){ as.BFBayesFactor.BFBayesFactorTop(from) }) ######## S3 sort.BFBayesFactorTop <- function(x, decreasing = FALSE, ...){ x = as.BFBayesFactor(x) x = sort(x,decreasing = decreasing, ...) return(BFBayesFactorTop(x)) } as.BFBayesFactor.BFBayesFactorTop <- function(object){ BFBayesFactor(numerator=object@numerator, denominator=object@denominator, bayesFactor = object@bayesFactor, data = object@data) } length.BFBayesFactorTop <- function(x) length(as.BFBayesFactor(x)) BayesFactor/R/onAttach.R0000644000176200001440000000344313036477172014557 0ustar liggesusers.onAttach<- function(libname, pkgname){ packageStartupMessage("************\nWelcome to ",pkgname," ",BFInfo(FALSE),". If you have", " questions, please contact Richard Morey (richarddmorey@gmail.com).\n\n", "Type BFManual() to open the manual.\n************", appendLF = TRUE) } #'options() for package BayesFactor #' #'Options that can be set for the BayesFactor package #' #'The BayesFactor package has numerous options that can be set to globally #'change the behavior of the functions in the package. These options can be #'changed using \code{\link[base]{options}}(). #' #'\describe{ #'\item{\code{BFMaxModels}}{Integer; maximum number of models to analyze in \code{\link{anovaBF}} or \code{\link{regressionBF}}} #'\item{\code{BFprogress}}{If \code{TRUE}, progress bars are on by default; if \code{FALSE}, they are disabled by default.} #'\item{\code{BFpretestIterations}}{Integer; if sampling is needed to compute the Bayes factor, the package attempts to #'choose the most efficient sampler. This option controls the number of initial test iterations.} #'\item{\code{BFapproxOptimizer}}{\code{"nlm"} or \code{"optim"}; changes the optimization function used for the importance sampler. If one fails, try the other.} #'\item{\code{BFapproxLimits}}{Vector of length two containing the lower and upper limits on #'on \code{log(g)} before the the posterior returns \code{-Inf}. This only affects the initial optimization step for the importance sampler.} #'\item{\code{BFfactorsMax}}{Maximum number of factors to try to do enumeration with in generalTestBF.} #'\item{\code{BFcheckProbabilityList}}{Check for duplicate models when creating BFprobability objects?} #'} #' #'@name options-BayesFactor #'@seealso \code{\link[base]{options}} NULL BayesFactor/R/oneWayAOV-utility.R0000644000176200001440000000044412473412213016312 0ustar liggesusers marginal.g.oneWay = Vectorize(function(g,F,N,J,rscale,log=FALSE, log.const=0) { dfs = (J-1)/(N*J-J) omega = (1+(N*g/(dfs*F+1)))/(N*g+1) m = log(rscale) - 0.5*log(2*pi) - 1.5*log(g) - rscale^2/(2*g) - (J-1)/2*log(N*g+1) - (N*J-1)/2*log(omega) - log.const ifelse(log,m,exp(m)) },"g") BayesFactor/R/proportionBF.R0000644000176200001440000001070413043077372015433 0ustar liggesusers##' Bayes factors or posterior samples for binomial, geometric, or neg. binomial data. ##' ##' Given count data modeled as a binomial, geometric, or negative binomial random variable, ##' the Bayes factor provided by \code{proportionBF} tests the null hypothesis that ##' the probability of a success is \eqn{p_0}{p_0} (argument \code{p}). Specifically, ##' the Bayes factor compares two hypotheses: that the probability is \eqn{p_0}{p_0}, or ##' probability is not \eqn{p_0}{p_0}. Currently, the default alternative is that ##' \deqn{\lambda~logistic(\lambda_0,r)} where ##' \eqn{\lambda_0=logit(p_0)}{lambda_0=logit(p_0)} and ##' \eqn{\lambda=logit(p)}{lambda=logit(p)}. \eqn{r}{r} serves as a prior scale parameter. ##' ##' For the \code{rscale} argument, several named values are recognized: ##' "medium", "wide", and "ultrawide". These correspond ##' to \eqn{r} scale values of \eqn{1/2}{1/2}, \eqn{\sqrt{2}/2}{sqrt(2)/2}, and 1, ##' respectively. ##' ##' The Bayes factor is computed via Gaussian quadrature, and posterior ##' samples are drawn via independence Metropolis-Hastings. ##' @title Function for Bayesian analysis of proportions ##' @param y a vector of successes ##' @param N a vector of total number of observations ##' @param p the null value for the probability of a success to be tested against ##' @param rscale prior scale. A number of preset values can be given as ##' strings; see Details. ##' @param nullInterval optional vector of length 2 containing ##' lower and upper bounds of an interval hypothesis to test, in probability units ##' @param posterior if \code{TRUE}, return samples from the posterior instead ##' of Bayes factor ##' @param callback callback function for third-party interfaces ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor} containing the computed model comparisons is ##' returned. If \code{nullInterval} is defined, then two Bayes factors will ##' be computed: The Bayes factor for the interval against the null hypothesis ##' that the probability is \eqn{p_0}{p0}, and the corresponding Bayes factor for ##' the compliment of the interval. ##' ##' If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, ##' containing MCMC samples from the posterior is returned. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @examples ##' bf = proportionBF(y = 15, N = 25, p = .5) ##' bf ##' ## Sample from the corresponding posterior distribution ##' samples =proportionBF(y = 15, N = 25, p = .5, posterior = TRUE, iterations = 10000) ##' plot(samples[,"p"]) ##' @seealso \code{\link{prop.test}} proportionBF <- function(y, N, p, rscale = "medium", nullInterval = NULL, posterior=FALSE, callback = function(...) as.integer(0), ...) { if (p >= 1 || p <= 0) stop('p must be between 0 and 1', call.=FALSE) if(!is.null(nullInterval)){ if(any(nullInterval<0) | any(nullInterval>1)) stop("nullInterval endpoints must be in [0,1].") nullInterval = range(nullInterval) } rscale = rpriorValues("proptest",,rscale) if( length(p) > 1 ) stop("Only a single null allowed (length(p) > 1).") if( length(y) != length(N) ) stop("Length of y and N must be the same.") if( any(y>N) | any(y < 0) ) stop("Invalid data (y>N or y<0).") if( any( c(y,N)%%1 != 0 ) ) stop("y and N must be integers.") hypNames = makePropHypothesisNames(rscale, nullInterval, p) mod1 = BFproportion(type = "logistic", identifier = list(formula = "p =/= p0", nullInterval = nullInterval, p0 = p), prior=list(rscale=rscale, nullInterval = nullInterval, p0 = p), shortName = hypNames$shortName, longName = hypNames$longName ) data = data.frame(y = y, N = N) checkCallback(callback,as.integer(0)) if(posterior) return(posterior(mod1, data = data, callback = callback, ...)) bf1 = compare(numerator = mod1, data = data) if(!is.null(nullInterval)){ mod2 = mod1 attr(mod2@identifier$nullInterval, "complement") = TRUE attr(mod2@prior$nullInterval, "complement") = TRUE hypNames = makePropHypothesisNames(rscale, mod2@identifier$nullInterval,p) mod2@shortName = hypNames$shortName mod2@longName = hypNames$longName bf2 = compare(numerator = mod2, data = data) checkCallback(callback,as.integer(1000)) return(c(bf1, bf2)) }else{ checkCallback(callback,as.integer(1000)) return(c(bf1)) } } BayesFactor/R/proportion-utility.R0000644000176200001440000001224213043077372016723 0ustar liggesusersmakePropHypothesisNames = function(rscale, nullInterval=NULL, p){ if(is.null(nullInterval)){ shortName = paste("Alt., p0=",p,", r=",round(rscale,3),sep="") longName = paste("Alternative, p0 = ",p,", r = ",rscale,", p =/= p0", sep="") }else{ if(!is.null(attr(nullInterval,"complement"))){ shortName = paste("Alt., p0=",p,", r=",round(rscale,3)," !(",nullInterval[1]," 1) ##' @param sampleType the sampling plan (see details) ##' @param fixedMargin for the independent multinomial sampling plan, which margin is fixed ("rows" or "cols") ##' @param priorConcentration prior concentration parameter, set to 1 by default (see details) ##' @param posterior if \code{TRUE}, return samples from the posterior instead ##' of Bayes factor ##' @param callback callback function for third-party interfaces ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor} containing the computed model comparisons is ##' returned. ##' ##' If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, ##' containing MCMC samples from the posterior is returned. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @author Tahira Jamil (\email{tahjamil@@gmail.com}) ##' @references Gunel, E. and Dickey, J., (1974) ##' Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557 ##' ##' @note Posterior sampling for the hypergeometric model under the alternative ##' has not yet been implemented. ##' ##' @examples ##' ## Hraba and Grant (1970) doll race data ##' data(raceDolls) ##' ##' ## Compute Bayes factor for independent binomial design, with ##' ## columns as the fixed margin ##' bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") ##' bf ##' ##' ## Posterior distribution of difference in probabilities, under alternative ##' chains = posterior(bf, iterations = 10000) ##' sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"] ##' sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"] ##' hist(sameRaceGivenWhite - sameRaceGivenBlack, xlab = "Probability increase", ##' main = "Increase in probability of child picking\nsame race doll (white - black)", ##' freq=FALSE, yaxt='n') ##' box() ##' contingencyTableBF <- function(x, sampleType, fixedMargin = NULL, priorConcentration = 1, posterior = FALSE, callback = function(...) as.integer(0), ...) { x.mat = as.matrix(as.integer(x)) dim(x.mat) = dim(x) x = as.data.frame(x.mat) if( sampleType == "indepMulti" ) if( is.null(fixedMargin) ){ stop("Argument fixedMargin ('rows' or 'cols') required with independent multinomial sampling plan.") }else if( !(fixedMargin %in% c("rows","cols")) ){ stop("Argument fixedMargin must be either 'rows' or 'cols'.") } checkCallback(callback,as.integer(0)) numerator = switch(sampleType, poisson = BFcontingencyTable(type = "poisson", identifier = list(formula = "non-independence"), prior=list(a=priorConcentration), shortName = paste0("Non-indep. (a=",priorConcentration,")"), longName = paste0("Alternative, non-independence, a = ", priorConcentration)), jointMulti = BFcontingencyTable(type = "joint multinomial", identifier = list(formula = "non-independence"), prior=list(a=priorConcentration), shortName = paste0("Non-indep. (a=",priorConcentration,")"), longName = paste0("Alternative, non-independence, a = ", priorConcentration)), indepMulti = BFcontingencyTable(type = "independent multinomial", identifier = list(formula = "non-independence", fixedMargin = fixedMargin), prior=list(a=priorConcentration, fixedMargin = fixedMargin), shortName = paste0("Non-indep. (a=",priorConcentration,")"), longName = paste0("Alternative, non-independence, a = ", priorConcentration)), hypergeom = BFcontingencyTable(type = "hypergeometric", identifier = list(formula = "non-independence"), prior=list(a=priorConcentration), shortName = paste0("Non-indep. (a=",priorConcentration,")"), longName = paste0("Alternative, non-independence, a = ", priorConcentration)), stop("Unknown value of sampleType (see help for contingencyTableBF).") ) if(posterior){ chains = posterior(numerator, data = x, callback = callback, ...) checkCallback(callback,as.integer(1000)) return(chains) }else{ bf = compare(numerator = numerator, data = x) checkCallback(callback,as.integer(1000)) return(bf) } } BayesFactor/R/aaClasses.R0000644000176200001440000001741513043077372014715 0ustar liggesusers# https://stat.ethz.ch/pipermail/r-devel/2010-May/057506.html ## for 'i' in x[i] or A[i,] : (numeric = {double, integer}) # setClassUnion("index", members = c("numeric", "logical", "character")) #' General S4 classes for representing models for comparison #' #' The \code{BFmodel} is a general S4 class for representing models for comparison. The more classes #' \code{BFlinearModel}, \code{BFindepSample}, and \code{BFoneSample} inherit directly from \code{BFmodel}. #' #' \describe{ #' These model classes all have the following slots defined: #' \item{type}{Model type} #' \item{identifier}{a list uniquely identifying the model from other models of the same type} #' \item{prior}{list giving appropriate prior settings for the model} #' \item{dataTypes}{a character vector whose names are possible columns in the data; elements specify the corresponding data type, currently one of c("fixed","random","continuous")} #' \item{shortName}{a short, readable identifying string} #' \item{longName}{a longer, readable identifying string} #' \item{analysis}{object storing information about a previous analysis of this model} #' \item{version}{character string giving the version and revision number of the package that the model was created in} #' } #' @name BFmodel-class #' @rdname model-classes #' @export setClass("BFmodel", representation( type = "character", identifier = "list", prior = "list", dataTypes = "character", shortName = "character", longName = "character", analysis = "list", version = "character" )) #' @name BFcorrelation-class #' @rdname model-classes setClass("BFcorrelation", contains = "BFmodel") #' @name BFproportion-class #' @rdname model-classes setClass("BFproportion", contains = "BFmodel") #' @name BFcontingencyTable-class #' @rdname model-classes setClass("BFcontingencyTable", contains = "BFmodel") #' @name BFlinearModel-class #' @rdname model-classes setClass("BFlinearModel", contains = "BFmodel") #' @name BFoneSample-class #' @rdname model-classes setClass("BFoneSample", contains = "BFlinearModel") #' @name BFoneSample-class #' @rdname model-classes setClass("BFmetat", contains = "BFmodel") #' @name BFindepSample-class #' @rdname model-classes setClass("BFindepSample", contains = "BFlinearModel") #' General S4 class for representing multiple Bayes factor model comparisons, all against the same model #' #' The \code{BFBayesFactor} class is a general S4 class for representing models model comparison via Bayes factor. #' #' \code{BFBayesFactor} objects can be inverted by taking the reciprocal and can #' be divided by one another, provided both objects have the same denominator. In addition, #' the \code{t} (transpose) method can be used to invert Bayes factor objects. #' \describe{ #' The \code{BFBayesFactor} class has the following slots defined: #' \item{numerator}{a list of models all inheriting \code{BFmodel}, each providing a single denominator} #' \item{denominator}{a single \code{BFmodel} object serving as the denominator for all model comparisons} #' \item{bayesFactor}{a data frame containing information about the comparison between each numerator and the denominator} #' \item{data}{a data frame containing the data used for the comparison} #' \item{version}{character string giving the version and revision number of the package that the model was created in} #' } #' @name BFBayesFactor-class #' @export #' @examples #' ## Compute some Bayes factors to demonstrate division and indexing #' data(puzzles) #' bfs <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) #' #' ## First and second models can be separated; they remain BFBayesFactor objects #' b1 = bfs[1] #' b2 = bfs[2] #' b1 #' #' ## We can invert them, or divide them to obtain new model comparisons #' 1/b1 #' b1 / b2 #' #' ## Use transpose to create a BFBayesFactorList #' t(bfs) setClass("BFBayesFactor", representation( numerator = "list", denominator = "BFmodel", bayesFactor = "data.frame", data = "data.frame", version = "character" )) #' General S4 class for representing a collection of Bayes factor model #' comprisons, each against a different denominator #' #' The \code{BFBayesFactorList} class is a general S4 class for representing #' models model comparison via Bayes factor. See the examples for demonstrations #' of BFBayesFactorList methods. #' #' \describe{ \code{BFBayesFactorList} objects inherit from lists, and contain a #' single slot: #' #' \item{version}{character string giving the version and revision number of the #' package that the model was created in} #' #' Each element of the list contains a single #' \code{"\link[=BFBayesFactor-class]{BFBayesFactor}"} object. Each element of #' the list must have the same numerators, in the same order, as all the others. #' The list object is displayed as a matrix of Bayes factors. } #' @name BFBayesFactorList-class #' @export #' @examples #' ## Compute some Bayes factors to demonstrate Bayes factor lists #' data(puzzles) #' bfs <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) #' #' ## Create a matrix of Bayes factors #' bfList <- bfs / bfs #' bfList #' #' ## Use indexing to select parts of the 'matrix' #' bfList[1,] #' bfList[,1] #' #' ## We can use the t (transpose) function as well, to get back a BFBayesFactor #' t(bfList[2,]) #' #' ## Or transpose the whole matrix #' t(bfList) setClass("BFBayesFactorList", contains = "list", representation(version="character")) #' @name BFBayesFactorTop-class #' @rdname BFBayesFactor-class setClass("BFBayesFactorTop", contains = "BFBayesFactor") setOldClass("mcmc") setClass("BFmcmc", contains = "mcmc", representation(model="BFmodel",data = "data.frame")) setClassUnion("BFOrNULL", members = c("BFBayesFactor", "NULL")) #' General S4 class for representing multiple odds model comparisons, all against the same model #' #' The \code{BFodds} class is a general S4 class for representing models model comparison via prior or posterior odds. #' #' \code{BFodds} objects can be inverted by taking the reciprocal and can #' be divided by one another, provided both objects have the same denominator. In addition, #' the \code{t} (transpose) method can be used to invert odds objects. #' \describe{ #' The \code{BFodds} class has the following slots defined: #' \item{numerator}{a list of models all inheriting \code{BFmodel}, each providing a single numerator} #' \item{denominator}{a single \code{BFmodel} object serving as the denominator for all model comparisons} #' \item{logodds}{a data frame containing information about the (log) prior odds between each numerator and the denominator} #' \item{bayesFactor}{a \code{BFBayesFactor} object (possibly) containing the evidence from the data.} #' \item{version}{character string giving the version and revision number of the package that the model was created in} #' } #' @name BFodds-class #' @export setClass("BFodds", representation( numerator = "list", denominator = "BFmodel", logodds = "data.frame", bayesFactor = "BFOrNULL", version = "character" )) #' General S4 class for representing multiple model probability comparisons #' #' The \code{BFprobability} class is a general S4 class for representing models model comparison via prior or posterior probabilities. #' #' \describe{ #' The \code{BFprobability} class has the following slots defined: #' \item{odds}{A BFodds object containing the models from which to compute the probabilities} #' \item{normalize}{the sum of the probabilities of all models (will often be 1.0)} #' \item{version}{character string giving the version and revision number of the package that the model was created in} #' } #' @name BFprobability-class #' @export setClass("BFprobability", representation( odds = "BFodds", normalize = "numeric", version = "character" )) BayesFactor/R/methods-BFodds.R0000644000176200001440000002723113043077372015615 0ustar liggesusers# constructor BFodds <- function(BFinit, logodds = NULL, bayesFactor = NULL){ if(is.null(logodds)) logodds = data.frame(odds = BFinit@bayesFactor$bf * 0) rownames(logodds) = rownames(BFinit@bayesFactor) new("BFodds", numerator = BFinit@numerator, denominator = BFinit@denominator, logodds = logodds, bayesFactor = bayesFactor, version = BFInfo(FALSE)) } setValidity("BFodds", function(object){ if( length(object@numerator) != nrow(object@logodds)) return("Number of numerator models does not equal number of Bayes factors.") if( !is.null(object@bayesFactor)){ if( length(object@numerator) != length(object@bayesFactor)) return("Number of numerator models does not equal number of Bayes factors.") for(i in 1:length(object@numerator)){ if( !(object@numerator[[i]] %same% object@bayesFactor@numerator[[i]])){ return("Models in numerator are not the same as the numerators in Bayes factor.") } } if( !(object@denominator %same% object@denominator)) return("Model in denominator is not the same as the denominator in Bayes factor.") } numeratorsAreBFs = sapply(object@numerator,function(el) inherits(el,"BFmodel")) if( any(!numeratorsAreBFs)) return("Some numerators are not BFmodel objects.") # check numerators all have same data types as denominator dataTypeDenom = object@denominator@dataTypes dataTypesEqual = unlist(lapply(object@numerator, function(model, compType) model@dataTypes %com% compType, compType=dataTypeDenom)) if( any(!dataTypesEqual)) return("Data types are not equal across models.") typeDenom = object@denominator@type typesEqual = unlist(lapply(object@numerator, function(model, compType) identical(model@type, compType), compType=typeDenom)) if( any(!typesEqual)) return("Model types are not equal across models.") classDenom = class(object@denominator) typesEqual = unlist(lapply(object@numerator, function(model, compType) identical(class(model), compType), compType=classDenom)) if( any(!typesEqual)) return("Model classes are not equal across models.") return(TRUE) }) #' @rdname extractOdds-methods #' @aliases extractOdds,BFodds-method setMethod("extractOdds", "BFodds", function(x, logodds = FALSE, onlyodds = FALSE){ z = x@logodds if(is.null(x@bayesFactor)){ z$error = 0 }else{ bfs = extractBF(x@bayesFactor, logbf=TRUE) z$odds = z$odds + bfs$bf z$error = x@bayesFactor@bayesFactor$error } if(!logodds) z$odds = exp(z$odds) if(onlyodds) z = z$odds return(z) }) setMethod('show', "BFodds", function(object){ is.prior = is.null(object@bayesFactor) if(is.prior){ cat("Prior odds\n--------------\n") }else{ cat("Posterior odds\n--------------\n") } odds = extractOdds(object, logodds = TRUE) odds$odds = sapply(odds$odds, expString) indices = paste("[",1:nrow(odds),"]",sep="") # pad model names nms = paste(indices,rownames(odds),sep=" ") maxwidth = max(nchar(nms)) nms = str_pad(nms,maxwidth,side="right",pad=" ") # pad Bayes factors maxwidth = max(nchar(odds$odds)) oddsString = str_pad(odds$odds,maxwidth,side="right",pad=" ") for(i in 1:nrow(odds)){ if(is.prior){ cat(nms[i]," : ",oddsString[i],"\n",sep="") }else{ cat(nms[i]," : ",oddsString[i]," \u00B1",round(odds$error[i]*100,2),"%\n",sep="") } } cat("\nAgainst denominator:\n") cat(" ",object@denominator@longName,"\n") cat("---\nModel type: ",class(object@denominator)[1],", ",object@denominator@type,"\n\n",sep="") }) setMethod('summary', "BFodds", function(object){ show(object) }) #' @rdname BFodds-class #' @name /,numeric,BFodds-method #' @param e1 Numerator of the ratio #' @param e2 Denominator of the ratio setMethod('/', signature("numeric", "BFodds"), function(e1, e2){ if( (e1 == 1) & (length(e2)==1) ){ numer = e2@numerator[[1]] denom = list(e2@denominator) odds_df = e2@logodds if(is.null(e2@bayesFactor)){ bf = NULL }else{ bf = 1/e2@bayesFactor } rownames(odds_df) = denom[[1]]@shortName odds_df$odds = -odds_df$odds oddsobj = new("BFodds",numerator=denom, denominator=numer, bayesFactor=bf, logodds = odds_df, version = BFInfo(FALSE)) return(oddsobj) }else if( e1 != 1 ){ stop("Dividend must be 1 (to take reciprocal).") }else if( length(e2)>1 ){ allNum = as(e2,"list") #BFlist = BFBayesFactorList(lapply(allNum, function(num) 1 / num)) stop("Length of odds object must be ==1 to take reciprocal.") } } ) #' @rdname BFodds-class #' @name /,BFodds,BFodds-method setMethod('/', signature("BFodds", "BFodds"), function(e1, e2){ if( length(e2) > 1) stop("Length of divisor must be ==1 to divide.") if( !(e1@denominator %same% e2@denominator) ) stop("Odds have different denominator models; they cannot be compared.") if(!is.null(e1@bayesFactor) & !is.null(e1@bayesFactor)){ bf = e1@bayesFactor / e2@bayesFactor }else if(is.null(e1@bayesFactor) & is.null(e1@bayesFactor)){ bf = NULL }else{ stop("Both odds objects must be prior, or both must be posterior.") } if( (length(e2)==1) ){ logodds = data.frame(odds=e1@logodds$odds - e2@logodds$odds) rownames(logodds) = rownames(e1@logodds) oddsobj = new("BFodds",numerator=e1@numerator, denominator=e2@numerator[[1]], bayesFactor=bf, logodds = logodds, version = BFInfo(FALSE)) return(oddsobj) }else{ stop("Length of divisor must be ==1 to divide.") } } ) #' @rdname BFodds-class #' @name *,BFodds,BFBayesFactor-method setMethod('*', signature("BFodds", "BFBayesFactor"), function(e1, e2){ if(!is.null(e1@bayesFactor)) stop("Cannot multiply posterior odds object with Bayes factor.") new("BFodds", numerator = e1@numerator, denominator = e1@denominator, logodds = e1@logodds, bayesFactor = e2, version = BFInfo(FALSE)) } ) #' @rdname BFodds-class #' @name [,BFodds,index,missing,missing-method #' @param x BFodds object #' @param i indices indicating elements to extract #' @param j unused for BFodds objects #' @param drop unused #' @param ... further arguments passed to related methods setMethod("[", signature(x = "BFodds", i = "index", j = "missing", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 2){ newodds = x x@numerator = x@numerator[i, drop=FALSE] x@logodds = x@logodds[i, ,drop=FALSE] if(is.null(x@bayesFactor)){ x@bayesFactor = NULL }else{ x@bayesFactor = x@bayesFactor[i] } }else stop("invalid nargs()= ",na) return(x) }) #' @rdname recompute-methods #' @aliases recompute,BFodds-method setMethod("recompute", "BFodds", function(x, progress = getOption('BFprogress', interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...){ bf = as.BFBayesFactor(x) bf = recompute(bf, progress = progress, multicore = multicore, callback = callback, ...) x@bayesFactor = bf return(x) }) #' @rdname priorOdds-method #' @name priorOdds<-,BFodds,numeric-method #' @docType methods #' @exportMethod setReplaceMethod("priorOdds", signature(object = "BFodds", value = "numeric"), definition = function (object, value) { priorLogodds(object) <- log(value) object }) #' @rdname priorLogodds-method #' @name priorLogodds<-,BFodds,numeric-method #' @docType methods #' @exportMethod setReplaceMethod("priorLogodds", signature(object = "BFodds", value = "numeric"), definition = function (object, value) { object@logodds$odds <- value object }) setAs("BFodds", "BFBayesFactor", function( from, to ){ as.BFBayesFactor.BFodds(from) }) setAs("BFodds", "BFprobability", function( from, to ){ as.BFprobability.BFodds(from) }) ###### # S3 ###### as.BFBayesFactor.BFodds <- function(object){ if(!is.null(object@bayesFactor)){ return(object@bayesFactor) }else{ stop("Cannot convert prior odds to Bayes factor; no data has been given.") } } as.BFprobability.BFodds <- function(object, normalize = NULL, lognormalize = NULL){ if(is.null(lognormalize) & is.null(normalize)){ lognormalize = 0 }else if(is.null(lognormalize) & !is.null(normalize)){ lognormalize = log(normalize) }else if(!is.null(normalize)){ stop("Cannot specify foth normalize and lognormalize.") } return(BFprobability(object, lognormalize)) } length.BFodds <- function(x) nrow(x@logodds) c.BFodds <- function(..., recursive = FALSE) { z = list(...) if(length(z)==1) return(z[[1]]) correctClass = unlist(lapply(z, function(object) inherits(object,"BFodds"))) if(any(!correctClass)) stop("Cannot concatenate odds with non-odds object.") denoms = lapply(z, function(object){ object@denominator }) samedenom = unlist(lapply(denoms[-1], function(el, cmp){ el %same% cmp }, cmp=denoms[[1]])) if(any(!samedenom)) stop("Cannot concatenate odds objects with different denominator models.") logodds = lapply(z, function(object){object@logodds}) df_rownames = unlist(lapply(z, function(object){rownames(object@logodds)})) df_rownames = make.unique(df_rownames, sep=" #") logodds = do.call("rbind",logodds) rownames(logodds) = df_rownames ### Grab the Bayes factors is.prior = 1:length(z) * NA for(i in 1:length(is.prior)){ is.prior[i] = is.null(z[[i]]@bayesFactor) } if(all(!is.prior)){ bfs = lapply(z, function(object){ object@bayesFactor }) bfs = do.call("c", bfs) bf = BFodds(bfs, logodds = logodds, bayesFactor = bfs) }else if(all(is.prior)){ numerators = unlist(lapply(z, function(object){object@numerator}),recursive=FALSE, use.names=FALSE) bf = new("BFodds", numerator = numerators, denominator = z[[1]]@denominator, logodds = logodds, bayesFactor = NULL, version = BFInfo(FALSE)) }else{ stop("Cannot concatenate prior odds with posterior odds.") } return(bf) } names.BFodds <- function(x) { rownames(extractOdds(x)) } # See http://www-stat.stanford.edu/~jmc4/classInheritance.pdf sort.BFodds <- function(x, decreasing = FALSE, ...){ ord = order(extractOdds(x, logodds=TRUE)$odds, decreasing = decreasing) return(x[ord]) } max.BFodds <- function(..., na.rm=FALSE){ joinedodds = do.call('c',list(...)) el <- head(joinedodds, n=1) return(el) } min.BFodds <- function(..., na.rm=FALSE){ joinedodds = do.call('c',list(...)) el <- tail(joinedodds, n=1) return(el) } which.max.BFodds <- function(x){ index = which.max(extractOdds(x, logodds=TRUE)$odds) names(index) = names(x)[index] return(index) } which.min.BFodds <- function(x){ index = which.min(extractOdds(x, logodds=TRUE)$odds) names(index) = names(x)[index] return(index) } head.BFodds <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x, decreasing=TRUE) return(x[1:n]) } tail.BFodds <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x) return(x[n:1])} as.data.frame.BFodds <- function(x, row.names = NULL, optional=FALSE,...){ df = extractOdds(x) return(df) } as.vector.BFodds <- function(x, mode = "any"){ if( !(mode %in% c("any", "numeric"))) stop("Cannot coerce to mode ", mode) v = extractOdds(x)$odds names(v) = names(x) return(v) } BayesFactor/R/correlationBF.R0000644000176200001440000001142313274042462015536 0ustar liggesusers##' Bayes factors or posterior samples for correlations. ##' ##' The Bayes factor provided by \code{ttestBF} tests the null hypothesis that ##' the true linear correlation \eqn{\rho}{rho} between two samples (\eqn{y}{y} and \eqn{x}{x}) ##' of size \eqn{n}{n} from normal populations is equal to 0. The Bayes factor is based on Jeffreys (1961) ##' test for linear correlation. Noninformative priors are assumed for the population means and ##' variances of the two population; a shifted, scaled beta(1/rscale,1/rscale) prior distribution ##' is assumed for \eqn{\rho}{rho} (note that \code{rscale} is called \eqn{\kappa}{kappa} by ##' Ly et al. 2015; we call it \code{rscale} for consistency with other BayesFactor functions). ##' ##' For the \code{rscale} argument, several named values are recognized: ##' "medium.narrow", "medium", "wide", and "ultrawide". These correspond ##' to \eqn{r} scale values of \eqn{1/\sqrt(27)}{1/sqrt(27)}, \eqn{1/3}{1/3}, ##' \eqn{1/\sqrt(3)}{1/sqrt(3)} and 1, respectively. ##' ##' The Bayes factor is computed via several different methods. ##' @title Function for Bayesian analysis of correlations ##' @param y first continuous variable ##' @param x second continuous variable ##' @param rscale prior scale. A number of preset values can be given as ##' strings; see Details. ##' @param nullInterval optional vector of length 2 containing ##' lower and upper bounds of an interval hypothesis to test, in correlation units ##' @param posterior if \code{TRUE}, return samples from the posterior instead ##' of Bayes factor ##' @param callback callback function for third-party interfaces ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor} containing the computed model comparisons is ##' returned. If \code{nullInterval} is defined, then two Bayes factors will ##' be computed: The Bayes factor for the interval against the null hypothesis ##' that the probability is 0, and the corresponding Bayes factor for ##' the complement of the interval. ##' ##' If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, ##' containing MCMC samples from the posterior is returned. ##' @export ##' @keywords htest ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @examples ##' bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) ##' bf ##' ## Sample from the corresponding posterior distribution ##' samples = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width, ##' posterior = TRUE, iterations = 10000) ##' plot(samples[,"rho"]) ##' @seealso \code{\link{cor.test}} ##' @references Ly, A., Verhagen, A. J. & Wagenmakers, E.-J. (2015). ##' Harold Jeffreys's Default Bayes Factor Hypothesis Tests: Explanation, Extension, and Application in Psychology. ##' Journal of Mathematical Psychology, Available online 28 August 2015, http://dx.doi.org/10.1016/j.jmp.2015.06.004. ##' ##' Jeffreys, H. (1961). Theory of probability, 3rd edn. Oxford, UK: Oxford University Press. correlationBF <- function(y, x, rscale = "medium", nullInterval = NULL, posterior=FALSE, callback = function(...) as.integer(0), ...) { if(!is.null(nullInterval)){ if(any(nullInterval< -1) | any(nullInterval>1)) stop("nullInterval endpoints must be in [-1,1].") nullInterval = range(nullInterval) } rscale = rpriorValues("correlation",,rscale) if( length(y) != length(x) ) stop("Length of y and x must be the same.") if(!is.null(nullInterval)) if(any(abs(nullInterval)>1)) stop("Invalid interval hypothesis; endpoints must be in [-1,1].") if( length(y)<3 ) stop("N must be >2.") n = length(x) - sum(is.na(y) | is.na(x)) if(n < 3) stop("Need at least 3 complete observations.") hypNames = makeCorrHypothesisNames(rscale, nullInterval) mod1 = BFcorrelation(type = "Jeffreys-beta*", identifier = list(formula = "rho =/= 0", nullInterval = nullInterval), prior=list(rscale=rscale, nullInterval = nullInterval), shortName = hypNames$shortName, longName = hypNames$longName ) data = data.frame(y = y, x = x) checkCallback(callback,as.integer(0)) if(posterior) return(posterior(mod1, data = data, callback = callback, ...)) bf1 = compare(numerator = mod1, data = data) if(!is.null(nullInterval)){ mod2 = mod1 attr(mod2@identifier$nullInterval, "complement") = TRUE attr(mod2@prior$nullInterval, "complement") = TRUE hypNames = makeCorrHypothesisNames(rscale, mod2@identifier$nullInterval) mod2@shortName = hypNames$shortName mod2@longName = hypNames$longName bf2 = compare(numerator = mod2, data = data) checkCallback(callback,as.integer(1000)) return(c(bf1, bf2)) }else{ checkCallback(callback,as.integer(1000)) return(c(bf1)) } } BayesFactor/R/plot-BFBayesFactor.R0000644000176200001440000000756413043077372016410 0ustar liggesusers## S4 method ##### # setMethod("plot", "BFBayesFactor", function(x, include1 = TRUE, addDenom = FALSE, sortbf=TRUE, logbase = c("log10", "log2","ln"), marginExpand=.4,pars=NULL, ...){ # plot.BFBayesFactor(x, include1 = include1, # addDenom = addDenom, # sortbf = sortbf, # logbase = logbase, # marginExpand = marginExpand, # pars = pars, ...) # invisible(NULL) # }) ## S3 method ##### #' Plot a Bayes factor object #' #' This function creates a barplot of the (log) Bayes factors in a Bayes factor #' object. Error bars are added (though in many cases they may be too small to #' see) in red to show the error in estimation of the Bayes factor. If a red question mark #' appears next to a bar, then that Bayes factor has no error estimate available. #' @title Plot a Bayes factor object #' @param x a BFBayesFactor object #' @param include1 if \code{TRUE}, ensure that Bayes factor = 1 is on the plot #' @param addDenom if \code{TRUE}, add the denominator model into the group #' @param sortbf sort the Bayes factors before plotting them? Defaults to #' \code{TRUE} #' @param logbase the base of the log Bayes factors in the plot #' @param marginExpand an expansion factor for the left margin, in case more #' space is needed for model names #' @param cols a vector of length two of valid color names or numbers #' @param main a character vector for the plot title #' @param pars a list of par() settings #' @param ... additional arguments to pass to barplot() #' @method plot BFBayesFactor #' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) #' @examples #' data(puzzles) #' #' bfs = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", progress=FALSE) #' plot(bfs) plot.BFBayesFactor <- function(x, include1=TRUE, addDenom = FALSE, sortbf=TRUE, logbase = c("log10", "log2","ln"), marginExpand = .4, cols = c("wheat","lightslateblue"), main = paste("vs.",x@denominator@longName), pars=NULL, ...){ # eliminate NAs x = x[!is.na(x)] oldPar <- par() on.exit(par(oldPar[c("mfrow","las",names(pars))])) textLogBase = logbase[1] logBase <- switch(textLogBase, log10=10, ln=exp(1), log2=2, stop('Invalid logarithm base.')) # Add denominator if(addDenom) x = c(x, (1/x[1]) / (1/x[1])) if(sortbf) x = sort(x) bfs <- extractBF(x, logbf = TRUE) # Estimate left margin maxChar = max(nchar(rownames(bfs))) leftMargin = marginExpand * maxChar + 4 # Errors whichNA = is.na(bfs$error) bfs$error[whichNA] = 0 errs <- exp(bfs$bf + log(bfs$error)) errs <- log(outer(errs,c(-1,1),'*') + exp(bfs$bf))/log(logBase) if(include1){ rng <- range(c(0,errs)) }else{ rng <- range(errs) } yaxes <- seq(floor(rng[1]), ceiling(rng[2]), 1) ygrids <- seq(yaxes[1], yaxes[length(yaxes)], .1) if(textLogBase=="ln"){ tickLab <- paste("exp(",yaxes,")",sep="") tickLab[yaxes==0] = "1" }else{ tickLab <- logBase^yaxes tickLab[yaxes<0] = paste("1/",logBase^abs(yaxes[yaxes<0]),sep="") } cols = cols[(bfs$bf>0) + 1] pars = c(pars, list(oma=c(5,leftMargin,0,1),las=1,mar=c(0,0,2,0))) par(pars) yloc <- barplot( bfs$bf/log(logBase), names.arg=rownames(bfs), horiz=TRUE, axes=FALSE, xlim=range(yaxes), main = main, col=cols, ...) # add error bars segments(errs[,1],yloc,errs[,2],yloc,col="red") # add unknown errors if(any(whichNA)) mapply(function(x,y,adj) text(x,y,"?",col="red",adj=adj) , x=errs[whichNA,1],y=yloc[whichNA],adj=1-(errs[whichNA,1]>0)) axis(1, at = yaxes, labels=tickLab, las=2) if(length(ygrids) < 50) abline(v=ygrids,col="gray",lty=2) abline(v=yaxes, col="gray") abline(v=0) invisible(NULL) } BayesFactor/R/aaGenerics.R0000644000176200001440000002157313274042462015055 0ustar liggesusers#' Compare two objects to see if they are the 'same', for some loose definition #' of same #' @param x first object #' @param y second object #' @return Returns \code{TRUE} or \code{FALSE} setGeneric("%same%", function(x, y) standardGeneric("%same%")) #' Find a model term in a vector of model terms #' @param x the terms to be matched #' @param table the terms to be matched against #' @return A logical vector of the same length as x, indicating if a #' match was located for each element of x. setGeneric("%termin%", function(x, table) standardGeneric("%termin%")) #' Compare two models, with respect to some data #' #' This method is used primarily in the backend, and will only rarely be called #' by the end user. But see the examples below for a demonstration. #' @param numerator first model #' @param denominator second model (if omitted, compare to predefined null) #' @param data data for the comparison #' @param ... arguments passed to and from related methods #' @return The compare function will return a model comparison object, typically #' a Bayes factor #' @export #' @docType methods #' @rdname compare-methods #' @aliases compare,BFoneSample,missing,data.frame-method #' compare,BFlinearModel,BFlinearModel,data.frame-method #' compare,BFindepSample,missing,data.frame-method #' compare,BFlinearModel,missing,data.frame-method #' compare,BFmetat,missing,data.frame-method #' compare,BFproportion,missing,data.frame-method #' compare,BFcontingencyTable,BFcontingencyTable,data.frame-method #' compare,BFcontingencyTable,missing,data.frame-method #' compare,BFcorrelation,missing,data.frame-method #' compare,BFmcmc,BFmcmc,ANY-method #' compare,BFmcmc,missing,ANY-method #' @examples #' ## Sample from the posteriors for two models #' data(puzzles) #' #' ## Main effects model; result is a BFmcmc object, inheriting #' ## mcmc from the coda package #' mod1 = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID", #' progress = FALSE, posterior = TRUE, iterations = 1000) #' #' plot(mod1) #' #' ## Full model #' mod2 = lmBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", #' progress = FALSE, posterior = TRUE, iterations = 1000) #' #' ## Each BFmcmc object contains the model used to generate it, so we #' ## can compare them (data is not needed, it is contained in the objects): #' #' compare(mod1, mod2) setGeneric("compare", function(numerator, denominator, data, ...) standardGeneric("compare")) #' Recompute a Bayes factor computation or MCMC object. #' #' Take an object and redo the computation (useful for sampling). In cases where sampling is #' used to compute the Bayes factor, the estimate of the precision of new samples will be added #' to the estimate precision of the old sample will be added to produce a new estimate of the #' precision. #' @param x object to recompute #' @param progress report progress of the computation? #' @param multicore Use multicore, if available #' @param callback callback function for third-party interfaces #' @param ... arguments passed to and from related methods #' @return Returns an object of the same type, after repeating the sampling (perhaps with more iterations) #' @export #' @docType methods #' @rdname recompute-methods #' @examples #' ## Sample from the posteriors for two models #' data(puzzles) #' #' ## Main effects model; result is a BFmcmc object, inheriting #' ## mcmc from the coda package #' bf = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID", #' progress = FALSE) #' #' ## recompute Bayes factor object #' recompute(bf, iterations = 1000, progress = FALSE) #' #' ## Sample from posterior distribution of model above, and recompute: #' chains = posterior(bf, iterations = 1000, progress = FALSE) #' newChains = recompute(chains, iterations = 1000, progress=FALSE) setGeneric("recompute", function(x, progress=getOption('BFprogress', interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) standardGeneric("recompute")) #' Sample from the posterior distribution of one of several models. #' #' This function samples from the posterior distribution of a \code{BFmodel}, #' which can be obtained from a \code{BFBayesFactor} object. If there is more #' than one numerator in the \code{BFBayesFactor} object, the \code{index} #' argument can be passed to select one numerator. #' #' The data argument is used internally, and will y not be needed by #' end-users. #' #' Note that if there are fixed effects in the model, the reduced #' parameterzation used internally (see help for \code{\link{anovaBF}}) is #' unreduced. For a factor with two levels, the chain will contain two effect #' estimates that sum to 0. #' #' Two useful arguments that can be passed to related methods are \code{thin} #' and \code{columnFilter}, currently implemented for methods using #' \code{nWayAOV} (models with more than one categorical covariate, or a mix of #' categorical and continuous covariates). \code{thin}, an integer, will keep #' only every \code{thin} iterations. The default is \code{thin=1}, which keeps #' all iterations. Argument \code{columnFilter} is either \code{NULL} (for no #' filtering) or a character vector of extended regular expressions (see #' \link{regex} help for details). Any column from an effect that matches one of #' the filters will not be saved. #' @param model or set of models from which to sample #' @param index the index within the set of models giving the desired model #' @param data the data to be conditioned on #' @param iterations the number of iterations to sample #' @param ... arguments passed to and from related methods #' @return Returns an object containing samples from the posterior distribution #' of the specified model #' @export #' @docType methods #' @rdname posterior-methods #' @examples #' ## Sample from the posteriors for two models #' data(sleep) #' #' bf = lmBF(extra ~ group + ID, data = sleep, whichRandom="ID", progress=FALSE) #' #' ## sample from the posterior of the numerator model #' ## data argument not needed - it is included in the Bayes factor object #' chains = posterior(bf, iterations = 1000, progress = FALSE) #' #' plot(chains) #' #' ## demonstrate column filtering by filtering out participant effects #' data(puzzles) #' bf = lmBF(RT ~ shape + color + shape:color + ID, data=puzzles) #' chains = posterior(bf, iterations = 1000, progress = FALSE, columnFilter="^ID$") #' colnames(chains) # Contains no participant effects setGeneric("posterior", function(model, index, data, iterations, ...) standardGeneric("posterior")) #' Extract the Bayes factor from an object #' @param x object from which to extract the Bayes factors #' @param logbf return the logarithm of the Bayes factors #' @param onlybf return a vector of only the Bayes factors #' @return Returns an object containing Bayes factors extracted from the object #' @export #' @docType methods #' @rdname extractBF-methods #' @examples #' ## Sample from the posteriors for two models #' data(puzzles) #' #' bf = lmBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", progress=FALSE) #' #' extractBF(bf) setGeneric("extractBF", function(x, logbf=FALSE, onlybf=FALSE) standardGeneric("extractBF")) #' Extract the odds from an object #' @param x object from which to extract #' @param logodds return the logarithm #' @param onlyodds return a vector of only the odds #' @return Returns an object containing odds extracted from the object #' @export #' @docType methods #' @rdname extractOdds-methods setGeneric("extractOdds", function(x, logodds=FALSE, onlyodds=FALSE) standardGeneric("extractOdds")) #' Extract the probabilities from an object #' @param x object from which to extract #' @param logprobs return the logarithm #' @param onlyprobs return a vector of only the probabilities #' @return Returns an object containing probabilities extracted from the object #' @export #' @docType methods #' @rdname extractProbabilities-methods setGeneric("extractProbabilities", function(x, logprobs=FALSE, onlyprobs=FALSE) standardGeneric("extractProbabilities")) #' Set prior odds in an object #' @docType methods #' @rdname priorOdds-method #' @param object object in which to set odds #' @param value odds setGeneric("priorOdds<-", function(object, value) standardGeneric("priorOdds<-")) #' Set prior log odds in an object #' @docType methods #' @rdname priorLogodds-method #' @param object object in which to set log odds #' @param value log odds setGeneric("priorLogodds<-", function(object, value) standardGeneric("priorLogodds<-")) #' Filter the elements of an object according to some pre-specified criteria #' @param x object #' @param name regular expression to search name #' @param perl logical. Should perl-compatible regexps be used? See ?grepl for details. #' @param fixed logical. If TRUE, pattern is a string to be matched as is. See ?grepl for details. #' @param ... arguments passed to and from related methods #' @return Returns a filtered object setGeneric("filterBF", function(x, name, perl = FALSE, fixed = FALSE, ...) standardGeneric("filterBF")) BayesFactor/R/lmBF.R0000644000176200001440000001066213043077372013633 0ustar liggesusers##' This function computes Bayes factors, or samples from the posterior, of ##' specific linear models (either ANOVA or regression). ##' ##' This function provides an interface for computing Bayes factors for ##' specific linear models against the intercept-only null; other tests may be ##' obtained by computing two models and dividing their Bayes factors. Specifics ##' about the priors for regression models -- and possible settings for ##' \code{rscaleCont} -- can be found in the help for \code{\link{regressionBF}}; ##' likewise, details for ANOVA models -- and settings for \code{rscaleFixed} ##' and \code{rscaleRandom} -- can be found in the help for \code{\link{anovaBF}}. ##' ##' Currently, the function does not allow for general linear models, containing ##' both continuous and categorical predcitors, but this support will be added ##' in the future. ##' @title Function to compute Bayes factors for specific linear models ##' @param formula a formula containing all factors to include in the analysis ##' (see Examples) ##' @param data a data frame containing data for all factors in the formula ##' @param whichRandom a character vector specifying which factors are random ##' @param rscaleFixed prior scale for standardized, reduced fixed effects. A ##' number of preset values can be given as strings; see Details. ##' @param rscaleRandom prior scale for standardized random effects ##' @param rscaleCont prior scale for standardized slopes. A ##' number of preset values can be given as strings; see Details. ##' @param rscaleEffects A named vector of prior settings for individual factors, ##' overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names. ##' @param posterior if \code{TRUE}, return samples from the posterior ##' distribution instead of the Bayes factor ##' @param progress if \code{TRUE}, show progress with a text progress bar ##' @param ... further arguments to be passed to or from methods. ##' @return If \code{posterior} is \code{FALSE}, an object of class ##' \code{BFBayesFactor}, containing the computed model comparisons is ##' returned. Otherwise, an object of class \code{BFmcmc}, containing MCMC ##' samples from the posterior is returned. ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @export ##' @keywords htest ##' @examples ##' ## Puzzles data; see ?puzzles for details ##' data(puzzles) ##' ## Bayes factor of full model against null ##' bfFull = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID") ##' ##' ## Bayes factor of main effects only against null ##' bfMain = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID") ##' ##' ## Compare the main-effects only model to the full model ##' bfMain / bfFull ##' ##' ## sample from the posterior of the full model ##' samples = lmBF(RT ~ shape + color + shape:color + ID, ##' data = puzzles, whichRandom = "ID", posterior = TRUE, ##' iterations = 1000) ##' ##' ## Aother way to sample from the posterior of the full model ##' samples2 = posterior(bfFull, iterations = 1000) ##' @seealso \code{\link{regressionBF}} and \code{anovaBF} for ##' testing many regression or ANOVA models simultaneously. lmBF <- function(formula, data, whichRandom = NULL, rscaleFixed="medium", rscaleRandom="nuisance", rscaleCont="medium", rscaleEffects=NULL, posterior=FALSE,progress=getOption('BFprogress', interactive()), ...) { data <- marshallTibble(data) data <- reFactorData(data) checkFormula(formula, data, analysis="lm") dataTypes <- createDataTypes(formula, whichRandom = whichRandom, data = data, analysis="lm") rscales = list(fixed=rpriorValues("allNways","fixed",rscaleFixed), random=rpriorValues("allNways","random",rscaleRandom), continuous=rpriorValues("regression",,rscaleCont), effects=rscaleEffects) numerator = BFlinearModel(type = "JZS", identifier = list(formula = stringFromFormula(formula)), prior=list(rscale=rscales), dataTypes = dataTypes, shortName = paste(stringFromFormula(formula[[3]]),sep=""), longName = paste(stringFromFormula(formula),sep="") ) if(posterior){ chains = posterior(numerator, data = data, progress=progress, ...) return(chains) }else{ bf = compare(numerator = numerator, data = data, progress=progress, ...) return(bf) } } BayesFactor/R/meta-ttest-utility.R0000644000176200001440000001575513043077372016613 0ustar liggesusersmakeMetaTtestHypothesisNames = function(rscale, nullInterval=NULL){ if(is.null(nullInterval)){ shortName = paste("Alt., r=",round(rscale,3),sep="") longName = paste("Alternative, r = ",rscale,", delta =/= 0", sep="") }else{ if(!is.null(attr(nullInterval,"complement"))){ shortName = paste("Alt., r=",round(rscale,3)," !(",nullInterval[1],"15)){ message("t is large; approximation invoked.") meta.bf.interval = meta.bf.interval_approx } if(is.null(interval)){ return(meta.bf.interval(-Inf,Inf,t,N,df,rscale)) } interval = range(interval) if(interval[1]==-Inf & interval[2]==Inf){ if(complement){ return(list(bf=NA,properror=NA,method=NA)) }else{ return(meta.bf.interval(-Inf,Inf,t,N,df,rscale)) } } if(any(abs(t)>5)){ message("t is large; approximation invoked.") meta.bf.interval = meta.bf.interval_approx } if(any(is.infinite(interval))){ if(!complement){ bf = meta.bf.interval(interval[1],interval[2],t,N,df,rscale) }else{ if( ( interval[1]==-Inf ) ){ bf.compl = meta.bf.interval(interval[2],Inf,t,N,df,rscale) }else{ bf.compl = meta.bf.interval(-Inf,interval[1],t,N,df,rscale) } } }else{ logPriorProbs = pcauchy(c(-Inf,interval,Inf),scale=rscale,log.p=TRUE) prior.interval1 = logExpXminusExpY(logPriorProbs[2], logPriorProbs[1]) prior.interval3 = logExpXminusExpY(logPriorProbs[4], logPriorProbs[3]) prior.interval.1.3 = logExpXplusExpY(prior.interval1,prior.interval3) bf1 = meta.bf.interval(-Inf,interval[1],t,N,df,rscale) bf = meta.bf.interval(interval[1],interval[2],t,N,df,rscale) bf3 = meta.bf.interval(interval[2],Inf,t,N,df,rscale) if(complement){ bf.compl = sumWithPropErr(bf1[['bf']] + prior.interval1, bf3[['bf']] + prior.interval3, bf1[['properror']], bf3[['properror']]) bf.compl[1] = bf.compl[1] - prior.interval.1.3 } } if(complement){ return( list( bf = bf.compl[[1]], properror = bf.compl[[2]], method = "Savage-Dickey t approximation" )) }else{ return( list( bf = bf[['bf']], properror = bf[['properror']], method = bf[['method']] )) } } meta.bf.interval <- function(lower,upper,t,N,df,rscale){ nullLike = sum(dt(t,df,log=TRUE)) logPriorProbs = pcauchy(c(upper,lower),scale=rscale,log.p=TRUE) prior.interval = logExpXminusExpY(logPriorProbs[1], logPriorProbs[2]) delta.est = t/sqrt(N) mean.delta = sum((delta.est * N)/sum(N)) log.const = meta.t.like(mean.delta,t,N,df,rscale,log=TRUE) intgl = integrate(meta.t.like,lower-mean.delta,upper-mean.delta,t=t,N=N,df=df,rscale=rscale,log.const=log.const,shift=mean.delta) val = log(intgl[[1]]) + log.const - prior.interval - nullLike err = exp(log(intgl[[2]]) - val) return( list( bf = val, properror = err, method = "quadrature" ) ) } meta.t.like <- Vectorize(function(delta,t,N,df,rscale=1,log.const=0,log=FALSE,shift=0){ ans = suppressWarnings( sum(dt(t,df,ncp=(delta + shift)*sqrt(N),log=TRUE)) + dcauchy(delta+shift,scale=rscale,log=TRUE) - log.const ) if(log){ return(ans) }else{ return(exp(ans)) } },"delta") meta.t.Metrop <- function(t, n1, n2=NULL, nullModel, iterations=10000, nullInterval=NULL, rscale, progress=getOption('BFprogress', interactive()), noSample=FALSE, callback = NULL, callbackInterval = 1){ if(length(t)!=length(n1)) stop("lengths of t and n1 must be equal.") if(!is.null(n2)){ if(length(t) != length(n2)) stop("If n2 is defined, it must have the same length as t.") } iterations = as.integer(iterations) if( is.null(n2) ){ n2 = n1*0 twoSample = FALSE }else{ twoSample = TRUE } progress = as.logical(progress) if(is.null(callback) | !is.function(callback)) callback=function(...) as.integer(0) if(is.null(nullInterval) | nullModel){ doInterval = FALSE nullInterval = c(-Inf, Inf) intervalCompl = FALSE }else{ doInterval = TRUE intervalCompl = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) nullInterval = range(nullInterval) } if(noSample){ chains = matrix(as.numeric(NA),1,1) }else{ if(nullModel) rscale = 0 chains = metropMetaTRcpp(t, n1, n2, twoSample, rscale, iterations, doInterval, nullInterval, intervalCompl, nullModel, progress, callback, callbackInterval) if(!nullModel & !noSample){ acc.rate = mean(diff(chains) != 0) message("Independent-candidate M-H acceptance rate: ",round(100*acc.rate),"%") } } return(mcmc(data.frame(delta=chains))) } meta.bf.interval_approx <- function(lower,upper,t,N,df,rscale){ ## Savage-Dickey using t approximation to posterior of delta delta.est = t/sqrt(N) mean.delta = sum((delta.est * N)/sum(N)) var.delta = 1/sum(N) logPriorProbs = pcauchy(c(upper,lower),scale=rscale,log.p=TRUE) logPostProbs = pt((c(upper,lower) - mean.delta)/sqrt(var.delta),sum(df),log.p=TRUE) prior.interval = logExpXminusExpY(logPriorProbs[1], logPriorProbs[2]) post.interval = logExpXminusExpY(logPostProbs[1], logPostProbs[2]) log.bf.interval = post.interval - prior.interval log.bf.point = meta.bf.interval(-Inf, Inf, t, N, df, rscale) if(lower == -Inf & upper == Inf){ val = log.bf.point$bf err = log.bf.point$properror }else{ val = log.bf.interval + log.bf.point$bf err = NA } return( list( bf = val, properror = err, method = "Savage-Dickey t approximation" ) ) } BayesFactor/R/common.R0000644000176200001440000003203613043077372014302 0ustar liggesusersif(getRversion() >= '2.15.1') globalVariables("gIndex") mcoptions <- list(preschedule=FALSE, set.seed=TRUE) # Create (new) factors out of factor and character columns reFactorData <- function(data){ if(is.data.frame(data)){ indChar <- sapply(data, is.character) indFac <- sapply(data, is.factor) data[indChar | indFac] <- lapply(data[indChar | indFac], factor) return(data) }else{ stop("Data must be in data.frame format.") } } filterVectorLogical <- function(columnFilter,myNames){ if(!is.null(columnFilter)){ ignoreMatrix = sapply(columnFilter, function(el,namedCols){ grepl(el,namedCols) },namedCols=myNames) if(length(myNames)==1){ ignoreCols = any(ignoreMatrix) }else{ ignoreCols = apply(ignoreMatrix,1,any) } return(ignoreCols) }else{ return(rep(FALSE,length(myNames))) } } expString <- function(x){ if(is.na(x)) return("NA") doubleBase = .Machine$double.base toBase10log = x / log(10) toBaselog = x / log(doubleBase) numMax = .Machine$double.max.exp numMin = .Machine$double.min.exp if(toBaselog>numMax){ first <- prettyNum( 10 ^ (toBase10log - floor(toBase10log)) ) second <- prettyNum( floor(toBase10log) ) return( paste( first, "e+", second, sep="" ) ) }else if(toBaselog < numMin){ first <- prettyNum( 10 ^ (1 - (ceiling(toBase10log) - toBase10log)) ) second <- prettyNum( ceiling(toBase10log)-1 ) return( paste( first, "e", second, sep="" ) ) }else{ return( prettyNum( exp(x) ) ) } } alphabetizeTerms <- function(trms){ splt = strsplit(trms,":",fixed=TRUE) sorted=lapply(splt, function(trm){ if(length(trm)==1) return(trm) trm = sort(trm) paste(trm,collapse=":") }) sorted = unlist(sorted) return(sorted) } whichOmitted <- function(numerator, full){ fullFmla <- formula(full@identifier$formula) numFmla <- formula(numerator@identifier$formula) fullTrms <- attr(terms(fullFmla), "term.labels") numTrms <- attr(terms(numFmla), "term.labels") fullTrms = alphabetizeTerms(fullTrms) numTrms = alphabetizeTerms(numTrms) omitted = fullTrms[!(fullTrms %in% numTrms)] if(any( !(numTrms %in% fullTrms) )) stop("Numerator not a proper restriction of full.") return(omitted) } propErrorEst = function(logX){ logX = logX[!is.na(logX)] summaries = logSummaryStats(logX) exp( ( summaries$logVar - log(length(logX)) )/2 - summaries$logMean) } combineModels <- function(modelList, checkCodes = TRUE){ are.same = sapply(modelList[-1],function(m) modelList[[1]] %same% m) if( any(!are.same) ) stop("Cannot combine models that are not the same.") if(class(modelList[[1]]) != "BFlinearModel") return(modelList[[1]]) hasanalysis = sapply(modelList, .hasSlot, name = "analysis") if( all(!hasanalysis) ) return(modelList[[1]]) modelList = modelList[hasanalysis] if(length(modelList)==1) return(modelList[[1]]) sampledTRUE = sapply(sapply(modelList, function(m) m@analysis[['sampled']]),identical,y=TRUE) if( !any(sampledTRUE)) return(modelList[[1]]) modelList = modelList[which(sampledTRUE)] if( length(modelList)==1 ) return(modelList[[1]]) bfs = unlist(sapply(modelList, function(m) m@analysis[['bf']])) properrs = unlist(sapply(modelList, function(m) m@analysis[['properror']])) # We need to make sure we don't combine analyses that are based on the same codes. codes = lapply(modelList, function(m) m@analysis[['code']]) if(checkCodes){ n = length(codes) X = diag(n) for(i in 2:n) for(j in 1:(i-1)) X[i,j] = X[j,i] = length(intersect(codes[[i]],codes[[j]]))>0 if(!identical(X,diag(n))) return(modelList[[which.min(properrs)]]) } # Convert prop to abs err logAbs = bfs + log(properrs) # Compute log precisions logPrec = -2*logAbs # log sum of precisions logSumPrec = logMeanExpLogs(logPrec) + log(length(logPrec)) # log weighted average logAvgBF = logMeanExpLogs(logPrec + bfs - logSumPrec) + log(length(logPrec)) # convert prec back to abs err logSumAbs = -logSumPrec/2 # convert back to prop err sumPropErr = exp(logSumAbs - logAvgBF) bf = logAvgBF properror = sumPropErr new.analysis = list(bf = bf, properror = properror, sampled = TRUE, method = "composite") all.codes = do.call("c",codes) new.mod = modelList[[1]] new.mod@analysis = new.analysis new.mod@analysis[['code']] = all.codes new.mod@version = BFInfo(FALSE) return(new.mod) } combn2 <- function(x,lower=1){ unlist(lapply(lower:length(x),function(m,x) combn(x,m,simplify=FALSE),x=x),recursive=FALSE) } stringFromFormula <- function(formula){ oneLine = paste(deparse(formula),collapse="") sub("\\s\\s+"," ", oneLine, perl=TRUE) # get rid of extra spaces } fmlaFactors <- function(formula, data){ names <- rownames(attr(terms(formula, data = data),"factors")) names <- decomposeTerms(names) names <- unlist(names) names } are.factors<-function(df) sapply(df, function(v) is.factor(v)) `%com%` <- function(x,y){ common = intersect(names(x),names(y)) if(length(common)==0) return(logical(0)) all(sapply(common, function(el,x,y) identical(x[el],y[el]), x=x,y=y)) } randomString <- function(x=1){ n = ifelse(length(x)>1, length(x), x) substring(tempfile(rep("",n),"",""),2) } rpriorValues <- function(modelType,effectType=NULL,priorType=NULL){ if(length(priorType)==0){ return(NULL) }else if(length(priorType)>1 | is.numeric(priorType)){ return(priorType) }else if( suppressWarnings( !is.na( as.numeric( priorType ) ) ) ){ return(as.numeric(priorType)) }else if(length(priorType)==0){ return(NULL) } if(modelType=="proptest"){ return( switch(priorType, ultrawide=1, wide=sqrt(2)/2, medium=1/2, stop("Unknown prior type.")) ) } if(modelType=="allNways"){ return( switch(effectType, fixed = switch(priorType, ultrawide=1, wide=sqrt(2)/2, medium=1/2, stop("Unknown prior type.")), random = switch(priorType, wide=sqrt(2)/2, medium=1/2, nuisance=1, ultrawide=1, stop("Unknown prior type.")), continuous = rpriorValues("regression",,priorType), stop("Unknown prior type.") ) ) } if(modelType=="ttestTwo"){ return( switch(priorType, ultrawide=sqrt(2), wide=1, medium=sqrt(2)/2, stop("Unknown prior type.")) ) } if(modelType=="ttestOne"){ return( switch(priorType, ultrawide=sqrt(2), wide=1, medium=sqrt(2)/2, stop("Unknown prior type.")) ) } if(modelType=="regression"){ #return(1) return( switch(priorType, ultrawide=sqrt(2)/2, wide=1/2, medium=sqrt(2)/4, stop("Unknown prior type.") ) ) } if(modelType=="correlation"){ return( switch(priorType, ultrawide=1, wide=1/sqrt(3), medium=1/3, medium.narrow = 1/sqrt(27), stop("Unknown prior type.") ) ) } stop("Unknown prior type.") } dinvgamma = function (x, shape, scale = 1, log = FALSE, logx = FALSE) { if (shape <= 0 | scale <= 0) { stop("Shape or scale parameter negative in dinvgamma().\n") } shape = rep(0, length(x)) + shape scale = rep(0, length(x)) + scale if(logx){ log.density = mapply(dinvgamma1_logx_Rcpp, x = x, a = shape, b = scale) }else{ log.density = mapply(dinvgamma1_Rcpp, x = x, a = shape, b = scale) } if(log){ return(log.density) }else{ return(exp(log.density)) } } # Taken from the WLE package source by Claudio Agostinelli binary <- function(x, dim) { if (x==0) { pos <- 1 } else { pos <- floor(log(x, 2))+1 } if (!missing(dim)) { if (pos<=dim) { pos <- dim } else { warning("the value of `dim` is too small") } } bin <- rep(0, pos) dicotomy <- rep(FALSE, pos) for (i in pos:1) { bin[i] <- floor(x/2^(i-1)) dicotomy[i] <- bin[i]==1 x <- x-((2^(i-1))*bin[i]) } return(list(binary=bin, dicotomy=dicotomy)) } # Construct all monotone Boolean functions for m arguments monotoneBoolean <- function(m){ if(m==0){ return(list(FALSE,TRUE)) }else{ m0 = monotoneBoolean(m-1) m1 = list() for(i in 1:length(m0)) for(j in 1:length(m0)){ if(identical((m0[[i]] | m0[[j]]), m0[[j]])){ m1[[length(m1)+1]] = c(m0[[i]],m0[[j]]) } } return(m1) } } # Construct all monotone Boolean functions for m arguments # but output in nice format (matrix) monotoneBooleanNice = function(m){ mb = monotoneBoolean(m) n = length(mb) mb = unlist(mb) dim(mb) = c(length(mb)/n,n) t(mb) } makeTerm <- function(m,factors){ trms = factors[binary(m,length(factors))$dicotomy] trms = composeTerm(trms) trms } setMethod("%termin%", signature = c(x="character",table="character"), function(x,table){ table = strsplit(table,":",fixed=TRUE) x = strsplit(x,":",fixed=TRUE) returnVector = rep(FALSE,length(x)) for(i in 1:length(x)) for(j in 1:length(table)){ found = all(table[[j]] %in% x[[i]]) & all(x[[i]] %in% table[[j]]) returnVector[i] = returnVector[i] | found } return(returnVector) }) setMethod("%termin%", signature = c(x="character",table="NULL"), function(x,table){ return(rep(FALSE,length(x))) }) termMatch <- function(x, table, nomatch = NA_integer_){ returnVector = rep(nomatch,length(x)) if(is.null(table)){ return(returnVector) } table = strsplit(table,":",fixed=TRUE) x = strsplit(x,":",fixed=TRUE) for(i in 1:length(x)) for(j in 1:length(table)){ found = all(table[[j]] %in% x[[i]]) & all(x[[i]] %in% table[[j]]) if(is.na(returnVector[i]) & found) returnVector[i] = j } return(returnVector) } # Add two values for which the proportional error is known # and return the proportional error sumWithPropErr <- function(x1,x2,err1,err2){ # convert proportional error to abs err logAbs1 = x1 + log(err1) logAbs2 = x2 + log(err2) logSum = logExpXplusExpY( x1, x2 ) absSum = .5 * logExpXplusExpY(2*logAbs1, 2*logAbs2) propErr = exp(absSum - logSum) return(c(logSum,propErr)) } BFtry <- function(expression, silent=FALSE) { result <- base::try(expression, silent=silent) if (inherits(result, "try-error")) { message <- as.character(result) split <- base::strsplit(as.character(message), " : ")[[1]] error <- split[[length(split)]] while (substr(error, 1, 1) == ' ' || substr(error, 1, 1) == '\n') # trim front error <- substring(error, 2) while (substring(error, nchar(error)) == ' ' || substring(error, nchar(error)) == '\n') # trim back error <- substr(error, 1, nchar(error)-1) if (error == "Operation cancelled by callback function.") stop("Operation cancelled by callback function.") if (error == "Operation cancelled by interrupt.") stop("Operation cancelled by interrupt.") } result } marshallTibble <- function(data) { if (inherits(data, 'tbl_df')) { data <- as.data.frame(data) warning('data coerced from tibble to data frame', call.=FALSE) } data } # compose functions from jmvcore package composeTerm <- function(components) { components <- sapply(components, function(component) { if (make.names(component) != component) { component <- gsub('\\', '\\\\', component, fixed=TRUE) component <- gsub('`', '\\`', component, fixed=TRUE) component <- paste0('`', component, '`') } component }, USE.NAMES=FALSE) term <- paste0(components, collapse=':') term } composeTerms <- function(listOfComponents) { sapply(listOfComponents, composeTerm, USE.NAMES=FALSE) } decomposeTerms <- function(terms) { decomposed <- list() for (i in seq_along(terms)) decomposed[[i]] <- decomposeTerm(terms[[i]]) decomposed } decomposeTerm <- function(term) { chars <- strsplit(term, '')[[1]] components <- character() componentChars <- character() inQuote <- FALSE i <- 1 n <- length(chars) while (i <= n) { char <- chars[i] if (char == '`') { inQuote <- ! inQuote } else if (char == '\\') { i <- i + 1 char <- chars[i] componentChars <- c(componentChars, char) } else if (char == ':' && inQuote == FALSE) { component <- paste0(componentChars, collapse='') components <- c(components, component) componentChars <- character() } else { componentChars <- c(componentChars, char) } i <- i + 1 } component <- paste0(componentChars, collapse='') components <- c(components, component) components } BayesFactor/R/manual.R0000644000176200001440000000074312452540640014263 0ustar liggesusers #'Opens the HTML manual for the BayesFactor package #' #'This function opens the HTML manual for the BayesFactor package in whatever #'browser is configured. #' #'This function opens the HTML manual for the BayesFactor package in whatever #'browser is configured. #'@return \code{BFManual} returns \code{NULL} invisibly. #'@author Richard D. Morey (\email{richarddmorey@@gmail.com}) #'@keywords misc #'@export BFManual <- function(){ vignette('index', package = 'BayesFactor') } BayesFactor/R/RcppExports.R0000644000176200001440000001140713277750317015310 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 hFunc <- function(rho, n, r, hg_checkmod, hg_iter) { .Call('_BayesFactor_hFunc', PACKAGE = 'BayesFactor', rho, n, r, hg_checkmod, hg_iter) } jeffreys_approx_corr <- function(rho, n, r) { .Call('_BayesFactor_jeffreys_approx_corr', PACKAGE = 'BayesFactor', rho, n, r) } metropCorrRcpp_jeffreys <- function(r, n, a_prior, b_prior, approx, iterations, doInterval, intervalz, intervalCompl, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_metropCorrRcpp_jeffreys', PACKAGE = 'BayesFactor', r, n, a_prior, b_prior, approx, iterations, doInterval, intervalz, intervalCompl, nullModel, progress, callback, callbackInterval) } dinvgamma1_Rcpp <- function(x, a, b) { .Call('_BayesFactor_dinvgamma1_Rcpp', PACKAGE = 'BayesFactor', x, a, b) } dinvgamma1_logx_Rcpp <- function(x, a, b) { .Call('_BayesFactor_dinvgamma1_logx_Rcpp', PACKAGE = 'BayesFactor', x, a, b) } ddinvgamma1_Rcpp <- function(x, a, b) { .Call('_BayesFactor_ddinvgamma1_Rcpp', PACKAGE = 'BayesFactor', x, a, b) } d2dinvgamma1_Rcpp <- function(x, a, b) { .Call('_BayesFactor_d2dinvgamma1_Rcpp', PACKAGE = 'BayesFactor', x, a, b) } genhypergeo_series_pos <- function(U, L, z, tol, maxiter, check_mod, check_conds, polynomial) { .Call('_BayesFactor_genhypergeo_series_pos', PACKAGE = 'BayesFactor', U, L, z, tol, maxiter, check_mod, check_conds, polynomial) } jzs_sampler <- function(iterations, y, X, rscale, gMap, incCont, importanceMu, importanceSig, progress, callback, callbackInterval, which) { .Call('_BayesFactor_jzs_sampler', PACKAGE = 'BayesFactor', iterations, y, X, rscale, gMap, incCont, importanceMu, importanceSig, progress, callback, callbackInterval, which) } jzs_log_marginal_posterior_logg <- function(q, sumSq, N, XtCnX0, CnytCnX0, rscale, gMap, gMapCounts, priorX, incCont, limit, limits, which) { .Call('_BayesFactor_jzs_log_marginal_posterior_logg', PACKAGE = 'BayesFactor', q, sumSq, N, XtCnX0, CnytCnX0, rscale, gMap, gMapCounts, priorX, incCont, limit, limits, which) } jzs_Gibbs <- function(iterations, y, X, rscale, sig2start, gMap, gMapCounts, incCont, nullModel, ignoreCols, thin, progress, callback, callbackInterval) { .Call('_BayesFactor_jzs_Gibbs', PACKAGE = 'BayesFactor', iterations, y, X, rscale, sig2start, gMap, gMapCounts, incCont, nullModel, ignoreCols, thin, progress, callback, callbackInterval) } GibbsLinearRegRcpp <- function(iterations, y, X, r, sig2start, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_GibbsLinearRegRcpp', PACKAGE = 'BayesFactor', iterations, y, X, r, sig2start, nullModel, progress, callback, callbackInterval) } log_determinant_pos_def <- function(A) { .Call('_BayesFactor_log_determinant_pos_def', PACKAGE = 'BayesFactor', A) } logSummaryStats <- function(x) { .Call('_BayesFactor_logSummaryStats', PACKAGE = 'BayesFactor', x) } log1pExp <- function(x) { .Call('_BayesFactor_log1pExp', PACKAGE = 'BayesFactor', x) } logExpXplusExpY <- function(x, y) { .Call('_BayesFactor_logExpXplusExpY', PACKAGE = 'BayesFactor', x, y) } logExpXminusExpY <- function(x, y) { .Call('_BayesFactor_logExpXminusExpY', PACKAGE = 'BayesFactor', x, y) } metropMetaTRcpp <- function(t, n1, n2, twoSample, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_metropMetaTRcpp', PACKAGE = 'BayesFactor', t, n1, n2, twoSample, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) } metropProportionRcpp <- function(y, n, p0, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_metropProportionRcpp', PACKAGE = 'BayesFactor', y, n, p0, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) } gibbsTwoSampleRcpp <- function(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_gibbsTwoSampleRcpp', PACKAGE = 'BayesFactor', ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) } gibbsOneSampleRcpp <- function(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) { .Call('_BayesFactor_gibbsOneSampleRcpp', PACKAGE = 'BayesFactor', ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval) } # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { .Call('_BayesFactor_RcppExport_registerCCallable', PACKAGE = 'BayesFactor') }) BayesFactor/R/newPriorOdds.R0000644000176200001440000000135113043077372015425 0ustar liggesusers#'Create prior odds from a Bayes factor object #' #'Create a prior odds object from a Bayes factor object #' #'This function takes a Bayes factor object and, using its structure and #'specified type of prior odds, will create a prior odds object. #' #'For now, the only type is "equal", which assigns equal prior odds to all #'models. #' #'@param bf A BFBayesFactor object, eg, from an analysis #'@param type The type of prior odds to create (by default "equal"; see details) #'@return A (prior) BFodds object, which can then be multiplied by the #'BFBayesFactor object to obtain posterior odds. #'@author Richard D. Morey (\email{richarddmorey@@gmail.com}) #'@keywords misc #'@export newPriorOdds = function(bf, type = "equal"){ BFodds(bf) } BayesFactor/R/correlation-utility.R0000644000176200001440000001203113274042462017023 0ustar liggesusersmakeCorrHypothesisNames = function(rscale, nullInterval=NULL){ if(is.null(nullInterval)){ shortName = paste("Alt., r=",round(rscale,3),sep="") longName = paste("Alternative, r = ",rscale,", rho =/= 0", sep="") }else{ if(!is.null(attr(nullInterval,"complement"))){ shortName = paste("Alt., r=",round(rscale,3)," !(",nullInterval[1],"=1){ if(complement){ return(list(bf=NA,properror=NA)) }else{ return(return(.bf10Exact(n, r, rscale))) } } if(any(abs(nullInterval)>=1)){ bf = corr.test.bf.interval(y, x, rscale, nullInterval) if(interval[1]<=-1){ bf.compl = corr.test.bf.interval(y, x, rscale, c(nullInterval[2], 1)) }else{ bf.compl = corr.test.bf.interval(y, x, rscale, c(-1,nullInterval[1])) } }else{ logPriorProbs = pbeta(c(-1,nullInterval,1)/2+.5, 1/rscale, 1/rscale, log.p=TRUE) prior.interval1 = logExpXminusExpY(logPriorProbs[2], logPriorProbs[1]) prior.interval3 = logExpXminusExpY(logPriorProbs[4], logPriorProbs[3]) prior.interval.1.3 = logMeanExpLogs(c(prior.interval1,prior.interval3)) + log(2) bf1 = corr.test.bf.interval(y, x, rscale, c(-1,nullInterval[1])) bf = corr.test.bf.interval(y, x, rscale, nullInterval) bf3 = corr.test.bf.interval(y, x, rscale, c(nullInterval[2],1)) bf.compl = sumWithPropErr(bf1[['bf']] + prior.interval1, bf3[['bf']] + prior.interval3, bf1[['properror']], bf3[['properror']]) bf.compl[1] = bf.compl[1] - prior.interval.1.3 } if(complement){ return( list( bf = bf.compl[[1]], properror = bf.compl[[2]], method = "quadrature" )) }else{ return( list( bf = bf[['bf']], properror = bf[['properror']], method = bf[['method']] )) } } correlation.Metrop <- function(y, x, nullModel, iterations=10000, nullInterval=NULL, rscale, progress=getOption('BFprogress', interactive()), noSample=FALSE, callback = NULL, callbackInterval = 1){ if(length(y)!=length(x)) stop("lengths of y and x must be equal.") iterations = as.integer(iterations) progress = as.logical(progress) if(is.null(callback) | !is.function(callback)) callback=function(...) as.integer(0) if(is.null(nullInterval) | nullModel){ doInterval = FALSE nullInterval = c(-1, 1) intervalCompl = FALSE }else{ doInterval = TRUE intervalCompl = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) nullInterval = range(nullInterval) } r = cor(y, x, use="pairwise.complete.obs") n = length(x) - sum(is.na(y) | is.na(x)) if(n != length(x)) message(paste("Ignored",sum(is.na(y) | is.na(x)), "rows containing missing observations.")) if(noSample){ chains = matrix(as.numeric(NA),1,1) }else{ if(nullModel) rscale = 0 chains = metropCorrRcpp_jeffreys(r, n, 1/rscale, 1/rscale, TRUE, iterations, doInterval, .5*log((1+nullInterval)/(1-nullInterval)), intervalCompl, nullModel, progress, callback, callbackInterval) if(!nullModel & !noSample){ acc.rate = mean(diff(chains) != 0) message("Independent-candidate M-H acceptance rate: ",round(100*acc.rate),"%") } } chains = mcmc(data.frame(chains)) return(chains) } BayesFactor/R/contingency-utility.R0000644000176200001440000003025713043077372017036 0ustar liggesusers# By Tahira Jamil, edited by Richard Morey (July 2014) # Bayes Factor from Gunel & Dickey Paper, For different sampling models # (BF1: Poisson; BF2: Multinomial; BF3: Poisson; BF4: Hypergeometric) #The Bayes factor are provided in favour of alternative hypothesis(against the null hypothesis: no association) ############################################## ## Utility functions ############################################## ldirich <- function(a) { val <- sum(lgamma(a)) - lgamma(sum(a)) return(val) } ldirich1 <- function(y, a) { val <- sum(lgamma(a) - lgamma(a+y)) return(val) } pcomb <- function( x, log=TRUE ) { x <- as.vector(x) n <- sum(x) ans = lgamma(n+1) - sum(lgamma(x+1)) if(log){ return(ans) }else{ return(exp(ans)) } } ######################################################################################### # Bayes Factor Gunel & Dickey Equation 4.2 # Poisson Sampling ######################################################################################### contingencyPoisson<-function (y, a){ if( a < 1 ) stop("Prior concentration cannot be less than 1.") n <- sum(y) d <- dim(y) I <- d[1] J <- d[2] b <- I*J*a/n a <- a + 0 * y ac <- colSums(a) ar <- rowSums(a) yc <- colSums(y) yr <- rowSums(y) oc <- 1 + 0 * yc or <- 1 + 0 * yr lbf<-lgamma(sum(a) - (I-1)*(J-1)) - ((I-1)*(J-1)*log(1 + 1/b)) - lgamma(sum(y) + sum(a) - (I-1)*(J-1)) - ldirich(yr + ar-(J- 1)*or) + ldirich( ar - (J - 1) * or) - ldirich(yc + ac - (I - 1) * oc) + ldirich( ac - (I - 1) * oc) - ldirich1(y,a) return(lbf) } ######################################################################################### # Bayes Factor Gunel & Dickey Equation 4.4 # Joint Multinomial Sampling ######################################################################################### contingencyJointMultinomial <-function (y, a){ if( a < 1 ) stop("Prior concentration cannot be less than 1.") a <- a + 0 * y ac <- colSums(a) ar <- rowSums(a) yc <- colSums(y) yr <- rowSums(y) d <- dim(y) oc <- 1 + 0 * yc or <- 1 + 0 * yr I <- d[1] J <- d[2] lbf <- ldirich(c(y) + c(a)) + ldirich(ar - (J - 1) * or) + ldirich(ac - (I - 1) * oc) - ldirich(c(a)) - ldirich(yr + ar - (J - 1) * or) - ldirich(yc + ac - (I - 1) * oc) return(lbf) } ######################################################################################### # Bayes Factor Gunel & Dickey Equation 4.7 #Binomial/ Independent Multinomial Sampling ######################################################################################### contingencyIndepMultinomial<-function (y, a){ if( a < 1 ) stop("Prior concentration cannot be less than 1.") a <- a + 0 * y ac <- colSums(a) ar <- rowSums(a) yc <- colSums(y) yr <- rowSums(y) d <- dim(y) oc <- 1 + 0 * yc or <- 1 + 0 * yr I <- d[1] J <- d[2] lbf <- ldirich(ac - (I - 1) * oc) + ldirich(ar) + ldirich(c(y) + c(a)) - ldirich(yc + ac - (I - 1) * oc) - ldirich(yr + ar) - ldirich(c(a)) return(lbf) } ######################################################################################### # Bayes Factor Gunel & Dickey Equation 4.11 # Hypergeometric Condition on both Margins ######################################################################################### contingencyHypergeometric<-function (y, a) { if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(!identical(dim(y),as.integer(c(2,2)))) stop("hypergeometric contingency tables restricted to 2 x 2 tables; see help for contingencyTableBF()") a <- a + 0 * y ac <- colSums(a) ar <- rowSums(a) yc <- colSums(y) yr <- rowSums(y) d <- dim(y) oc <- 1 + 0 * yc or <- 1 + 0 * yr I <- d[1] J <- d[2] sumg<-function(y,a) { M <- c(yc,yr) stopifnot(M[1]+M[2] == M[3]+M[4]) # To check both marginal totals are equal upper <- min(M[c(1,3)]) lower <- 0 if (min(M) < upper) lower <- upper - min(M) all.M <- t(sapply(lower:upper, function(i) c(a=i, b=M[1] - i, c=M[3] - i, d=M[4] - M[1] + i))) a <- a + 0 * y n.sim<-n.sim<-dim(all.M)[1] g1<- rep(NA,n.sim) for (s in 1:n.sim) { y1<-matrix(all.M[s,],2,2) g1[s]<-pcomb(y1) + ldirich(c(y1)+c(a)) - ldirich(c(a)) } return (logMeanExpLogs(g1) + log(length(g1))) } sum.mar<- sumg(y,a) lbf<-ldirich(c(y) + c(a)) + pcomb(yc) + pcomb(yr) - ldirich(c(a)) - sumg(y,a) return(lbf) } ########################### ## Sampling ## All code below by Richard Morey ########################### sampleContingency <- function(model, type, fixedMargin, prior, data, iterations, ...) { if(type == "poisson"){ if(model == "non-independence"){ chains = samplePoissonContingencyAlt(prior, data, iterations, ...) }else if(model == "independence"){ chains = samplePoissonContingencyNull(prior, data, iterations, ...) } }else if(type == "joint multinomial"){ if(model == "non-independence"){ chains = sampleJointMultiContingencyAlt(prior, data, iterations, ...) }else if(model == "independence"){ chains = sampleJointMultiContingencyNull(prior, data, iterations, ...) } }else if(type == "independent multinomial"){ if(model == "non-independence"){ chains = sampleIndepMultiContingencyAlt(fixedMargin, prior, data, iterations, ...) }else if(model == "independence"){ chains = sampleIndepMultiContingencyNull(fixedMargin, prior, data, iterations, ...) } }else if(type == "hypergeometric"){ if(model == "non-independence"){ chains = sampleHypergeomContingencyAlt(prior, data, iterations, ...) }else if(model == "independence"){ chains = sampleHypergeomContingencyNull(prior, data, iterations, ...) } }else{ stop("Unknown model type.") } } samplePoissonContingencyNull <- function(prior, data, iterations, noSample=FALSE, ...) { a = prior b = length(data) * a / sum(data) I = nrow(data) J = ncol(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1, I*J + 1 + I + J)) }else{ lambda = rgamma(iterations, sum(data) + I*J*(a - 1) + I + J - 1, b + 1) pi_i = rdirichlet(iterations, rowSums(data) + a - J + 1) pi_j = rdirichlet(iterations, colSums(data) + a - I + 1) lambda_ij = t(sapply( 1:iterations, function(i) as.vector( lambda[i] * outer( pi_i[i,], pi_j[i,] ) ) ) ) samples = data.frame( lambda_ij, lambda, pi_i, pi_j ) } cn1 = paste0("lambda[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") cn2 = paste0("pi[",1:nrow(data),",*]") cn3 = paste0("pi[*,",1:ncol(data),"]") colnames(samples) = c(cn1,"lambda..",cn2,cn3) return(mcmc(samples)) } samplePoissonContingencyAlt <- function(prior, data, iterations, noSample=FALSE, ...) { data = as.matrix(data) a = prior IJ = length(data) b = IJ * a / sum(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") a.post = data + a b.post = data*0 + b + 1 if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1, IJ)) }else{ samples = rgamma(iterations * IJ, a.post, rate = b.post) dim(samples) = c(IJ, iterations) samples = data.frame(t(samples)) } cn = paste0("lambda[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") colnames(samples) = cn return(mcmc(samples)) } sampleJointMultiContingencyNull <- function(prior, data, iterations, noSample = FALSE, ...) { a = prior I = nrow(data) J = ncol(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1, I*J + I + J)) }else{ pi_i = rdirichlet(iterations, rowSums(data) + a - J + 1) pi_j = rdirichlet(iterations, colSums(data) + a - I + 1) pi_ij = t(sapply( 1:iterations, function(i) as.vector( outer( pi_i[i,], pi_j[i,] ) ) ) ) samples = data.frame( pi_ij, pi_i, pi_j ) } cn1 = paste0("pi[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") cn2 = paste0("pi[",1:nrow(data),",*]") cn3 = paste0("pi[*,",1:ncol(data),"]") colnames(samples) = c(cn1,cn2,cn3) return(mcmc(samples)) } sampleJointMultiContingencyAlt <- function(prior, data, iterations, noSample = FALSE, ...) { a = prior I = nrow(data) J = ncol(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1, I*J)) }else{ pi_ij = rdirichlet( iterations, as.matrix(data) + a ) samples = data.frame( pi_ij ) } cn = paste0("pi[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") colnames(samples) = cn return(mcmc(samples)) } sampleIndepMultiContingencyNull <- function(fixedMargin, prior, data, iterations, noSample = FALSE, ...) { a = prior I = nrow(data) J = ncol(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ if(fixedMargin == "rows"){ samples = data.frame(matrix(as.numeric(NA), 1, I*J + I + J)) }else{ samples = data.frame(matrix(as.numeric(NA), 1, I*J + J + J)) } }else{ if(fixedMargin == "rows"){ pi_star = rdirichlet( iterations, rowSums(data) + J*a ) omega = rdirichlet( iterations, colSums(data) + a ) pi_ij = t(sapply(1:iterations, function(i){ as.vector(outer( pi_star[i,], omega[i,] )) })) }else{ pi_star = rdirichlet( iterations, colSums(data) + I*a ) omega = rdirichlet( iterations, rowSums(data) + a ) pi_ij = t(sapply(1:iterations, function(i){ as.vector(outer( omega[i,], pi_star[i,] )) })) } samples = data.frame( pi_ij, pi_star, omega ) } cn1 = paste0("pi[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") if(fixedMargin == "rows"){ cn2 = paste0("pi[",1:nrow(data),",*]") cn3 = paste0("omega[*,",1:ncol(data),"]") }else{ cn2 = paste0("pi[*,",1:ncol(data),"]") cn3 = paste0("omega[",1:nrow(data),",*]") } colnames(samples) = c(cn1,cn2,cn3) return(mcmc(samples)) } sampleIndepMultiContingencyAlt <- function(fixedMargin, prior, data, iterations, noSample = FALSE, ...) { a = prior I = nrow(data) J = ncol(data) if( a < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ if(fixedMargin == "rows"){ samples = data.frame(matrix(as.numeric(NA), 1, I*J + I + I*J)) }else{ samples = data.frame(matrix(as.numeric(NA), 1, I*J + J + I*J)) } }else{ if(fixedMargin == "rows"){ pi_star = rdirichlet( iterations, rowSums(data) + J*a ) omega = t(replicate(iterations, as.vector(t(apply(data, 1, function( v ) rdirichlet( 1, v + a )))))) pi_ij = t(sapply(1:iterations, function(i){ as.vector(rep(pi_star[i,], J) * omega[i,]) })) }else{ pi_star = rdirichlet( iterations, colSums(data) + I*a ) omega = t(replicate(iterations, as.vector(apply(data, 2, function( v ) rdirichlet( 1, v + a ))))) pi_ij = t(sapply(1:iterations, function(i){ as.vector(rep(pi_star[i,], each = I ) * omega[i,]) })) } samples = data.frame( pi_ij, pi_star, omega ) } cn1 = paste0("pi[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") if(fixedMargin == "rows"){ cn2 = paste0("pi[",1:nrow(data),",*]") }else{ cn2 = paste0("pi[*,",1:ncol(data),"]") } cn3 = paste0("omega[",outer(1:nrow(data), 1:ncol(data),paste,sep=","),"]") colnames(samples) = c(cn1,cn2,cn3) return(mcmc(samples)) } sampleHypergeomContingencyNull <- function(prior, data, iterations, noSample = FALSE, ...) { if( prior < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1)) }else{ samples = data.frame(matrix(0, iterations, 1)) } colnames(samples) = c("log.odds.ratio") return(mcmc(samples)) } sampleHypergeomContingencyAlt <- function(prior, data, iterations, noSample = FALSE, ...) { if( prior < 1 ) stop("Prior concentration cannot be less than 1.") if(noSample){ samples = data.frame(matrix(as.numeric(NA), 1)) }else{ stop("Sampling for this model not yet implemented.") } colnames(samples) = c("log.odds.ratio") return(mcmc(samples)) } BayesFactor/R/methods-BFmodelSample.R0000644000176200001440000002171013043077372017122 0ustar liggesuserssetMethod('show', signature = c("BFmcmc"), function(object){ show(S3Part(object)) show(object@model) } ) setAs("BFmcmc" , "mcmc", function ( from , to ){ as.mcmc(from) }) setAs("BFmcmc" , "matrix", function ( from , to ){ as.matrix(from) }) setAs("BFmcmc" , "data.frame", function ( from , to ){ as.data.frame(from) }) #' @rdname recompute-methods #' @aliases recompute,BFmcmc-method setMethod('recompute', signature(x = "BFmcmc", progress="ANY"), function(x, progress, ...){ posterior(model=x@model, data = x@data, progress = progress, ...) } ) setMethod('compare', signature(numerator = "BFmcmc", denominator = "BFmcmc"), function(numerator, denominator, ...){ compare(numerator = numerator@model, data = numerator@data, ...) / compare(numerator = denominator@model, data = denominator@data, ...) } ) setMethod('compare', signature(numerator = "BFmcmc", denominator = "missing"), function(numerator, denominator, ...){ compare(numerator = numerator@model, data = numerator@data, ...) } ) #' @rdname posterior-methods #' @aliases posterior,BFmodel,missing,data.frame,missing-method setMethod("posterior", signature(model="BFmodel", index="missing", data="data.frame", iterations="missing"), function(model, index, data, iterations, ...) stop("Iterations must be specified for posterior sampling.") ) #' @rdname posterior-methods #' @aliases posterior,BFBayesFactor,missing,missing,missing-method setMethod("posterior", signature(model="BFBayesFactor", index="missing", data="missing", iterations="missing"), function(model, index, data, iterations, ...) stop("Iterations must be specified for posterior sampling.") ) #' @rdname posterior-methods #' @aliases posterior,BFBayesFactor,numeric,missing,numeric-method setMethod('posterior', signature(model = "BFBayesFactor", index = "numeric", data = "missing", iterations = "numeric"), function(model, index, data, iterations, ...){ if(length(model[index])>1) stop("Index must specify single element.") posterior(model = model[index], iterations = iterations, ...) } ) #' @rdname posterior-methods #' @aliases posterior,BFBayesFactor,missing,missing,numeric-method setMethod('posterior', signature(model = "BFBayesFactor", index = "missing", data = "missing", iterations = "numeric"), function(model, index=NULL, data, iterations, ...){ if(length(model)>1) stop("Index argument required for posterior with multiple numerators.") posterior(model = model@numerator[[1]], data = model@data, iterations = iterations, ...) } ) #' @rdname posterior-methods #' @aliases posterior,BFlinearModel,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFlinearModel", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ rscaleFixed = rpriorValues("allNways","fixed",model@prior$rscale[['fixed']]) rscaleRandom = rpriorValues("allNways","random",model@prior$rscale[['random']]) rscaleCont = rpriorValues("regression",,model@prior$rscale[['continuous']]) rscaleEffects = model@prior$rscale[['effects']] formula = formula(model@identifier$formula) checkFormula(formula, data, analysis = "lm") factors = fmlaFactors(formula, data)[-1] nFactors = length(factors) dataTypes = model@dataTypes relevantDataTypes = dataTypes[names(dataTypes) %in% factors] dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) if(model@type != "JZS") stop("Unknown model type.") if( nFactors == 0 ){ stop("Sampling from intercept-only model not implemented.") }else if(all(relevantDataTypes == "continuous")){ ## Regression X = fullDesignMatrix(formula, data, dataTypes) chains = linearReg.Gibbs(y = data[[dv]],covariates = X,iterations = iterations, rscale = rscaleCont, ...) }else if(all(relevantDataTypes != "continuous")){ # ANOVA or t test chains = nWayFormula(formula=formula, data = data, dataTypes = dataTypes, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleEffects = rscaleEffects, iterations = iterations, posterior = TRUE, ...) }else{ # GLM chains = nWayFormula(formula=formula, data = data, dataTypes = dataTypes, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleCont = rscaleCont, rscaleEffects = rscaleEffects, iterations = iterations, posterior = TRUE, ...) } return(new("BFmcmc",chains, model = model, data = data)) } ) #' @rdname posterior-methods #' @aliases posterior,BFindepSample,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFindepSample", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ formula = formula(model@identifier$formula) rscale = model@prior$rscale interval = model@prior$nullInterval nullModel = ( formula[[3]] == 1 ) chains = ttestIndepSample.Gibbs(formula, data, nullModel, iterations,rscale, interval,...) new("BFmcmc",chains,model = model, data = data) }) #' @rdname posterior-methods #' @aliases posterior,BFcontingencyTable,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFcontingencyTable", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ mod = formula(model@identifier) type = model@type prior = model@prior$a marg = model@prior$fixedMargin chains = sampleContingency(mod, type, marg, prior, data = data, iterations = iterations, ...) new("BFmcmc",chains,model = model, data = data) }) #' @rdname posterior-methods #' @aliases posterior,BFoneSample,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFoneSample", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ mu = model@prior$mu rscale = model@prior$rscale interval = model@prior$nullInterval nullModel = ( model@identifier$formula == "y ~ 0" ) chains = ttestOneSample.Gibbs(y = data$y, nullModel, iterations = iterations, rscale = rscale, nullInterval = interval, ...) new("BFmcmc",chains,model = model, data = data) }) #' @rdname posterior-methods #' @aliases posterior,BFmetat,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFmetat", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ rscale = model@prior$rscale interval = model@prior$nullInterval nullModel = ( model@identifier$formula == "d = 0" ) chains = meta.t.Metrop(t = data$t, n1 = data$n1, n2 = data$n2, nullModel, iterations = iterations, rscale = rscale, nullInterval = interval, ...) new("BFmcmc",chains, model = model, data = data) }) #' @rdname posterior-methods #' @aliases posterior,BFproportion,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFproportion", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ rscale = model@prior$rscale p = model@prior$p0 interval = model@prior$nullInterval nullModel = ( model@identifier$formula == "p = p0" ) chains = proportion.Metrop(y = data$y, N = data$N, nullModel, iterations = iterations, nullInterval = interval, p = p, rscale = rscale, ...) new("BFmcmc",chains, model = model, data = data) }) #' @rdname posterior-methods #' @aliases posterior,BFcorrelation,missing,data.frame,numeric-method setMethod('posterior', signature(model = "BFcorrelation", index = "missing", data = "data.frame", iterations = "numeric"), function(model, index = NULL, data, iterations, ...){ rscale = model@prior$rscale interval = model@prior$nullInterval nullModel = ( model@identifier$formula == "rho = 0" ) chains = correlation.Metrop(y = data$y, x = data$x, nullModel, iterations = iterations, nullInterval = interval, rscale = rscale, ...) new("BFmcmc",chains, model = model, data = data) }) ########### ## S3 ########### as.mcmc.BFmcmc <- function(x, ...){ return(S3Part(x)) } as.matrix.BFmcmc <- function(x,...){ return(as.matrix(S3Part(x))) } as.data.frame.BFmcmc <- function(x, row.names=NULL,optional=FALSE,...){ return(as.data.frame(S3Part(x))) } BayesFactor/R/regressionBF-utility.R0000644000176200001440000000574513274042462017110 0ustar liggesusersenumerateRegressionModels = function(fmla, whichModels, data){ trms <- attr(terms(fmla, data = data), "term.labels") ntrms <- length(trms) dv = stringFromFormula(fmla[[2]]) dv = composeTerm(dv) if(ntrms == 1 ) whichModels = "all" if(whichModels=="top"){ lst = combn2( trms, ntrms - 1 ) }else if(whichModels=="all"){ lst = combn2( trms, 1 ) }else if(whichModels=='bottom'){ lst = as.list(combn( trms, 1 )) }else{ stop("Unknown whichModels value: ",whichModels) } strng <- lapply(lst,function(el){ paste(el,collapse=" + ") }) fmla <- lapply(strng, function(el){ formula(paste(dv,"~", el)) }) return(fmla) } createFullRegressionModel <- function(formula, data){ factors = fmlaFactors(formula, data)[-1] factors = composeTerms(factors) dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) RHS = paste(factors,collapse=" + ") strng = paste(dv, " ~ ", RHS, collapse = "") return(formula(strng)) } integrand.regression=Vectorize(function(g, N, p, R2, rscaleSqr=1, log=FALSE, log.const=0){ a = .5 * ((N - p - 1 ) * log(1 + g) - (N - 1) * log(1 + g * (1 - R2))) shape=.5 scale=rscaleSqr*N/2 log.density.igam <- dinvgamma(g, shape, scale, log=TRUE) ans = a + log.density.igam - log.const ifelse(log,ans,exp(ans)) },"g") # This is a more numerically stable version of the integrand, as a function of log(g) integrand.regression.u=Vectorize(function(u, N, p, R2, rscaleSqr=1, log=FALSE, log.const=0, shift = 0){ u = u + shift a = .5 * ((N - p - 1 ) * log1pExp(u) - (N - 1) * log1pExp(u + log(1 - R2))) shape=.5 scale=rscaleSqr*N/2 log.density.igam <- dinvgamma(u, shape, scale, log=TRUE, logx=TRUE) ans = a + log.density.igam - log.const + u ifelse(log,ans,exp(ans)) },"u") linearReg.Gibbs <- function(y, covariates, iterations = 10000, rscale = "medium", progress = getOption('BFprogress', interactive()), callback=function(...) as.integer(0), noSample=FALSE, callbackInterval = 1, ignoreCols = NULL, thin = 1, ...){ rscale = rpriorValues("allNways","continuous",rscale) X = apply(covariates,2,function(v) v - mean(v)) y = matrix(y,ncol=1) N = length(y) P = ncol(X) nGs = 1 if(is.null(ignoreCols)) ignoreCols = rep(0,P) # Check thinning to make sure number is reasonable if( (thin<1) | (thin>(iterations/3)) ) stop("MCMC thin parameter cannot be less than 1 or greater than iterations/3. Was:", thin) gMap = rep(0, P) sig2start = sum( (X%*%solve(t(X)%*%X)%*%t(X)%*%y - y)^2 ) / N progress = as.logical(progress) if(is.null(callback) | !is.function(callback)) callback=function(...) as.integer(0) if(noSample){ # Return structure of chains chains = matrix(NA, 2, P + 2 + nGs) }else{ chains = jzs_Gibbs(iterations, y, cbind(1,X), rscale, sig2start, gMap, table(gMap), P, FALSE, as.integer(ignoreCols), as.integer(thin), as.logical(progress), callback, 1) } colnames(chains) = c("mu", colnames(covariates), "sig2", "g") chains = mcmc(chains) return(chains) } BayesFactor/R/base64.R0000644000176200001440000000535413052027753014077 0ustar liggesusers # Author: Jonathon Love toB64Lookup <- c( 0x41, # A 0x42, # B 0x43, # C 0x44, # D 0x45, # E 0x46, # F 0x47, # G 0x48, # H 0x49, # I 0x4A, # J 0x4B, # K 0x4C, # L 0x4D, # M 0x4E, # N 0x4F, # O 0x50, # P 0x51, # Q 0x52, # R 0x53, # S 0x54, # T 0x55, # U 0x56, # V 0x57, # W 0x58, # X 0x59, # Y 0x5A, # Z 0x61, # a 0x62, # b 0x63, # c 0x64, # d 0x65, # e 0x66, # f 0x67, # g 0x68, # h 0x69, # i 0x6A, # j 0x6B, # k 0x6C, # l 0x6D, # m 0x6E, # n 0x6F, # o 0x70, # p 0x71, # q 0x72, # r 0x73, # s 0x74, # t 0x75, # u 0x76, # v 0x77, # w 0x78, # x 0x79, # y 0x7A, # z 0x30, # 0 0x31, # 1 0x32, # 2 0x33, # 3 0x34, # 4 0x35, # 5 0x36, # 6 0x37, # 7 0x38, # 8 0x39, # 9 0x2E, # . 0x5F) # _ fromB64Lookup <- c( rep(-1, 0x2D), 63, -1, 0x35:0x3E, # 0x30 rep(-1, 0x40 - 0x3A + 1), 1:26, # 0x41 rep(-1, 0x5E - 0x5B + 1), # 0x5B 64, # 0x5F -1, # 0x60 1:26+26, rep(-1, 0x7F - 0x7A + 1)) toB64 <- function(names) { sapply(names, toB64string, USE.NAMES=FALSE) } fromB64 <- function(names) { sapply(names, fromB64string, USE.NAMES=FALSE) } fromB64string <- function(string) { if ( ! startsWith(string, '.')) stop('b64 names should begin with a dot') string <- substring(string, 2) if (string == "") return("") array <- as.integer(charToRaw(string)) array <- fromB64Lookup[array] - 1 out <- c() i <- 1 j <- 1 while (i <= length(array)) { if (i + 1 <= length(array)) out[j + 0] <- 4 * array[i + 0] + floor(array[i + 1] / 16) else out[j + 0] <- 4 * array[i + 0] if (i + 2 <= length(array)) out[j + 1] <- 16 * (array[i + 1] %% 16) + as.integer(array[i + 2] / 4) if (i + 3 <= length(array)) out[j + 2] <- 64 * (array[i + 2] %% 4) + array[i + 3] i <- i + 4 j <- j + 3 } rawToChar(as.raw(out)) } toB64string <- function(string) { if (string == "") return("") array <- as.integer(charToRaw(string)) out <- c() i <- 1 j <- 1 while (i <= length(array)) { out[j + 0] <- floor(array[i + 0] / 4) if (i + 1 <= length(array)) { out[j + 1] <- (array[i + 0] %% 4) * 16 + floor((array[i + 1] / 16)) if (i + 2 <= length(array)) { out[j + 2] <- (array[i + 1] %% 16) * 4 + floor(array[i + 2] / 64) out[j + 3] <- array[i + 2] %% 64 } else { out[j + 2] <- (array[i + 1] %% 16) * 4 } } else { out[j + 1] <- (array[i + 0] %% 4) * 16 } i <- i + 3 j <- j + 4 } chars <- toB64Lookup[out + 1] paste0('.', rawToChar(as.raw(chars))) } BayesFactor/R/linearReg_R2stat.R0000644000176200001440000000723313043077372016162 0ustar liggesusers##' Using the classical R^2 test statistic for (linear) regression designs, this ##' function computes the corresponding Bayes factor test. ##' ##' This function can be used to compute the Bayes factor corresponding to a ##' multiple regression, using the classical R^2 (coefficient of determination) ##' statistic. It can be used when you don't have access to the full data set ##' for analysis by \code{\link{lmBF}}, but you do have the test statistic. ##' ##' For details about the model, see the help for \code{\link{regressionBF}}, ##' and the references therein. ##' ##' The Bayes factor is computed via Gaussian quadrature. ##' @title Use R^2 statistic to compute Bayes factor for regression designs ##' @param N number of observations ##' @param p number of predictors in model, excluding intercept ##' @param R2 proportion of variance accounted for by the predictors, excluding ##' intercept ##' @param rscale numeric prior scale ##' @param simple if \code{TRUE}, return only the Bayes factor ##' @return If \code{simple} is \code{TRUE}, returns the Bayes factor (against the ##' intercept-only null). If \code{FALSE}, the function returns a ##' vector of length 3 containing the computed log(e) Bayes factor, ##' along with a proportional error estimate on the Bayes factor and the method used to compute it. ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) and Jeffrey N. ##' Rouder (\email{rouderj@@missouri.edu}) ##' @keywords htest ##' @export ##' @references Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and ##' Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable ##' Selection. Journal of the American Statistical Association, 103, pp. ##' 410-423 ##' ##' Rouder, J. N. and Morey, R. D. (in press, Multivariate Behavioral Research). Bayesian testing in ##' regression. ##' ##' Perception and Cognition Lab (University of Missouri): Bayes factor ##' calculators. \url{http://pcl.missouri.edu/bayesfactor} ##' @seealso \code{\link{integrate}}, \code{\link{lm}}; see ##' \code{\link{lmBF}} for the intended interface to this function, using ##' the full data set. ##' @examples ##' ## Use attitude data set ##' data(attitude) ##' ## Scatterplot ##' lm1 = lm(rating~complaints,data=attitude) ##' plot(attitude$complaints,attitude$rating) ##' abline(lm1) ##' ## Traditional analysis ##' ## p value is highly significant ##' summary(lm1) ##' ##' ## Bayes factor ##' ## The Bayes factor is over 400,000; ##' ## the data strongly favor hypothesis that ##' ## the slope is not 0. ##' result = linearReg.R2stat(30,1,0.6813) ##' exp(result[['bf']]) linearReg.R2stat=function(N,p,R2,rscale="medium", simple = FALSE) { rscale = rpriorValues("regression",,rscale) if(p<1) stop("Number of predictors must be >0") if(p>=(N-1)) stop("Number of predictors must be less than N - 1 (number of data points minus 1).") if( (R2>=1) | (R2<0) ) stop("Illegal R2 value (must be 0 <= R2 < 1)") ### Compute approximation to posterior mode of g ### Liang et al Eq. A.3, assuming a=b=0 g3 = -(1 - R2) * (p + 3) #* g^3 g2 = (N - p - 4 - 2 * (1 - R2)) #* g^2 g1 = (N * (2 - R2) - 3) #*g g0 = N sol = polyroot(c(g0, g1, g2, g3)) ## Pick the real solution modeg = Re(sol[which.min(Im(sol)^2)]) if(modeg<=0) modeg = N/20 log.const = integrand.regression.u(0, N, p , R2, rscaleSqr=rscale^2, log=TRUE, shift=log(modeg)) h=integrate(integrand.regression.u,lower=-Inf,upper=Inf,N=N,p=p,R2=R2,rscaleSqr=rscale^2,log.const=log.const,shift=log(modeg)) properror = exp(log(h[[2]]) - log(h[[1]])) bf = log(h$value) + log.const if(simple){ return(c(B10=exp(bf))) }else{ return(list(bf=bf, properror=properror, method="quadrature")) } } BayesFactor/R/gaussApproxAOV.R0000644000176200001440000000570413043077372015676 0ustar liggesusersQg <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX=NULL,incCont=0,limit=TRUE) { qLimits = getOption('BFapproxLimits', c(-15,15)) zz = jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, limit, qLimits, which = 0) return(zz[["d0g"]]) } dQg <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap, gMapCounts, priorX=NULL, incCont=0) { zz = jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, FALSE, c(-Inf,Inf), which = 1) return(zz[['d1g']]) } d2Qg <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX=NULL,incCont=0) { zz = jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, FALSE, c(-Inf, Inf), which = 2) return(zz[['d2g']]) } hessianQg <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX=NULL,incCont=0) { diag(d2Qg(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX,incCont)) } Qg_nlm <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX=NULL,incCont=0) { zz = jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX, CnytCnX, rscale, gMap, gMapCounts, priorX, incCont, FALSE, c(-Inf,Inf), which = 2) res = -zz[['d0g']] attr(res, "gradient") <- -zz[['d1g']] attr(res, "hessian") <- -zz[['d2g']] return(res) } gaussianApproxAOV <- function(y,X,rscale,gMap,incCont=0) { optMethod = getOption('BFapproxOptimizer', 'optim') # dumb starting values qs = rscale * 0 N = length(y) if(!incCont){ priorX = matrix(1,0,0) }else if(incCont == 1){ priorX = matrix(sum(X[,1]^2),1,1) / N }else{ priorX = crossprod(X[,1:incCont]) / N } Cny = matrix(y - mean(y), N) CnX = t(t(X) - colMeans(X)) XtCnX = crossprod(CnX) CnytCnX = crossprod(Cny, CnX) sumSq = var(y) * (N-1) gMapCounts = table(gMap) if(optMethod=="optim"){ opt = optim(qs, Qg, gr = dQg,control=list(fnscale=-1),method="BFGS",sumSq=sumSq,N=N,XtCnX=XtCnX,CnytCnX=CnytCnX,rscale=rscale,gMap=gMap,gMapCounts=gMapCounts,priorX=priorX,incCont=incCont) if(opt$convergence) stop("Convergence not achieved in optim: ",opt$convergence) mu = opt$par val = opt$value }else if(optMethod=="nlm"){ opt = nlm(Qg_nlm, qs, sumSq=sumSq,N=N,XtCnX=XtCnX,CnytCnX=CnytCnX,rscale=rscale,gMap=gMap,gMapCounts=gMapCounts, priorX=priorX,incCont=incCont, hessian=FALSE, check.analyticals=FALSE) if(opt$code>2) stop("Convergence not achieved in nlm: ",opt$code) val = -opt$minimum mu = opt$estimate }else{ stop("unknown method in gaussianApproxAOV: ",optMethod) } hess = hessianQg(mu,sumSq=sumSq,N=N,XtCnX=XtCnX,CnytCnX=CnytCnX,rscale=rscale,gMap=gMap,gMapCounts=gMapCounts,priorX=priorX,incCont=incCont) sig2 = -1/diag(hess) return(list(mu=mu,sig=sqrt(sig2),val=val)) } laplaceAOV <- function(y,X,rscale,gMap,incCont=0) { apx = gaussianApproxAOV(y,X,rscale,gMap,incCont) approxVal = sum(dnorm(apx$mu,apx$mu,apx$sig,log=TRUE)) apx$val - approxVal } BayesFactor/R/generalTest-utility.R0000644000176200001440000001502013043077372016762 0ustar liggesusersrequiredFor = Vectorize(function(t1,t2){ t1 = unique(unlist(strsplit(t1,":",fixed=TRUE))) t2 = unique(unlist(strsplit(t2,":",fixed=TRUE))) return(all(t1 %in% t2)) },c("t1","t2")) ##' Generate lists of nested models, given a model formula ##' ##' This is a backend function not intended for users. It is exposed for third-party ##' applications. ##' @title Function for generation of nested linear models ##' @param fmla formula for the "full" model ##' @param whichModels which subsets of models to generate ##' @param neverExclude a character vector of terms to never remove ##' @param includeBottom Include the base model containing only \code{neverExclude} terms ##' @param data a data frame containing the columns mentioned in \code{fmla} ##' @keywords internal enumerateGeneralModels = function(fmla, whichModels, neverExclude=NULL, includeBottom=TRUE, data=NULL){ trms <- attr(terms(fmla, data = data), "term.labels") # Remove everything we never exclude, to replace them later logicalToInclude = filterVectorLogical(neverExclude,trms) if(any(logicalToInclude)){ alwaysIncluded = trms[logicalToInclude] if(whichModels=="withmain"){ rq = matrix(outer(trms,alwaysIncluded,requiredFor),nrow=length(trms)) rq = apply(rq,1,any) logicalToInclude[rq] = TRUE alwaysIncluded = unique(c(trms[rq], alwaysIncluded)) } alwaysIncludedString = paste(alwaysIncluded,collapse=" + ") } trms = trms[!logicalToInclude] ntrms <- length(trms) dv = stringFromFormula(fmla[[2]]) dv = composeTerm(dv) if(ntrms == 0 ) return(list(fmla)) if(ntrms == 1 ) whichModels = "all" if(whichModels=="top"){ lst = combn2( trms, ntrms - 1 ) }else if(whichModels=='bottom'){ lst = as.list(combn( trms, 1 )) }else if(whichModels=="all"){ lst = combn2( trms, 1 ) }else if(whichModels=="withmain"){ if(any(logicalToInclude)){ lst = possibleRestrictionsWithMainGeneral( trms, alwaysIncluded ) }else{ lst = possibleRestrictionsWithMainGeneral( trms, NULL ) } }else{ stop("Unknown whichModels value: ",whichModels) } strng <- sapply(lst,function(el, suffix){ paste(el,collapse=" + ") }) # Add back in the terms to always include if(any(logicalToInclude)){ strng <- sapply(strng,function(el, suffix){ paste(el,suffix,collapse=" + ",sep=" + ") },suffix=alwaysIncludedString) if(includeBottom) strng <- c(strng,alwaysIncludedString) } strng <- unique(strng) fmlaOut <- lapply(strng, function(el){ formula(paste(dv,"~", el)) }) return(fmlaOut) } possibleRestrictionsWithMainGeneralFallback <- function(trms, alwaysKept){ ntrms = length( trms ) if(ntrms==1) return(NULL) thisLevelRestrictions = lapply(1:ntrms,function(i, trms, alwaysKept ){ removed = unlist(strsplit(trms[i],":",fixed=TRUE)) remaining = trms[-i] containsRemoved = sapply(remaining,function(el){ splt = unlist(strsplit(el,":",fixed=TRUE)) all(removed %in% splt) }) if(any(containsRemoved)){ return(NULL) }else{ return(remaining) } },trms=trms,alwaysKept=alwaysKept) thisLevelRestrictions = thisLevelRestrictions[!sapply(thisLevelRestrictions, is.null)] nextLevelRestrictions <- lapply(thisLevelRestrictions, possibleRestrictionsWithMainGeneralFallback, alwaysKept=alwaysKept) bothLevelRestrictions = c(thisLevelRestrictions,unlist(nextLevelRestrictions,recursive=FALSE)) bothLevelRestrictions = bothLevelRestrictions[!sapply(bothLevelRestrictions, is.null)] return(unique(bothLevelRestrictions)) } possibleRestrictionsWithMainGeneral <- function(trms, alwaysKept=NULL){ if(length(trms)==1) return(list(trms)) myFactors = unique(unlist(decomposeTerms(trms))) nFactors = length(myFactors) # If there are more than 5 factors involved then the total number of models is # over 7 million; fall back to search-based method (becase there may not be # that many) if(nFactors>getOption('BFfactorsMax', 5)){ warning("Falling back to slow recursive method of enumerating models due to many factors.") retList = possibleRestrictionsWithMainGeneralFallback(trms, alwaysKept) return(c(retList,list(trms))) } myTerms = sapply(1:(2^nFactors-1),makeTerm,factors=myFactors) # These terms MUST be in the model toKeep = rev(myTerms) %termin% alwaysKept # These terms should not be in the model, because they were not in the original # specification toDiscard = !(rev(myTerms) %termin% c(trms, alwaysKept)) # The specified full model, specified as TRUE/FALSE on the list of terms row = rep(FALSE,2^nFactors-1) row[termMatch(c(trms,alwaysKept),rev(myTerms))]=TRUE # Get all possible models with nFactors factors, as matrix mb = monotoneBooleanNice(nFactors) mb = mb[-c(1,2),-ncol(mb)] if(dim(mb)[1]==0) stop("No models left in analysis. Please check that your model is valid under 'withmain'.") # Remove rows that have include invalidRows = apply(mb,1,function(v) any(v[toDiscard])) mb = matrix(mb[!invalidRows,], ncol = ncol(mb)) if(dim(mb)[1]==0) stop("No models left in analysis. Please check that your model is valid under 'withmain'.") # Remove rows that do NOT include required terms validRows = apply(mb,1,function(v) all(v[toKeep])) mb = matrix(mb[validRows,], ncol = ncol(mb)) if(dim(mb)[1]==0) stop("No models left in analysis. Please check that your model is valid under 'withmain'.") # Get all submodels of the specified model subMods = subModelsMatrix(row,mb) # Turn logicals into term numbers myModels = apply(subMods,1,function(v) rev(((length(v):1))[v])) if(nrow(subMods)==1){ retVec = myTerms[myModels] # eliminate anything that should be always kept, to be added in later retVec = retVec[!(retVec %termin% alwaysKept)] if(length(retVec)>0){ return(list(retVec)) }else{ return(NULL) } }else{ retList = lapply(myModels, function(v){ retVec = myTerms[v] # eliminate anything that should be always kept, to be added in later retVec = retVec[!(retVec %termin% alwaysKept)] if(length(retVec)>0){ return(retVec) }else{ return(NULL) } }) return(retList[!sapply(retList, is.null)]) } } subModelsMatrix<-function(row,monoBool){ if(length(row) != ncol(monoBool)) stop("Invalid number of terms in submodel") rows = apply(monoBool,1,function(v) all(row[v])) rowNum = which(apply(monoBool,1,function(v) all(row==v))) if(!any(rows)) return(matrix(row,nrow=1)) retMatrix = matrix(monoBool[rows,],nrow=sum(rows)) if(length(rowNum)>0){ return(retMatrix) }else{ return(rbind(retMatrix,row)) } } BayesFactor/R/methods-BFprobability.R0000644000176200001440000002155013043077372017202 0ustar liggesusers# constructor BFprobability <- function(odds, normalize = 0){ ## Add denominator if(getOption('BFcheckProbabilityList', TRUE)){ ## eliminate redundant models if( length(odds) > 1 ){ odds = c( odds, (1/odds[1]) / (1/odds[1]) ) duplicates = 1:length(odds) for(i in 2:length(odds)){ for(j in 1:(i-1)){ if( odds@numerator[[i]] %same% odds@numerator[[j]] ){ duplicates[i] = j break } } } which.denom = duplicates[length(odds)] not.duplicate = duplicates == (1:length(odds)) not.duplicate[ which.denom ] = FALSE # get rid of redundant models (this could be done better) odds = odds[not.duplicate] } } new("BFprobability", odds = odds, normalize = normalize, version = BFInfo(FALSE)) } setValidity("BFprobability", function(object){ if( !is.numeric(object@normalize) ) return("Normalization constant must be numeric.") if( object@normalize > 0 ) return("Normalization constant must be a valid probability.") odds = object@odds ## Add denominator if(getOption('BFcheckProbabilityList', TRUE)){ if( length(odds) > 1 ){ odds = c( odds, (1/odds[1]) / (1/odds[1]) ) duplicates = 1:length(odds) for(i in 2:length(odds)){ for(j in 1:(i-1)){ if( odds@numerator[[i]] %same% odds@numerator[[j]] ){ return("Duplicate models not allowed in probability objects.") } } } } } return(TRUE) }) setMethod('show', "BFprobability", function(object){ odds = object@odds is.prior = is.null(object@odds@bayesFactor) if(is.prior){ cat("Prior probabilities\n--------------\n") }else{ cat("Posterior probabilities\n--------------\n") } logprobs = extractProbabilities(object, logprobs = TRUE) logprobs$probs = sapply(logprobs$probs, expString) indices = paste("[",1:length(object),"]",sep="") # pad model names nms = paste(indices,rownames(logprobs),sep=" ") maxwidth = max(nchar(nms)) nms = str_pad(nms,maxwidth,side="right",pad=" ") # pad Bayes factors maxwidth = max(nchar(logprobs$probs)) probString = str_pad(logprobs$probs,maxwidth,side="right",pad=" ") for(i in 1:nrow(logprobs)){ if(is.prior){ cat(nms[i]," : ",probString[i],"\n",sep="") }else{ cat(nms[i]," : ",probString[i]," \u00B1",round(logprobs$error[i]*100,2),"%\n",sep="") } } cat("\nNormalized probability: ", expString(object@normalize), " \n") cat("---\nModel type: ",class(object@odds@denominator)[1],", ",object@odds@denominator@type,"\n\n",sep="") }) setMethod('summary', "BFprobability", function(object){ show(object) }) #' @rdname extractProbabilities-methods #' @aliases extractProbabilities,BFprobability-method setMethod("extractProbabilities", "BFprobability", function(x, logprobs = FALSE, onlyprobs = FALSE){ norm = x@normalize odds = x@odds if( (length(odds) > 1 ) | !( odds@numerator[[1]] %same% odds@denominator ) ){ odds = c(odds, (1/odds[1])/(1/odds[1])) x = extractOdds(odds, logodds = TRUE) logsumodds = logMeanExpLogs(x$odds) + log(length(x$odds)) logp = x$odds - logsumodds + norm z = data.frame(probs = logp, error = NA) }else{ # numerator and denominator are the same x = extractOdds(odds, logodds = TRUE) z = data.frame(probs = norm, error = NA) } rownames(z) = rownames(x) if(!logprobs) z$probs = exp(z$probs) if(onlyprobs) z = z$probs return(z) }) #' @rdname BFprobability-class #' @name /,BFprobability,numeric-method #' @param e1 BFprobability object #' @param e2 new normalization constant setMethod('/', signature("BFprobability", "numeric"), function(e1, e2){ if(e2 > 1 | e2 <= 0) stop("Normalization constant must be >0 and not >1") return(e1 - log(e2)) } ) #' @rdname BFprobability-class #' @name -,BFprobability,numeric-method setMethod('-', signature("BFprobability", "numeric"), function(e1, e2){ if(length(e2)>1) stop("Normalization constant must be a scalar.") if(e2 > 0 | e2 == -Inf) stop("Normalization constant must be >0 and not >1") e1@normalize = e2 return(e1) } ) #' @rdname BFprobability-class #' @name [,BFprobability,index,missing,missing-method #' @param x BFprobability object #' @param i indices indicating elements to extract #' @param j unused for BFprobability objects #' @param drop unused #' @param ... further arguments passed to related methods setMethod("[", signature(x = "BFprobability", i = "index", j = "missing", drop = "missing"), function (x, i, j, ..., drop) { if((na <- nargs()) == 2){ if(is.logical(i)){ if(any(i)){ i = (1:length(i))[i] }else{ return(NULL) } } i = unique(i) norm = x@normalize logprobs = extractProbabilities(x, logprobs = TRUE)[i, ,drop=FALSE] sumlogprobs = logMeanExpLogs(logprobs$probs) + log(nrow(logprobs)) if(length(x) == length(i) ){ newnorm = norm }else if( length(i) == 1){ newnorm = sumlogprobs }else{ newnorm = norm + sumlogprobs } whichnum = i[1:max(1, length(i)-1)] whichdenom = i[length(i)] newodds = c(x@odds, (1/x@odds[1])/(1/x@odds[1])) newodds = newodds[whichnum] / newodds[whichdenom] x = BFprobability( newodds, newnorm ) }else stop("invalid nargs()= ",na) return(x) }) #' @rdname BFprobability-class #' @name filterBF,BFprobability,character-method #' @param name regular expression to search name #' @param perl logical. Should perl-compatible regexps be used? See ?grepl for details. #' @param fixed logical. If TRUE, pattern is a string to be matched as is. See ?grepl for details. setMethod("filterBF", signature(x = "BFprobability", name = "character"), function (x, name, perl, fixed, ...) { my.names = names(x) matches = sapply(name, function(el){ grepl(el, my.names, fixed = fixed, perl = perl) }) any.matches = apply(matches, 1, any) x[any.matches] } ) ###### # S3 ###### ##' This function coerces objects to the BFprobability class ##' ##' Function to coerce objects to the BFprobability class ##' ##' Currently, this function will only work with objects of class ##' \code{BFOdds}. ##' @title Function to coerce objects to the BFprobability class ##' @param object an object of appropriate class (BFodds) ##' @param normalize the sum of the probabilities for all models in the object (1 by default) ##' @param lognormalize alternative to \code{normalize}; the ##' logarithm of the normalization constant (0 by default) ##' @return An object of class \code{BFprobability} ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @export ##' @keywords misc as.BFprobability <- function(object, normalize = NULL, lognormalize = NULL) UseMethod("as.BFprobability") length.BFprobability <- function(x) nrow(extractProbabilities(x)) names.BFprobability <- function(x) { rownames(extractProbabilities(x)) } # See http://www-stat.stanford.edu/~jmc4/classInheritance.pdf sort.BFprobability <- function(x, decreasing = FALSE, ...){ ord = order(extractProbabilities(x, logprobs=TRUE)$probs, decreasing = decreasing) return(x[ord]) } max.BFprobability <- function(..., na.rm=FALSE){ if(nargs()>2) stop("Cannot concatenate probability objects.") el <- head(list(...)[[1]], n=1) return(el) } min.BFprobability <- function(..., na.rm=FALSE){ if(nargs()>2) stop("Cannot concatenate probability objects.") el <- tail(list(...)[[1]], n=1) return(el) } which.max.BFprobability <- function(x){ index = which.max(extractProbabilities(x, logprobs=TRUE)$probs) names(index) = names(x)[index] return(index) } which.min.BFprobability <- function(x){ index = which.min(extractProbabilities(x, logprobs=TRUE)$probs) names(index) = names(x)[index] return(index) } head.BFprobability <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x, decreasing=TRUE) return(x[1:n]) } tail.BFprobability <- function(x, n=6L, ...){ n = ifelse(n>length(x),length(x),n) x = sort(x) return(x[n:1])} as.data.frame.BFprobability <- function(x, row.names = NULL, optional=FALSE,...){ df = extractProbabilities(x) return(df) } as.vector.BFprobability <- function(x, mode = "any"){ if( !(mode %in% c("any", "numeric"))) stop("Cannot coerce to mode ", mode) v = extractProbabilities(x)$probs names(v) = names(x) return(v) } sum.BFprobability <- function(..., na.rm = FALSE) { if(na.rm) warning("na.rm argument not used for BFprobability objects.") sapply(list(...), function(el){ if(is(el, "BFprobability")){ return(exp(el@normalize)) }else{ return(NA) } }, USE.NAMES = FALSE) } BayesFactor/R/correlation-JASP.R0000644000176200001440000001036113274274556016074 0ustar liggesusers## The code in this file is from the JASP project ## (https://github.com/jasp-stats/jasp-desktop/blob/development/JASP-Engine/JASP/R/correlationbayesian.R) ## and written by Alexander Ly (Alexander.Ly.NL@gmail.com) .bf10Exact <- function(n, r, kappa=1) { # Ly et al 2015 # This is the exact result with symmetric beta prior on rho # with parameter alpha. If kappa = 1 then uniform prior on rho # # if (n <= 2){ return(list(bf = 0, properror=0,method="exact")) } else if (any(is.na(r))){ return(list(bf = NA, properror=NA,method=NA)) } # TODO: use which check.r <- abs(r) >= 1 # check whether |r| >= 1 if (kappa >= 1 && n > 2 && check.r) { return(list(bf = Inf, properror=0,method="exact")) } #log.hyper.term <- log(hypergeo::hypergeo(((n-1)/2), ((n-1)/2), ((n+2/kappa)/2), r^2)) log.hyper.term <- Re( genhypergeo_series_pos(U=c((n-1)/2, (n-1)/2), L=((n+2/kappa)/2), z=r^2, 0, 2000, TRUE, TRUE, FALSE) ) log.result <- (1-2/kappa)*log(2)+0.5*log(pi)-lbeta(1/kappa, 1/kappa)+ lgamma((n+2/kappa-1)/2)-lgamma((n+2/kappa)/2)+log.hyper.term real.result <- log.result return(list(bf = real.result, properror=0,method="exact")) } # 2.2 Two-sided secondary Bayes factor .bf10JeffreysIntegrate <- function(n, r, kappa=1) { # Jeffreys' test for whether a correlation is zero or not # Jeffreys (1961), pp. 289-292 # This is the exact result, see EJ ## if (n <= 2){ return(list(bf = 0, properror=0,method="exact")) } else if ( any(is.na(r)) ){ return(list(bf = NA, properror=NA,method=NA)) } # TODO: use which if (n > 2 && abs(r)==1) { return(list(bf = Inf, properror=0,method="exact")) } hyper.term <- Re( genhypergeo_series_pos(U=c((2*n-3)/4, (2*n-1)/4), L=(n+2/kappa)/2, z=r^2, 0, 2000, TRUE, TRUE, FALSE) ) log.term <- lgamma((n+2/kappa-1)/2)-lgamma((n+2/kappa)/2)-lbeta(1/kappa, 1/kappa) result <- .5*log(pi) + (1-2/kappa)*log(2) + log.term + hyper.term return(list(bf = result, properror=NA, method="Jeffreys' approximation")) } # 2.3 Two-sided third Bayes factor .bfCorNumerical <- function(n, r, kappa=1, lowerRho=-1, upperRho=1, approx = TRUE) { # Numerically integrate Jeffreys approximation of the likelihood if(approx){ likeFun = jeffreys_approx_corr }else{ likeFun = function(rho,n,r){ hFunc(rho, n, r, FALSE, 2000) } } log.const = likeFun(r,n,r) integrand <- Vectorize(function(rho){ exp(likeFun(rho, n, r) + dbeta(rho/2+.5,1/kappa,1/kappa,log=TRUE) - log(2) - log.const) },"rho") some.integral <- try(integrate(integrand, lowerRho, upperRho)) if (is(some.integral, "try-error")) { return(NULL) } if (some.integral$message=="OK"){ some.integral$value = exp(log(some.integral$value) + log.const) return(some.integral) } else { return(NULL) } } .bf10Numerical <- function(n, r, kappa=1, lowerRho=-1, upperRho=1,approx=TRUE) { # Jeffreys' test for whether a correlation is zero or not # Jeffreys (1961), pp. 289-292 # This is a numerical approximation for .bf10JeffreysIntegrate, # when it explodes # # # TODO: 1. check for n=1, n=2, as r is then undefined # 2. check for r=1, r=-1 # # TODO: REMOVE ALL NUMERICAL STUFF if ( any(is.na(r)) ){ return(list(bf = NA, properror=NA, method=NA)) } # TODO: use which if (n > 2 && abs(r)==1) { return(list(bf = Inf, properror=0, method="exact")) } # TODO: be very careful here, might integrate over non-finite function jeffreysNumericalIntegrate <- .bfCorNumerical(n, r, kappa, lowerRho=-1, upperRho=1,approx) if (is.null(jeffreysNumericalIntegrate)){ return(list(bf = NA, properror=NA, method=NA)) }else if(jeffreysNumericalIntegrate$value < 0){ return(list(bf = NA, properror=NA, method=NA)) } else if (jeffreysNumericalIntegrate$value >= 0){ # jeffreys numerical integrate success log.bf = log(jeffreysNumericalIntegrate$value) err = jeffreysNumericalIntegrate$abs.error prop.error = exp(log(err) - log.bf) return(list(bf = log.bf, properror=err, method="quadrature")) } else { # NO IDEA, EVERYTHING FAILED :( return(list(bf = NA, properror=NA, method=NA)) } return(list(bf = NA, properror=NA, method=NA)) } BayesFactor/R/BayesFactorPCL-package.R0000644000176200001440000001161613274334520017142 0ustar liggesusers #'Functions to compute Bayes factor hypothesis tests for common research designs #'and hypotheses. #' #'This package contains function to compute Bayes factors for a number of #'research designs and hypotheses, including t tests, ANOVA, and linear #'regression, correlations, proportions, and contingency tables. #' #'\tabular{ll}{ Package: \tab BayesFactor\cr Type: \tab Package\cr Version: \tab #'0.9.12-4.2\cr Date: \tab 2018-5-09\cr License: \tab GPL 2.0\cr LazyLoad: \tab #'yes\cr } The following methods are currently implemented, with more to follow: #' #'general linear models (including linear mixed effects models): \code{\link{generalTestBF}}, \code{\link{lmBF}} #' #'linear regression: \code{\link{regressionBF}}, \code{\link{lmBF}}, #'\code{\link{linearReg.R2stat}}; #' #'linear correlation: \code{\link{correlationBF}}; #' #'t tests: \code{\link{ttestBF}}, \code{\link{ttest.tstat}}; #' #'meta-analytic t tests: \code{\link{meta.ttestBF}} #' #'ANOVA: \code{\link{anovaBF}}, \code{\link{lmBF}}, \code{\link{oneWayAOV.Fstat}}; #' #'contingency tables: \code{\link{contingencyTableBF}}; #' #'single proportions: \code{\link{proportionBF}}; #' #'linear correlations: \code{\link{correlationBF}}; #' #'Other useful functions: \code{\link{posterior}}, for sampling from posterior #'distributions; \code{\link{recompute}}, for re-estimating a Bayes factor or #'posterior distribution; \code{\link{compare}}, to compare two model #'posteriors; and \code{\link{plot.BFBayesFactor}}, for plotting Bayes factor #'objects. #' #'@name BayesFactor-package #'@aliases BayesFactor-package BayesFactor #'@docType package #'@author Richard D. Morey and Jeffrey N. Rouder (with contributions from Tahira Jamil) #' #' Maintainer: Richard D. Morey #'@references Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and #' Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. #' Journal of the American Statistical Association, 103, pp. 410-423 #' #' Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., \& Iverson, G. #' (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. #' Psychonomic Bulletin & Review, 16, 225-237 #' #' Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) #' Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. #' 56. p. 356-374. #' #' Perception and Cognition Lab (University of Missouri): Bayes factor #' calculators. \url{http://pcl.missouri.edu/bayesfactor} #'@keywords htest #'@examples #' #'## See specific functions for examples. #' #'@useDynLib BayesFactor NULL #'Puzzle completion times from Hays (1994) #' #'Puzzle completion time example data from Hays (1994). #' #'Hays (1994; section 13.21, table 13.21.2, p. 570) describes a experiment #'wherein 12 participants complete four puzzles each. Puzzles could be either #'square or round, and either monochromatic or in color. Each participant #'completed every combination of the two factors. #' #'@name puzzles #'@docType data #'@format A data frame with 48 observations on 3 variables. \describe{ #'\item{RT}{Puzzle completion time, in minutes} \item{ID}{the #'subject identifier} \item{shape}{shape of the puzzle (round or #'square)} \item{color}{color content of the puzzle (monochromatic or #'color)} } #'@source Hays, W. L. (1994), Statistics (5th edition), Harcourt Brace, Fort #'Worth, Texas #'@keywords datasets #'@examples #' #'data(puzzles) #' #'## classical ANOVA #'## Both color and shape are significant, interaction is not #'classical <- aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles) #'summary(classical) #' #'## Bayes Factor #'## Best model is main effects model, no interaction #' anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) #' #' NULL #'Hraba and Grant (1970) children's doll preference data #' #'Hraba and Grant (1970) describe a replication of Clark and Clark (1947) in which #'black and white children from Lincoln, Nebraska were shown dolls that were either black #'or white. They were then asked a series of questions, including "Give me the doll that is #'a nice doll." This data set contains the frequency of children giving the same-race or different race doll in #'response to this question. #'@name raceDolls #'@docType data #'@format A matrix with 2 rows and 2 columns. Rows give doll preference; colums give the #'race of the child. #'@source Hraba, J. and Grant, G. (1970). Black is Beautiful: A reexamination of #'racial preference and identification. Journal of Personality and Social Psychology, 16, 398-402. #' #'@keywords datasets #'@examples #' #'data(raceDolls) #' #'## chi-square test #'## Barely significant with continuity correction #'chisq.test(raceDolls) #' #'## Bayes factor test (assuming independent binomial sampling plan) #'## Very little evidence for the alternative of lack of independence #'bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") #'bf NULL BayesFactor/R/plot-BFBayesFactorTop.R0000644000176200001440000000744413043077372017070 0ustar liggesusers## S4 method ##### # setMethod("plot", "BFBayesFactor", function(x, include1 = TRUE, addDenom = FALSE, sortbf=TRUE, logbase = c("log10", "log2","ln"), marginExpand=.4,pars=NULL, ...){ # plot.BFBayesFactor(x, include1 = include1, # addDenom = addDenom, # sortbf = sortbf, # logbase = logbase, # marginExpand = marginExpand, # pars = pars, ...) # invisible(NULL) # }) ## S3 method ##### #' Plot a Bayes factor top-down object #' #' This function creates a barplot of the (log) Bayes factors in a Bayes factor #' object. Error bars are added (though in many cases they may be too small to #' see) in red to show the error in estimation of the Bayes factor. If a red question mark #' appears next to a bar, then that Bayes factor has no error estimate available. #' @title Plot a Bayes factor top-down object #' @param x a BFBayesFactorTop object #' @param include1 if \code{TRUE}, ensure that Bayes factor = 1 is on the plot #' @param addDenom if \code{TRUE}, add the denominator model into the group #' @param sortbf sort the Bayes factors before plotting them? Defaults to #' \code{TRUE} #' @param logbase the base of the log Bayes factors in the plot #' @param marginExpand an expansion factor for the left margin, in case more #' space is needed for model names #' @param pars a list of par() settings #' @param ... additional arguments to pass to barplot() #' @method plot BFBayesFactorTop #' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) #' @examples #' data(puzzles) #' #' bfs = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", #' whichModels='top', progress=FALSE) #' plot(bfs) plot.BFBayesFactorTop <- function(x, include1=TRUE, addDenom = FALSE, sortbf=FALSE, logbase = c("log10", "log2","ln"), marginExpand = .4, pars=NULL, ...){ # eliminate NAs x = x[!is.na(x)] oldPar <- par() on.exit(par(oldPar[c("mfrow","las",names(pars))])) textLogBase = logbase[1] logBase <- switch(textLogBase, log10=10, ln=exp(1), log2=2, stop('Invalid logarithm base.')) # Add denominator if(addDenom) x = c(x, (1/x[1]) / (1/x[1])) if(sortbf) x = sort(x) bfs <- extractBF(x, logbf = TRUE) omitted = unlist(lapply(x@numerator, whichOmitted, full = x@denominator)) # Estimate left margin maxChar = max(nchar(omitted)) leftMargin = marginExpand * maxChar + 4 # Errors whichNA = is.na(bfs$error) bfs$error[whichNA] = 0 errs <- exp(bfs$bf + log(bfs$error)) errs <- log(outer(errs,c(-1,1),'*') + exp(bfs$bf))/log(logBase) if(include1){ rng <- range(c(0,errs)) }else{ rng <- range(errs) } yaxes <- seq(floor(rng[1]), ceiling(rng[2]), 1) ygrids <- seq(yaxes[1], yaxes[length(yaxes)], .1) if(textLogBase=="ln"){ tickLab <- paste("exp(",yaxes,")",sep="") tickLab[yaxes==0] = "1" }else{ tickLab <- logBase^yaxes tickLab[yaxes<0] = paste("1/",logBase^abs(yaxes[yaxes<0]),sep="") } cols = c("wheat","lightslateblue")[(bfs$bf>0) + 1] pars = c(pars, list(oma=c(5,leftMargin,0,1),las=1,mar=c(0,0,2,0))) par(pars) yloc <- barplot( bfs$bf/log(logBase), names.arg=omitted, horiz=TRUE, axes=FALSE, xlim=range(yaxes), main = paste("BF change when omitted from\n",x@denominator@longName), col=cols,...) # add error bars segments(errs[,1],yloc,errs[,2],yloc,col="red") # add unknown errors if(any(whichNA)) mapply(function(x,y,adj) text(x,y,"?",col="red",adj=adj) , x=errs[whichNA,1],y=yloc[whichNA],adj=1-(errs[whichNA,1]>0)) axis(1, at = yaxes, labels=tickLab, las=2) if(length(ygrids) < 50) abline(v=ygrids,col="gray",lty=2) abline(v=yaxes, col="gray") abline(v=0) invisible(NULL) } BayesFactor/R/methods-BFmodel.R0000644000176200001440000004412213063264537015765 0ustar liggesusers# constructors BFmodel <- function(type, identifier, prior, dataTypes, shortName, longName, analysis = list()){ new("BFmodel", type = type, identifier = identifier, prior = prior, dataTypes = dataTypes, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFcorrelation <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFcorrelation", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFproportion <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFproportion", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFcontingencyTable <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFcontingencyTable", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFlinearModel <- function(type, identifier, prior, dataTypes, shortName, longName, analysis = list()){ new("BFlinearModel", type = type, identifier = identifier, prior = prior, dataTypes = dataTypes, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFoneSample <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFoneSample", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFindepSample <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFindepSample", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } BFmetat <- function(type, identifier, prior, shortName, longName, analysis = list()){ new("BFmetat", type = type, identifier = identifier, prior = prior, shortName = shortName, longName = longName, analysis = analysis, version = BFInfo(FALSE)) } ####### setMethod('show', signature = c("BFlinearModel"), function(object){ cat("---\n Model:\n") cat("Type: ",class(object)[1],", ",object@type,"\n",sep="") cat(object@longName,"\n") cat("Data types:\n") lapply(names(object@dataTypes),function(el) cat(el,": ",object@dataTypes[el],"\n") ) cat("\n\n") } ) setMethod('show', signature = c("BFmodel"), function(object){ cat("---\n Model:\n") cat("Type: ",class(object)[1],", ",object@type,"\n",sep="") cat(object@longName,"\n") cat("\n\n") } ) setMethod("%same%", signature = c(x="BFmodel",y="BFmodel"), function(x,y){ classesSame = identical(class(x),class(y)) dataTypeSame = x@dataTypes %com% y@dataTypes slotSame = sapply(slotNames(x), function(el,x,y) identical(slot(x,el),slot(y,el)), x=x,y=y) slotSame["dataTypes"] = ifelse(length(dataTypeSame)>0,dataTypeSame, TRUE) # exclude version and analysis slotSame = slotSame[ !( names(slotSame) %in% c("version", "analysis") ) ] return(all(slotSame) & classesSame) }) setMethod('compare', signature(numerator = "BFlinearModel", denominator = "BFlinearModel", data = "data.frame"), function(numerator, denominator, data, ...){ if(!identical(numerator@type, denominator@type)) stop("Models of different types cannot be currently be compared by compare().") if(!identical(numerator@prior$mu, denominator@prior$mu)) stop("Models of different null means cannot currently be compared by compare()") if(!identical(class(numerator), class(denominator))) stop("Models of different classes cannot be currently be compared by compare().") LHSnum = all.vars(update(formula(numerator@identifier$formula), .~0)) LHSden = all.vars(update(formula(denominator@identifier$formula), .~0)) if(!identical(LHSnum, LHSden)) stop("Models have different dependent variables!") BFnum = compare(numerator = numerator, data = data) BFden = compare(numerator = denominator, data = data) return(BFnum / BFden) }) setMethod('compare', signature(numerator = "BFoneSample", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ formula = formula(numerator@identifier$formula) LHSnum = all.vars(update(formula, .~0)) y = data[[LHSnum]] N = length(y) mu = numerator@prior$mu nullInterval=numerator@prior$nullInterval if( (numerator@type=="JZS") ){ if( attr(terms(formula, data = data),"intercept") == 0 ){ numBF = 0 errorEst = 0 bf = list() }else{ t = (mean(y) - mu) / sd(y) * sqrt(N) complement = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) bf = ttest.tstat(t=t, n1=N,nullInterval=nullInterval,rscale=numerator@prior$rscale,complement=complement) numBF = bf[['bf']] errorEst = bf[['properror']] } numerator@analysis = bf numList = list(numerator) nms = numerator@shortName modDenominator = BFoneSample(type = "JZS", identifier = list(formula = "y ~ 0"), prior=list(mu=mu), shortName = paste("Null, mu=",mu,sep=""), longName = paste("Null, mu = ",mu, sep=""), analysis = list(method="trivial") ) bf_df = data.frame(bf = numBF, error = errorEst, time = date(), code = randomString(length(numBF))) rownames(bf_df) <- nms newBF = BFBayesFactor(numerator = numList, denominator = modDenominator, data = data, bayesFactor = bf_df ) return(newBF) }else{ stop("Unknown prior type: ", numerator@type) } }) setMethod('compare', signature(numerator = "BFindepSample", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ formula = formula(numerator@identifier$formula) checkFormula(formula, data, analysis = "indept") dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) factor = fmlaFactors(formula, data)[-1] y = data[[dv]] if(!is.null(factor)){ iv = data[[factor]] ns = table(iv) }else{ iv = NULL ns = NULL } mu = numerator@prior$mu nullInterval=numerator@prior$nullInterval if( mu != 0 ) stop("Indep. groups t test with nonzero null not supported yet.") if( (numerator@type=="JZS") ){ if( length(attr(terms(formula, data = data),"term.labels")) == 0 ){ numBF = 0 errorEst = 0 bf = list() }else{ t = t.test(formula = formula,data=data, var.eq=TRUE)$statistic complement = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) bf = ttest.tstat(t=t, n1=ns[1], n2=ns[2], nullInterval=nullInterval,rscale=numerator@prior$rscale, complement = complement) numBF = bf[['bf']] errorEst = bf[['properror']] } numerator@analysis = bf numList = list(numerator) nms = numerator@shortName nullFormula = paste(formula[[2]],"1",sep=" ~ ") modDenominator = BFindepSample(type = "JZS", identifier = list(formula = nullFormula), prior=list(mu=mu), shortName = paste("Null, mu1-mu2=",mu,sep=""), longName = paste("Null, mu1-mu2 = ",mu, sep=""), analysis = list(method="trivial") ) bf_df = data.frame(bf = numBF, error = errorEst, time = date(), code = randomString(length(numBF))) rownames(bf_df) <- nms newBF = BFBayesFactor(numerator = numList, denominator = modDenominator, data = data, bayesFactor = bf_df ) return(newBF) }else{ stop("Unknown prior type: ", numerator@type) } }) setMethod('compare', signature(numerator = "BFmetat", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ nullInterval=numerator@prior$nullInterval if( (numerator@type=="JZS") ){ if( numerator@identifier$formula=="d = 0" ){ numBF = 0 errorEst = 0 bf = list() }else{ complement = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) bf = meta.ttest.tstat(t=data$t, n1=data$n1, n2=data$n2, nullInterval=nullInterval, rscale=numerator@prior$rscale,complement=complement) numBF = bf[['bf']] errorEst = bf[['properror']] } numerator@analysis = bf numList = list(numerator) nms = numerator@shortName modDenominator = BFmetat(type = "JZS", identifier = list(formula = "d = 0"), prior=list(), shortName = "Null, d=0", longName = "Null, d = 0", analysis = list(method="trivial")) bf_df = data.frame(bf = numBF, error = errorEst, time = date(), code = randomString(length(numBF))) rownames(bf_df) <- nms newBF = BFBayesFactor(numerator = numList, denominator = modDenominator, data = data, bayesFactor = bf_df) return(newBF) }else{ stop("Unknown prior type: ", numerator@type) } }) setMethod('compare', signature(numerator = "BFcorrelation", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ nullInterval=numerator@prior$nullInterval if( (numerator@type=="Jeffreys-beta*") ){ if( numerator@identifier$formula=="rho = 0" ){ numBF = 0 errorEst = 0 bf = list() }else{ complement = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) bf = corr.test.bf(y=data$y, x=data$x, rscale=numerator@prior$rscale, nullInterval, complement = complement) numBF = bf[['bf']] errorEst = bf[['properror']] } numerator@analysis = bf numList = list(numerator) nms = numerator@shortName modDenominator = BFcorrelation(type = "Jeffreys-beta*", identifier = list(formula = "rho = 0"), prior=list(), shortName = "Null, rho = 0", longName = "Null, rho = 0", analysis = list(method="trivial")) bf_df = data.frame(bf = numBF, error = errorEst, time = date(), code = randomString(length(numBF))) rownames(bf_df) <- nms newBF = BFBayesFactor(numerator = numList, denominator = modDenominator, data = data, bayesFactor = bf_df) return(newBF) }else{ stop("Unknown prior type: ", numerator@type) } }) setMethod('compare', signature(numerator = "BFproportion", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ nullInterval=numerator@prior$nullInterval if( (numerator@type=="logistic") ){ if( numerator@identifier$formula=="p = p0" ){ numBF = 0 errorEst = 0 bf = list() }else{ complement = ifelse(!is.null(attr(nullInterval,"complement")),TRUE,FALSE) bf = prop.test.bf(y=data$y, N=data$N, p=numerator@prior$p0, rscale=numerator@prior$rscale, nullInterval, complement = complement) numBF = bf[['bf']] errorEst = bf[['properror']] } numerator@analysis = bf numList = list(numerator) nms = numerator@shortName modDenominator = BFproportion(type = "logistic", identifier = list(formula = "p = p0",p0=numerator@prior$p0), prior=list(p0=numerator@prior$p0), shortName = paste("Null, p=",round(numerator@prior$p0,3),sep=""), longName = paste("Null, p = ", numerator@prior$p0, sep=""), analysis = list(method="trivial")) bf_df = data.frame(bf = numBF, error = errorEst, time = date(), code = randomString(length(numBF))) rownames(bf_df) <- nms newBF = BFBayesFactor(numerator = numList, denominator = modDenominator, data = data, bayesFactor = bf_df) return(newBF) }else{ stop("Unknown prior type: ", numerator@type) } }) setMethod('compare', signature(numerator = "BFcontingencyTable", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ type = numerator@type a = numerator@prior$a marg = numerator@prior$fixedMargin data2 = as.matrix(data) if( !is.null(marg) ) if( ( marg == "cols" ) & ( type == "independent multinomial" ) ) data2 = t(data2) if(any(data%%1 != 0)) stop("All elements of x must be integers.") if(any(dim(data)<2) | (length(dim(data)) != 2)) stop("x must be m by n.") if(numerator@identifier$formula == "independence"){ lbf = 0 error = 0 }else{ lbf = switch(type, "poisson" = contingencyPoisson(as.matrix(data2), a), "joint multinomial" = contingencyJointMultinomial(as.matrix(data2), a), "independent multinomial" = contingencyIndepMultinomial(as.matrix(data2), a), "hypergeometric" = contingencyHypergeometric(as.matrix(data2), a), stop("Unknown value of sampleType (see help for contingencyBF).") ) error = 0 } denominator = BFcontingencyTable(type = type, identifier = list(formula = "independence"), prior=numerator@prior, shortName = paste0("Indep. (a=",a,")"), longName = paste0("Null, independence, a = ", a), analysis = list(method = "trivial")) bf_df = data.frame(bf = lbf, error = error, time = date(), code = randomString(1)) rownames(bf_df) <- numerator@shortName numerator@analysis = list(method="analytic") newBF = BFBayesFactor(numerator = list(numerator), denominator = denominator, data = as.data.frame(data), bayesFactor = bf_df ) return(newBF) }) setMethod('compare', signature(numerator = "BFcontingencyTable", denominator = "BFcontingencyTable", data = "data.frame"), function(numerator, denominator, data, ...){ if(!identical(numerator@type, denominator@type)) stop("Models of different types cannot be currently be compared by compare().") if(!identical(class(numerator), class(denominator))) stop("Models of different classes cannot be currently be compared by compare().") BFnum = compare(numerator = numerator, data = data) BFden = compare(numerator = denominator, data = data) return(BFnum / BFden) }) BayesFactor/R/methods-BFlinearModel-compare.R0000644000176200001440000001054013043077372020536 0ustar liggesusers ############### Linear models setMethod('compare', signature(numerator = "BFlinearModel", denominator = "missing", data = "data.frame"), function(numerator, data, ...){ if(!.hasSlot(numerator,"analysis")) numerator@analysis = list() old.numerator = numerator rscaleFixed = rpriorValues("allNways","fixed",numerator@prior$rscale[['fixed']]) rscaleRandom = rpriorValues("allNways","random",numerator@prior$rscale[['random']]) rscaleCont = rpriorValues("regression",,numerator@prior$rscale[['continuous']]) rscaleEffects = numerator@prior$rscale[['effects']] formula = formula(numerator@identifier$formula) checkFormula(formula, data, analysis = "lm") factors = fmlaFactors(formula, data)[-1] nFactors = length(factors) dataTypes = numerator@dataTypes relevantDataTypes = dataTypes[names(dataTypes) %in% factors] dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) if(numerator@type != "JZS") stop("Unknown model type.") denominator = BFlinearModel(type = "JZS", identifier = list(formula = paste(dv,"~ 1")), prior=list(), dataTypes = dataTypes, shortName = paste("Intercept only",sep=""), longName = paste("Intercept only", sep=""), analysis = list(method="trivial") ) bf <- list(bf=NA, properror=NA, method=NA) BFtry({ if( nFactors == 0 ){ numerator = denominator bf = list(bf = 0, properror = 0, method = "trivial") }else if(all(relevantDataTypes == "continuous")){ ## Regression reg = summary(lm(formula,data=data)) R2 = reg[[8]] N = nrow(data) p = length(attr(terms(formula),"term.labels")) if( any( names( rscaleEffects ) %in% attr(terms(formula),"term.labels")) ){ stop("Continuous prior settings set from rscaleEffects; use rscaleCont instead.") } bf = linearReg.R2stat(N,p,R2,rscale=rscaleCont) }else if(all(relevantDataTypes != "continuous")){ # ANOVA or t test freqs <- table(data[[factors[1]]]) if(all(freqs==1)) stop("not enough observations") nLvls <- length(freqs) rscale = ifelse(dataTypes[factors[1]] == "fixed", rscaleFixed, rscaleRandom) if(length(rscaleEffects)>0) if(!is.na(rscaleEffects[factors[1]])) rscale = rscaleEffects[factors[1]] if( (nFactors==1) & (nLvls==2) ){ # test # independent groups t t = t.test(formula = formula,data=data, var.eq=TRUE)$statistic bf = ttest.tstat(t=t, n1=freqs[1], n2=freqs[2],rscale=rscale*sqrt(2)) }else if( (nFactors==1) & (nLvls>2) & all(freqs==freqs[1])){ # Balanced one-way Fstat = summary(aov(formula, data=data))[[1]]["F value"][1,] J = length(freqs) N = freqs[1] bf = oneWayAOV.Fstat(Fstat, N, J, rscale) }else if( (nFactors > 1) | ( (nFactors == 1) & any(freqs!=freqs[1]))){ # Nway ANOVA or unbalanced one-way ANOVA bf = nWayFormula(formula=formula, data = data, dataTypes = dataTypes, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleEffects = rscaleEffects, posterior = FALSE, ...) }else{ # Nothing stop("Too few levels in independent variable: ",factors[1]) } }else{ # GLM bf = nWayFormula(formula=formula, data = data, dataTypes = dataTypes, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleCont = rscaleCont, rscaleEffects = rscaleEffects, posterior = FALSE, ...) } }) # End try expression numerator@analysis = as.list(bf) numerator = combineModels(list(numerator,old.numerator)) bf_df = data.frame(bf = numerator@analysis[['bf']], error = numerator@analysis[['properror']], time = date(), code = randomString(1) ) rownames(bf_df) <- numerator@shortName newBF = BFBayesFactor(numerator = list(numerator), denominator = denominator, data = data, bayesFactor = bf_df ) return(newBF) } ) BayesFactor/R/regressionBF.R0000644000176200001440000001265313043077372015405 0ustar liggesusers ##' This function simultaneously computes Bayes factors for groups of models in ##' regression designs ##' ##' \code{regressionBF} computes Bayes factors to test the hypothesis that ##' slopes are 0 against the alternative that all slopes are nonzero. ##' ##' The vector of observations \eqn{y} is assumed to be distributed as \deqn{y ~ ##' Normal(\alpha 1 + X\beta, \sigma^2 I).} The joint prior on ##' \eqn{\alpha,\sigma^2} is proportional to \eqn{1/\sigma^2}, the prior on ##' \eqn{\beta} is \deqn{\beta ~ Normal(0, N g \sigma^2(X'X)^{-1}).} where ##' \eqn{g ~ InverseGamma(1/2,r/2)}. See Liang et al. (2008) section 3 for ##' details. ##' ##' Possible values for \code{whichModels} are 'all', 'top', and 'bottom', where ##' 'all' computes Bayes factors for all models, 'top' computes the Bayes ##' factors for models that have one covariate missing from the full model, and ##' 'bottom' computes the Bayes factors for all models containing a single ##' covariate. Caution should be used when interpreting the results; when the ##' results of 'top' testing is interpreted as a test of each covariate, the ##' test is conditional on all other covariates being in the model (and likewise ##' 'bottom' testing is conditional on no other covariates being in the model). ##' ##' An option is included to prevent analyzing too many models at once: ##' \code{options('BFMaxModels')}, which defaults to 50,000, is the maximum ##' number of models that `regressionBF` will analyze at once. This can be ##' increased by increasing the option value. ##' ##' For the \code{rscaleCont} argument, several named values are recongized: ##' "medium", "wide", and "ultrawide", which correspond \eqn{r} scales of ##' \eqn{\sqrt{2}/4}{sqrt(2)/4}, 1/2, and \eqn{\sqrt{2}/2}{sqrt(2)/2}, ##' respectively. These values were chosen to yield consistent Bayes factors ##' with \code{\link{anovaBF}}. ##' @title Function to compute Bayes factors for regression designs ##' @param formula a formula containing all covariates to include in the ##' analysis (see Examples) ##' @param data a data frame containing data for all factors in the formula ##' @param whichModels which set of models to compare; see Details ##' @param progress if \code{TRUE}, show progress with a text progress bar ##' @param rscaleCont prior scale on all standardized slopes ##' @param noSample if \code{TRUE}, do not sample, instead returning NA. ##' @param callback callback function for third-party interfaces ##' @return An object of class \code{BFBayesFactor}, containing the computed ##' model comparisons ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @references Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and ##' Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable ##' Selection. Journal of the American Statistical Association, 103, pp. ##' 410-423 ##' ##' Rouder, J. N. and Morey, R. D. (in press). Bayesian testing in ##' regression. Multivariate Behavioral Research. ##' ##' Zellner, A. and Siow, A., (1980) Posterior Odds Ratios for Selected ##' Regression Hypotheses. In Bayesian Statistics: Proceedings of the First ##' Interanational Meeting held in Valencia (Spain). Bernardo, J. M., ##' Lindley, D. V., and Smith A. F. M. (eds), pp. 585-603. University of ##' Valencia. ##' @export ##' @keywords htest ##' @examples ##' ## See help(attitude) for details about the data set ##' data(attitude) ##' ##' ## Classical regression ##' summary(fm1 <- lm(rating ~ ., data = attitude)) ##' ##' ## Compute Bayes factors for all regression models ##' output = regressionBF(rating ~ ., data = attitude, progress=FALSE) ##' head(output) ##' ## Best model is 'complaints' only ##' ##' ## Compute all Bayes factors against the full model, and ##' ## look again at best models ##' head(output / output[63]) ##' ##' @seealso \code{\link{lmBF}}, for testing specific models, and ##' \code{\link{anovaBF}} for the function similar to \code{regressionBF} for ##' ANOVA models. regressionBF <- function(formula, data, whichModels = "all", progress=getOption('BFprogress', interactive()), rscaleCont = "medium", callback = function(...) as.integer(0), noSample=FALSE) { data <- marshallTibble(data) checkFormula(formula, data, analysis = "regression") dataTypes <- createDataTypes(formula, whichRandom=c(), data, analysis = "regression") fmla <- createFullRegressionModel(formula, data) models <- enumerateRegressionModels(fmla, whichModels, data) if(length(models)>getOption('BFMaxModels', 50000)) stop("Maximum number of models exceeded (", length(models), " > ",getOption('BFMaxModels', 50000) ,"). ", "The maximum can be increased by changing ", "options('BFMaxModels').") bfs = NULL if(progress){ pb = txtProgressBar(min = 0, max = length(models), style = 3) }else{ pb = NULL } checkCallback(callback,as.integer(0)) for(i in 1:length(models)){ oneModel <- lmBF(models[[i]],data = data, dataTypes = dataTypes, rscaleCont = rscaleCont,noSample=noSample) if(inherits(pb,"txtProgressBar")) setTxtProgressBar(pb, i) checkCallback(callback,as.integer((i - 1)/length(models) * 1000)) bfs = c(bfs,oneModel) } if(inherits(pb,"txtProgressBar")) close(pb) checkCallback(callback,as.integer(1000)) bfObj = do.call("c", bfs) if(whichModels=="top") bfObj = BFBayesFactorTop(bfObj) return(bfObj) } BayesFactor/R/anovaBF-utility.R0000644000176200001440000000347013043077372016027 0ustar liggesusers enumerateAnovaModelsWithMain<-function(factors){ nFactors = length(factors) mb = monotoneBooleanNice(nFactors) mb = mb[-c(1,2),-ncol(mb)] myModels = apply(mb,1,function(v) rev(((length(v):1))[v])) myTerms = sapply(1:(2^nFactors-1),makeTerm,factors=factors) lapply(myModels, function(v) myTerms[v]) } enumerateAnovaModels = function(fmla, whichModels, data){ trms <- attr(terms(fmla, data = data), "term.labels") ntrms <- length(trms) dv = stringFromFormula(fmla[[2]]) dv = composeTerm(dv) if(ntrms == 1 ) whichModels = "all" if(whichModels=="top"){ lst = combn2( trms, ntrms - 1 ) }else if(whichModels=='bottom'){ lst = as.list(combn( trms, 1 )) }else if(whichModels=="all"){ lst = combn2( trms, 1 ) }else if(whichModels=="withmain"){ lst = enumerateAnovaModelsWithMain( fmlaFactors(fmla, data)[-1] ) }else{ stop("Unknown whichModels value: ",whichModels) } strng <- sapply(lst,function(el){ paste(el,collapse=" + ") }) strng <- unique(strng) fmla <- lapply(strng, function(el){ formula(paste(dv,"~", el)) }) return(fmla) } createFixedAnovaModel <- function(dataTypes, formula){ fixedFactors <- names(dataTypes[dataTypes=="fixed"]) fixedPart <- paste(composeTerms(fixedFactors),collapse="*") # get LHS of formula dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) formula(paste(dv, "~", fixedPart, collapse="")) } addRandomModelPart <- function(formula, dataTypes, null = FALSE){ randomFactors <- names(dataTypes[dataTypes=="random"]) randomPart <- paste(randomFactors,collapse="+") fmla = stringFromFormula(formula) dv = stringFromFormula(formula[[2]]) dv = composeTerm(dv) if(null){ ret = formula(paste(dv, "~", randomPart, collapse="")) }else{ ret = formula(paste(fmla, "+", randomPart, collapse="")) } return(ret) } BayesFactor/R/generalTestBF.R0000644000176200001440000001570113043077372015477 0ustar liggesusers##' This function computes Bayes factors corresponding to restrictions on a full model. ##' ##' See the help for \code{\link{anovaBF}} and \code{\link{anovaBF}} or details. ##' ##' Models, priors, and methods of computation are provided in Rouder et al. ##' (2012) and Liang et al (2008). ##' ##' @title Function to compute Bayes factors for general designs ##' @param formula a formula containing the full model for the analysis ##' (see Examples) ##' @param data a data frame containing data for all factors in the formula ##' @param whichRandom a character vector specifying which factors are random ##' @param whichModels which set of models to compare; see Details ##' @param neverExclude a character vector containing a regular expression (see ##' help for \link{regex} for details) that indicates which terms to always keep ##' in the analysis ##' @param iterations How many Monte Carlo simulations to generate, if relevant ##' @param progress if \code{TRUE}, show progress with a text progress bar ##' @param rscaleFixed prior scale for standardized, reduced fixed effects. A ##' number of preset values can be given as strings; see Details. ##' @param rscaleRandom prior scale for standardized random effects ##' @param rscaleCont prior scale for standardized slopes ##' @param rscaleEffects A named vector of prior settings for individual factors, ##' overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names. ##' @param multicore if \code{TRUE} use multiple cores through the \code{doMC} ##' package. Unavailable on Windows. ##' @param method approximation method, if needed. See \code{\link{nWayAOV}} for ##' details. ##' @param noSample if \code{TRUE}, do not sample, instead returning NA. ##' @return An object of class \code{BFBayesFactor}, containing the computed ##' model comparisons ##' @param callback callback function for third-party interfaces ##' @author Richard D. Morey (\email{richarddmorey@@gmail.com}) ##' @export ##' @references ##' Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) ##' Default Bayes Factors for ANOVA Designs. Journal of Mathematical ##' Psychology. 56. p. 356-374. ##' ##' Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and ##' Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable ##' Selection. Journal of the American Statistical Association, 103, pp. ##' 410-423 ##' ##' @note The function \code{generalTestBF} can compute Bayes factors for all ##' restrictions of a full model against the null ##' hypothesis that all effects are 0. The total number of tests ##' computed -- if all tests are requested -- will be \eqn{2^K-1}{2^K - 1} ##' for \eqn{K} factors or covariates. ##' This number increases very quickly with the number of tested predictors. An option is included to ##' prevent testing too many models: \code{options('BFMaxModels')}, which defaults to 50,000, is ##' the maximum number of models that will be analyzed at once. This can ##' be increased by increased using \code{\link{options}}. ##' ##' It is possible to reduce the number of models tested by only testing the ##' most complex model and every restriction that can be formed by removing ##' one factor or interaction using the \code{whichModels} argument. See the ##' help for \code{\link{anovaBF}} for details. ##' ##' @examples ##' ## Puzzles example: see ?puzzles and ?anovaBF ##' data(puzzles) ##' ## neverExclude argument makes sure that participant factor ID ##' ## is in all models ##' result = generalTestBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", ##' neverExclude="ID", progress=FALSE) ##' result ##' ##' @keywords htest ##' @seealso \code{\link{lmBF}}, for testing specific models, and ##' \code{\link{regressionBF}} and \code{anovaBF} for other functions for ##' testing multiple models simultaneously. generalTestBF <- function(formula, data, whichRandom = NULL, whichModels = "withmain", neverExclude=NULL, iterations = 10000, progress = getOption('BFprogress', interactive()), rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleCont="medium", rscaleEffects = NULL, multicore = FALSE, method="auto", noSample=FALSE, callback=function(...) as.integer(0)) { data <- marshallTibble(data) checkFormula(formula, data, analysis = "lm") # pare whichRandom down to terms that appear in the formula whichRandom <- whichRandom[whichRandom %in% fmlaFactors(formula, data)[-1]] dataTypes <- createDataTypes(formula, whichRandom, data, analysis = "lm") models = enumerateGeneralModels(formula, whichModels, neverExclude, includeBottom = whichModels!="top", data = data) if(length(models)>getOption('BFMaxModels', 50000)) stop("Maximum number of models exceeded (", length(models), " > ",getOption('BFMaxModels', 50000) ,"). ", "The maximum can be increased by changing ", "options('BFMaxModels').") if(multicore){ message("Note: Progress bars and callbacks are suppressed when running multicore.") if(!requireNamespace("doMC", quietly = TRUE)){ stop("Required package (doMC) missing for multicore functionality.") } doMC::registerDoMC() if(foreach::getDoParWorkers()==1){ warning("Multicore specified, but only using 1 core. Set options(cores) to something >1.") } bfs <- foreach::"%dopar%"( foreach::foreach(gIndex=models, .options.multicore=mcoptions), lmBF(gIndex,data = data, whichRandom = whichRandom, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleCont = rscaleCont, rscaleEffects = rscaleEffects, iterations = iterations, method=method, progress=FALSE,noSample=noSample) ) }else{ # Single core checkCallback(callback,as.integer(0)) bfs = NULL myCallback <- function(prgs){ frac <- (i - 1 + prgs/1000)/length(models) ret <- callback(frac*1000) return(as.integer(ret)) } if(progress){ pb = txtProgressBar(min = 0, max = length(models), style = 3) }else{ pb = NULL } for(i in 1:length(models)){ oneModel <- lmBF(models[[i]],data = data, whichRandom = whichRandom, rscaleFixed = rscaleFixed, rscaleRandom = rscaleRandom, rscaleCont = rscaleCont, rscaleEffects = rscaleEffects, iterations = iterations, progress = FALSE, method = method,noSample=noSample,callback=myCallback) if(inherits(pb,"txtProgressBar")) setTxtProgressBar(pb, i) bfs = c(bfs,oneModel) } if(inherits(pb,"txtProgressBar")) close(pb) checkCallback(callback,as.integer(1000)) } # combine all the Bayes factors into one BFBayesFactor object bfObj = do.call("c", bfs) if(whichModels=="top") bfObj = BFBayesFactorTop(bfObj) return(bfObj) } BayesFactor/vignettes/0000755000176200001440000000000013277750604014477 5ustar liggesusersBayesFactor/vignettes/priors.Rmd0000644000176200001440000000746713274042567016476 0ustar liggesusers ![alt text](extra/logo.png) ------ ```{r echo=FALSE,message=FALSE,results='hide'} ``` Prior checks =========== ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") set.seed(2) ``` The BayesFactor has a number of prior settings that should provide for a consistent Bayes factor. In this document, Bayes factors are checked for consistency. Independent-samples t test and ANOVA ------ The independent samples $t$ test and ANOVA functions should provide the same answers with the default prior settings. ```{r} # Create data x <- rnorm(20) x[1:10] = x[1:10] + .2 grp = factor(rep(1:2,each=10)) dat = data.frame(x=x,grp=grp) t.test(x ~ grp, data=dat) ``` If the prior settings are consistent, then all three of these numbers should be the same. ```{r} as.vector(ttestBF(formula = x ~ grp, data=dat)) as.vector(anovaBF(x~grp, data=dat)) as.vector(generalTestBF(x~grp, data=dat)) ``` Regression and ANOVA ------ In a paired design with an additive random factor and and a fixed effect with two levels, the Bayes factors should be the same, regardless of whether we treat the fixed factor as a factor or as a dummy-coded covariate. ```{r} # create some data id = rnorm(10) eff = c(-1,1)*1 effCross = outer(id,eff,'+')+rnorm(length(id)*2) dat = data.frame(x=as.vector(effCross),id=factor(1:10), grp=factor(rep(1:2,each=length(id)))) dat$forReg = as.numeric(dat$grp)-1.5 idOnly = lmBF(x~id, data=dat, whichRandom="id") summary(aov(x~grp+Error(id/grp),data=dat)) ``` If the prior settings are consistent, these two numbers should be almost the same (within MC estimation error). ```{r} as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(lmBF(x ~ forReg+id, data=dat, whichRandom="id")/idOnly) ``` Independent t test and paired t test ------- Given the effect size $\hat{\delta}=t\sqrt{N_{eff}}$, where the effective sample size $N_{eff}$ is the sample size in the one-sample case, and \[ N_{eff} = \frac{N_1N_2}{N_1+N_2} \] in the two-sample case, the Bayes factors should be the same for the one-sample and two sample case, given the same observed effect size, save for the difference from the degrees of freedom that affects the shape of the noncentral $t$ likelihood. The difference from the degrees of freedom should get smaller for a given $t$ as $N_{eff}\rightarrow\infty$. ```{r} # create some data tstat = 3 NTwoSample = 500 effSampleSize = (NTwoSample^2)/(2*NTwoSample) effSize = tstat/sqrt(effSampleSize) # One sample x0 = rnorm(effSampleSize) x0 = (x0 - mean(x0))/sd(x0) + effSize t.test(x0) # Two sample x1 = rnorm(NTwoSample) x1 = (x1 - mean(x1))/sd(x1) x2 = x1 + effSize t.test(x2,x1) ``` These (log) Bayes factors should be approximately the same. ```{r} log(as.vector(ttestBF(x0))) log(as.vector(ttestBF(x=x1,y=x2))) ``` Paired samples and ANOVA ------ A paired sample $t$ test and a linear mixed effects model should broadly agree. The two are based on different models — the paired t test has the participant effects substracted out, while the linear mixed effects model has a prior on the participant effects — but we'd expect them to lead to the same conclusions. These two Bayes factors should be lead to similar conclusions. ```{r} # using the data previously defined t.test(x~grp,data=dat,paired=TRUE) as.vector(lmBF(x ~ grp+id, data=dat, whichRandom="id")/idOnly) as.vector(ttestBF(x=dat$x[dat$grp==1],y=dat$x[dat$grp==2],paired=TRUE)) ``` ------- *This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/vignettes/extra/0000755000176200001440000000000012452540640015611 5ustar liggesusersBayesFactor/vignettes/extra/logo.png0000644000176200001440000005737712452540640017302 0ustar liggesusers‰PNG  IHDR€}WÑ AiCCPICC ProfileH –wTSهϽ7½Ð" %ôz Ò;HQ‰I€P†„&vDF)VdTÀG‡"cE ƒ‚b× òPÆÁQDEåÝŒk ï­5óÞšýÇYßÙç·×Ùgï}׺Pü‚ÂtX€4¡XîëÁ\ËÄ÷XÀáffGøDÔü½=™™¨HƳöî.€d»Û,¿P&sÖÿ‘"7C$ EÕ6<~&å”S³Å2ÿÊô•)2†12¡ ¢¬"ãįlö§æ+»É˜—&ä¡Yμ4žŒ»PÞš%ᣌ¡\˜%àg£|e½TIšå÷(ÓÓøœL0™_Ìç&¡l‰2Eî‰ò”Ä9¼r‹ù9hžx¦g䊉Ib¦טiåèÈfúñ³Sùb1+”ÃMáˆxLÏô´ Ž0€¯o–E%Ym™h‘í­ííYÖæhù¿Ùß~Sý=ÈzûUñ&ìÏžAŒžYßlì¬/½ö$Z›³¾•U´m@åá¬Oï ò´Þœó†l^’Äâ ' ‹ììlsŸk.+è7ûŸ‚oÊ¿†9÷™ËîûV;¦?#I3eE妧¦KDÌÌ —Ïdý÷ÿãÀ9iÍÉÃ,œŸÀñ…èUQè” „‰h»…Ø A1ØvƒjpÔzÐN‚6p\WÀ p €G@ †ÁK0Þi‚ð¢Aª¤™BÖZyCAP8ÅC‰’@ùÐ&¨*ƒª¡CP=ô#tº]ƒú Ð 4ý}„˜Óa ض€Ù°;GÂËàDxœÀÛáJ¸>·Âáð,…_“@ÈÑFXñDBX$!k‘"¤©Eš¤¹H‘q䇡a˜Æã‡YŒábVaÖbJ0Õ˜c˜VLæ6f3ù‚¥bÕ±¦X'¬?v 6›-ÄV``[°—±Øaì;ÇÀâp~¸\2n5®·׌»€ëà á&ñx¼*Þï‚Ásðb|!¾ ߯¿' Zk‚!– $l$Tçý„Â4Q¨Ot"†yÄ\b)±ŽØA¼I&N“I†$R$)™´TIj"]&=&½!“É:dGrY@^O®$Ÿ _%’?P”(&OJEBÙN9J¹@y@yC¥R ¨nÔXª˜ºZO½D}J}/G“3—ó—ãÉ­“«‘k•ë—{%O”×—w—_.Ÿ'_!Jþ¦ü¸QÁ@ÁS£°V¡Fá´Â=…IEš¢•bˆbšb‰bƒâ5ÅQ%¼’’·O©@é°Ò%¥!BÓ¥yÒ¸´M´:ÚeÚ0G7¤ûÓ“éÅôè½ô e%e[å(ååå³ÊRÂ0`ø3R¥Œ“Œ»Œó4æ¹ÏãÏÛ6¯i^ÿ¼)•ù*n*|•"•f••ªLUoÕÕªmªOÔ0j&jajÙjûÕ.«Ï§ÏwžÏ_4ÿäü‡ê°º‰z¸újõÃê=ꓚ¾U—4Æ5šnšÉšåšç4Ç´hZ µZåZçµ^0•™îÌTf%³‹9¡­®í§-Ñ>¤Ý«=­c¨³Xg£N³Î]’.[7A·\·SwBOK/X/_¯Qï¡>QŸ­Ÿ¤¿G¿[ÊÀÐ Ú`‹A›Á¨¡Š¡¿aža£ác#ª‘«Ñ*£Z£;Æ8c¶qŠñ>ã[&°‰I’IÉMSØÔÞT`ºÏ´Ï kæh&4«5»Ç¢°ÜYY¬FÖ 9Ã<È|£y›ù+ =‹X‹Ý_,í,S-ë,Y)YXm´ê°úÃÚÄšk]c}džjãc³Î¦Ýæµ­©-ßv¿í};š]°Ý»N»Ïöö"û&û1=‡x‡½÷Øtv(»„}Õëèá¸ÎñŒã'{'±ÓI§ßYÎ)ΠΣ ðÔ-rÑqá¸r‘.d.Œ_xp¡ÔUÛ•ãZëúÌM×çvÄmÄÝØ=Ùý¸û+K‘G‹Ç”§“çÏ ^ˆ—¯W‘W¯·’÷bïjï§>:>‰>>¾v¾«}/øaýývúÝó×ðçú×ûO8¬ è ¤FV> 2 uÃÁÁ»‚/Ò_$\ÔBüCv…< 5 ]ús.,4¬&ìy¸Ux~xw-bEDCÄ»HÈÒÈG‹KwFÉGÅEÕGME{E—EK—X,Y³äFŒZŒ ¦={$vr©÷ÒÝK‡ãìâ ãî.3\–³ìÚrµå©ËÏ®_ÁYq*ßÿ‰©åL®ô_¹wåד»‡û’çÆ+çñ]øeü‘—„²„ÑD—Ä]‰cI®IIãOAµàu²_òä©””£)3©Ñ©Íi„´ø´ÓB%aа+]3='½/Ã4£0CºÊiÕîU¢@Ñ‘L(sYf»˜ŽþLõHŒ$›%ƒY ³j²ÞgGeŸÊQÌæôäšänËÉóÉû~5f5wug¾vþ†üÁ5îk­…Ö®\Û¹Nw]Áºáõ¾ëm mHÙðËFËeßnŠÞÔQ Q°¾`h³ïæÆB¹BQá½-Î[lÅllíÝf³­jÛ—"^ÑõbËâŠâO%Ü’ëßY}WùÝÌö„í½¥ö¥ûwàvwÜÝéºóX™bY^ÙЮà]­åÌò¢ò·»Wì¾Va[q`id´2¨²½J¯jGÕ§ê¤êšæ½ê{·íÚÇÛ׿ßmÓÅ>¼È÷Pk­AmÅaÜá¬ÃÏë¢êº¿g_DíHñ‘ÏG…G¥ÇÂuÕ;Ô×7¨7”6’ƱãqÇoýàõC{«éP3£¹ø8!9ñâÇøïž <ÙyŠ}ªé'ýŸö¶ÐZŠZ¡ÖÜÖ‰¶¤6i{L{ßé€ÓÎ-?›ÿ|ôŒö™š³ÊgKϑΜ›9Ÿw~òBÆ…ñ‹‰‡:Wt>º´äÒ®°®ÞË—¯^ñ¹r©Û½ûüU—«g®9];}}½í†ýÖ»ž–_ì~iéµïm½ép³ý–ã­Ž¾}çú]û/Þöº}åŽÿ‹úî.¾{ÿ^Ü=é}ÞýÑ©^?Ìz8ýhýcìã¢' O*žª?­ýÕø×f©½ôì ×`ϳˆg†¸C/ÿ•ù¯OÃÏ©Ï+F´FêG­GÏŒùŒÝz±ôÅðËŒ—Óã…¿)þ¶÷•Ñ«Ÿ~wû½gbÉÄðkÑë™?JÞ¨¾9úÖömçdèäÓwi獵ŠÞ«¾?öý¡ûcôÇ‘éìOøO•Ÿ?w| üòx&mfæß÷„óû2:Y~ pHYs%%IR$ðâiTXtXML:com.adobe.xmp 1 5 144 1 144 512 1 128 2013-03-31T23:03:41 Pixelmator 2.1.4 gsiV@IDATxí]|ÅÕŸÝ»Su/²pÁ÷& cI¶iÆ` È… @€pL‡ðHâ„Þƒ% cÀØ–åP‚$÷‚ î–lËV±úÝî÷§ÛÓÞÞîÝÞéV:I3¿ß»yó¦ýovæM]A–eÆ G€#Ààp8í ±}——–#Ààp8BÀÞšaX°`¸oßwÝËk+»ˆb¼Ü¡«XÖ¿ûÙ%óçÏ—Zs¹xÞ9ŽG€#`5Bk[˜={¶Íé<:áøñÒKŽ)I/.>9âÔ©ªnT‡ 'zöè¼í´Þ=óúöê¹bÄØIßseÀê*Äãçp8Öˆ@«QfΜԱ¸øÔEEÇnØ·ïð3`ÜïóþýûüsÍšo?ƒ¢ÃgÌ€Æe8ŽG ] õ À¥—f&/>šµ÷@ÑMGžο2tÈÀœ!Cû=ñÙgy›Â ÏÃp8ŽG ­!• Mó×Õ<{ïž’«wÿtp6¦øû4x,?~Ä‚iÓ.{‰/ 4Mž#ÀàpZ;Q§\xá9ÓÚsèŽ]»^b¸©ãG,}ú¦»æÏçû¬ÆšÇÏàp8щ@T(&ŒN..:þÊþÅ—ƒ)©3Û{é9³G‰uƒO“䮘d³1We sî:ÀتäîŸü—«¨f‰âÊÈHûená~ŽG€#Àh«´¸pÁùgž¾å§ýo9t,#È)ƒlÿ{ú6¶-óLׇYÁ@¾¾¢’}ýX̓o°‹qÑ¡®\×.N™š:åƒòvÄÃÙŽG€#Àh³´¨pùEgÌßüÓ»‡;Ïá;«zé·¶?¿ÄÕÏncgÉéñ·ÿ$,›õ|ø¨açþ(që{È»N?M¾<Ü?¡¤”}ué}¬ßw;Øpm11ŽS³feNÌÎþr³Ö»9ŽG€#Жh‘oÌž}ÑÀ‚Í»vþ÷\i[³êE©¼)?ýqÝ»° Vü™Þ‡íÕþ‘uuõ<6KËçnŽG€#Àà´uš]¸îº‹’ò󷼊 º#ÿÄ8VùñcÂǹÛ5:&†‰? ”€ždù}úðÀÁ¢© ÍŽC$ÊÅãàp8Ž@¸4sÇ'›7í{bÏžCSõ2<~°¸uó[ª™éòðOÒ“ —7| »ü©…/´á—”Ú±cjO-Ÿ»9ŽG€#ЖhVàâ‹ÏÉ*\¿ãf=@/H±å­[(íÐ[ž©ç Þ¯¯–ã:ųSê¸pË`ššz÷Ç„Ô|nçp8Ž@[F Ù€Ë/?3aë–=º—ü\œfÿòÓç\µØÅV‚Ý1‘Mšyž°^›†\+ÆjyÜÍàp8¶Œ@³)e'œ3<ê·¦Öû7KŸvÖÇ:Ø…Í´cÚ™ì„6!VªÕò¸›#Ààp8mfS>vÈ8»PòáSÒøX6Cëg•{X?ßë;$&‹sø)V¥Ïãåp8Ž@4 Ð, Àå—Ÿú¡CǦh üʽâWýzI³µ|+Ý;øÞ Ø£{çmÆÌÊ4yÜŽG€#Àˆ6šE(+«8gî;ª Ÿ6ÄžÍÅ®j^sØE‘IêtNëÓc-ÿ<°nçp8ö€@³(%%Z0û¥¼ñ éj_má¸kªÅzu¸äîÝ>W»¹#Ààp8íË€Ûggv(.>™¡3¹‹p`ÚY®~j^sÙ÷³%­þý{¯¶Ç'}¯¸ù“#Ààp8íË€"—˜züøÉj@gLd?z¾è§f[oXÝê|É®$Ô¿_¯w/^ìRÜüÉàp8ö‚€å À±â“éZ03SXxºŸéÕÊFÒí¬g«Þ_͆Qœ½’z®ï×?ùãHÆÏãâp8Ž@kAÀr ädé-Cúj9Íâ–Þú”<^ÁÒ(µáCú¼úÞ{+Ê›%ežG€#Ààp¢ K¦¶¦¶»¶Ì:0›–gµ{ÛOìý[Ÿgîk†ûôîY8pè€÷­N“ÇÏàp¢̵{ãf/Ù yáyˆ,UdAiºßÇÄ8šqúßÿ[¿}0ùv–‰ó½(##‡øË›o~Tê“)îàp8mÌ%ëÇ»Ž”T9«7¶Áâñ"5&Ä0hB\ì>­>ËÛ,¦¢’ýgáBùƒ¯ËW+ Ž;äµó2.möÑ梂‹%AÎPòöS`¥‚$îcv¶7ÆÅö77¥h>ó½Û ì¸y@Ž@"Vƒ¤£öΛ›ö€ÚÍí¡! ;åóC Á¥Û Ö+ññ»µ`Š Ãr‹Œ$³Ší?±ÍÿZÉ„WW°±ÇJeïDöþâü´3j‰‹$&§Ë2û}“‹ èdêïÌ}žqMvAíÆ€»… ÂQŒû$7k¤Ï›œ&€#àA bõ84D¹^>Ò² oa“ë“w´.,WqŽÃÍÉçß°mÏ/aý¿úMÔ¦Ù·oÒç£Fõÿå_ßXѦ®ýÅ* }Épˆ›dy¦K®®NÏ.x#Ñ&,X‘•ҦʪýO¹›#À0…Ÿ0Sû²\°Û¿= '#7 €QÕ‚×…£¿+€ÝÏ ìßç½äÞ]îúôÓÿFçG¶[ÙcÚŒËØD ¬â&ue±#ä“GC›bÆiåÝn™ÅËL¾ý”S¾.cQáÖÎKù›®gr"Œ*ëvÙ&ÜáhytM@ ýÃõg`æ1¹ Qð mËÁÅ|®ÞµË7>e}GvŸïׯ?x`ß¿ïþéàïöì=µŸü˜p,o^êÛÚ¼¹g/9_$›Î\Òµ˜öŸÉ°×RG¶£Ä¤¿f,Ê;l(ûõËii–ÿ:yà¬ö„€ ”®›úe{*rÔ—µÎucÔç‘g°Å°^p8tÆä‘+oU +yéÓ†Ë}´±öíÛã]êü1Mµ¿6ÏfÜ‹³úV3Ö÷CÈ~8%;ÿlc/äñza±[àæí; ·ܪçÏyŽ@ÛD sÉÖ˜A¼v qÃÐCÀÒc€” ]Wň\…ÜsˆUmÞã_´„ĸ'NT=ÐÖ:mI×ÌMûN´ÇŸÕìÔ7Àà,ÌÓ÷å\ŽG -" »ªoÄr`—¶X6^¦È Ð €CçÒ½ëð t¢œ9ku&·{%÷x¶²²²Ù6 †—ûÈ„¢]ÿ;:®ÆŽb£eA~rc–ÿßFés>G€#Ð|ÜšŸOS¯|?FóAÞ*S²¼Ca,F¦R¿Ýn«¬(;ASäíÆ,¿tÌI¨UO³ÖæL7òç|ŽG m pùòü„m;…eØü7°m”ˆ—Â*t'è#™˜$Õë ÷#·Ð)ùÝçß½k§ï‹4 G²|Ñ—$°¯-÷É›Œü.ojži&aíÒ½Y½³¯ÌDt¼r§­¾|Ý•iEˆ;rnS3Úáiäµ}gl²lsfcrËæ*¶uK;–›A774›2—nì#»\ýð‚—1§£ÄuÚè’fÎC³6PBÑVWé:Þ[íir”ì„ò¸®öý_^8Öo¨Lü2?^ßEª>ÃÆàsÉ5ƒŸ0}IaJ&%‹’ˆ¹Çãñ:]qÉ¿öºòb˜Dzöæ~6¡¾[±ç {« EÛ¤‡å €(‛…¦c"óÛà{#^ìk_fĶ þjQvºÀÏ``€38CÈXœŸÁ\ìK†QÅé‚ ÷ÁÓSw\L’° ÝÛäEùå8Ѱg¾¶Ûìï¬É»#xôŒ¥/*˜#Ž©ú²Bõ”¹©Í·è¶ÃŒœü_¡,ýÒäÍM]¨Ÿ}.ݱî*.½ˆÉÒÕ8¢yÌ„$&× „Pqãâ:R MÎf›ð&,—í¶eë²Æ}¯[xÜÙK˜í¨Tp$± ñß c²0k¿‰[;ÊZ&Ô¦/’WË"û(&&ñ£U³†—„—ZT‡²¼®†ZzªrщKð\Ã:Óp zOæôœÚAÅ«.©g“³óO nì‡ß>(Ô_Øl±ï…s™Wæ’üI.—°ÿXý| Ix×^Ð÷ƒæn·½nÝÌ\ËìBQaºSp*‰MǨ¯¿ÒF¸hL€ÖøTiÞõüœ\*ÀæÄÏ15üEîÜ”|ä'ì>bæ²K++ýŽPS1÷¼*wNªß€'3{ýI–G›3yLv"õ"é¨4yÑÑ5Ì<´vÎøÿaÔÖø–+’$ZÚwÁéxퟂ—ÈÝøiùmÝMGýÒwÐ}ßg”5Á€ïÇ&ÍXfµ7àÕ¼žƒÜx[ȸèitŽvs2ÂLv:ëJÏÎ_)Ú„Ûs³Rw¹ýâAYvåè{Ë,7»pÏü¹)ïêû‡Ïº´©¿ö©ˆì~³±QÃ. M¦¿E˜Ž΃ŽNève6þã˜Óù‡ÉÙË6Ûm«³ÆÒ‰59gýLh`Xú‘GRÀ†¿¨!'hh½ÿ‘G)œŽ†xz]MÕ³øoîÀ»ï‡”X” 7k]5‰ÁôÏwuª*-ÿ#ºz(˜2vã“ÁÿâùkÜž_™u»üp’GšérV?‹Žú]Q´ÿ3wÎØÍ>²*GÆ¢õP8¥t´€§! xá=ÕK@ $w…ï]ŠËïér­/$åô¢•kOÖß+ItÿƒÜUIÞ(àÇ¡’bvB> òc4ìÁ ñq¡W껹aÌ’UVÖ' ’ë– 1NK5Îx’’"ÜÛ,ÿ~¼’×ðŽ26 íPfFNáekç¤|ÞÀoÛ¿ThK :÷@È7¿>Û×;WÇÖ©['LsªLuuuÿÑ£GǨXíÆŠ† S€ÂàçõJÏ)À‘ÁÚ=xA ADáAdÅÚYÿd[ª#66f°`³]ŠŽæ½ß_tFJNyÓä%&øúøºòæŽÿ/60~âËmtáÔŠ/™9ëä;”Î3•:8^kLÕØ–±¸à2©¨d+°ž)tþÀFþžg6ñjQnû”©„¹‘åN—sKzváÓNê`pãã:&¹>Fcêîü‘ÖŒ`ÂD[GÖÓ–œc³ gп·¹g»,:™ý Ì3>ÛÔÕt¢Q(ØÜuÕÂäœü›O•–ïDGsŸÒù£>ìñ)tv7Ú˜p >’v=êË“ Õ:qvDÿµKªß”‘Oï ¾¤k ÷¤AõÈóžê‹šá ˆÈŒœGFÈÈ)¸¥æDý.t´ Ü?y@éD]û £ïÛQ§‹L¼†‰Âýà½Ï£:ñ’$ù WQþöŒì‚Y:þaQû!å Éòh×â"¥ö@–ä÷i)ÏH¦-ñ-Ÿ\.J¥Ã U|Yðôѧ³ýë6³1J'N–I;shÜ^{xÒæ¼dgàeÔ-.*÷~]o±¸:»à9hè÷øÈ ¬Êf“/ÊÍJûÚ‡ÏÆì›hEæâü%—ð&¤.jä$޹œïcª.哎éÜ Ù í°‰Õ»¤ôªÃ“íÒ€b©úW°¾¨õ ×M#Àt³Ë#ïÐFJÅmôœœSp“äg¨²GÐÉÎ[“•’§ð<ÏWé9%§pœK–ÞÞúI|”³3F{¯c$>'ÆÆ~ùUVZÀÿ†Â¨ŒPYZþ°>_á!O?ƒ=òrZŠæLŒ{ö…f`V`¤ü0»§‘ö5ᯪ¨¨ïƒz3uÙŒ´*%®Öðlɺj„gVèm;[y¡X–¢S¼>onÊ2Ãp9…s1%ýRCð•ÂͦCÉé˜7'•fš|^lÑfZd®·|C`éÉ%¿†wfˆ–™‚ýv›xßÃŽíF~j>µ3eÂ;TÔ|tòÅ6»tMVZ¾š¯ØÑ ßU쪡N~>ò7Bở2 …i)ÊúÂð!òý‘¼¸Œ.N+vÖ|ð.òIÓÀAmØö¶³pwÊ DÚ ÛnuI°&åSiÒCså[—›’G²Bµàtºâ¥:y "=Ø”ˆ[[ØS§¨“qOeéf£wÝS^Ÿƒ¿åjÅ­ÚÞÝU[ù ÞŸóŒú·1‡83ïªñ;žÞ3wNJ6ÞÞØ¶äÿî Þ©»1«`[7'í7êðž=6~ûl°Î~J-§ØÑWé(ªŠ·©çÔ%úÔ;…O«4u´è‚}ꪬq?ªùjû⬑upçà‚¢Ï\®ê7õÚ*ë¶ì¬Ìëgä^1¾T>L»Pä,¦¥.S¿’†M#¶1S‰3Ÿ¢Õ™rêÌ€F:Í3‡3¿ÑKé©j_ 3Ò‰Fa|-Ül”-hçysÒVùgæÌÐ{!I*Å›FáÔü$±ç?ÑQó¼vY¾»‚{zÝ:1Æ>ákt¼¨§ìy²²êwº~¡3L[zS4Œ+s¯J 8úÁTìo|:A8–`»rÕ<ãÎ_Év>×®—z?FƒÿRxê'”€^µ.a™{VBí¡cÏXR8ŠË#j/ü·Ï«ÝÁìkç¦>) ì&EJÀ%Ò‘ü×w´?£¡®ª1¢q]mÕjMç¿&±s§s‚uþJ<ôîÀ^®¸ýž’p{æ‡ùÃýøÍÈ  wN§s•_ç/{™Ý1yÕãÎ_MÚà¸nnZfFܳdj?·J”TíZ‰e¿ôœüß#Î+2œ]ü×KOVŽÇŸnyù"S‚¦ÅB» ±ðgø²`´÷MÑJÜ}ád(çcÑ5íÒ\—P p؈÷4^WݵxŒT;Ô u4Œß¤¦ZïV‰îÈgüLÛ±7ëíê¯/ yètuGóªxý¬¹3ÒŽ£NÎb |·Ð×Ûüª¸ëáB•훜xñ’­ÝÔ<³öd[Ò]h€ ¡Mܰn^ÚSfõ´\´ÔUÂÇHÎÿZ5&8 úfГ/ê;þ‹ý:l/ uÐàõŠXf¡‘4pŸ©M€FËkgûµÓÊé¹ifLt°Ÿéù¹y²üóLì0ôâwc"òlC7‰¶¸)šS72µ‰ëæ¦Nƒ2еC—Îqëæ¥vƒûç4 u›ñ¶[]Á¡wpdSÅ]ñÚKË+†^rÉùÝÁ×qi´B7íTÝñ£p6÷<ŒÆÁsÔHU ™¡Ý 7è1^’ÈÃg]bÂÙöbUŒA­˜Nßxt$H#t=TLÚˆ—±¨àiÌf莆ÑIÞzÁÒMÏu¥{¢*¤9«g4ïíD13B3FYfØ9<ˆÏl®¶Xj.5)1QZáªðç{8VïúìºâlÒÄÿÔ[›Ù*©†¦óÿì‰Ãôƒ»[ó‹ÏŽÔ†+ä+¾)ÓÔC°Ýfò-u•Öý±”…µÑ@Á«e,&àl[£´¯ ïÚf`8Ë—Ûè‚‚Ð"³4}´1‰IomÍ£ )>ú{4f; –ÞpðkMÒtIòÓØ\ùqnÆ€=ÿ <™íò`÷*24®6(`ù9ÎÞ, @—nY©úÿ©ªªÁ¨¨.àš³Z¾5Ø©ÃÇ.Ù +AØþ#ÛˆeÏÐÈØ/ÿÛ©­+ÌtþVåe~q_>×ãñD»ñ( 7N)7Iö¤¿¡!=d 騭«{ÜÀ/(»Þ)7®ýc‡vlWÇÛaë·Z«[§å™u»gmN•…™´›\/¾µkqŸšì¿©ßzœšW©Ñ kÄ3Óá…õãcÜUǶ…K»ö‰:‹y~©DM]uÖTý¹ë¨Î!FK=›-ÕlSv»`ïˆ~G'‡í¢í-SEX¨¦ÆùÍ4i£Å;º ù|¨å‡êÆšü;ÆaäþRÑÉ»Œýû ¿É;~o`©öëk¹€ ‡?¼a+ŒþQcÀ˜Â­'N ø¼œZÿèqËgá8Xi0Ú¾“a]Þ úô8Pô_X‘ß%Ûâ±Þe|ôH[ö©sÒÞÀËâ3²…{.¬ÑÝ™¬ ïu;Äã^{˜Ïzè|ãàÂÜÌ%ëÇûëûÐT9ö½7žDØk®aM_\8*ϬFaeYã7ê§`–+IRC+=qž¿{]RÖkýÜa$¶§ZrX›-ËÜÑPW±“=YäÛµ…˜¸UË3ë¦Mt²h›‹i·ê0x¿µË¶ 5SØjË쓗柆üܦ›îè¿É¹'.A GàX²»E7ý`LAø"œ¥º`Ѷ%Ë—lø2?`袚^o£X÷óFËy}ÏZ×××ꎤF‡Ö©“ÎMÎ@7_ ·*/}9md}(ñ¡·•æÏM½ŠF’¸D9 ³»ñ…Á¯ÌœW§ƒsÙ¥f¨ìˆÓtcÑË–òV±«à^Ìnø/`X.9¥§õŪèƒZ«]µ¿DµsÏB #wá’’…IÒ<­? ³fQ~þòÀœ­Ç_yÒþ<·ñ+¼†' ¢Ä…5âŠ]÷ébçƒÿ©®c?€ŽŽŸ)¼#~;lò|³G uâ ›…·ºeû*ܤ©ÒLØùQPW%WõµJ]òɳ,ÿèãѱnÎøOpŸÿ`¹Vžˆ62×êlÂ(›þó1b=›…Ësbu›VV%N:î‡ÁÍ@f)<ÍsݧAGj5ü€NœqõS–h‡ž–+®†Ñ-‡vÒX¡’½ïmcÝé¹\’~ŵ<7!'PŽÎ¤À(:N|WF¦K;£ƒé‚†¡«®,n¸Âh03e¸ø È*öêöa(ëgž£‚†ÇuÓ3sy~©B˜‚²ïÿ`&qse.–r¹ØGzr(çEøFAæÚÙi¹zþZ^&6óá@õ|á“ Sƒ2Ëh”÷ØÜÓ•­0ºÅl`6v÷žp>Ý€^ øN…£.|²{e}-Ø)Ž«›ë\Â<¬«.Œs<ó嬱G}e,t ÂNl¢òSš¬J±%ë*þKuË%ØvêòC`zοBËDÑÞÌ0¨è ùÙ©„qË軲K6R˜K–ioDH @¤òÖ–ã±\Ñ&5€£É~K è<ÐYF¿Áô×VOÉ4›SºŒC’gáæ½ ÷”6îW‡EçƒÙyú‰9®¢’§äœüY¨Ú³:>»ž½~¢ KW Cº{Æ!MšÚ14 è¯ H»tq]í7‡Ñ¿ÁTÍœíïãÏ‘Ž\‰F»¯×G^ôÚu,tÜòÃu¼ê1º÷™¢Õ‘i"KŽ1Š É›S쪾ÿqª‘ &HñýmM­óvÌ,l⋹YãÛóh(¢u—6uFEž¤§†‰6G“£ÿµ¹ùî›EefØ.ÙcMšíP—G²Ë?+¦¨å¹=2X®àOuúgUïÕñ— …“ÜuïÏN•W7««íJ­EÖ³H›ä>Ɔ±\Å%4ù ÈGp—Gf£œLþSlÀÇ_h=?lð`ÓïšÅ…“°&w5úò«0+Ѹ#†¼è1¾¶ë"…%:[:~¤»ééL˜¼¸ðªu³MmDº[Éâ,Ì›¢§"S/ÖG_0Ó(k롬MÐò›ËM·©á¨à\¡^*ÐÝü©Ê)ÀèætÝ0yQA½|äÄʺZ/ “­nÛÓ™¾-×6Ly¥m”Ì\qº¥Á £®®1ûtýÂ`Ò'³]EÐõ  †³ba$ǃx°| Ëâ)ÿ¤#† ?XøIqÓ³¬¬j¬ÚÝí4½+B_³ÙâG¡ÎÓ-£,Ç ý3”€Guýƒ0±á©Ý„·&»`·ì’òÐ1ÞI¿;LKŠ+fŽ8ƒ%ÇØoØÓFÊ%,N1ü—s,WÜ~O—ô„{zßÏ£‘A#ò™EƒSŸ÷éÓƒ­««t»vNÿŠŒŽrm”!9]’¤¸&¶³*³©ƒ4’lÍüf©«²l8°¨9!ú+á­PAJ6Ì::êr¶µéû–< ä6\C}Ü0=ÆN àǽÂD Í4c=ÏÊÔ8œ8QzÎM7Mj%'Ô9ÝŽs®E]/C§`¸—JÀï§-*0­ÑNçŒìÂ']ΚýX[~£žÞœáA ÿ]pˆÃp‘Æåtâ ¢Gʼ 1ÜäaÊÎxÜ-4 Ÿøü…JÜÏ*¸œw52…£‰]:g7ºõmH¬‡®l°ÿBWØ:&Ý%›…}¡¤‚áéx(C9k²óÿ—™³qt(a£Y¶9ë*>qÞË ‡\×â ¢QÞBåcóŸa9)®:)²3¬ïÑ9êj¸¼–+¢.bÒkfÉÎÇ|v?^>ôx‘ÜnÖŽÜÊ„kt–Žz½>{‰ÿ͉Ú÷ ü ;·ã+eè|Už{ÄÏÞqØìC1~§Ù»Îµñ‡â¦o¢ãœwŒÂ 6ͧ/~éù_˜MYQï.^2sé#]›»Òèzi57/wNê·¶x‘n¼Ì 5m`’ê’ù8õñ€™újüÍ)ßÜu¯€áÈØ%C›³ì–¦%±žâ‡"i8(œ‘Þ­b#?´iÇŒý¸O¸X®Ô×£Ëñ3:,?™Ðz9>5ô˜ZoϽð‹J€Qü™G]—ùãR¬/Â=ï¡“ÐLñ [q¨ó¬¼yi×7÷™d:Ú†Ž®V/ß(SŸb×±ßèùÕ0÷Yí† ¢‚Pg³ÇþSONËú†A'/‹¥••giå[ÊM;Æ¡ˆÍíâ¹x«rCÊ- Iì)·\‚pÖ¼”!e(4á–ª«x/ü6+9ÇÅ\¦6¥*òÑüÄûV(‘V°ÈgW6Ò  ¨%¹=,W0MiÍp_§”ÊF@µ×±ce“P‘[]ã¦.C¨vQ”×£?+Bßj\1âŸë^ȶÙãÎ^“•šïïg=Ç}®]ÿn˜’,?0ã³M>Ó¯t£Î«/É¡¥Ã8Ô²l8â@mÒ;‡¯ÝìöµY)ß@1›bÄiØkäÿ÷ͨY“³óÿèËnWKÖÕ€SÕ2k± ¢ÿÇv$`œ²ÑìJ1~çÎÌ%÷ €€å €$6Ï1@*cL 4v Û§.oÉÉò1“&iÇÕùnŠ]Ä-ÂC#óÛÐpN¾.£½—ú/øPƼ`÷iJ3~ñbü“è|Ëôâ¡Kù©úÔ~t:eõNåcöâEµ ;Ò1lüÐaÎ ¶%ýÖÌMY=éîAX† ”&pa”€K[2ïfÓnñº*Tq×ÕySsò›-‹Y¹Ì%ù“2³×0+ 9œÍ7|(~Ìvèµa'¶Çû®j#Á®EÚ|´5·å Ó=`²M í¤óF³Ãê`••ÕXÇ®e©åÛ‚=^ˆÝ¤~ €Tœÿ4:щÚpxñr“íi÷kù-á¦ÏxÆ0mY¾“îHPüÑõ5nþØB™½Àg”蘥®AíîÝûºª˜tb!q»gæ¦Î¤%LîÿG•„¾»º1sðg}Ïèâ¶t]Å~ŸA†ÔO›SîSóšj'…Gr±÷]²´'y®ij|fÃ;˜D××ËËgû…îƒ÷ÕPq¬Ÿ‡# Ë€Z—K§·G·b‘™0Úw# %ƒãOÝ-J.*£¥Žy¥Qæð‡øìî¥;ï±|¯Ÿ‚)°ÜwèG¹¨pêr?¼Ž®ˆÊP´A£Á²[ʹÖPPÎr)ÐP 4´Kº ê푼¹ãÚóEV¡‚´å €KW!‡!ŠžÑWç|³‹%…M«O_²q Fó‰F…ÀÉ}ßÑ­KºÉ@vcsoö3ȇ—½lFZF` ¼ ›÷~AŸ¤ÅåGÞ‹0ÞßÓ–ò‘F4 “ö  áù&€MÉfðÙ‹.5B'|&Ķ•!G ÀÚy)‹L˜Š2•à ¶4<‹ûEA]¥Ž×iýÛ ü‡±b->Óƒ±ä™>]weZÀiùÈ$©ŽEøDíòµËbu]½á†b_ÙÀ.º¿{ôÛ醔é $ÇÉ}ƒ#`¹ ŸëþËä,N›f­ÓÕ_ËkËnQrÞ‰,È?iÊ?]ãv;±Ù)P¨¤YxB¯Ô7нÄh VªÈß»ž-ÊÂÂpf1Ð ¨—†Â“˜±Yú¶¼à’Ÿ¢¸‘î6:⧤©çªy©E»mâ«0ŒS¢}¹,*ê*FÆb¬ßF§ɘñÃrÐo¼3Y‚ü’™0‘”qÈ1@®2ŒSæú…â!Õxgë|‚áäNŒM~Ö‡ÇC …ŒC,2X·®|7ŠaÀ(‹’‹Êhqvßo-_Q™‰ÞÑ0Ÿ‡:¦¿ùFf§«ÃE‹=·†aƒÒCFùqïeP®EãÕ¡“ãU#Ù@ü„N_Co|ÌH#½)éÙ…7ù›åÓtq]meòí^SÅ&Î͆ UÎýM-7 'ˆ; ýZØ#šêjl7ÇëPÕŽ€¤£T-½Ó”;2rÖŸ…j¬t~{ðñ£¯¤g‰×ªy£‹1cø¼qäò4Ú·bìoÎ Å·ëIbòFK|ÙR//m‘×B €uPÆ8Ø€1Ø~u e¥ãgÏžmSóÚª=cIáDLOª¾ù£ËÚ[ìb…y,¾8Q±û=ãÎøÉzN‡ÞÅOFÒáóqßÁRŒL¾ TÍwBý¤±'. *ùOŠ[ÿ)½’¹8ÿ }¿àÜ©K û³:L'ã› $½_Ò'a„2<›™S87€L@/›l¼¼c‹ÚÝÖÑTW¿¼p,í±qÏØ …î²bgÁ_üñiö@–]9ؘCr‚ÈH‰mÒÔ)‡5òê’˜øL EûVþDy ×Ð;€Ž^¯>Wˆ1Ž'—‡ Ž@›SPÅ{Lé{L§äDÙˆÚÚÃ>ß‚CÓú$hí_rÉŸàE÷[Q•æ)Ú$¨¸sg¤7z¹1õ˜œž]`zŠoú’žRµë_JÜÚ'İ m<ŠÛn¯ØuŸtNÂj€•ø„^i¯ Ü ohÉ_\ŒÏï>Êh¾´69§à>g­”fݳùIØ'ÆÚoÖO Ÿ\ÆnpÜåÿ¦—ïÃŽð×ééF²ø’¨¤ ÎÁfý|p LêøE[]µÖí%´7?êdÕËBÿ5êÆGÚ;*¼:úÌ5îãÀÇžØ@·· lèœÈÌ×cAð¾ßêè¡ü÷YÆ7 è†Q¼Iw¨ãRÛ1v í_QóB±××K÷¢¬~WEvSî•c†— ¶§ ügŽô]³ª««ïXVVíidC¨µH§/Ƀ#—+0b0\ÃE¿©—-ÎoÔB|ãrÊ/˜i¼&笟Yé”6@ù˜nWd}Öd¥ä¡QûÜ(VŒ*¾òÜŒh$”OË 8A0ÓHIòDàÀóIܨ·ŽÎÒR>VSpOi…ð“ägWwŠÿÁ‡(O Ô๊ò„üuî4e–€o¤L{Üî~0¥ëÞh¨ ‚ƒ€kµ¼hsGS]¥qÙeû•NÜx𻢼¼¾prNþÍîOì€zñ’­ÝPþ!IÂj¥óGyKPÿ® Í¯ÁüØ»Ï :êkròiˆŸ¡ë­§-)éçáaàn ÌŠù3—ô¾Ré^Â2”Ññp‡‘ÙM~^‚ðüÚ9iKüøœQü´®ˆÆÞB‘ løNOê5Uµ#Àø·³õ;„)‹×ŸëtÇ+n¨Ð¡£Ü%ÆØ§/¾rd±åÿ7ÅŸOK.¯¨ûÊ¢MdZ™ÌìÂ3ñÑG y:'ô“·hhÎÑÊYåvÈì:&\¤[vÑöb$ÒÍ;~/pžå”¤5Ê”¬^¼(÷¹à/‡"p(=[^%Ëâ>܃U„¿¥F‚ø´ª< “ µymhäí¬ž3n·^¼ /ÙÖë¹"WñÌdé ¨¯­\‹[ñ¦çÍ}@‘ ô$å›oÔÊ Gâbí÷jùÑ玮ººfÞ¸-˜%» ÿIv`¬äþØøjY…€¯r|‰?ï'Lë%Z«±xwp7d܆Þ$z—˜ ÿœ5¨n†ÉܺW’ô…‘Þ+Sm¸”ò­HÐCs}Šé²¡Ùwà œ´ÜàgÖÍKùî!‚6á?OÆ:Éõ®å™K .ÍÍJÝ¥ãïÇB>F1Áµ Ø%øx ì[rêý><î°Ë›¬·&ÜPÁ-)"íÙÅÿc7Õ©V¥×äxe91sÉúñâÁE ²(u\¬³,ÈÃÐ`Á‹3Hö ŽüÐÆ2aÆÊ+Çꞟ·Å?[å¬ù $ݸd6´žÉßáåÿþ_#¾*I† ýÉ“¦„Açÿœ#6á麚Êã OýÄH)â<)%“³ þ…¼ü\MÍæÍo8;à#k±föøÿ qœ&ÑÉ€³,:æ>x\O{ÁbukìA¹Í.\´&«±A6ÊÎ⬾ՙKÊ/“\5_z” ¤ÅF ¬ö;Œ.gà³ÐFa~±Tð°ÊPÜ O|üØ&ÿ,š§ÿ•üFc]Å·rðnØð¦½ÿ%VÉ«ÞJ`à?‡üpßýÒ®ÁûrÝì¨ë€‰p+ï}¹¿Sp@ ùïÈTѳñZN@=BþåzÉnß ÎÍ•óæ¦];yQá.„y•ÍÊ À©ïï2­Ÿ»vÞø¯T>~VÔ×T^‰t}f°¨ žÔùãg„‹€n@³áp°åihóÒ)Åky'JË&dffZ®ðhÓ5ãFMãrº 6ý‡¹ä/Ѐ`c{/NÂìüñ2Õ"ý‡Ää´ +ç¦èvþ”¿†‹ƒØòŠ´âæLПѩ-ÄËÞQwç¹»ò¯Â‹{Ÿà¬4¾ %PMðÃ(éh9uê(ÐÒšiDŒŒþk“Ï$…JV¸vü?˄ۙ¡ÜPH×1'vît Âzg³PÈÓ Z}—¾¨à=£OüÒNm¬EÿWÉÜ­Í/âš¿vvZ®–îh­«èßÇ{p½ MÅ õ §\؃¨ovß§â>B*ÆŠ}J–/§º€öd"Þitþ´9@¼w]Ö¸ïcvûȘ ˜oå+¡ðœô“•Y7Ì&¬Ä^•5é‹×OŸþù.…ˆö eää?Å#õVÝùcíp µ!ˆ3¢ï­_9Ë€å¢Ãasïbõ¦è¶à5±ð?Nˆg]{tb'—³®JºÅÅ'ÆN˜P;nSÓSJ¸VùÄMy@øŒú_]9/Õ°ãW—Öø0*À2‰üG4¦ë:ÏќܴîÊÔ#êøšÓNSô˜Xƒ4/¦tÑ€–‰¶¸·­ÈIº5?ÿì»Ø/Ó# ^¡¦ƒÿf“Mï gtGiÑé<ÒÝGe W8³ ÿ™ü3|â÷¬#€B@Ë ”Dy$^·d ëcpÄXÝ–7'e©?ÊÑZWIAÄžŒaõµU €ù­¡¼G äxŸ¶á¢«›zæ]ÿˆYºsÐÁŸòñ&ʪq2ä–Üy)ï)¬`ÏÜÙiã¤ÂZuüdI‘ðIu2“¹\™§JË%ÌŽ‚›Ú$|š[ Ù1ï õÏ…7öu,?=Üf ‚áÒÚü½„U·1Á§bX•Ž:^: 8n ïQ@h¼¶ÒÒªè]PÀ¤Å)LãíG#¿ö¥xÁ~g…‰¶äÔþФõë%AaÐ1aƒ˜ð(½´a(ØÄt„™Þü·“ùæë¨s›¢pÑð¾n凋^NK«Ç¥ˆ¶ø!Àâ>üßá?:jf;1Sr[/{ZJ¸¿RF<1›òzÇN1Cñß?Úëö£iYÜß@ 0è:Ôû)À÷óØÈßÑ5!q°û8¥*ÒÖbÖººjÖðäíÔ‡±¨ÿDý( Š)êþoñîeM™›:º©?¥Gq8ìÂXwH¿ù[E!w^ªéÎ_‰Ïý)êy©Œ‹³Âèý¨ßß íP¯wATQÿú¡Nží~zö)¹ß=ã°‰c×­¼óWPmÞ'¾–´ÝjRŽf\rîMŸ}ñÍkêHöf Ëû÷–g¨y‘¶?õûâ¡·F„JÜcÇ zaÃÆÝ˜ºæ&´Qì¸T8Z’is’ŒÍI8¦&ãëx¸APÅŸÉñ½ÙMgÒ‰”¦¾G>ÿП ¡!L³‘ŠßL<î»ßë„‹ „õV§!?½ÐT£A¤+…w3‡¸2ïªñ;ÍÄ®LzŽ{çB¬-ŸŽ4{ ¢õæ#غ›òàØ.[wûnÏöp“‰ªpÑ^W`´››]pþ‹³p¥/FÀ¬7þ‹¨‹Çp¸ÿÚßõbGyûˆ£È^´rcbíI×d,Ù¥ ¥¢eÁôA#AŒ[FW^G2ÙÌåù=X¥8 mG´É(_/ÔÁxtøÅxŽ ì‡ÁþM›#™.+<,W.¼p½_}õ¿çÔÙkàû-쓳ÅfªÓíÝ»ç>6•R£¥ª¥¸½5!@ǪÊ*Ø~4lîõDŒ¤>ˆë“Üp8Ž@ ,_ÀÈgH ÌDÒoÄÖŸBõÙVZZ6rÖ…çöˆd:<®–E ¼’]¯tþ”›Mx±esÄSçp8­fP|;áæ‚¥C;#mó™r­ªªëZ!ÕÑ&nÚ4½Š©Fï®vL/®§ËÚ@Ñx8Ž€åX®`Í«ÊòRè$€Í-½'e‡´^®Z']¼ÁM@k«3±¾8T) vRñÑ¿r8 X®àbˆ[oŸ0ŠÑ;|LumÝ w´VhÛýC™ŽvèÜiQ£›Û8ŽG –+uÕÕ]eÀJ¿atøDc*NUÖ°¸³"‘Sp6sâÈbƒÁõ§ p>žv8sÃàp8&°\(+¯l"–ˆ$uó¿¸ôdûù4°% 6C¤³—lÕ¹<ª1a÷W%ö´—ƒ¯õ%‰i/{ÝÜÂàp8A0}ã[ИtfÏl¥åI£t¼š……€vl «À4@G%ÁÒ²SgÄÆ–Ó÷-vs’þlD€¾’'9kÇÅ!Wáÿê‹ÛÊáû…ÍæxjMÖXïe&øØÈÙÉVAŽþC·ÁUÀw-΢Ÿáp8³Xªœ:u~·“'þ§ó‰H¿™y³ù I.cpáE->˜¢¬¬ªéêtºèf4®( ´ðÓ½›Ÿ>pÃÜ_Ósç›GéŠÝë]®úkqEqüv`Ag Ž•žK·‹)Y¦›ÌpéÏZÅÍŸŽG€#`K—ËÙn7sY‰¼:‡ ì;ª¹®®¾Åö%hóÂÝŒ­É)¸ëùèØý úJÙøÁ4*˜ÝÙîcïlàó_ŽG€#ÀïH*”@feNÙ÷;ÏfFHÎéb»Ñ]8´ÑÉN渉påp¨y¡Î_´Çg®š7š– ¸áp8°X¨n®ùd Í·ÕFfÅ«ó?Õ±Æéo’6K'>¼Ép‹9P6˜“lR:ÿHßcJ¸,G€#ÀhíXªÔÔÔúÃo.ÀjjÙ+×>;HWmš6«Ñò¸»åH²%}Ñð%± y¨Ç‡DÿæˆKœÄ;ÿ XqŽG€#K€ÒÒò‡íTÀDÞ³èǽìo§ÏbCWœºY½( uññ1ǵ|în9gõ­ãÅéøÏøj&m4ÆÍ²ccc†¯›“öúäªF‚;9ŽG D, ÿñÇÃå;%•ÕW ñÍ—ÁÊ€¯PH®zûiãöãß>`ö·W±8Q/‚~ý’¶ùF>Ï,Dçž3.'=ýü…få¹G€#ÀàpÚ*–*'NŒÝ¾}³Î=áwþ¥ålõï2Ç+Ÿ³éf•ˆÄ„ø’‰çŒuÒäaÏÜÿ3mõÏäåâp8Ž€Y,Uºvuv®¬¬ñ^Ùj6Szr¸æÐ'yì‡ÛþÂÎ+.e=ôd´¼ääîôYvÆý>|ç囵þÜÍàp8öŠ€¥ €Ënï€[÷¼÷ð7‚ÚÀ‰2¶ê®XÜ{«ÙÌÆ8ümñ±1eÝ{v-èÑ£Óê®]»¯êß?nÛoæò#þPqG€#Àà´s,Uì.›|‰|6H2# ¨ÁBÁÉ•ÿò®Zž¤7ê=–”ÔíËîÝ;Ý9±Ãf1ƶkõêïŽ8PþCÐ\qŽG€#Àà´~,UbbbË:tˆ?qêTµfÊúAŒäbü';úìbù ­h÷î zöìò’$9?Ú±ã?Ó¯ˆ»9ŽG€#Ÿ‘yÙ½?úhõÉÎ;îÒ”df M]=ûnÞìúÙÅìµP—Î6qúõ%%å“¶mÛ÷*ïüÕèp{{B—& ½ º®5–ùîz ôh9è× S3ƒ­±¼‘Ì3`J­eE2ÞpãB>f¾õ 7ŽÖeîztW¤Ë€8Ÿ-YöMK|áMêÜ9q£˜z'«×ò7>à³þçó™¼økvŽÂ³ÛmC‡ôùmiÙ©‰[·î{ñV+~üÙ¶@å hÛ¥ «téEï°B·` üŸt=7}ÿá$Þå›ñ,Ññ\œìáÆÔ!ÐæêÎ&d›CäV$r(.ÔÄPFƒ,ëàBÍOòis ¨aƒé úŸ-›©·T ÒuLˆÛFOµ)-.â9òàßÙqu矌5~ì䟸cçÁçÑXTªãáövÀÏQÊEV•OHmmv€H«ou«U8E8Þ{ßé O=ñ>ˆç¯@¹·%üŸ÷ƒè¿>Ú: ªýz4Ú’„#)ÚÁÿ€Æ‚^‹pÔ-Ýï¨ÎQñ–ÈJt¥‰ÿ÷zP:¨ÜªœY®Äwˆ;¨ÍüÖ½Ýå®-”3g¥ðÍs²iŠüA}=qåÎû¶(<þl? A¦)aê,Îu‚Å%ÏÄ‹6iP§ÿˆ´úï.V¹‰,ÊçŸÝß}îÇ@/ª"›Œalï!­ÓA4ºêz4 Dÿ÷x<¹i€5l/n†¤xX®0&øößüÔ~ùyänð<ðÍö¯yË—(ù>´ÿÂ]{ÞÝŒ‚’4F4­8“ˆ¯±éõM=¿ï@´¦y»žç5 ¨ñQûz ¥¡ÿœ¦¢ç7©dPoâÁ\"Ës7Õè·ª0zd.Uñƒ×”we*—ƒ”:HõfˆòB4Ä“Ÿ€¸AŽ”%u=äq fÂ+åÑ>GDq@|ËáÉ«ò_üÅã6U7)ª{@ñžpôŽÓ;èmo`_"\;xd‚†!¹P($áP"Vd33SÒ=…P*‰û™Ô¹ÃÒäÎ_wl·â/ŠbÝ”)©S”°üÚŸÙ–ðBxô • & D–c 8u9á¦F?uCGÉŸPËêÙ!ã§€w=ˆ:fzA»é…SxðW:"zñ;ªø4s@q‘½ˆò™§ÈІ:M’Q”‚®°ƒ®×ȽxÅNI÷ð¨A}Dµ»AñȘMób„£¸½ÊŠ'ü#¾;M–EèÎ8r+÷“ÙWžÑrŠ‚Ö_-þÞ8&hø}À§Ù@úÿ“ÈF)ÿ^ØÝÿžn?uXµþ~ x  ËA÷Ð`Oüf±ËDÊÐN]“Þ¿À»ÆŸ)Ü Oe¥øn×Ä• žè‰KétàÏž0´ÅýŸÀ}³‡§îPƒÖ»‚pI Âh…’†'/¤QžI¡3…›'¬Rú*q†^ £<6b8˜Íä”ÿBQÌÖ‡W–ps¿÷<âá©*VF köiG‚-bŽ–š¥Mxܘ3žY½:–ÏÝí LsѺ 5ÊgPÉQ™óÁ£Qãù Ÿ^©M=d>S°†<½\tF—Mê`ƒ™ÿƒ,ÉШüt5&O#ìI<͘O![¡ÂNÓöÔÀ¥ƒ¦Áý<ÜT&Ê—ÛÀ=Ê%ªýDm.Hmh§4“&•™L]ÃÃû[à± òrvëÇÁý âVã:Ð#sJÖ´qÙ LÊL òý½: ܇à¿<ŠûjÐ?Tþ/Ãÿ¹ñ<ªâ²Ò¹ušµ Ü©Ã= D3÷!ŽÝxR\¦°ƒ\.âZ SA7€^Ñ46Õaª¯¿ 7̯@fp£²Ôƒ¨>’üB¤QRþ °ü ÕÕÍ ªo”6)5¤“¡8Ô&Üw….𡙝A¾èTÅv0HÁ1›7Ñ™Â]LqF‡°òü›­¤äf«ß·DŠõV¥0:ÏpÂèDÓÈj1 1 ¶Ý;ïHîôW-Ÿ»Û%Ô .¹ðrtò @ +5¨¿½îáz¸yêø=^gз z/>Ä i¶ó‡¸®¡©iR/âû åéú#œ—¨Cךí C× l ïzŠf ¾Å‚hŠ×kL¦ùµ'ÀXoÀKGû{Ÿ–fHÉXÒ* *±­¤ QÇµ× äFðI Ž[mBýŸ)ìGÀå6%ü¤ü Dk±Tﮆ?3ÿEó0ˆ€‡þ„#\n½å±Ãê^Ò Šä«ÕEêÌhYé÷p¿€'ƒö©๠øGayrSA·Ãž:àö4÷cÃLOTûu¢ô ü˜ÅM'*Óï‰_ØHãЄr˜©/¢×€ÎâûÏG¦ú]ËÇ„Æ'­CÔ2ZÊ=xP¿®X±îXK¥ÏÓð"ЈåVÐHÐ Ñäh,d¦àiS‹—:™ß EHGéÃMK©Ï¤¹ÓÈl»@ƒ@!=J«DF¹Ó¨€ ɘ1¤4“Òr6èMm“i~ƒp‹(<å•:‘{@4²|¤˜Þ° IîÖ#E0Ägw<Æõ urd*‘ûE!¶Ÿ(+A¤œ™ý¿H±#ühŠfŽ~ ìlxÞz¤Ó¸!>êø/Ñh°'è m’S0‚³Ñ€ßD³@ïhFä"<¿ðH(õÊã û¡¼ ݂ŀ¼˜©ç†Ñ„>Ò8„›3õ2Ô6¤‚ê@ôŸ}ƒ4oÇSׄF7"3*Üx¨{Ï9ª|qkûEàç(ú¿QÙ'i üùXî² ¤IÓËËAÔ“½)†o2?âŦøƒÖ"A¥ä¡ch:•ÌÕ ß_Äó_Ž{ÄOëûAsáÿˆâo6Mä…¦òï}ºážÇ“:ý·AgÂ_QRàdJþ(M?ƒ°zøygl‚uV]^O è䉂ä"nPF]“²Cf ò`öÿjѸá`Ìå#NR,nKÊï½45ôHÏÂ@ÿ)•4’´Â(ù(ò0p󉮉á#†CóAe¢YªÏFõÇ“ ; 3ô1H½€´»à©k £‘‡I ¶¸pzŸÅŸ}–[ÔâáhQPñidI£Î?däMðKA3 :Ø@&ì Ú¯E:Ô›1‰:BÁ£x¨1¿¢Ñb ó©Çó¤=J-÷õpSóÈŽFÒ Që)П 7O2¦Ò„|gÈR¾>G\—îÝ ¢õçZŠHe”üÝ‹pýU|1„›þ¿5ߌé”AŽp"s]ÃÃç÷¸Ž€>ôáFȼÓ Z† ³ d ;·4~ÿB<(o¤¼¼ú;HmLㆼ$Q@ÄIwRШžfÈøàÝÀrÿÎÄo%ÈåÈ“Ž’ÿ›?ªÇF&$Üt"iJøHâД|­À°;ˆfŠHöWÖƒì š-ò3á„ñ‹DÈ  [n–¼Ôš²rgô#p1²H·ÂÑHÔÏ€O5®ToïôˆéP'{H-Ä‹7Ï`f6ä:*B°_ {è!ÄW…'-_¡´ˆe+:)?Ô,ÁƒFq4â] ZW¦Mkÿ÷oAù„Û&McSžß‚üYxšJr4e{ˆ”ºù ÐC »@4«0 ~nƒthãP2è¿ð£5jÊßp¯Qy)á˜_!P ˆ6ŽS"€ýBØ'ƒhg¼z6B û‰¸EÐhD@¸Óò •aÈ,võšù°ÑlÊä3ÏË…nS¸!/ƒ NkÂô(†”^2«~¿”×DÐÝgM…ý~”»^yìMy|€À¤$’rB{%Ü£T<χ›ê¹bBÁM‘ÍD<ƒ=q)¼€ï‰’˜æIš’%[†õÏ‚þ¬¢~P½¡ºMÊÀ _ó 'Œ&  Så´ŒŒŽ"ÔHÈI=»ç5*ÆÊ<ð¸­û#‰-êÃW â„?P=ˆFŒÔáÑ.iŸ: ÞO ªcî£SZÅ êœI.Yá)Oð^ôø}§C᫟àßâ‘!íF޽ Ú ¢Ídî|ÁNšýç J‹^ö- ó@4íL<÷Y_’‡‰½¢=1ˆ–ƒNWŧ¤û€Âó„½Ï#O¸ôM2@Ÿ‚j@Jzê'åw’ìУ ê˜9êð|Ž*òÚ'䨓¥pýuüH± Î˜f5²A¯ƒþ:[- ·RþûÕü@v„¡N‘Ò­õÕ%R,7€hsf"ÅcúÿR§‰p+AÞ3ü?S¸!üe ÊÏ_@O‚öž)ç䯀2©¼vê<ˆGõ™êíµ·[ÆS&ªMyW¨ž| r‚·­ Êã¿A”öiÜ {9ˆâ¡°?€’@¦Ã«±õ”/b8˜Íä”ÿÂ} P'Oºõá¨ízDþTïèý£Y¤4%Ø×ƒwÛ€gÐ0JX³O¥B!nk Îõ§çæ®5Š}ôÈAÚ´e÷#ÎçD3µPGô2èAÐó jKðê.iA¾?üEÐ^ÈÐËmh kƒç`ЈV ñ–&üG! R\¨ã!ÓDMhè*e¤ÚkN€c ˆÖ2Oz="`AÔTv SÙIjƒ|„òuE&I¡Š<“R¡kÌàæ‘¡ºD†ê u”†ò ð:Ù°ëŠa*¤EŠ@m­ƒ›f+ˆ·îZLÿ_HäNP¨ñóKþAqóȘ.?äiäO#rË Ò¢Ù"·Û/Ÿà™Â rÇ”xÔO³áÕaÈŽpÅ!Ü|xò´> þRÈ™6á„1мE€n];m=qbÇ&£Ìq>G€#`9´¾ßDwŒ‡ç‡h`Ü#H¸©}8ôˆ¦•¹Q!|Nƒó%ÐnÐ!Íy÷.ÀÎM;B 5Ö‡fPŒ“èÞ£ów?þXæž2jGõ„µm!@ëã´&JÏÖhhÝ‘ÖqzD3¢ •©;è[]'»On| ¥ZÇ&CSØW§·‹ÿ´GZ]}0î#ö÷Q;¢oºtIl–)+ýÔ9—#ÐtÐ࿆XˆZ¥Aþi:šŽô=„çxPmB¤= ûàM#[nt6«€ÛÙðêZ7M?sÓNhõ¡ãÚÐ)1Aw£”qîÃàX/š‰£%nB@¸Ñ n8nZ[} ÝÈ-fbâc[lwo‹š'Ìàp8(@ E€¸¸Øš(À€g#Ààp8íË—ËIkŒºFpù]3ª+Ç™ŽG€#ÀàDËl’1Tb!ŒlÑylŽG€#Àh¿X®¸\ú @bbü‰„„„âö =/9G€#ÀàpZfPœuzÅëÞ½ËöŠŠX®èÃyŽG€#À°ËIt7úuëÖù»Å‹ÓuŸÜp8ŽG€#ÐÌX®$Úe6›è§ôêÑ9¯™ËÊ“ãp8ŽGÀƒ€õ @wñXRRjÄ;vLÜ0dXï¯ÕØ A1ØvƒjpÔzÐN‚6p\WÀ p €G@ †ÁK0Þi‚ð¢Aª¤™BÖZyCAP8ÅC‰’@ùÐ&¨*ƒª¡CP=ô#tº]ƒú Ð 4ý}„˜Óa ض€Ù°;GÂËàDxœÀÛáJ¸>·Âáð,…_“@ÈÑFXñDBX$!k‘"¤©Eš¤¹H‘q䇡a˜Æã‡YŒábVaÖbJ0Õ˜c˜VLæ6f3ù‚¥bÕ±¦X'¬?v 6›-ÄV``[°—±Øaì;ÇÀâp~¸\2n5®·׌»€ëà á&ñx¼*Þï‚Ásðb|!¾ ߯¿' Zk‚!– $l$Tçý„Â4Q¨Ot"†yÄ\b)±ŽØA¼I&N“I†$R$)™´TIj"]&=&½!“É:dGrY@^O®$Ÿ _%’?P”(&OJEBÙN9J¹@y@yC¥R ¨nÔXª˜ºZO½D}J}/G“3—ó—ãÉ­“«‘k•ë—{%O”×—w—_.Ÿ'_!Jþ¦ü¸QÁ@ÁS£°V¡Fá´Â=…IEš¢•bˆbšb‰bƒâ5ÅQ%¼’’·O©@é°Ò%¥!BÓ¥yÒ¸´M´:ÚeÚ0G7¤ûÓ“éÅôè½ô e%e[å(ååå³ÊRÂ0`ø3R¥Œ“Œ»Œó4æ¹ÏãÏÛ6¯i^ÿ¼)•ù*n*|•"•f••ªLUoÕÕªmªOÔ0j&jajÙjûÕ.«Ï§ÏwžÏ_4ÿäü‡ê°º‰z¸újõÃê=ꓚ¾U—4Æ5šnšÉšåšç4Ç´hZ µZåZçµ^0•™îÌTf%³‹9¡­®í§-Ñ>¤Ý«=­c¨³Xg£N³Î]’.[7A·\·SwBOK/X/_¯Qï¡>QŸ­Ÿ¤¿G¿[ÊÀÐ Ú`‹A›Á¨¡Š¡¿aža£ác#ª‘«Ñ*£Z£;Æ8c¶qŠñ>ã[&°‰I’IÉMSØÔÞT`ºÏ´Ï kæh&4«5»Ç¢°ÜYY¬FÖ 9Ã<È|£y›ù+ =‹X‹Ý_,í,S-ë,Y)YXm´ê°úÃÚÄšk]c}džjãc³Î¦Ýæµ­©-ßv¿í};š]°Ý»N»Ïöö"û&û1=‡x‡½÷Øtv(»„}Õëèá¸ÎñŒã'{'±ÓI§ßYÎ)ΠΣ ðÔ-rÑqá¸r‘.d.Œ_xp¡ÔUÛ•ãZëúÌM×çvÄmÄÝØ=Ùý¸û+K‘G‹Ç”§“çÏ ^ˆ—¯W‘W¯·’÷bïjï§>:>‰>>¾v¾«}/øaýývúÝó×ðçú×ûO8¬ è ¤FV> 2 uÃÁÁ»‚/Ò_$\ÔBüCv…< 5 ]ús.,4¬&ìy¸Ux~xw-bEDCÄ»HÈÒÈG‹KwFÉGÅEÕGME{E—EK—X,Y³äFŒZŒ ¦={$vr©÷ÒÝK‡ãìâ ãî.3\–³ìÚrµå©ËÏ®_ÁYq*ßÿ‰©åL®ô_¹wåד»‡û’çÆ+çñ]øeü‘—„²„ÑD—Ä]‰cI®IIãOAµàu²_òä©””£)3©Ñ©Íi„´ø´ÓB%aа+]3='½/Ã4£0CºÊiÕîU¢@Ñ‘L(sYf»˜ŽþLõHŒ$›%ƒY ³j²ÞgGeŸÊQÌæôäšänËÉóÉû~5f5wug¾vþ†üÁ5îk­…Ö®\Û¹Nw]Áºáõ¾ëm mHÙðËFËeßnŠÞÔQ Q°¾`h³ïæÆB¹BQá½-Î[lÅllíÝf³­jÛ—"^ÑõbËâŠâO%Ü’ëßY}WùÝÌö„í½¥ö¥ûwàvwÜÝéºóX™bY^ÙЮà]­åÌò¢ò·»Wì¾Va[q`id´2¨²½J¯jGÕ§ê¤êšæ½ê{·íÚÇÛ׿ßmÓÅ>¼È÷Pk­AmÅaÜá¬ÃÏë¢êº¿g_DíHñ‘ÏG…G¥ÇÂuÕ;Ô×7¨7”6’ƱãqÇoýàõC{«éP3£¹ø8!9ñâÇøïž <ÙyŠ}ªé'ýŸö¶ÐZŠZ¡ÖÜÖ‰¶¤6i{L{ßé€ÓÎ-?›ÿ|ôŒö™š³ÊgKϑΜ›9Ÿw~òBÆ…ñ‹‰‡:Wt>º´äÒ®°®ÞË—¯^ñ¹r©Û½ûüU—«g®9];}}½í†ýÖ»ž–_ì~iéµïm½ép³ý–ã­Ž¾}çú]û/Þöº}åŽÿ‹úî.¾{ÿ^Ü=é}ÞýÑ©^?Ìz8ýhýcìã¢' O*žª?­ýÕø×f©½ôì ×`ϳˆg†¸C/ÿ•ù¯OÃÏ©Ï+F´FêG­GÏŒùŒÝz±ôÅðËŒ—Óã…¿)þ¶÷•Ñ«Ÿ~wû½gbÉÄðkÑë™?JÞ¨¾9úÖömçdèäÓwi獵ŠÞ«¾?öý¡ûcôÇ‘éìOøO•Ÿ?w| üòx&mfæß÷„óû2:Y~ pHYs  šœ¦iTXtXML:com.adobe.xmp 2014-01-26T18:01:77 Pixelmator 3.1 1 5 1 72 72 82 1 32 ¼—È‘IDATX ÝÙY¨_p‡czÍó˜1³DBE¹’„¢…D”\H™§ Š’¡ %S\HnŒ"Ûم1ó<Ïïçw¶÷ù?ßïüÎóóþßú³/žÖ³žµ¿k}×Ú{íý;'ïÇ%J”øôéÓû÷ï¿|ùBþÃÆ·oß¾~ýZ¶lÙ’%Kþ«` ˜‡öëׯŸ>}Z©R¥R¥J…,ü1Ìóòò¾ÿŽT öêÕ« *Ô©S'Oo߾ݰaCùHÎÜ?!A¹†¡ì>¬X±bþ›7oªV­Z¦LYINû7µÌÏÏWíä[ú}«*Íñ)m2‹¦Äí“ØDÓ1ãP‘Y3Ð ‚‘™REr±BBã$fIlâñ$±O· Ï0~ÖÙKú—SÕœ‹e®ÚŸ?Öüô†ßºü\äÙ9ûªè+W®¼~ýz—.]&L˜P¹r團Ç;HÜ]\N¾Ê ™øksyù‹v=@yçÍ›÷öíÛaÆmÞ¼Ùë¬Y³´CV¤ÜvŠJ½###+7ˆxF2ÚRòþñãG~Ë—/_èS±¯æOÚÙ­Ñ~þüù¥K—–-[ÖµkWþ6nÜ#|ÿþýcÇŽ9 ûôé#¹`dï´œ}:‚عsg­ZµÖ¯_çÎQ£F]¼x±[·nïö ‹¼õíÛ×ÜŠ$ügϞݸqÃ>ÂGý«U«‡„¾{÷Î^° Î;W»vmPa!ø5Á8·‘<Î3’Ã×mRÑ·tA7nÔ¨ÑÝ»w[¶l‰ªÒ…âø$ý"“°K¡Å"p‚ ëÕ«ÿêv gÿþý«W¯îÕŠàH‚úõëpÇŽk×®0`ýöíÛ§N*) áŒðŒ3.\¸Ð Aƒ¥K—JY’ý’¨Ú!JGDqàV aøðá§NòT%‘uìØ‘YœU\åÉ“'åËDe„fá4kÖLÐsç΅ЪU«Ö­[_¾|ùÚµk³gÏö›¡C‡!­GŽ AÙCZ¡ñµpáÂÇ×­[W‹mÚ´©@Ž;Í(ÿE;`e4¢Ìˆ%n~Ĉ\Ö¨QcüøñBeQ ªºuëV "à¿`ÁTí”—/_¶oß^U«W¯îçàØ±c¯^½º{÷n´¹6¬õ8p _RÁªÖÒ,u^¼xq§N¬vú,Dà×?ig1 v… ÌÇÐPöÓ§Oø¶µ2.0sÃtÆÝ»w¯_¿~x• ¥FÞ–Ø»woœ…^³fÍ=z\¹r…7€•”1cÆ03LçñÞ½{·nݲú¤Æù8‡h‹z¦â(Ø€¿Rmžì(^_¼xqèСûž={ÚW8å’OÛÁ^ˆl$¯ýÀMWó*,OÛ˜ Á PÊ©é,çðyÁ8Ï„!+"BÎ(HYÐç\mÝûüùó£GvÛHB™¢ :´¨]̯j"ô(>Ÿ¼ÊK°ª=±b@f¯øöE˜Î }ˆ›ÆÐ´.6l8{ö¬Ý¡æ Bš2r¦4+|JÑ/‘*ãþä5 '0†4.':³f+j?™t„889býû÷?zô¨U£™;ÿŽ?®Mª$}àF8œ&ÎB!ý»`høvJDÆé´€´Ú&¸¨=yò7·÷t2ýÓÐcÔ<;gάÿPê(ô–‰ƒ>sæÌ¾}ûV­ZµfÍ;Y.† 2hÐ nn„o:%(CH½zõr;Ü»wïºu뤬E‹ûKð¹N´·C’tKå4iŽnÎ80œ+\z‚iTFjÜp¬‘6mÚ ·'«˜LK;qâ„?w1ÖùÚèa‹Mh„ŒyÔüo”²ãÕIÞ¹sgÆðr?R´vò=zÄ(ûåFX®P#GŽ\²d‰:oÛ¶mË–-~X‡qÐ,2Kç-4ŒÈ}4%2ˆ4Љ’WÑ#è£á«æ›ŒË©-MãSXéàa–§O¦àRüÞf ÚÒµgÏ?pà€‹OòZ”§(ëèØ‘û¸l‚ƒ&(É,ñöáÕ§;Ê”uÁ=ÚÒ^éÃôB³Â§ ,þ¯+© ìÌ™3]­(¹Ÿ6mZД §?Ã×ôgÜ2þ•^Š=ã°‘A˜½rÒÄS‹œ'‹Ü3Ž—åÉœp+´÷œ+Ù{X|îÿU%wa·Zäa¢NŽ3h?6ÔÙµÁªË’£äAüï–!°ä8‘}¢NáÚ†×\Ó!ü½B®a°({j{GiHV®ö as5Ë5 öFгnÅQ&’øÎÉ8 à¯Ùäã@»J•*)ÉeÓ¾®ø¿Áo1 Y‡®ø¥h‹ØÏÝÐÒÿ!½êoObXþ(àGù?^/µR¸ÖIEND®B`‚BayesFactor/vignettes/extra/socialmedia/0000755000176200001440000000000012452540640020063 5ustar liggesusersBayesFactor/vignettes/extra/socialmedia/png/0000755000176200001440000000000012452540640020647 5ustar liggesusersBayesFactor/vignettes/extra/socialmedia/png/48x48/0000755000176200001440000000000012452540640021446 5ustar liggesusersBayesFactor/vignettes/extra/socialmedia/png/48x48/myspace.png0000755000176200001440000000104012452540640023613 0ustar liggesusers‰PNG  IHDR00Wù‡çIDATxœí˜ËŽ‚0F¿ßLT.5^Å5¯â»ø4îõ]|*k—!”ÅÌÂt¢ —‘Ú“~iKàÛÒ¦´\.¿ñÆiéÐ# ;F@wŒ€îÝ1ºctÇèÎGYãl6Cu«ÕJ*Ð|>(‡aˆõz]xidá`»ÝÖD«— p< Ûk !ÕÉW‚Óé”ÛV{(• Iò%„&±* "\.œÏç‡6á¯Ðn»}Ä¿BD ¢?B„Û?³ÛÉ•àð¼'®×+¢( ÀáùÏ~¿£,{×<¿NÓq—¯yY,/¬Jž—Ó4}Ÿ•8 ϯßB ¾R C%€eÙl6…ð@U§Ó‡Ãqß |ÞÞ=ìVMeÆjE]á=e°9åÊ!4NÁk$ü¿ç€?õÁk<ðÄ$ö}®ë6 žèÉ…ìW¢!ðµ>£“É.sÔÜJŒÇc8Ž£¾VÜK¸Ž«ÜzŸÇÑßj‰o%<ï&¡xѱÊh4‚íØÊá…æ@6Ãá¶m+…^|°5 `Ù–2ø—öO¿ßG·ÛU/E€KXÖó=ñ,< ñl´×ë¡ÓéH…—Öy2à§ÓŒ1´Ûm)ððMm`éàbmµIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/deviantart.png0000755000176200001440000000307612452540640024326 0ustar liggesusers‰PNG  IHDR00Wù‡IDATxœí˜kl[åÇíØu“ø’ÄNB’:J+¢#lE´J© ›&1mBâ+¾Nš6i¶IÓ>Lcª´ií&!6‰M+¢¥*mYiU%äâØI´i|‹ã[âË9ûàÄĵŸÚ)ÿ/–ÏyÞçüþç}ßç}Ï+?üFãK,Ãf|^mØlmØlmØlmØlmØl™êˆ‘;Ì.º-.ºÌt›]8L­dµ¿ž›D!};8kóÕ ØaéæE÷×ÍÒĽ+œR/a4×MsËTwM/_a!®zooÿ,û Ùü¦Wº^ݹÔ(ÏXT66yù™W‚4;Zi·81K1¥Å`Æi²•Ågµ‹¹¥Òÿ…l€`v‘X^!žWˆç7d@ô|Â+ÏÒnqÜPò›QF]a~%ÄÕ•ÞÌe"¹ø†ñºz ÏÒ‰Áx{ –Õ`aÈÚǵ}Žû‰dcŒgfIM¡ä“ñö@G“ƒŽa†¬}º¢é‹é8ÁdâCzm݈Á@«¹§Õ~ã΀«ËA>J\Ÿ™+]«Ú‚ð Û}µø ƃo<ýõ N“—ÜGp›Ûj6Êr ƪ÷\Íí÷ÂãìÅÝÒQ5ÆãìåôÜùâŸâ#Ë0ññÑ•óäÕƒŽEsuä±ÞñÙ:àjròíΧ°™Zª/¦ãüìÄQþrñš w¹†¸Û}ÿUS«›ÜÞÆ£{KðRì D _æ?3'ùå…?^Šõd€bÍ~Öuf£µjÐJ>Ë›§/àÜìE‚‰ê À3wb!ætà|͘CCû°o³•Á¯ÿ])d‰Lê2`x²m_Å¢³^¾ðw®*A4TŽyOðÝû_¨Ûkïæ«=÷rlê†{÷`1™+b,F3Ïï>Âo/½…µÉB¿£G/ýö^<ö^,ÆÊ6µ$ ¾«}Ë}¸f@8åïýUS‘Õ‰gß?ø:5Æy4ãG'Á£{yz÷ã5s‡RQÜÍíºa«Éðˆãk|à?S ¢òï‰÷k¶ißîdÿƒœ œciY©w³ð¡L”ç?æwocê2W‹kú4è-ƒ_›|æG9’|¬f/ô0ÿœ:ÎcƒÑÓª])h|ñÓK³LĦYÈD(UU‘¼Ô3°’ÏVÀ´õ±Ûµ“ýìlØäaÏ0Î}Ì߯ßåµá—7Œ½– 1õãWfñÇg)PX]è¤&Èn÷ìl¤Ù\½ÔVmo4sxh?oý‹Ñð$÷¸v•î%²I¦bÆ¢^üñY’¹tÙê¬^DMÓnéñºªiüô̯PçvÆ0ñJGWáä:hýð·Ö@$½ÈhØËù…æ“ ¬I îsÂë™Ä7¢d6…/`,<Ådt%›([a¿hx]Uh#©šŠ7:ƒ?`<âcN™¯¹=¸ð ó‹l½B©#Á |‹¼‹3äÕ|ÕÙí€=’ÙÞÈ4Ÿ†¼x£3Ä—•Ф›¦d>M‹i{ 8¯ðEgðF¦ MqEY¨€ix0}’c—q# “x#ÓLE/“WsŸ%l`xD0Q.qìÚ ”` ´ë68|©ŒÚ»ˆÈª‰/¼ÈºIlë*Z)¡x)¸Ñááº*dër Jx ´Æ‡Gª,d­!^*ëF„/Be&ÜvH†•††G¤öñz«Ë^4ÒÀðB½PKGñ¤"I4$<èØJ´tØ’ÑDÃÁ#ðAè&jÒ~;IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/linkedin.png0000755000176200001440000000164012452540640023755 0ustar liggesusers‰PNG  IHDR00Wù‡gIDATxœí™KhAÆ¿¦ÓÆVJúH[ÛRADâE<õ /Þô ·ž •›¸:z7}åðj»›qotd˜žÏç0'ÃS…Ü:ïeZÎãlÅ´'…\æOʵ`„€CÍì›ìoG[2Œ\Æ<—8D€˜kÃ;x8Äý·«X ›¸Ôç‚ ššàZ•¢0H`öÝ>‡vð=žÆƒù æÖŒÛΠÛAŠnšàV,)ôük´lßx±7œßílý7? #—)/l.5ÀšB‚¸§ÙôÉ8=”(sSñMä²¥&êÚFµð,‘ÓÎMÿJLÔµêU.üò¹»ÛQäe|ۨŷÉT;xet"†|6˱2¼}}xÓ©·›ŒsªÍiÔd²%xåžâÚšâ•B`Š‚.|•uCòý\ЏÏ¼Õ.¤†qˆ€žF o± ©á¹°Ò…ôà-Õž¸°Ô… ÏX7:ðœS¨Ê.Är<@¬òÅø5ÀúŒá6€¯¸† <`¡ uœm8xË)Ôyb¢¡à«ªÎáÓ _u:6x²!àvb·oÜvøªR¨ÄÄÀ˜­ð\s}#¶Á×Eí½Ã¶Àÿfm÷Õž[¹z|u…'"ü&SÍâ](IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/youtube.png0000755000176200001440000000252712452540640023661 0ustar liggesusers‰PNG  IHDR00Wù‡IDATxœí™mlSUÇÏm×µe”vÝÆØ 0cŒA„(ÞÄ001Æ/ ¿šMH4‘„cÔ˜`Pˆ„7‘ÈcÄM àx‘ am×­-£·õC×ö¶½mwÛ» þ_zî=çžó{îóœç<7•ø†uqîa)£ P®î0ÚºoÀhë¾£­{ÞkÞžŠ x¡ ¦M·{‘4òûáçÓpè ¨QÝ!ù X±fÏ.´¡É톅‹éWc8íGt†ä¡§fåí:ûö[t¬xž?u¤î]?r˜SmËé|÷ruUÙ:‡zƒèÕ<ú8‰ʣƥË„ë?NÝ»qì( Ë–—«'«ËE8¥+Ø—cDþ* š'ŸÆæöüë<¡«WˆÝ ïÂìµuxž˜É­S'¹¶w7¡Ë]8›šil{oë~YµfîÚ˯«Û`ÆÎ=CZSDˆD£\ö1qlU*œJÊBbµÒ°d Ý?¡ûØQD„úE‹EáÂgŸþ÷¾·‘ÈÕ+\úüÓÄsÚ9²®‹®9øQ£\íK{Bß»½è„õó`±Ùè>~Œ›';°ØíÔÏ_@l`‹Í†kÊTâwî¤ADrŒ²‚‰ª\ëë'ž×Ÿ¯èd®qÔÍG,F …¨›÷,§3—ݶÖ#ð2øÜmUåzyÙ„¥ËRÀõ‹§Ó.œÕÎgL1iá¿p[•g€³©95©£¡1£Ïê“^\'lƒ >i~IY(cbKe%Ñ€ŸÞs¿#"Xl¶ÄXExœ®?2îx“j¡l–×6`±ÛùûýTTU1iýxfµ"€U“¬‘ /’÷£~ÍZxf¶Áe†GþƒûéÙ¹=žB!´{'½اÏÀæöŒj¦Ô€ŸàéSøöìÒ…¡€€X<ÎÙ›·ˆ¨jâa27d¡T™s1&7«ä»¯6švÁ= ˆðx‡ÕzWÂi+"LóVã,îî&xA†–F¦V{èìññØ·ß{fu[|r|gûJÓáÁ@UD˜R]|3ë½y0ÿÍ'û dб ëøí¿›@¢,8÷ê˨¡P^ø„æÃ %dŠ3jkrNà|1ŸÝo&|Ñ,TȈé5Þ¢ðZ? 6[¼bµ– o8„²ÐÂMÛ±€?Ö¬dêàÆ=ß¾*5¦eÓf*›œ8Î-_à~nî%K©¨­ãNw7ûèë8a¾ddKNÙa“Tec®ÖÙˆÅBMûZ*jëèÙ±Šñã©n_k†¡˜Ë›¤.¾™(èÄjÅb·#ƒjàЈÃiÞ´jTq8t¡µR}=©¶E3¾å›íég  &|Ä#a DñpŠG"©v×+/•ôæËÊBÙ²8œ©¶cÒä4´Æ¶ ©¶bÏôØÄ¯·ÑüÕ6¬^¯!xÓB(N{`òfÀ%5qӿĨHÕw 5Ø €wýë¨>±žCð`Ö&!ré"¡ó÷“ =@`ÿ÷‚oë—ÄÂ!ÆÌjE ðoÝb^ÂßCÑŸ>êM[Æ8‰‡Â‡Z±CÊârKƒ7#„ñ¸S‹…¡,xÁ¤zØãÖÀ•WÛ1) <ä7âð`ò_LŽs(¼i!¤Õ.׈Á›ve«Å5vDàaÿ¥œ4¶jØáM;‰ó©¹ªjXáøp AqçøIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/email.png0000755000176200001440000000200712452540640023245 0ustar liggesusers‰PNG  IHDR00Wù‡ÎIDATxœí™]sU€Ÿ÷ä´R i…V­í•·\X?@hmù!Î8ƒm…ñ_X+H/¼ðÒ´S1ãàǽS‘ˆ-`úEÊ´ìábÉ&!g7»›¦gú^%³›³Ï“óžó¾'3û‰á*i€FcO éØH:ö’Ž=¤Cû^95 /ÜE”€ØÚ€\ÖzÉn}‡1N³B‡1wrßðÇëõÀzøÛt¢Æ8æ¦p¸UX­¹Ç_àí¸Ÿ»’ˆD%|ßÙ "à˜ÿg­ê>¥é8y€ÂÜW»*Q ¯pŒaáßõ2fÐ@’Òy€¿f¾Ü ãl×À "ÂSÇ_t%ên£’Òô}ø,|?ÙT ãlSøár <”áK¯n/= W$¥96tþ¼Ö‰ xº /Èó5aÂ2Iiú‡3 0¿Ãõà=† øÒŒDªÄ’Ò |”A€ùk_ìˆD#ðBŒVBRš‘ ‚4œNaáÁy¼ÁRšsni+°Â‹4Ð̉(Îe…ˆQáËÕ𠸃*úG³ °p=œDx°ÃôÓ"Šþ‘ [Eòu$Jð[EúÎ\ Xá…˜k  Ê8äg¦Ø÷r‚Åö¾ycØw°‹»7®@„´³Á7œBÆ8ä¯Opb4ËñwMÜž­–¨J›¡K¼qæ"ÂÝ—CKØàcïB5ð#Ùç —âØð%áïÙ)Œq¬9/JóÚé Xü1œ„ >Vðƒ/?HñÖ°Ûþæ¦ü{¥é==Àb.¤Ä ð±R(¾RâÍ¡Œ÷Þo·¥é95 Ü˯ |ä _)Ñw6S¿Â*ÍÑÆAàþO_ûJØà#Í@øJ‰P÷)÷Ü!À |èm4|Ô¥é~o (Þ¬•°ÁCˆ0ÎvÓá=H¥ézw €âÍ«U6øº)dœmò3îñ®Ùð¨Ò¤Ç`åçiOÂ,|)Di~ Àê/®„ >xúý[„݇/…(Í¡wÎ#ÀÚ¯ÓVøàBÖÞˉÑÏ/…(Mçà8ºãu÷½íLô/åâò#––¹®,$^Y¯l²ª·9ï>')¿ÞÆo·±A?î½évXZ~Ü’ð"uzÒíˆ÷V·|èJ|ôp=é¶–ƒ¤þ ”âÈ!WàÁêfËÀ‡J¡%D„ÿÖ6[" ¼ÚyŠë›‰ÃÇ>‘uw »³-qøÈ)T]¯ìG–ן$ ¤;ö»Mׯ“DàxBGåÖWƼIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/app_store.png0000755000176200001440000000333112452540640024153 0ustar liggesusers‰PNG  IHDR00Wù‡ IDATxœí™ÛS[ׇ¿}¤£ ! (SƒM¨/ÄØMpÒÔÓÄ™ö%omŸúзþ/}ëSžš>õ6Í¥ž6‡±Úd(¶ðÄUH »@çI§!–à(žÎxÍ0šY{Ÿµ¾ŸöÚK{Äïÿ®ëü›ô¢Žk/¼h{)àEÛK/Úê&À.ïßO½2V7Šñ´Îk[äÔt½ÒÔ·„B_[¯´ÇÈn§ê’£®ËÆç›—O ¥æQ¶Í_‰º HmÁJ¤€l•¸q­‡µå‡¦‹¨{šY0Rœîó0Ðça}%€’5ODÝ,†!™)ðîx‹`}e%›1%~Ýè:<\x=v®üЇ‚ðêcSD˜.à§£ð‹·a §ä{h9ãÚ1~ɇÛe ²öU9žSôŸ€îvh°Ãëçà'çUÔ–Œ96Yâ‹!BY{†ªl9§id+Œþ Üg·æX[œ`fAP¼û]òâooŒÒÚ]„iFú¡ÑQîûèó%4-Khù!É CÆf–„àí1B‚Íðª²]s^S¸áÜ©rßÔ£(Áµ B4U!´üˆé…Rºþž&NÏ ;¥$D#ATµ6¦iO$U+póΊñíî”INS˜šž#/ìÎ{ër'’dÀ#Œy±È"Z "¬•~~õð“älnOCO‡ñ·×nÝ‘Êä8wº•÷¯÷ðáÇ æSÜý:ÌÏ®åÓéupáL+_ÎÆððÞ¸ïÀ\á8üõöÁWÀ㪠¿•Íñ§¿"¾±ÈØ`ùØf\áîƒ0N‡•ëWºvý?:o¨ü&°Iz+·Ç߆M–˜šKÚTÌ×ÜP [«MÀavëÞ*ÛJžá~ wcùاËäóðãË~Ü.y×ßík ÇßH¾÷g¢»þ¦F+[ÐuÁ­ÉÍŠ9óšJ2:¾€Íx–/¦Â¸]6®v•’Rôv5raÈ»ïÙ±‘6„LNÇPÔÒ^¸2ÒŠÃnáéÒó+Ú©är*©øúñ|tk‰|^çÆx6¹ôx>¯óÉÄ ‹àÆ'‘v6å^èsãm¶£h:÷¦K«à´[nà³{Q*½+BËi¤‘ç ˆp` ÌÇ ÌÇèó0ôý–²±;_‡‰Æ®ŒtàkwV€ÑsèäLU+­ÂÅ¡fVÂQ•é'åÉ£‰ÜnGBPÈk¤“FÌÃÞ®ÿ‹’MïþØX-¿ýÕ^½” ®ð»?<¢P ¬uŸ+öùbŒâœ·FÛ{µôEüû~”ÿL'*Î/?Šñ­²íðêêÄát•!¸zÞWðÉÄJÍðBî<ˆ‘ÞÊ ¨CÙªá…äó¹Ê¿Eó÷ ²¶4‹šÝ¢¹ÉÆø%Ùx`!É\0U3¼U+ðÁß–éõ;y¶’e[)T _Œ_Õ&öwŸÁîtqýêÉ}÷Ó‰Õ#Á&HeòÌ<Íà°[øå»~~óþ l²¨ ª0|v€áÖ2ßÝbIõÈð{ç¿÷z';íxš¬\tW5´Q‡²ö–LkL|6^ øæqébsq° Ù*=¾ê®Ãÿ™&¸j$ºyg UÓMG¦æÒ,¯G‰ôV¡*x!Äám´h¯1>¿šƒhtYßd#¦š_œo·Y8uÂÁÓe…\žçƒx~8å—ú» üc²•…%€5SáA j:`–³ýŒ »H¤óüùóøŽ˜ýðU•¥›Vxs›gO#Ûx¼]¦Âï»úª w£…îNgûᡊMÜ`‡|nÞ^ヿ<#•Q‰†ƒXeÍ-~Óáž,—ŽÕ>¯\žjV “…ÿ•ã‹©èn ˆm,"ËvÜ-{î¶&À !øl2Ž™ ZNÇa“* ªÜÄšºÍFh}FH-mÝä4…T"b üÞ ë° ú»ÌÎ+Ã×ÒFe›“6_’$íÂèºN|s«l§ÉÓa*<ÿc8 j¼È6'ÞŽ>ÄÎ ^ã]O"ºŠ,Ûq¹ÛLƒ?´ljÙûE8hmïE’¤²à‰è*VÙŽ«¹í;ƒ¯©„¾-¢¥½Ç(§€ºÉX«Õ†«ÉûÀSËanŸÙAK[wY2H%ÂX¬6šZëÇ|±e•íx¼'r*Ö!Œ`±Ê4ºZê äú¶ˆæÖ®}Ý)“Ü0VÂ婼‚ÿZ–!ng?IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/facebook.png0000755000176200001440000000115312452540640023730 0ustar liggesusers‰PNG  IHDR00Wù‡2IDATxœí—ÏOAÇ¿¯` bm$ ÅA¤RðÂ?Á¿à?A´'®þ^5ö/0¼i%@Œ)MùÕÒ"hª.ÐC=¬ÛVÜvwºoö-Ißi3óæíç;3ïÍ =S¯ã[HÀ«õH[O€´Ýxý~ý(|˜Ÿb†ìý’)µ¸¾X‰Ë3‘³o!ûãÓË®ckßB+qàɬ;x "w?ºŽ¯U@dМye#Âq.íÊU«€¹ ÷3ß0" B)¿áè®UÀø°ú žþ*/å3ýµ&±1Ô¾¯R½Ä«·{ØÎý4ZfžËf~—÷?!:±`Gë ܾվï]ºä Þê;9Ø´£U@_‡èï3'æ‡ x«ïÛáÖqdObx«ý´°óO9]À[ígÅ/0bº…·Ú¿5Gq>)Ÿ­zŸ=:Ç‹×9GøÖö@ÝF«çWJð„€ ¨ü®)ÁS(,¿.jPG`WÀ%<-*Õš<ˆxïBÉšwy"¼\K´õ}ºþY9a¯ÃkIâØã¥&H'c€×VFcŽx­906µèàá^´ qÀËV!x"ÁƒŒ^ö.Ä/º…8à…¯ÞáE·| ªxÙs€^6‰à•ÄÝÀË—Qðò™Gxóƒæº%SÀr–-aíÆk_#:­ Þ·ˆŒNi÷µ Ý»?Éï{ ‚™§ü™ã5DWO€3¿g/N,øR!NŽ_¡â*™|N|±mdö®éb_} Fç´ˆï§O’°éÿMu—Q‰#ôiðâ>Ž>üœÇ/— dÈñÉäUþ:v–‡I?.ƒ#ÒëäÃú[w`‹ó¾TˆcÏ3Ö€ƒ—E‡›wñ¦»€3›ó] G€Èmð‹¦ïÑ`tâ±6±/ÞÎÇ‘!Œ5VJ™®pba7›´ó“ãWtÁ¼»®ƒM½¸ v\;ï4öðnS߬çàrôýkšÿýu]˜ý”Hbeì¥C+•¦†èŸ¸ª {ÜÛçùÛ]שÁ}|,Œ`– üȽ“Äx%’\ž2ßåe P*/†Êùl6φnÎ/й»ËWñG…ÌÛË )”LláÄ.™ÄY£µG¢£ZÇIægëúx£~g¦nplì% @–GŸœæè“ÓÇ|oM;&©€0šžd<f›µUë{"^¾è§dy kmOuÓ\GÓp•À%o9;5ßçb#äȳÁÜ ]{œ , :rà3e­ÝÞ²"ðÁ!w7k 5$òi.>½BÐfnÖúI- Ð!à:^5 ÀVǺkÛ– ÿzM?píÐúøgè*‘|’×l6[ZPÔ,×–„zB(M–ß¡×ÕA’+‚7W9ìîá×ßGL—´{)§¢ƒ%™îêZ¡;ût˜™%áBß~àS1ÄNu=fa §¶;‰1>™œY‘z¬ü²yY5ÇÄS~ÙŠšA–dê v:¬-tÙ¾U˜œ¦m2åþSdɳßñ ß©þ6)5Éؗ%á…й¡ “ä´z›¢P2÷ÕwÈĈÜF8ܸ‹6k!v·T¿¤½—GEZdÆû:=ÁŸü§˜ÊÅØióð¶c&¡ûc× ç%ᡌ‰ì”4Œ7S˜æŒNÞiè¡Û¹ „`0vuU ÁGs Ž/ñþØqüÙ(;m~\ó*käBB{3ANľÔåmêëó6~›ßC.lõ&”0ýk|¤Ù\Ç&k3K#¦ZUL’¬š#–KñD p31ÊPê1‘|£$󖣓·|4ŸäþãL䢺à˰NqpDôá2Ì,ò"·¹»Å•ØÝEy!xÍæ¡»z£ó¡\œ'y™Ò/¨ìÓ¢%ªòù <Ö&íš |Ä­¤—ûi?ãJ`.Ž—lc­±– æÚÌÍl¶´Ì ®¯• >|J$Ÿ, ¾¢ЀCiöçÚÙ_×…QTö…RQ³ôÇ®óØ(äʆ‡ G hé`S áú^z›°J&]ï%ò —w9ý‘|RwÂ΃_Îh"Bq’dI¦³º•íÕëÙhY‹„ ÕTÀ#e’<*wÓ>n¤F¹™z<³õ\øÉy"„(T¨Õ†_ñ(šÁnéP|UáaF`F„(a}«ÊJàW%„戰™A2‘ĪÀ#ÿ©î°˜Ú•mÝIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/odnoklassniki.png0000755000176200001440000000301312452540640025024 0ustar liggesusers‰PNG  IHDR00Wù‡ÒIDATxœí™[lUÇgöÞn·]Úe¶ÐR®)W[/@!‚`DA"ááAã%‘'bBŒŠ‰0ò¦!!*"ˆF`€`%XŠ@D ¥´i^–mw[¶—ÝÎÎÎúÐ¥lw çéœoÿ3ç÷ßóíwÎÌŠøŽqà&Ýo½í¡ûݸßí7`6ônU@~9ä–€5¢a6@óih<}]†N) ÛŠ*`îKàw[I¬Ë¨ÙƒTØ)Á¨˜±ÊÖÝQfÊ ëé¶yqÖí6djý¿’Å)ÁßÜœ®Å—ÿŒî©Aï XCÂG:}´×þN$ØŒ=ÛKné“8ò 5ÏÂu\øì7Jscºô(ª‡[j¯­â¿}[ˆöÞ@ ÄšªwRüì[xËV&u&[®™Ë©ùó[fºÒFЗBEša8ÐÄ¥Þ×À ª¦~ïfzZ.kô¹3— +*ç›Ò¯Lú Œ*Ñ Ûj*Q•¨^ˆþ‘üg÷kôöÜBYQ¹Ðœž }LÍ0l¹-¼ wø4za² è OQ©KÄ>±¨fhÏÝ6¼@`uy4ú¸ª0 Cr,ÎÅÖî!è3ÐqE3ôÌZФ!áJH—Ðõ×w#º¦ýÌ/øŽí¼#¼ Äâ4¶‡o?¿>üþ–U·›ÖC[‰v‡ÕÅ"]´ÞFÓO¨w„Oô•˜ÊÕÀÐ&Œ;NuA ÎÒe¸§Î'Ã[‚d¶¡Æd"þBõ§Ö"ºžÒ7Ÿì't¬&AÁ(‡L–þC\Þdh>uû Ú @͵²¢j`@ "™,x[ƒkÚBúÚ¹~äsâ}½ÃÂ'ŒZÌù9ö$JzUhú*˜>p0óL#Z0Ó¹=H-§™]èâ|SW¿‰[à%³…¬¢Gð.ZGÆ@UÊÈ/E ß íèö; !ˆÅâ´vF;`"=ãæj†–¼bX²‘Xg’¿–™z®46 ÷`²Ø±¹Çá3 ç„9Ø=Ńnç(˜‘|¢Sáú>¼Ù¶4 ÔþDÜ[ŠLš°)§r ˜0/õÛužÝ›2|B‹Çñ‡ä4«PË•"‡ÚÒº<Ñbá­>¦ûbÕˆà}5×W…|r&ÒܵŒ*]‚Ù‘úC‰*÷ÒuùÇ¿FélM >Ù×[F¯#tÄ]d—”ãœ0 »§‹3k¶7©QºD»ÚWé½vžÞÆ¿QB¾§Íà¾Aû@SG¨/ 2á…wpÏX–ü¼§á4WÜŠœR©L^cvⷯˆ‚Â4ð™Åe®þÉd6^`à«Å|·É+Ö“;wÅŸ;KgÜÊH’Å0x!Œ|µ8ïM2§ ÿ®'kúb$‹ ß¾M0ð4¦Þ˜žx†€ïºTM\U4±ÌIó³ê]$«]7¼1)´`=L]>(ì?²æŸß£uÿG×Ö‰ÌI ³j’Ù¢ ^½Ê^†’§…ÛCðÔ÷Ý«ðWn¤q•“·üm]ðúShÆšA¡¶£_Ð~ìK H¨æþƒ›¯ÄÔźàõ§¬}ðöWm'pr×¥²»®’¶C[n1ׯ¿ U‚\ö ’ÙFû‰]tžÝ7lï©«%‚{Ñ«ÉLèä]ð`ÀNÜݧp-1|‡M ªÓff|®ã¾Àv”È´™(p;î9¼þ2z‹‰|·ýžÂ’B7· «‰±9¶{oX ÝjbL¶ížÀÃ]ú£Ûa5áuYï:¼ð?CXá•ÌÜcEIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/digg.png0000755000176200001440000000154712452540640023100 0ustar liggesusers‰PNG  IHDR00Wù‡.IDATxœí™MhAÇÿ/FD¡õ£1ÕÒJšcC­µ¢¨{ð"<¨´èED1 PA<ˆ'OÞ*(x¼ŠŒXÐcbý *(¥­_x©IðÅjÐÔCºÉìÎÌîÛ$f#ä›Ý—7¿7ï½™IB§îÍÏã?–Ïk€rUÀkÕðZõ¼V=¯UÀkùÝlö†‹ãxB~64 üú])â àün ÒÄ›3ž0¥âÂH.!¿ßdž€¯_±á 3ûÎ4öþP,‚“}&ù¡0tì—ÇŒOâþÅ=Vo²ųƒÃ/ò}ÂÝs½Žöƒ×'ó¾‰0r:*@ |K}BC0ÄÍ€‹UR¬¨¯\meò¶¤ò%¼ûžþÌ €˜YË–¨’ªÏ;Q>+m÷Žˆ—c[dMn©]QÕ|Ðd@€'NZxæ²9w~4%¤Ÿ—LYpÎ@Á oõ´=°Ð|Êw{Ny•×Ä̾(ÀëVTå×6àbI2®úúåÝ9»Ùƽl;ÞÁãá¸Ðçdâdoîò ƒPb¬°säæ|°ñâÊZ€g–Z&’Òj¾Lc.›Ã᫯‹5/Ô?aäL§täÆ{ÉÎØmnh³FP€W–P<|™|lÚÆDqLD8te¼ϋ «‚²Jg§9‰ExmÖtö!9õÄ^¡N·ÊI箢óáqL\5Ëbè¾utV°5«îBé•gÚàtš=>ÎЦÍÓ `f²„·ïà÷õ¡…BÅ "´?óƒÿŽÖW@Ê¥à]walé:¿>°žèÁ¡pyxÉ]Ìp˜Á'Ÿ¶Åv/˜çÂóØ?öoýÈ×ÛÆƒ6’‰TŸ÷KG¢Œö~o‹×~çmd°806V{Eð\sUaï ´k· ¾­{1¼÷6«?ýÕŸlâ¤åK§„Ï‹ oùÒ–ÃÙÒŠ÷ŒNÒ†ÎÁèô"*`.ïGqZpó'XãHˆ@Sk€eŸGñzÉ/yöé²ð‚  ‡À4my|=ÝãefŠ•Q±GÏÒâÀ0ëßgƒê¸óöÒ9ªZ^¬¬>©\ÜííÅ23 †bÑÚPæûw&FOk6¨–U«¦œW¾ bÒ  ëü…ŒaðW<6{’ d#0€â÷•ÌÑBá²ð¢ºP|~û$§³/¹¼šap8aQù0Œ¢˜Ü^˜Øm¦²Ø/» ~%ðŠKÅáqÛóhš ^r¾šar$¯^‘bVçÎEq*x²#¥7¡‘ÞïÊ ‚Óë)™“*Ï ÒL“`"Qcïï…ï®¶V| m}>²}»ÍßÌdHýýOYx|Ë—•äѧ„/üP–ÉÑd¢Š=Ð÷XÅãSÇÝwà ¦Gí5šø£SÓË‹@óE«í¢³Y²ÇŽ•…Ï—jÖ4+àÖMb›?.Œý==̽â¡ùœ³mþc;vN ï øñi_ØÛ ×ÝÊÁKîSÕQÂóÕ·$úû c-<:ãqãíZbó5âɲð‚pòÚ›`Òæ|þÅŒàE¤:.‡^~‘oz1¢QâƒïÂù8\.›¯’ë.SÁ{œÆœ57Øü}{уGg_õ ø,p½û!{y¢Pã¾®Å%~§¬½—¿©Þ¿¢‡E/l(ñ~åUÇŒàEdvõͪÊ"Mc0W³Î*ñqÏŸG÷K/0¼é#’ûöã>õT篢uÒS@p㋘±ÔŒá…¼•hVUºZZù3•À»¬¸-ÓÄH&qúý8ÛÚ˜wß=ÓÆ~ó-R»ûÆÁf/T¹JD¸T:ÚÛqŠÇLðƒ=Jü×ߦ«Œpä¹ç‰}»µbx‘¾jê¶wŸäÞ~Œx’¿7¾DËçÑvÝ5x:;q( F"Arß~â?í$µ§+™®¨l&Þk&@9{¥mœèAtûb?ïÂàp»1£Q¬ÌÌúütðPÃpLê@é É0-Œ±(æ4ǃJáEjønT™3§ð= ¡GÆlçùr³ÙÀÏê>0õn#ÿœP?øšu¡Û¶5¾¦%”·ÔÀÚÑá†À×e‚¯½‰Èä£@}àk¾£[¾${l¸aðPC–¦zçý\ðÆÀ×´„ä¡ÇÁ´ _ó6º´µ­¡ðuéB]-­ ƒ¯Û}`qsKCࡎ³. 4×¾.%4Ñ:üºÂ  íñ«‹ÅÞˆIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/sharethis.png0000755000176200001440000000236512452540640024157 0ustar liggesusers‰PNG  IHDR00Wù‡¼IDATxœí™KlEÇŸã×z½Žã4iB“”´…¦M«¢R%„¨€‡.½pC Nœ8ôÜↄ„"$T$-‡ŠGAUA%)¶@C•¶NÇqlÇ묱9¸IÝÆŽg›¬£Jý_,­f¾ùýwv¾of,/•¿+s˵ޫÕ]ë­»Ö[w ¬·îxîfÆÇú L7:&F‰s”ÿ˜£`;^S á0;Ѫ†Õñ°nv—"|\þ‹‹-i[1›ö …ññ";n‚¯VÈåãpyžtÞVܦ8H?:žÛ„ÝÏä7‘Of”ã6ÍÀ."Jí0zÈ\‰)›hŠA"„ð*µ »5ÁŒÆÉ§Ì†í]Ľb ƒŠo YœGD@„ìD¼!½n{G „ðòýì£ÛvßßÍ A„Љk Á Ôl¿¦<¸x‚^ЇÛýÓE‹Ï§Ï.ÁWŒÙɱ܄-a|¤Ÿm´Ò‰F’Hò ãlÆ`ˆ~"øëö?•¼Äc–åë!»çýèIÌRî&xæ§fÁch7õÕ#åÚx™Áºy|%¤¯ðIô4Ñ\’ˆWç…î½ èéôLæÓ\ÈÆŽ0»­ ¿¸&Aë ã Þ0¡d „—7ÙÛ0ߪKó3|=ÍÙ¹èDåwqt©zNCøÅ6ZG·^™i¥×9Ä[ð‰‚ÉðÄN$þ¾Î¹vð"‚5“Æ/àøÕ ì¤Mþ³‰_ù*ö'ùrÑx®Ç±fÒøQœ ·ÿÅäè¨Sð‹±s³µJœDmƒU,—Ø¿a{SàŸ+øƒ%nqñJߣ¼;ð<»MŽÃ#Š{¡ã\&[R?lÜ«µóÆÖ§9Òÿ$=¾°cðˆ¨×mƒW]»k¡•T*—ù>y‘áéR ó„܇:äá`a·F¼h2bNðuê<±¢iÞŽ€@ªÀ~«‹=¡zµ6Ʋqþ1§8?Ïc‘ûx¶c^Wí-„U*òczŒGŒÍ„Z–Wk«Tä©8Ÿ›V†·5KM§È\žª9@»WçP×C<Þv¿KJ.X¼>qŒL¹ ¯ºªåïh%¸ycÍÅ,]ý‰×þ=ÊosWm·ø ïR†‡Û<Ðø7´ì묛*£ùo_9Á[ãǹhÅmÅÞ£u)ãšFkšhoEïí\_=ȹùGÆñÞµ“Êq[]~eøU¨˜¡÷tÔ„¯N•§æÆI/XJ1S%K^¹­$_Ä@ïéh˜çϘQ¥x£Ö5exåBÖÐD›Aàž +©áÄ(ɳ0³åËÌeø5™&‚ºÛëVØt)ϱŸÉ”jï«2¥<ÎþB¶\P†ì×FʧÌÊñ¯Îö Í­ñTh;[½ºÔª ­BY… 5ËËŽK—bJ¼½t•?Ü;ÍØÊ$ž'3äV/À Ú Ê ®A±œµ\¼b¡¤iNY“åäâüeú,÷r3;Á¼Éj ÐNalYH*æ3Ž÷?t”Š–¦ÀZÏ}=ÏÛ™÷™{—Åhy'Ø(§PN6­ A3›qŒ^wD‘¡É ¡¬‰H™iNfNq~å<9Ÿ­¿ícÆ)ŒUh«Ñ‚P3› 8ûQH1¶49¡Q{Bã LDRÝáÝÜ·‹×(Q¬ŸãÚþÇrå„D¨IfŒÜLÅ–F¡ZH6y&ù‹…Ó¤ãI¥•1¢½Ç‘g¿[MjëVÐA¥¹‰¬×\c¬`,$BÍíÕfÞœé`uE±gô.©L>*«– fN!c¿#Š¢Oå©ÉÊ*D­…J9ŒÔÚ~ƒ7””o‘rŽüT–ì¯ÿIãsy&)"¼1¾Lb ¢#KLLLÐ×ׇÖú¡<5wⵑBÛJ²òàýÊRNFK×üßúý[tŒN19’$.”ÀC>wÞÅ,XtGÁGLNN>ÒU'ñ«7Î]ñÀ†^KÞ 9–ÎxùWoÑcå<”r½Š®ïîÇì6xƒ‰AÅDánî‡_`!ê"Н"‚ÖšžžžOôDõ} LP¾ÓÆ :Ø|Ç×ö4ZºSË ÿf„ý×ÒD6À#X£‰&²¤ÿ ÀçÊaPð1r¸ùö×(íí©tó­Áo|/NÓÑÑRª‚QR)“åDF<ÞXÚ“žÿÙ{t-',Êð"K1ôîÆ¼úrxÞ˜G‚? ~ãgsss´··W/À8Vº2 ‚eh›.rìõst_^"(Ÿ§ÇD BÓk/Áçà[¾fðÏ™ŸŸ¯A€Ñhõ ÷=†ÖT‘¡×/²çÒ >tDÑ*‘Šiyåæø>ⶆOª~í<¨!*?Ú Íé˜ç~2Fû…âÀRˆs4e/ /ö¡{Z¶ T-üÚ¾jªLCËLÄÁŸ~DÇ9 ¡¦y¨™¶áAì¡Öª€j…¯I€bÑ´¦`ÿn±ëB=ÐÈžoöÑ8Ø º: íÀ×$@DÓœRtÿø&­ÉËËðéÌÎÂׯMÝ´><4Ä_·n!¤&5†ÑÑòïÜ9Ì™º^½*›ò æSH”“¨÷Сák¨ëØ1¬ÉIôDÂÓø¾,b¨Ÿ?c†7ˆPùÎÔ±1÷×z±BÎ".,.²05EaiÉ[I"rã©xÜÕuþ,b!@&™$“Ln;é%ø±V"££ô$ì½t 9ÝGŠD_¹Ââ£Gü‰44¶/kÀÜv^^ù/_H¿~Í?w_¯çÈô‘–4­M\ÀWö±T•Ÿ<Á¨±ì=u U×YÎçÛcÀ-¼Ón©*+ÏŸWÅìGªë¬ì`Ÿ*äÞ9ª³³Uñº‡‡·úæ ƒÕBÁuJ¤x†°²Ùª˜B–’´ÕW3 RuL4n@×kš x†@ Æ¶Ã6 „moë«é&Ü¥P;yÒ3¼þ8q¢*¦þí[;yÓ$S,6a`~¾ªiß… ¢QOð]==ôŸ?_³0?_¿ ›&륒GÓÓUMr4ÊÁÉIºc1Wðro/C÷î!+JUÌÜÛ·5ácÁ0ø¾i¢ëáñã6Íb " okô÷Ÿ˜ËÂÈd°5­~ÎÇãì9{–ý·o©†÷Ž7oêÂ;ÿMÛÆ´m„ëyÿ>]?mü™Íò߃˜««¿„¯œi÷ÏT ëÙ3Ï;Ïz² ƒÔÓ§®àd…rSS˜ îWv„/X}ü˜âÇ®àxH¡ ­„Ãt_¼Hß™3žásÉ$ë/_º¾ó[íÍ~#[Ô4rŠÂžÓ§é=z”€¢ ÿbOo¬­a¦ÓäçæÐ¦§Ô|/ð49Ž–4L±X·v7RV=Á{ZÄ5´?! µ|z#Ø#€õÍ™h¼ðÓÀÞMßK¥¶Àûn`0FA¶Tj9¼Â¡ØÐõ–·d)¡’lèzËài¥€x0€Z1~·,…~6!(¿Ûú ßÒªT,Dæ˜ð ¾múº»‘(¿Ûúð?f['¦NrnIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/vimeo.png0000755000176200001440000000244012452540640023276 0ustar liggesusers‰PNG  IHDR00Wù‡çIDATxœí™Koe†ŸoâKìø–[›KÓ´i mJ¹H bÁ‚.ذE%$„TH ,P¥nú«v X JÐÐE•"Bš¸mÒ4‰›¦vìØ{ì±gXLìÖÇ3¶Ç*å]fæ|çyÇç»ZœžÑuž`I; Юv ì´v ì´v ì´v ì´žx®JrÁë}p<C^ãK® *ÃIˆíµ#Z] {áí½ð\ðÁ½ .¬ÀB®qìñ |0 ¾®úÏ•²Î¹h‰¸æ¶äh©„^Á—µð}nøpXER²¦±Çðј9<@w—àÍ€Œš—-Yš6prÀðšDFºÝ.Ü¥˜ÝÜö,ä‚÷GÁ%¬óL ôYY¤da¢)ï ec¥ƒ½=$oÍR̦kî¿5A›½nÀçFA&¶D)o^“¶ HÞ7úí%øR ×kL¼Ök/¾*!B½»DI©oÂÒ€KîDÉGƒ>„ µ8‡*&Tæ29µl“_T.È®-×5aiàÔ¼6®‹e»™¼eâÁÝnW"u;Š*gøô:œùýŸÿ6ÇF^mØFIÓ«ð@ ß[¥¤Ôæ·4p%éb™ÖRœþñ*ÿ<ÍìzºaŒ$ÃA¯ñ·Ê`sÉ0Ñäy6 e..ͱ&kà+íäîÇ(˜°4•á³é,g/ýGRQÑtóWÐ,¦ñˆ¿šÔ`óÎMÔ\–¾§ž%ž/5ŒŸÝÈoƒ¯ÊÇ×({<Á0½‡ŸAHÁíTŽéXªaÌXØ__H/ßBÍeyúÀXÃøË«éºðF›‚|âå‚bõÂôNCê2f ?——À¡^ÿ6x¶ É«‹¼2ÿg9n$SøÊ‡Éo¬77xa"S©‹éXªaŒøë !xe4L¿Ç|6û>𰄝Üoz&öBD&Ž’SuæãæK†×Åž€w¼$I¼{Ô|6¼Ë0—TlÁ‹V TM:¿뙆ïM kà‚“ýŒ¼ußWJßÌÇm÷ô Täî ±(E ÔÀïù85eþõ¿‹&H(eÛð‚6 ,㧨™÷ƒû"½.‚=~/g^ÇÓU?e4©ðëͦࢽ ªÁE0é¯ÿ¼Û%ñÅ˘Kä89чß] ]Òt.̬£Ñ|ÛædL €±,žèiØÆù™uVdµiø–;ñún>ÙÒ/‹).Dz-Á·Õ‰+ZR ¨µ{í~Žoó›„N%T æåæ·Õ1¹ÈW×î¡Ñ:¼#%0¶±G|H+Ù"çþŽ‘+ëmÁÓî0ZÑÕ´q’`GË>UÔÚ†w¤€QF—Öï]»Ÿãì_«¤Ugà…ÃhEã‚I¯Ê‘ðö³M‡ŸnmðÃÍd[öQxGæŠJ:|½êâ“rž£}¾êý…ÍçgÖYʇB´~2g&]ÓH/ßZˆÀCw…$›Iê8¼c¸®‰}°µí¼c虉àÈcÝ!xÇ&²F&Cû·L8ß±zÔDÏÞ}µåä<<¦h £Õc§à;^B5&„„p!$ÇàK =jÂ70T;ĶÿØ T’ûúö}¢Mx€ÿŽ&’,™B ÆIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/wordpress.png0000755000176200001440000000425712452540640024217 0ustar liggesusers‰PNG  IHDR00Wù‡vIDATxœí™ÛSG‡¿ÖŒ@`$d°dK (_œxƒ“l—«’§Tÿþœ‡dSyp\‹óâ²Ë‹ {ã›èf‰‹$Ð] Í%ã3a][•~‘4}¦çûõ9}NOKüòË/:ÿÇÍñ¡Þ·ý-àC·¿|èö·€ÝäÃH’$†‡‡ñù|x<dYæØ±c4 E¡Z­²²²B¡P@UÕCyî{ èëëcbb‚3gÎ Iår™••Z­ªª2<»?ÿü3år™F½a…Q2™dddÄfW.—9~ü8ŸÍ|Æìì,BÞʶg9NNŸ>Íòò2Š¢Øú†††(‹!Ð4 MÕXY]áÑ£G;Æñx‹‹‹¶¾ÉÉIË3¦k8VWWY__ßaûÊÐXºN§ÓáÞ½{6;EUˆÇãȲÌèè(¨ÕjoM¯] Ðul6Ë“'Ol}.—‹±±1+σQu%‡Ä³§Ïl¶~¿Ÿ÷€µ¨ÁÈN‰D‚J¥bÙÕëu2™ š¦ -Û·‰ØS€Çã¡\.³¹¹ÉÒÒÍfÓÖ?91iÁ›©RÓ4≸U‘;ññq ȼ¦i‹ ¯=»¶¶†ª¨”J%¼^¯egŠ{óù{ èëë£T*ápÕóùóç¶þh,jͪ°”@µZ%—ËÙl'&&lðæ=k…5Àð^>—·îw»Ý¼iÿ¦ˆ®ñÖÖB$IâéÓ§¶~—ËE8¶Á›`ù\Þfëóù,(K°€v» @>Ÿ§Ñl „ ÝnÓÓÓcƒ7¿7 «ØuUÈÌ}Ž‚B¡@©T²õOÄ&vÀ‚›Ýö0Ú¾nÌ4¹¸¸hÝ Þül6š´Z­½t:\.`¸X vx!2y]u_Q¹=nü~ÿ±ããã6x!¾S>t]'™LZ×z{{i·Û» zuWZ­ƒƒƒÆttâqûµe#a€nllìH“f6Úã?í'›ÍZ¡ ÆÆÑÜNìozfOÕj¯×‹Sv‚0¼P«ÕȽ|Ë}5x,#“J¥vl懑÷¤—ÁÁA,P§Ó‰×ëeccãðÐÅ( !ˆŒG^φÏžÙó|(Bv9ǃÏç#‘HXŸf‹F£L4EQ2™Œ5~ @A>Ÿ'|WVWWQU•³gÏÚb<žˆÛ¶.—Ë*<‘H„B¡@µZEAüEÜ6æÈȈUÔFGGÉd2t: n||UUÉf³ï„ï*„:ËËË„Ãa†O¿ºEaaaÁfkn¢Ñ¨A¡X \.Ûlc± YÙGÁ‰'…B¤R)c¿¾+€úå?¿´¥ÊçÏìE- 188ˆÏç3lË6ñ¸Ý ‘H„±±1Úí6¹\΂›™™àñãÇ{ÂC—u V«‘L& ‡Ã\¸pÁ £ìˬ­*öôôðõ×_³²²B£Þ°¥ÊDJø#`ŠB¼žßãž#Æ¡G/„à/!¬­ÿ}|IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/reddit.png0000755000176200001440000000425112452540640023434 0ustar liggesusers‰PNG  IHDR00Wù‡pIDATxœí˜Ùo\WÇ?¿;û>Ç;^jg“•¦Ð–ÒTF AŠ • ¼ðп‰*Á( uAªJA¥mè–.i“ÆI]'ŽÇËØžÅ3žýÎÌ=<\ÏfÏ8N'BÊy¹ö¹÷Üûùþ¶ó;#/©ÿÇC»×·;î ¸×ã¾€{=î ¸×Ãz¯"n˜gsîâ:œ‹AÕØ}í]àµÃ#Q €Ý¥*¬`% ñ<56 –7ŠÄ3EGý<±â¢Ä»KvDºʾ ðÚá¹#à¶™ÿÇ6ŠxV†ý6†ýÍçÞ™ZåÌåU4͂úÂo4ÎላÏg—È:ºŠØw§†Løo–3¼zvŽB¹!Ÿƒ‡Çz™<~€jMñþ×khš†RzÍÂ'W“<÷ÈAFz¼;}•ÈðDdÇû÷5‰½vöC®TåoÌRÔÍ€|…w¦bõš ¢ J)Sæ@Á¨Õˆ/΢:´mû* "S )ª @D… ±˜Èc·jüä;X4 ÜN p#Y@D0Œ‰¥¹"ö5„z]æu!žk±.f((@à©5Gý<~$̱A?E½FØçÀnÕXJ¹²šSDrå:½£pÚW¸¶Ì“/W‘6xÑ4D„µL‘?¿{D¶LÇÎ@ »Ucj1Ã_?¾Â„GÄôD­J*¶Ðð„Ü©ó€ß~;øvAÀa·Y6›%’¹2›… k™+©"K©B3)¥ É–Hi›—–{ˆ`±Zéé¾½ЏáPÆ‚Í2Ùi„ýNÂ~gÛ\Q¯qi1ÍÔb†ñÂ-Á›ž0H¯/u÷€Ï“Ã0àkÎÊÜ!W²pòD½Í{óë9–âY“yÒy‚^#×AÃJÐãÀã´1r3r3ÖïÅn5#x)YäÌô:C½nN cÑšår!QäókdŠÕ1ÒÚQ€Ï¿8fº¿¨×˜^Lb01Âíh:-¯pv&Æù¹¹bÑš)U·æçvXÒn³01àä=Œöyëʃ™Xî÷àvX(W þôþ’)¢ºT¡'†Lø©…§Ï|ƒ¡ àq0ñávX)é5Þúrs³ Jµ…ÀÖ]á¡RU|u#ÃW72ŒE¼<{2J¯ÏN^¯òÁL’Bøùw£L zyæÁ>NºÚHç*4ä3™^ÿxCßmçwOŸ /àb%•ç÷o\䳫q ¥@)D³´í’uOtám {=Qàå÷æ¹¼”%ä±ó›'‡ºm€ðæÅ8JÁhص^º ªa/UPÀ¯~x”×ÁµX†?¾u™tAo…ˆÖTJ¡‰¶'øú|­¯‹ñÙ\ŸÓÊóFM¨Ô¥ªùX;¿k7z%e^{=á÷Rçë–oÕš#à\^.t…ïšÄõq)UC1y<â±C!úÎ]ßU®L-ç8óÍF³Âlððô‰MøÇ…³ñÒîð{±åyæ˜yÜ›[Ëñæ—Ë$rúŽ˜ïõ9¹ºý>˜Õdm³ÌJZG¯ª¶°qÚ-L rrÈKµ¦øç¥43kÅ›ÂÃ-°—ü츰ϡçç78{5E"[Þó|[ºíòòø¸‡U#S¬ñúùñ\eoð·âúÈ&–9јœˆà´Yˆm”øze“¥T‰Õt½±ùì„ìq2ÖçbÓø`·Mj¯ó{¿-ptKÄæMv?àáü2çï=€Û¼'ðt;RÞêð…"” Ù» Û!´]„hB)Ÿ»kðÜIÞ` ¡swöá×io°‡Û{WàïhµO ¡\Üý0r»ðû&ÀíhTJ…}ƒøš»V–ë;Í”IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/skype.png0000755000176200001440000000265012452540640023315 0ustar liggesusers‰PNG  IHDR00Wù‡oIDATxœí™Kh\UÇçÎ;3“™Lf’4iš&•j±Å ±-U -Dw‚n,tã²à¦Á… ‚éÊ ÅZÜTê£`#¾Š¦IÓ¦Ió˜&™÷ëÞ;ëb:“ÄLîÜ;™1úßä¾ïœßÿœï<8#ÎLh±¤íتØn=2°Ýzd`»õа6’Ôç€Øã¿’˜ÌÁÕÜ‘›¨/aæ$–(ƒŸì«¨óÃJžœdcØU6êz0Ç+yÈa< gʆ›!S^ ÁñŽætœÈk\Ž ~L@i í^ÎæÁøl‚W»áü®"ýöƯc† ó7܇®v8-œë×8àPÊ7l`ÈÕPû†d·Hœpp@$Mç6൘nÛ´ÞØí¥/»d*Çð6š+­î(F—ó|>±ÈøJй”Œ$ ÚÛíëàäî.¬ÒÆmÌ* ÎŒø9÷ë ®Í50™…Ñvc±×f#|üÛ]äB!%ÉX†ÉX–ß—R\8<\3·ÇmçXÈÁ•ù¼}õMÓ¯#P(Õß-¦ãY>»³Êß”ÿ¤uÛxy$„%Ÿ#½8[·?Ã3°”‡o£E^ê§\™^¢¤iUøãƒAï T ÜNäH«õêoi›…§»Û¹¾˜$¾‡§§ë°ÔŸOÉUxIΨÖû³›slÐÁ.×Ã)ŠrŽÌýyÜÝ}5ãL]憜õc¼vkµl4à½_î0“4oØãwU¢(çÈ.-ÔŒ35Ýöú1û»}ü´¯ÖüX8ÉX8ÉHÀÍÑ]íïÀn©?nA§ «E¢X„  Èd—ô…zÖÅ™š·³àø`#A* Ê x*žãâyÎ^à¯eýE pY,å6„@AQÉ‘] 7nÀÀ&„$oäÜèû»¼Õ2¨üMªÞ›áf4[¿1Áj.åï’ª‹¬v¦ d‹Æcíðsþ™a>yñ ^ß×K°Í^…Ð4øôæ}Ýü’Ù¢¶¾R–EUAŽ.›7Λ‰.+à´qj(ÄûÏpÙJk:)ëÎèBVEc#|µœò*Jý=ÙºvíÔ€¯˜3e`^Y£×¹ùÐ]šZ&_Ò˜K+Ì¥®ÌF«e³öjqzH$Žôzù>œáVRÝ!Ì¿J|Ñ™wàÔîP!6ÀK^ÛÛÍS!wݾNìl×…˜œ€¸•.0â©úÒHO†<|3c:!s7¥à²Zèõ8ò9y~Wƒ^‡¡¾ó9táM—PE—¬¼e+àwÔNö·1ìok¤éuòÚ%]xÑH Ä ðѨŭ¼'ÔW*_Ò…‡-¼ÌÍä­¼;•#*7p8ÔxB-lßÐ"^«9áæÂ?)þXNm•µ¦®.ftá·l@ñøàvŽ·¾ËT¼IÏmÀwá,“©¼.¼ÂÜËœžäè2rl… ËÎh—‘].ív+vI‘ ÄÕ"·S ‡•c½Þší”4¸<—âË{   O3 ȱäØÊú*×êÿ@ìñ99±³}'«DB-2‘Tùê^š™l¡îÈW¯êÍþ™UŽGPâ]øz×Ãðdõäôw"„@‰G[ßðAVO_(ÉXKᛲ mn¢§/ÐRxѪ¨ÈÞîj*Ñxhð'&S&¼~@ ¦“M‡oÙØh‡5“j*|ËKh­lžòÝ>ŸI5 þ‡ZgÂí-›È¦›‚K­½YK–—IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/delicious.png0000755000176200001440000000060112452540640024134 0ustar liggesusers‰PNG  IHDR00Wù‡HIDATxœíšMN„@…¿g¼Âʃp·l=ͬ=̰vé k  zÚ‘Dx“® t…4ßKÕë4?jÛöã¸Ûà¿‘löîSɺ®W»ÁãóÇjs½<½]ä¬*B¸ÈY D×u³œ•EôïýÏØJ€$„@Ð÷£/ßð0ІÁKÀ^^˜Ãƒ™€^’Ÿ€é¹€Sœà-LáÁÔÙÄ[E6ñ"›xËH™8ùHÙ4Íj7}=V›ëx¼1ƒY Á^˜U †Gfˆá-=0…· Dð~ˆàq4ñù(äfb˜Ãƒ™€Þϼ€ÌZò‹­mãæž‰Á¬… Ú‘ºU †Ðo¿„fÇRý¸4éYj¿WZ¨ªªÝÃÿÙBeYî~‘Їb·ð°p*Šb—ð’øŒ™"ó”\IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/stumbleupon.png0000755000176200001440000000245512452540640024542 0ustar liggesusers‰PNG  IHDR00Wù‡ôIDATxœí˜ÏoTUÇ?gf:Ú™BQù¡íPäG£‰˜mhP‰Vp£nÔİҸ#!ºråÆÄø(þHL¤Qƒ¶&ˆP "P @‹´%a:miçW;7×ÅL§¯óÞ›™7?H¸›y¹sî9Ÿï½çž{ßõñ;Š{¸9ª Pj»/ Úí¾€j·ûªÝîy®²{\фڰ VùÁãKõ…Æa¨¹xn^/k8)ÛI\ãF=½iëÄÜF)â]¸Oü3ñ²„-O ¹jP»ßGÚ^Æ@wû.b¯¾GÒYžÅ/]€ÃêØ‹4­/xÈ–V&ž{DÉÁË @ù[‘Ç·Øç{ªÁeMÌ$“%Å/}6o/zhc{½ñ’D”,@VûMûµ©(Ãîüm*jj³È¿€‹qEŠ(}'ÕÔº”¦qå‹O ]>@äÚ%ÖîÛ8óìîôX.Üf}£—ÃÞœVä §“È@_êˆ ôà3¶"©º%М°½;‰ÅéBHæ(™)®ŒÚQ9¤à!hi—†Ÿ³®M,¢üW‰ ؼç?z›†-ÛðmÞ†ŠO¾|ŽÈåçÁëŸÆC4ûãräP_IzxÐ"!FŽv2Ú}4Í0ó³Ïú•ûïvˆ&¯g•K!Œdú¤ ølZÒúºVñ= ‡×oØ|ðº-ÁàDØRDÅW x}užŒ )£ó=°ÿKsªOÞ-\@ücŸOl°Ÿ±®ŸW žÖMÔo|‚¾öà×|vÐÔçЇ{xhqN]Y³µ‰O ؼjyá"t3°pµŸ•oí³°Ñ¥µCn…¢<àY”a+…è± Ÿ Í,mrÙ* Ž‘L§“=iï§ ‘}ÂæòiÈù‘”Û›xvÆNß æ ”}ÂZû+Ô>{UƒÑ){VîÜ=ï„ l}ÉÔ.¼ m&¡ ˜Ú.ݵg¼wÇkÖ˜/TóM¬†U͆þŸ4ðÕ^êš×²¬íEÓ@3ãAT"ž*ˆ“Á½ÔX–<óÉð$ñWYàßÀ’öSŸñ× ð`U…z{ÀD€Ã]ËŠ]o˜Ñ·hßù ül^¹À¢µ­[©qÓ°óͼ>§Î7À‹Xlb9åujÖ”–`âô1Ã!>s ¥÷¯â1¦ÿùÛ/XU¡Hí÷CE üø3Á[†61`¬óë¢|†ý™4À‹ˆõ&vúƒÈÉ.[&Nv3Öõ³åõàv÷aB=Úòëé&ö×SxœÚŸ<`5ØÝßK0eÁ#kr¾U)-ÁÈáïé<ˆ¨dλÍÔų(m†þuHŽ÷_53Mäè!"¿|‹¨¹ñßù>-* ¿Ö‹ïÙÔ·lÄYWŸùO‹†‰öõ2vìÓƒ]ÌfkW7ãÙºÚ–8ÖÍÅ‹Eˆ÷_"zü(ÚÍë–3Ÿ)ç…|UÀ…ÀIe¬ÅPø­rþoþëv^x ¼Jк¼—Cî*xË2j%bC£—8îx!G²±®Ñ‹S䮀‡"ÞÈxt™7•NU†·•BÙ"Z–.ÁåpTÞv e‹ð7,Æ™Q ø¢W@/¢ÙçÁ!ÙÐwÊñyhòyp¦«Ó„—r˜uô°·^'âÎÀ‹ÿŸ}<¿aðIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/apple.png0000755000176200001440000000204612452540640023262 0ustar liggesusers‰PNG  IHDR00Wù‡íIDATxœí˜mK*M‡¯1Ÿ%R³4í}†^}ï {› ôBµ4E7sO«ût¿XÖc§£¹ë®qC?–Ž.þ3³3#nnnLþÇ |7Àªùøîü|w~¾;Áu½(ÍfI¥R(ŠB­Vó¤ÝµÄãqNOO‰F£ÜßßÓn·Éår+·í{ ‡ÃœŸŸOá£Ñˆv»½rû¾  þ)ôëë+Fu¢"Ë2Ng¥ö}ØÜÜ$N¸W*•À¨ªÊh4âååÅõ;|ØÚÚš^†Áõõ5O­' „@Ó4dY¦ûÒuõ_q$A×uêõ:www úƒðB„hª†ü[†.ììì8z‡ð{9ýüüŒ$IÓnó7¼@€u‹p8L"‘ “É,ÝþJˆD"är9’É$áp˜ÉdÂh4¢ßï#I¦i²··Gr+Évf›B¡@&“! Ë2ív›‡‡z½žU Mãý÷;½^oi WBP,ÙßߟûMÓ‡$ "‘ÈÂöêõ:¥R ]ÓAX•ˆÇãŸ&€ÅÕ >99Y I§Ó_ÂpyyI`#ð¡ý~ÿËg  ¶··>öeº]k²Ç…¦k(ŠÂ`0Xøœ#P(D±XtO9'år™r¹ 0Ôv%E±&9q$Íf ¼ýtt:ªÕê‡iv¦Òu}¡„#šd2¹:ñ_Yo_ëºÎd2a8~zÞ‘@"‘ðùO àÓé,„·¯u]g¬Œ?I8˜]”yY–ç~àf¯í é†U‰···iK Øz™P0´4¼ý?Ã0P'Ö"Б€iš˜¦·«Žh,J,[~¶ªj-Çu¡÷÷wOÁ¨„ª:°ËæeÎÎΦ»µeáíŸaÎfW ‡Ã\\\‹ÅÁÛq$0 <©TŠ««+ …‚#x!„3ñx¼ð³¾J¢Ñ(ÇÇÇŽà žœ$ÌK­VsïJ ßï¹BtI’hµZŽàÁå~ ^¯{>*•ŠcxWk Ðl6½!šÍ¦µ­tïZ¬Ó5/ºÒh4¢\.»‚_IÀ4Mÿ¹Äµ#IÒBIEQ¸½½ES5Wð°â©„¦iT*vwwùµÿ ÝÐét:´Z-Úí6†aÖÉt>Ÿçððd2‰‚n·KµZe2ž¸†Î…4U£õÔr´ªt3`WþÍK0¤P(¬Þ3°6;ù|~­ðž ع\nmðž ØÙlv-ðàÓñz0´N™}†÷M`VÂOx_ºÐl666¬cHŸà}°%Òé´/ðÿØ¢™¦P>=IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/evernote.png0000755000176200001440000000246212452540640024012 0ustar liggesusers‰PNG  IHDR00Wù‡ùIDATxœí™KlEÇã]{mÇNš§Û@uÔUV¢¥B¨T­(xI=!QEEUBˆ+ÜàRÊ•WBˆ–CE% EªZ¨"…”ˆ¦Êƒ4‰ãØŽíø±öúÁ!µUDZ³c; HýŸ¬™ùf~Ï7Ý_äßÎó?–e³êÕC›­‡6[ l¶Ôz;ðàežqöqœÝ<‡›òä˜æ6C\bžñºA+©æ° r„·h§‡þäžæõ"<€ÀB/{9‘;‹¾d4vuޤbåÞeƒ\»s™ýÖ+¶µYìÌŽ„ÖÍ„t ©Xy‰÷ñà è[Ä=Ð^5æÓCV-7Hdša~b’!Y@rŽrº_Íb¯ip+[à8gØ•!=`%)Be»x’ÐTL*ÎôˆäÜ›øFå^*‡ºOÈ‘VQ§½‡d MèŸm½.S1¦ ìâY^îü¥³î££¢œŠ !@¦ MÇhëYÛ„éÚÉa”úϽªrªÍË?„ µd¾_3Æ´±·Ž&µ„@ˆåÕcá™ê&LS¤ê\Kª°á ¤â"s‰Š1ÿ)šb//ÌF:ž!ê[Ý„i)ÖÎG3JfcÜ þˆOŸ,«Ó,Î2ø‚¡t"Ct¾Ü„éU#D+Ûêaà›©sLÄGNïø„G%õ«ÁÎÊt"Ë’?‰»Ë!o ŠØS·SÞð铸նòà åF2K, ãêX¾¾˜N¡3uÃ?¨­öþå]g…ªÁÊd†XP$ Üc´!àÕ”'·&|!Å2z–D(eÞÀ¦rÃëC~_éœn ¾Pf¤²r§Ó–¤€>}‡\>gº}ŽœiøB™” ÓÜ2.™j1D2~öMĘŠÑ³1)x„¿Üܲ^dÊ?ÆŽçñº÷Vl÷{ð2BÀµ… \ \D°+Mt;¼h=Æ.÷Á²˜d../Do%]ñÕØ&Ýìï8Ê£Mƒ´kÛèк‰FÂ×¹¼Ÿn žÊ'˜LŽ0©ßæUÞãq÷á’~—²!)x¨ãµJ×c-øÇ"\õ}[qïîvîà˜ç z;Q„J,æüø„€‹Ë ,óRð5¥P‰‰Áüw£¤ãF|«æáTÿÇ%ÏË.uKhÁ(?W™y)xéE¼ª‰fìn[Ùöw¤ëäªû DùîÈÌHÁ×¼VªÃë&8±D*n;ïsî.ÖÏéã|çûœHf¡Ô­í(é#›Ï0oLHÁ#ø”Ò¾Ýæ²·+Îb]:¯£çâ À", :÷óŠçlIülzŒ †|Ãf h¢ßMh*F:™!bèÒzèsìæï—Uc‡âW¤á:µõ¹ÐšT†¢¿˜Ž™Iñwò7ixX§×ë­=.†SWŽþºf[¿1Å÷Áó òÒðB€XÏϬáÙ¶³Çu˜ûN<¶>BÆñ\˜ÑäMþL\%G¶6øF¯•ÚÒíÄ?7ÁLð®ô k~]ÖÀJµlsbs(ë߃̌š·:±:”†ÃÃ~#sw9PíjCá7$…JLtÚ±ÚÕ†ÁoX =¨¦v «¦4~S 8Û4TÍR# ›øØ¹EC±)uÁ#ÿÿ½t¥»"«cIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/blogger.png0000644000176200001440000000520612452540640023600 0ustar liggesusers‰PNG  IHDR00Wù‡ IIDATx^ÍY[¬\eþÖÞ{nç~z?”¶4Ж›”"ªh"cĈ ¾˜âƒ„#&¾¨/‹ꋂêƒ•Äø@b!ˆ±¤…RhKÏÐûœsfÎ\öÞÿúœ?ÿÌü™Îå”±~ÉÎÿÍÚ럽ÖηÖúçn}üÝë7çnÛ4žÙy¼A!@Àr¶WçííËágë;ž¬§»Š‹É¸qã3h!j“ï>{xg”É<0WOx²£Bè#ý@(ð,͈À–½Í½m(?D"ÈÎ ›/ø»‹·ýì“ìê$ð£ÝÅźÞS0ÄB#Å‹'j¨+:ˆépËB›ˆåTq ‰!r ô$v¶/a"#Ø>Ã|¬8YKn°«í…/>vðÇëòá]GÊ hKÏŸ¿p µØ #¼ëþÏ^twpó#6E‚Vg…O6ƒW¶@=…¶V’´ÜøÏt6ÇUÕ.PUË»| ‰TÝ~ ª[ýs–äϾ_ÅÆ‘/œ¨;uLdƒ‹6Œe®ß_ªÁ^—™Ö›U‰6”„Q ­.vá@½ Bwð«¹$¯%)ÌÇQB ©¥¨€¨Rà txª€QH ÀÒÎØÞb‹w|TA²åcH èøØÕß\š+Jœ ŸAt‹¶Åà£NΠ—–Ó‡µ@Õù”‚Ò¹Zª– ëþYòªQ€`ªê$dHt`AP£M*XŸPÚ{Œ ¢ÀùgÊ5Dõ Cº A0B&Gœþa\KPK jFÑŽ;" Èbœ¶“› RìFZNˆ¸Æ ª40zªŠ¼õ÷Ê•DœÒrðÄ"03.Ë;)yÇþœ* C$-É«¢œ„€ˆ­@®€ˆ P$ŒSŽ.TpQ\¶uJV ÀmdDº&R’BŽ”îÇBU…ï—)3°I°]$ûrµòI©RR£T¶$©|ê’@(6 é¤Ž/]2Ž«›ýxåD‘ B½³€@=%ŽÎã¾§‹8UN€b¸8 ˆßïK×ÃØ½†pñ*è%Uº ý$Hak¨-y⎫fdëÚ<†I%(§1@Våð½/dðû¿‘C'à\MdªÐžî®0è%õD%Q¢ÝíZ‘™$© €d§D¨"°mø­+WÈöÕ#„.ÄVUöá‚~Òò|ËÚ ¹yÇ>ø\QæçjÄXÈDN6N ˆÌņ-uH°ÜKÈ}S!7mÃÇgÆ‘ `Ñ÷À%]•+Xê¼wÃ¥kñÊ¡ þq`¬%@¢ʉ‚ªÞ'ÐŽ„锬l=¦[N›'²¸õ’•²¢Aé ÑA,|¤‚!< yÈ—¯¹Ï¿UÔR`Ô?³]¿õTQÕ?‡„*…êÛ¨“á%dyà«rëDN¶N:q"®ZÏù÷ÀG7¯±|À²1Òû6‘*YN†ôÒ‘…36 0ôñïBt7aH Bbˆa¸ýÚ (UcÌ–ëh¤ºäßk§F²øÆU3Ø09XBGjˆCJðŒ/‰o£ !ªØ%Þ:Y*¡kf&ð‹›.C9N%U.y„ÎgBlšÌ# ƒ]èµCó¨*¢Àî.¤tŽJ߀¾g˜ÎÎËì\•ë§F:¶3}ÖOæûì]š÷³Ù·ÿxñ´˜ûR²[B %]ûÑá‡OWñÌ;§ñõ>\%žØÂ>¢Ú‹å £í™…@Z›Ô¸ îêâåzŒG÷ű…:>lì=¾€]ÿ>Œ…ZÜ/o£º‚v^J§G‡þÔ;'ä7»¢nTº|–ÅýJ y|®â‡¿!{OTúùúªB\Q €’0fÉ©ùàK‡qß¿Þã\=ù¯Nâzjøäþã¼ó¯¯aÏÑù¡û@Œ2V dÿã©BÚÒÃSCÜûô›²¯XŸތ+f¦–}:ÐÔú¯ž? Ͻy Ç* =ßs†*€h,€ Ò }µ z¸]˵˜½zöºò‚)Ùºj”Ù08«Yæ3¡l˜.0ˆB9]•7—¹ç½’Ôâ´O·Á@£ÌÄ"lA ñAñÆûóx½8×~› ù¹]?0Rƒ\Áí“»}õzƒðéŸ>õ6Œá°—ØmóöåðsÚ—ÏgðOm:8¿P¹EþøâÛw®ýå·zOW…~ìÇÿÔç—¯àï¾¶×^8…à+;6Þ³}M7o[í\”îêå~õöåðsÚg›Î7·`Ûdè$Øh4¸°°€ÅS¸÷™ýøóÁ‰Áÿ%Æ£·lŽðýÏlĺ™uGÔn³“ÅÎ-‘\W(ñ¥â"ö—)j”©I‘&éy)‚(1 #a [Æ…;ÖæqÉÌ ‰¢h!²$ Cä LOOãbc0•!®«TP«Õ¦)õÆy)á\>‡(ŠP(Œ`ll+W­´1"›ÍÚ˜_ÇL’Í¥R •róóó°¶z½UEšÄ°0Fá|A€ q.P5 *A$@&›E>ŸC&“Áää$Æš²™ššB.çlÿ42¤[¡L2EIEND®B`‚2690BayesFactor/vignettes/extra/socialmedia/png/48x48/rss.png0000755000176200001440000000335712452540640022776 0ustar liggesusers‰PNG  IHDR00Wù‡¶IDATxœí˜kl[gǯÏ9¶ã[bÇ“æ²Ñ¦[;Ú­-íZi04ÆØ4±ŠqÙÔiR ¤ñ MHHl@Qê›4X%*ÖeÓ¶V¬´ ´éem“&$Í'ñ%>ÇçÆç¸9õ±c;ɪI}¤(Ϋçyßßßïs9'ÂþÍ'l>Âæ»Þ˵®·Ýp½í†€ëmyrÝžÿëêgÛ‚é30; S§áÂÈM¬ÞÒ&êžÄ‹x˜=}1ü\(‰ú¬þXÂD{?´÷Ãö¯cç&'ÀéK·µŠ¶*5 "ðÉïc~å/Øëî]#ʶªE,µõ!>û ÆžßCçÖU9£~Žý/jz´áCäÎͰg?ú®ï‚Oi8¾–Õ_ÄÀ©q•需?’ zÓV’›ï#¾éÓ(áD]{hã§ð¿ú"¿2]«!§ÇU¦ó%B,lÄÖí$¹åR»AHµ¿e#7…uè[øçÞo z±5,`hb‘g#!@ ­‹Þû¿CrÛžš{˜jõå' §ßkôx—5%`èŠJ:çÜ„X$¤ôêÚH߃ß#¶~wÕ=L5KæÏûˆk›A–Ñ…6¦‚´GdOx€ÂøgìcâõßVÝC F‰<üK&éh£ÉIœ>_š¶—8ÿï¦f2.xAéVœÏí[?Oß~‚O zn­N 1sp/]ÑKÀb3urçùç~r#'*àË)Õ³…õ{\¥[¥=‡öú3tµ6Öf—?È$…ÈÆ{¹íâ–GE ¾pÃF¹xð ,]õÜ&qçW1ºîd|NoèøÄm›>Ãæ'ÿFrûÞ)Udì¯?®ŸzðGduW2õ‹XñG Ÿ?ÄÍ_ú)½ý¸ ïÜÈì{‡øàÍýž±þD‰Ý‘Q-&3F]çIO?´öéº<å “#g0Õ,r$o‰aî¹@¢—ÌБ2< ¿ç/¼C¸o;þxoE\ s™wŸG+1mûkÇõ ;Êô©×¸øö‹L¼ù;ò—Oâ“Z:ú«†´tÞ –ÉüÈ»exçFÔÑ“Äw<‚ðI®ŸÄR³hc'Ð Ó‚P õ Z[$l [ÐѦ‡™ùÏaæÎJmÀßÚéY· uü4Åô%W:YêR BKï¶Š˜@j™cltLË®*¢áèûéjUÊ­r~t³û僣«Ç|ùYü±”«ÒoÀ*ÎWøKá$¡[î)ûç‹éyïšhèkm‘°lÈkÖBZØdξUÌë¿«Â_H äÇÈ rÕºŠi'Ø}{eŒmQ8óJ¹›¦iC‹âþΛîB=q…ÎVÅÕ*§ÞúÓÇž÷ôl¸›–ž-ex'²'_òôoé¿áó¹| E‹Ùyset·)tDWnÿýgÌ zú·ßõ5Š“C'ÏUøú‚=w¸| ºÅ\᪈Ælú"ì=\z¬xìUضîx€TL)ç¶mêL~Ö3¤0rœÜ9(á#zÛý.x¨ÃÞÏYJ×Ç+àÑt‹¬j5 `ç7=—C»çÒ”FªUaMT.0sì9oÿ›v¸`Šÿ;é- q³'¼§ˆx÷yŸ$§Y Ok¤b ÉH)òÞÂ6´ ÿ`Ï.x!¶–ÃÌNVøJm½UáõúÌx¿5™…9„(µÔËé"©˜L{DÛ¢àQÌr¬«â5T0æÆ*|…¤Ô„4"àè/<—'þñóòyÍâòL‘ŽhIDqªúKûµ…lkYo¿ðBˆŒ¥ðÒ·ÉǶLÔ‰!F_xŠÙã/¸`òšÅèL‘5™€™¯ ^––«éëM¼ÔOf ®dôŠ«]--DdÅÌaHzZˆöJÝçÓ`ÀÏêxüð(ŸÖ9@Ë'þMè›°ÃW*Cœ>½úÊ¥mmoŽgÏoÞóyº»¢’‡cG¬sç…¢kL¬ ÄÅKÉ1&ÞP™—¯ïMcâm :©àê­±‰x¨Â›F®‹u1±6Ô.±@¾ôi{kµðæÞqûþõãõߨy“²o@õ³¹­ÇWx6{¹Fð$ððñí¯…–†2ŽðæTÀ›1¾çÀâP¦)¼— H 6‰²é@ð2ð@ˆUh>›nxªt5 ¨…¬šè­;»„'ö™þ”í®áÉ€s VÓ})ƒ©€©©L§ HÂCÒL¦»•“Œàïôfç…¢øjÓ^´…¬šèíRzuÒx*9|àØ«ÆzŒHá÷Ñn#2øH[Ȫ‘®ÎHà#o!«†“âð€â+å ‘…WÖBVe„<ü²aOí.ÙNIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/hi5.png0000755000176200001440000000213112452540640022641 0ustar liggesusers‰PNG  IHDR00Wù‡ IDATxœí˜ßOSgÇ?Ï¡( - heHËP¦dˆSXT¦ÞlÉno–ìbÙÌ¢^l˲]ºìf^ìàf˜,Ù®\âÍâ6³]\Àb–‰:V¡ü¨ÒXOÛ³‹ÒÞC¡P&ýÞçyßs>ß÷yÞ÷m*ZççXŠÕU΀ÕʰZ9V+gÀjå X­œ«•3`µž{¶U³-íÆñ®‹›óu»_^}L4 =Ÿ˜¦W7`¢›=>Nq¯mðÒEˆÍA÷Ç‹Ï%Þ´Óçƒ xÉã2ÌgÜB7{|ëž‹iÜ}0±(©K;'ö×àᣧ†ùÕ+ÐuѼ€[÷ü¼vâD Î˜¾ãÎýqD@Dø½‚£ ;¡¸&­5ìGâ <~F}MÙ: ˜(¿¨ oë{T½x lvâ?P†¯@4˜´Äøñ–Źg‰Ç4zNÓ|Ô£ÇCþ þt PAHN ®i ÎPW½ccšßºŒÃ¹wYLq5˜~“’ñïÈ·™wf¬ÀU J¾„ü¼ÐzGE=eÕÄÕYæ§ÿfªÿs“ýº öñ¸KßÍĀù—x4’/ÞÓLï_“¨Ñ¸¹…U-(®@ÓÇ•{OQQÿEå^”<;¶B'%î#Ôœ¾D¡«Ñ+£iÆB™üµß¾9—Wl¨jœ¾)Ô;çM $L<½Kß·ï0øóçüÛÝÁÀõÏèÿþ‚¾žå㕇Þ^ÒV •Ð4FýáÌ øþü‘X$˜ Gâåj4ÎýÁi²Ðç6Ê=')(©âéÐ þ Œ‹ï½’2§¨¢~¼( &2ÚhQÓTò#fm$’0ºïÄG¸jÛ×aä—/uv"uNž=>ùœñ=<Íâ&i½J¥{šô˜£r¿TäJ½ÜÔÐCx‘t{ÀäÚ.\K‰çÙ´ž»Š´¼Õpnó»‰üÜÔà"`ØOž½˜"—wë‡)sBÿÜ6„‘ÌZÈlu9ea•Í×FQ_W;Þ׿$ßQ‰½Ôͳ†cgǺ Ü0„²ôkÔ¬½ô<0týS¦~  ¥Œ‰ÎN2Õ÷5þί-f ¯’îïõ[½Ot¨$×Ê[2‘O¯Œ™Ý°JžBç> ]µh±êÌcÔà¨iÛèðBz·ïe ^?MVœók‚g§PÛáÝÛ>ý)´D'›vo;øu8þrÕ¶‚Ïè"{µq×¶_w’j=´k[À¯yéØÁ–Ãg\¤^i¨´~ÚTZ¿¡_£KÕT_a ü¦T ©Æºò-‡ßÐ&6ÒAkKá7µI5Ô:· >+ö×”m ü¦mb#ÕUïÈ:¼å¿×=îҬ‹ÿn ÛÆIÉIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/vkontakte.png0000755000176200001440000000165012452540640024167 0ustar liggesusers‰PNG  IHDR00Wù‡oIDATxœí—OOAÆÓ"„b5–B¡¨@%ˆÆ†D½àŸ‹âÁ›=zð`04…”Æ`º®žzÞÄläcÅ&Ô$PŸÿÉ|Z̦´üh±–Ä\t¬"ê¦P|o§aÒCÉUx!Ì®0ý¼© 5S¨ þD—Ÿ+}íá'Ò˼ûù|¡]fIL L(Y…Üì«hÜlJãѳI2Zn|1=—#ñ}‚Æ`hõ¡”ʱ} 6ÿ›þ§ãÄ4Søb’ºÌñ36i˜„cüÞ:nœïäB¸™ºšÂyȾ4‰d<²Î„cjÜ‚6_=—·póbÞú]¦ð¥IÌÏFÿ2ñO%Ú›<\;݆Ûí2…_MBJæ¦WM(iâÛ_kZë¾z½uœ 8h0¬é î&|`Ñ´y…ÍN—’tb¯¿UýQBAl^ct*MÿÓ Æã‹¦5=Á†MáEá»Ô%éD\íQ¢ô¦ ~H˜Öu·6T_£ëRÝQ¢¾¸TŽDR¦eµ5=`_üO]ðáö½¦uRê–àQeÀ ÞëÙÅ¥ÞfÓª©¤f ^ Ô¬BåðÍ6y8ÕíÃï­5­‹-Y‚G(2pÿz¯åšE-ÇptѼ²°£·I2šÄ ¼Â°¦çŸú–Á*¼²¨Ts鞌$yÿý—-xe=°‘RKYfæ—ù_âÕDš¬Ä6¼ØŠ{/`æË°á›TÅ ¶ê=ÐÚÕë(|UV¡–PØ1x¨Ò*sªøBÓÜqtÛ᫾‘5µ÷l+¼’Ø {ÛàQa q×¶À‹j5±‘|Árxe µ¯¥C)<À¹S ~­sæIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/orkut.png0000755000176200001440000000263612452540640023332 0ustar liggesusers‰PNG  IHDR00Wù‡eIDATxœí™ÝU‡Ÿ·ítÛnww¶Û,ûX–%b"EQL¼PãŠx¥€ñïTÔ Á˜ã½‰ Æ@H4~%F%£‚@\]`Yö³í¶ÛN§3팥Øv–í´;ËÆ„_/ÚžÌ9ïó›sÞó1#ö«Ùüå[o€Õê®õÖ]ë­»Ö[ïZØma  ·eÔ%þÑá‚5°¼ +«^ÈÔ<ƒQhsסv¾„œÉÂÉ$dJ« ߺEà¹<©–· [/aÂ÷eŠ­a´6„bx­6¶µT½" ù‘½qŒ{C(Ï!™æÇUóI¼± Þ^5|µ‚£QŠû)ú›®Û\¨x}:–df $O]'ufšÂL}:‹ „¢„:Pê§{÷hÐQW‰‡1ô“=ú7QÍýÍqŸŠÀÁ¡òÌR§’^äÆç2}ü2V¡„PÎ A©þ þˆBß¾1z÷Žâ :o„6¾ˆùÁº|QWXî‡Ðs±eá óç~ÇõO/4„°´"ÓŸ\büÐ)Œ…¼£½ÈãéÒÆ’‡ÔìQ—…ÿã­oÑ®¦‘†ðRùˆ /2þîO˜IÝÑnÏ3›˜ eÈY ¼ØS^¨ªd%.½÷#fJo¾ò¿˜*píÃ_±‹µ³/ä'þÂ7´¹†&h÷ÃÎñ8}ürKw¾ú:¡Ü ''í«O á˜É/°dÞÞDc÷E •™)0õÙ¥U×ÿCâÄ–V¬‰!Aѽ0›O°dæZ4°-â(Jü0é*aÝÀ‹V¶HæÔŒ#NäõVݹ|‚¬©µ``Ð9g§Ÿó ¾Rž;·àˆÓ¶©£¦­y=é0ÑØ@\qéSYOáA¿âœ6• áš¶!QH‘+þ7ý66v^bÌkžÂXÙ¢#Ž/¨¹N¤Ü^BO¡Ý4ÑÚfÎÂSøê:õª‡¯\Ÿ,¤qÑyç1Øò>ÐéÌ5K+- _©¿hd\X0E‘QÕSxB7¶ZÅÙümá+ß LŽ"uÇOáE„Èý=Ž8ædnExp“Ä—®ØãCø#Šgðþ¨BtW¯#NábzExqeàlÎqÜóGúöoõ {ß&|‘ÚùÄ6,òg“+‹¸B¹öoνHï³›iUW SézjÈѾvz[+­ï.ù"U~]¶°‚nËlB‡Ÿ—“8†Föœ'm`ÆkÝ =—æO}¸­ðµzêx—O×·}tc #[W½ é˜vYÛ‹Ï dSö´]8Õ~?}|3‚STxý7F.‘MÕ—6P¯o¾8Áùã1iˆ Ûš»Ê—ʼuf’wgO±ÍQ.-¹ôNå*tnz”÷üWó¾Ï»ÕÆ_ª0¿’áÚ½4±í§l«ðö ùØ…dÿÈg&Ý<;6ÈØ`?£ûŠi%bùáDp¬@8^ZÛØ‚·k@‹oPHÆÕ moÌÁ@-À+U!§ïI@PL'À4» ¯´˜³Lœa™ !Zø¼îôN „ ˜~´N†GuªðŒ=›¬é|Ë,c F.eåDá•s`‰‘Q„èÙÔ>átxðJU¨‘žpû,ÛŸ¾;mþGæöZá”πɡ÷-„êL yAIËî|HðÁKUe<¥ÞðIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/livejournal.png0000755000176200001440000000571712452540640024523 0ustar liggesusers‰PNG  IHDR00Wù‡ –IDATxœÝ™YpTWzÇçÜÞ»¥nµ–’HÄ"VË+‹ÁË”klÇcÏ0Uã™JW%©r¥ò–TRS©JU^æ!ó0©Jf⇉¨Ç6ÆãqÀ dÀÀ€À$´ÓRw«÷¾­¾÷äáv70 ¼•ó½tõésïùýï÷}çûÎmñã×gß`“_7Àçµÿ?¤ø:1îÞÊL¨o^:ÜBB|ãDØn)‰³ÇÔê&Ak­À0¡gD14õõ‰¾UÌ*¢³E°e…¤¦âúøæe°çpŠ‹a×— :›Ý^Ü$®Áó]ËGuþë­Kô NRtów»ÖðÜ}n~úÖšõvU^As 4W Çi '£1¸8n’Ê}QJ"PìºßF[½`χ£¼ä"—…—+ªÉèõÕ?ÚäßÞ¼Š+ÐR¾Üë„ÎɺAȳ7³y·ÃJÁæÁ&$½£&¿?«ˆ¥–s V6JÚêï¿V„÷±­³Š?ÛÖŠÛ©•çÕW»yþA?ÿýá M­lY!Ù¼Lb×`<:ÃﺣŒ\KžÖ¹ÓÑófÑ»‚ö¦JÖ·x`u5+%ËBŠWç¹Ñæ [ €ŽFI:gòúþ^ì7ßßÑÈö LMçx÷è0ç¦y¼«‘›0LÅÚv‰&%Ç{üo÷ c“4›(Ó,o  Ÿ]MÐ{5Éþ“a^x¬…åÍ>¾w¿ÿ]‚´Yñù< Ï¡ñø½uex€W߻Ĺ+1~ýÁíM~ºVÕòÉù)ö$­Øínvk–U²´ÑO]ÀAmÀIc­›ñHŽéTžî 1>¹%’˜ágo^毞^ʪ%<¶Vc÷‘n_Õ¬|ÚÖïþøŸçà÷:Û0•âñ®&vÉoRWåf㊎ž 3SP˜JÐ7硵uH)øÃ© ‚Nžè ñâ·Ûx`u ˽蓑p–Á‰ é\e >º:‚l^¤o8E"mÐ3ä¡5Õ4×¹9~~œTNaw¸ïNÀpDÑZ=CWG5»ä£Sã¼þÁC×Òlß´ˆæîž)Ò9ƒXj†mêYOg·6ÓÖXAÿp’_}8Ì+û®päìg.Ç9{9Á™þiž™B“‚Î6?—øãåñŒÁLA±jI¹¼IÏ¥I¤Ô°9nݪç  LJ6´(lšäçoõ’ÊDâ:6MòPgÓTô$AF‚NV/ pq8ÁOö|ÆÁÓ“„c9„åÚ" $JAïP §]²²¥‚új'zãLÅóìØXƒÃ®ññùi z!å-"ÔNgàOgxfë @Þ>4ÌåÑ$Ooi¦½©² ¶{ÿ cSYZB^6­<ÿfxQü*Á;G¯‘άlöÑPã"3›Ò©©´[óL2‚ž‰ß¹€s£6Î\ÎpoG-Û6,¦Rübo?zÞ䥧Úñ¹ìÌŠÿ|ûR ^zjv›¼ üõº „ `©‹\{£!‰LK+MBA&EÏ$î\ÀGýNL¥ØõèRj<!˜Šë¼öþ‚•NþüÉeå…Æ#9~õÁMužÛÞ4 ¼({FÁȤU†ý^;R Ï˜7\c}fSQôlòÎ<¹NK) Cñ×Ï.Ça·žÎñ ŽõLÑÙ^Å#ë)íó‡ÏNq²7Æöõu¬o¯š _°ªo6o"¸‰Lá&xëRA.CÏ&. «MÒZ'øù;üò½Aj<ìÚ¹¤Ÿÿ³p,ÇóÛ›YÚà+Ãí>0DV7øÑ-Ôœ³ÂƒÀïµÊR$aå[mÀÎx$ |É“z&>!¨tÃÎÕ’wOĹ2Æîò1ͱe]ˆÞ« NôFÉϘ¼²ï ÿðBÿƒ•ŒGr$33´-ö!‹‹?°ºš½OÜ^AsÈ©àâH†J¯J‘)ý¶ð%¯,Ȯш$MÞý¨—·Š;|ÔU9‰&ò¼ðÄRj.@00žfp<©v›àž¦ Æ#9ö šÌªrÍ ïvj¬i­ w(MF7YÞä 4;+<, •hª¬müôa¤ÍA¥Kç¹í÷pðt˜CgÂüãWñÒSmüd÷g&dóé¬Á?ýâüM ­ ^U;g̓ûV°ÛûOEB°vi‰ŒÁàDnVx!à‡—KÎ æééEÚì|gë²¹¿=4ÂØT–=†h]ä噇c·k4‡AŸ ­Þ*XNŸZ¯Áºv?{?#Ÿ7É‘³“tŸðؽõ¼ød+^—{¢·<åpLǦ BUŽ›à‚GÖ úì¼q( \@ÁážÄœð‚y¶ÑÍK}c#ã“O=¼„édžîó“¡ !$¯íb<’c}{€tÎàtÿô-Oy2ž 6༠¾©ÎÅ“]5¼qd’Éx¯ËÆÖN?§/¥˜NsÂÏëU‹%ž ãtWâ”9ÖµWràÓ0”2‘R3ż}…áp¯Kã_^ìàÙ- ø}ö2@ikl¨q•á>/~«‘S—’é‰#„`ç†N»ä½±yáaŽ$ù\èŸÀæô²aå"¤€S}„” ªè”âZ,Ï¿¾ÖG[£—­ëjÙ±±–íëk9Ù7ÍÙ+Iv=b#BUÎ2üËÏ4žÎ³ûa„Ôlë pø\‚©Da^x!Äìf Ø÷iÃ40õ4÷,^ÄP8K4‘GÐ4”i‚Ri….f¸<6ÄoÙÙ¹¡–ûWUq_ÇõI¨ÊI¥Ç‚‹ê¼zà¦i½üÁαd÷NN/æM)Â1_ žt%Ÿ•X¦eZ  EO©sK„R€´Ö,!àòxŽ+ã×€ú “î qúRŠÎ%îP‰K"jüÖ)Mj”°`oÈ+ŒŠ›Û ðÚTûüÍ·q5¬³ç`äŽáÅB{!SA6õÁâ(,O DÑÖ 0 ¼xs)焯ª°óòÓ ÄR¯¼Æ0KS¿ *ÙhTѾ¸ŸÛF:gXƒ–+T)'ŠI޲¾ž×á[B.þò[‹äùåþIf w¿ ^¨d=# ›&xtSÝŸÜP¿Ë"°B ë SʉÒïëÛ+xùéFz‡³¼òû0zñ/º»‡æ@ϰÉÃËn®c,¢s¢/^¾IéÉSÔ£”yCNX"\vÁw¶Ô±n©½ÝQŽœOr71#<ÄüK¹8¨ø‹­6„„£çc¼{,L"c”‘Åþ¨6Bhxœ’-kül_`d*ϯM1/|1ðâ´ó|ï'^—†>cr¼7ÎÈTŽá°ÎDT§ÂëÀï±Ñ\çbe‹‡•Í^Æ#:û>‰ñÙpvÁv!ðÜ•±u…d[gM·“Êœ¾”âdŠ«×n<|qðÀÝ È&£zŒP•“†j'6Mb˜Š±HžhÒ £×ëÀ—?W/4Ÿ¹+‚d ‡£ Oê7Á¾lø;ª·á ‚\:öµÀÃl£³‹¨BA.=ý•ÃÏÛ.Ô\Þ¹Lü+…çóäÀíD!Èe_<|!t£9=~=“üJà…üKž–£Ci6xIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/dribbble.png0000755000176200001440000000420612452540640023726 0ustar liggesusers‰PNG  IHDR00Wù‡MIDATxœí™[lTÇÇsvÏ^Î^¼^{×WŒ0` $®Á@ …‚Bh¡MD¨·H-}ˆUy©úXEBªZõ¥­*µR•4U)M„š´ jB iQ@„ LBÌÅÅø‚ñ}×k{ï÷íÃÙ=¶Ùµw×`P%¾§ÑÎÌw~ÿïÌ|óÍY‘9öN†ÿc“6À½Ú#Û xØöHÀÃ6ý}óä¶ÃúzhvCC%èîŠM,ÃSpk®ÀLø¾º~þR‘B!Àè¬À¹µ•š½šýãM$Ho^@òÊFÑÛóíceÍØ´ŽlYÕž Eè}ý$:““Ël5c®­Âw©{¼@ŠÄõà9óñ©öuM½Él Ó¶‚Xÿú@¬,œò²P³¾¹I%|Ÿ÷pù§¯à¹pžWß%>¥Fй¹…†;æÁ«mµ•I¦˜<×ÅŸ½Nxp\1ÊÈÏïdÚ"–I€ÓßÚ¦Á{/Þ û÷o“ FHÂÜ|åŸdÒê–j<¼ ûÚÆ<øÙ¶Àäv`¬ªÐ¡3Q~°O*² u€QÔÈß|íd·,xk˜¡œU“+¿û4Bák÷o£ù¥çÐYL¤c b£> .ò3›ÍÜG¡© P3ÌÍ?ž€Tz|lôƒO ß™@YáÆõ•öycŒÕš_ïÑàM.²EAi¨F®°¢4ºPª17¸ º‰OÑ÷»¿“˜ôç ·É…»úU€²ºŽÀ'7TBà4Ï?Í‹ È.ŸL:CÛËG‘mJÑ)qï þ·qlZ‹ÞjFvÚH‡c‹ÂÄîx4Æjðrý3Ñ0¨œ#¢¸€lU)$Q>æ!ŠóLö$<0Fr:„œ RûÌ“H²žªá9ݹ ¼@‰'HùÃèì úJ«Ö¯Ž,‚‡ÉR¢€¬ûGûO'Ñ5_GF¿˜ƒ2Ô9‘d=¶'Z:‰t4^>÷¬P"Z‚€x zÌõÕEá«wµÑpd7R¶äŒ1u¶ ×þ­\„Aç_ )]Ù€ýÉ ªØÉÀ‚ð¹yÅLø¡Ñ‰ÁaEipöäÁëd™ßÛ‹sÇFmZ¨gˆÑ·?&zÇ£¾·ƒê¯mE§˜0¯ª%Ú;V0ºææÙs'1ê[J)%¼Z³bÃÊ‚ð«_:¬Á§c FÞú7}¿ù›/„ÀßÙ£ù±m\µàÒ°´­ÒÆE»‡…B” àÚÖ¬ÙÛ$Í™,I4ÿèÖuMjÄ|z~ñ“‘—*ã£>Ùû‚}ËÚ‚ð:Å„µC­“2‰$‘냋 Jyc3¤ûÕêÒà´ãܾQsXÿì.lëWŸôÓûëãÄ=Ó æùÐÕÛè+m\޼è:ö¶#²õRèr/™h|QøÒÞ éÖÚGö`tÚ©ìhÁ½o‹ù¾_'á ,zHEzG4?æÕuóàÍ«k±ïiS£Kà?ÙY^P¢'I^W—’ÞbbÕ‹i:º_}X2ÅàŸÞ#1\^ˆöŽj.M͵Úx½]Áut"{êÎ]#í…‡2ndúS×H…Õ ·ÒT£•Æã'Îî- /¤üa^õ’bn®Óàk^8€.{Î$'f|t¥$x!ʹR΄É¿@&™Ò~JEbLwÞ, ^+Ö†Ô¬&»(›¨ûñ³V¨åv:ÅûÚK–_úÊšþ¶ð[çH'’€Z´¼ü}ªv·#ä¢ðˆͦåš ¯T+ËT Œ÷Õ“¤¼’á…Kû2籂ã‡O#;g/©p”é³W Ý"rk‘É̃—d=JK#öí­(sr=YQ“þôT¨]ÚcÜ¥œ`.ãÚú»lÄ‹7ŽÇüãôyŸoªÏõÛïóÙqD ÚÚ5ºû½¶ævœƒþ±"üäÕQÞûq¤fÛÉŸGøàÚh¾_Ïsœ)øÊî·Úð_Q VÙwpû•hXÀ~í$Ãs *S›¯1—ùˆg"W›ÑZÓ&.2Ðñ4Oy…K7_afõCa•ÎÞú"¡ûüc¨DÅǽÚñå¬cðR{b`DSü<Þ?€¾a»]?œà‘hñÚrË^ݶ2y»‹÷>-ŠW‹y« µEØNb©[/›¬þøzÒduÑZÄ®8N×zÅê¤7sÄ—ªÃÖ¾WÀJ@i+Tµ”n_)á „ÜS`9T |ÙJè&k1£ØlW„•‚JøâžÒM«y¶Ón&±uYÀ6Hò+±¾ºKrÀrøZð[¹é´Ù¸€L.^¼Ö3qÒFÂUØÍÌrñ>eÄI›‰ÚðÅãG+0­¿IÆH’5u¾üã¬kðy2øzîU2fÃÔùvþìöð[9Òp,f/1¹òó[/ãnçÀìÚç¼3u¢~ØT–Vi2Ú¢*ûÊj³;ê$lxiV@(ªÒ{Ø#éÞ0uÛð`³ …"*=w{ùnö-²fA ØO‹¶áEšx°²dÂ`a6 Œ>z½ÌwñÊ`HFŽO—ùßþeÈÑ“/øíÄÁ°J÷!ëo:¥ðµýÎàEÄùQ"Vè>dñnP_ÿ¬cÞV[Y \=Lå„V~§ð® €Š:«˜0¿»–úÝ€Lé¯c˜:3ÉW³gª`.Ï)î´WλÓ*Ti›ëù—ðJ·¶ ÞÍ´)tôxî|Sg¡fD âKÙ–Ã;ÞjŠ)´wi-‡ÿà¨4HÑHIJ-ƒw=ªD"ZËà[.ÀPˆt¨-‡†P¥ÖㆫðÂü¬â (´µ«®Â#ð/NS@Ýf»pIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/48x48/google_plus.png0000755000176200001440000000343312452540640024501 0ustar liggesusers‰PNG  IHDR00Wù‡âIDATxœí™kŒ”WÇÏygØËì\ö¾v„îva·,l‹RŠ–(¶µ$MSS«iM4blbŒ–˜/ȇƘb‰ACÖµ„ƘB¼¡m(ec¡ lË.ËeÙû}ö6×÷øáywÞ½ÀÌì,ž3sæ=ç<¿ÿyžs›ýݯiþM­4ÀRí®€•¶»VÚî Xis-¹‡š lÞ õPu¸Ý·®?‚gÉnS–»€Êjxê9¨k ~î ]'ÿ†i&¨Øúþ¦MŽª}?Îô͈3ÒúF,ÊÕKe@rÚ‰î‡ç^ÓäÒ¡ ŸmE L­©zx'ëö|QV†&f¦¹ôÒ÷˜¾y·R´T—/Y@ös &hÁ»ÝÜ8þ:Ãg[1” €©5†R ž~“®×o71ŠŠYÿâ÷q—”`Õ„¸69?0²žü¢ç§ßB)ÐZ£Dd zÞ8Fd°ßn¶ª¼’šÇž°£3M.,QDvV×Bí:»mi°D`EB½ù³£yù¶6<€`EââàèаÑÙX¥š‹%"-ZkÆÏµ:êTVc¬*H¶pFââPn"²(s «?‚ˆ5šé‘0’ßE†‰9ÚˆárÀ“üœ05mÃcË,`Žù×7Y³x(I¦qÌ3Æœ™ž/ÉÆM“²‘€þG±lË6^’ù¯5(!mÚõÇ’ËíBðÍGŽÒ|ä( ­¹<2¾LÚ΃9 ØØ‚gM Ÿ‚J!Š k‚èxœ¾?ýaAøt ¡5£¡e0<@âÌÛŽ¯Ö~õ(—Ë•")ßö Ü¥e˜Ñ(‡^&:п |º†Ô`ÄM“+c·‘õ0N¼FøZ‡]öÔ®eÃÞ}¸}>Çèú›$øÌ—0#a®|‰‰óï- /iaHdÂÔtŽßZDög¡XŒU¯dà‘ÝTî|Q _S3-~A¨í±ñQ<÷ÕS¼¦3¥ãÀ~¦¯\¾%üœ,rÔ3M¸:>Aß» Nng!¬ÿ7œÀ¿y %÷ÕP\MI}£]§ûµWLnfs'l6vå…/àR½¾ù"r^F]J±±Ð`øÔ?¹öëÃ\ÿÍa"ý}Ž:‘žîyð¹˜`E¢+49Ÿ#·.“•¢¥ªœ÷‡AƒÛp<¯zt7“mïC<áH›‹{ž™—>~ùGÚ¿þ윕*-4tOLôzlK¾‘¹”°¹²aòËŽg%ͬ}qî@À†OAÏ_zS†O½'´¦gb*R"6U–1tò‘>çfçYßDý¾ÞóÑEáçNãÅàSƒ`}“Ó–ï%‘WVC]ïÅUXDsy%‰¢âùýêöþˆk?ÝO¬¿w¼#·O‰7þ©™ÁÖ°ýSà @"ÎÌÕ¦®u9÷á0f$LÅ®'(Ù0{zuùÔîÝÇõŸüØÈ.=™ÀÛ"´Îr­o„g÷@±‹2ôô¾q =3bu¬4QŠšÏ=OÅgv;ºy›ÞW~6>Ó‘Ÿ›~™Ï¶ÁW¾Åb£#\úÁ·é>ú[‡ÑöÈY/*¹õ}•î_BÇ¢v7¾=„ËëÏ ¼  ¨ ÂÓÏÛÅ®ß!:ØXC¥ÜcGC)ýû݇Îö¥…ÁÕyÏ<;? †5]t³(÷·ØÅøÔ¤µ£¤u†X×ICRNSÍÅr6Ýva¶±‘¼ÀC&XU`>€ËëÃð”,z2D¬§+/ð™¥PxÆfú¥¨üôã :M¡SN5ˆhŠ“KêØÉyƒ2ï¾å(V?ñ4¾Í.èpNlOS žM[w|HèÍ¿æ ^D0ö?¼eÿmÜè$¬Å¨¨²:P ÿÇ·SP$>2Db|tA§n¯—²ÇŸ¢âó_&ÒÙNßÏ_†X,oð™odÚp1ºã1ìB:žEzo2Óþf$L|x‚à\2ŠI„Æ=~ŒÉwOåuäízÙìĦÖ\žŽRúÉ]ø·n§puíÂbãqÂíL´žfâ!¦¹<ðHö723ù³‡©5"‚ÛÀUZ†ËëÜœ zãªÓérÁK§Q%Âú2?í£!L­‰‡ÆHLŒ]Ìé2Âg¾ Í1¡¾Ô‡!rk§Ë O®R"Ö•ú0D­¼uú]‚‰k^ Q+¿ä+¥ˆPç÷ÚÿÒÜ)xIVÎËXj}^G:-7|j×ÏÛÿÄ"°ÆWb‹¸ðü9MQ•tIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/0000755000176200001440000000000012452540640021430 5ustar liggesusersBayesFactor/vignettes/extra/socialmedia/png/32x32/myspace.png0000755000176200001440000000061412452540640023603 0ustar liggesusers‰PNG  IHDR szzôSIDATxœí–Ën‚@†¿3éFêÖ¾ŠïâÓ¸×wñ1\aX»ÂK:eÕ.¼-ZtƺáON—ð}Îd6›}óĨgÂF h€—ªƒãñ˜ÑhÀ|>·L&’$a±Xü:_Ù Žc+ò=Ó4­'pWæÓ°Ùlnp%!J0ƽg· ¬â•µ„…ù2dÙN¢rË™N§ÖÐ2¡( ¶Ûí?/Ã=üPEQT $I✽\.OàǺôO¸^¯É?r½¼Èq+ÈéÓTì‹Ú]_n{U]|Qá¿ú…‹Èõ! À<Ͽڲ„ïûCÍïÀp8Äó=÷p¥ê/ÃÁ`€çyNáµ;pH¿ßG{Ú¼Ö œ§×롵v¿K ÛíÒÖmkøÝNÝÖVp+€à- ÕjÝ ·‚ËÁAø‘fL 7"e IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/deviantart.png0000755000176200001440000000203612452540640024303 0ustar liggesusers‰PNG  IHDR szzôåIDATxœí–ËOœU‡Ÿ÷|ß\ ø†)ÃuÄVL°EM[M[ïIÓô/pé­ÿ‚îMÕÄĤ$Ö˜Æ4ÑE&’ÔÄ´Ê¥†a¸Éu˜;Ìýâ2Ì„N[#Ð gu¾óžó>¿÷wÎùräË…o ¼À¦^$üXÀ±€cz¥Àk5næFfƒS7W~$–‹¸€Š¸m»" ÌbâLÊE.=p¸£ÃÚZü>ï:G[ÐIUM"Bµf£V³ãkéÍb3f#`=d= ™OýwÙB–\!‡&Jí9ÌFy¿º»ø½’ò3ŸåqÜÇv.ñteæbÝ ƒµýOM¬M1¶:E0&•M#-µÍèJ£­®…^£“F[}Ù§ÅŽÓbçÒÉ!Æ·<ŒDÏS™€®ª—ø¨áÕZUÅJ™Ád˜ÏÞü¤lü»‡·¹5vQŠÖ:oŸâ¬sMiÅ9J„Ú>ú«»¸¼ÏhܳwOY\7®”Á=~/?* ¶a+µÍúÖfÙøµþ÷±š¬ °[gøÑÏ|1rƒåØÚ¾"LJçCãWj†v´˜í\7.£ÉÞ¥ðø}|õû·ü0v—l>WR…âjÿ»ü4ñKYÒ“Ö¼×sæjƒ>£‹P2ZÑÍ×N£k¢¸j¼ƒE™Ë‚·Gï’-ä %Âü±ø€ó犱þ¦^îyG˜ ÌÓÓØQ¿Ôñ-5MtÖ·c3UÞF€t./º„Þoë¢^?Q\ެ±YED„_§ãöAô’ý¼öÊ Þáó Ÿ¢vÓ”Æé¦¾ŠÐ¥Ø žÐ<³‘æbKäÝms훸Û(ÂHd“xs¸í{W«½ÎIs­+ãœmx"0’Šá Íñ8àÅYb;GD% ‚è¥÷·´¹›ºé1\ôÙ;é*±¹´}Üw™¯ÿüžW/cÑÌdòYf‚s̆÷{$C»…(Ø-¨Ž’/ä ‚T´íYíæ_ÃB&ŸÅž§@a φ‹ 'ò)lÊúÜÀH2ÊT`–Iÿ ÞÐÛéøN2Užøyà"‚ÉÆ°™+ Èä2Loúðç_ŸÂŸφ ÿ Ž€¾\¡Ål/ƒ.†—™Ü˜Á˜Ç˜£@Q{  .JÐG·<¸-.¦7f™X›Æ𱕊—,àÐà"‚ÊF¹±x‹µ©(ä €‘_±n1áp·¡4íHáBÉ‹H·˜hîs¢tíÈàEJE4õ¶ týhàJö¿ u³ {·¥i‡ßçÀž£³¥´C…‹<åU¬›u WJW‡G„)ìDñPýS–ºÇ$Ž ¡àÁGÅÕx‘–R<]Zú—÷ÄSç„£ž§/aµX@ÿü@Ð4±Ô¡“p¼ãчÒó]pA©…Üêåbß»ÓÁ¶gŽ„F'0ô<:ßyš„˹þø5Ïo]`Ì׿^¬+îg…»8uЬýQQø ‰evpRü+ç0'&¹á’Ênþ“²€Ïã¡Ì§á˜s¸XŸŸÇC©¦¡Ý¸5íÛÛ†ÝàÊÍ¥üæÞ7ÖÏ.’ê1Jæq8ÔÌ€®Su»ƒž8Ì.é*h¢DñZn…‘Ÿܲþ–êvàR*<Â¥(T܈#V‚mí,;q –;NiNJϲ½ˆrrâ7œSQŒè5bøËy«× yÕ5 ž?ËÂêuáYW€°qûÅo¸ð(“£Fü~õ2fW,=w!>NÏ¢•¸çIãØV˜Çv`#jÝ–Œðì+€ 0â¢m;bF lß95žœÄ»²ŒÂ3³á1ôŸ?ñÕmNZyþ¦:Fº»_ÏžRtò4¿_<ÏIõYh"¥ß˜ÑQ³ÎÛØ§e>mVá¶·À!ÂJ-Öà¶›Ð4Q’¯Î ÜvM,Wóþ.øÂÄV8¨ÒIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/email.png0000755000176200001440000000127312452540640023233 0ustar liggesusers‰PNG  IHDR szzô‚IDATxœí—;OQ†Ÿ÷8»$Ár_/1V*jpÑ’ÎÆÖÄ,üÆX ·X™Øû ‚P KcL”«â%€bD#ÃŒ·™ÙÙ‹:N7g2çyÎùæý&#wàŠË&³™ð--+mæÔ(*. í×<¼¸é›J?÷q]'r¶ëØL ?à퇯9€ï¯îE*á:6“ƒ=H`/;¼›ú–Eàðe>õF"á…WKa$ìe‡‘é… Æbçñ¦žtÿ—D.$ЪÄèÌBx $CÙékL tý“D|em!@Çu3ÇP2ìo¼Ž€ñþο’ÈÖáÆ¡ì}@2T'SŒæ)‘ N.åш$CíùŒåÈ?ùËá…gŒa6¸W"Ñ|›Dó­ðûÆb_C+> oHøà&L x¾CÆ¢¬á*FâËó>p\„•àÍýHà^‰½'[`öeŸžñHD÷J”žh<<†‰‹!Ü+Q|ì’.Â~L^ͱ´¼Q/ïFžkÒ{{0çÁš× ÝêѺŠb¦àð¬}àHͪDá9[ñ¡ê=Äc¦`ððÆÁÊbâk'1<¯ÀŠÝÄ-9<çÇÈ;êËwm‹.Á“Ë@êM6dIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/app_store.png0000755000176200001440000000221412452540640024134 0ustar liggesusers‰PNG  IHDR szzôSIDATxœÕ—ëO[eÀÏá´PÚu°BKKW.a‚nâdu'ÉbÌLüâ?˜ø/ùIã>›,:šef*º›ÎÁîcãÚRF¯ôJ{.~(E*—c#¾_úöé{žßï<ïóž“Êçß›&Û8”í„ÿÿ^íØfC]ਚÛ>p ެ%údl{LƒÏm§½I':;þâFƒ[0xïh€l&BôÉÄ‹Ðtx0-8V޼ÖDf>Blnòù ¸œðq?ôìEÛã‚iÂñÃ>ìµ2©(ñÈÔóxsØk ·»¤²&BV‹Â»}>@Ȥb$¢Ó[/pƒ×UšçòWoŒ ?æÎ„ðz·‹¦"B&' m€¢”î¾<.ü$¿ “Ë&¹uwŒ¹„"BŸD„l&N2>³n^uù—ŽC£rAt¾ýö·ƒÓ^ŠÍÌe¹>¥³½Ž#=œþf”Ë7cœ:Ö@g›“€×Ž(§¶UäJ¤áÌ¥u*P[Sù£ašœ¸Mrö=Ë»ç "UÂûGý´6;ðºk¹y7L6¯pâ Sá·ÎWä³Y§dÝ-¸:ü„ÉPšþ¾F,‹µº?–dt*Eß7»êªx«§‘¢frm$ @[³v¿ƒ‹W#èFåÛÞÐ5ÑàÓæÓ~œ¢Íïä@W©ótÝ䇟§©µ©ëmZZÛÝQÇ»…ËÃ1 E€w5’Lk\NTäEÁÐ5’±™•éÜ?óï.Ž£ë&§N´,ņnÌKèïóa«©ZŠWU ‡ö»È þ¼[ú=6:v†þŠ“Êh¥›Êh"†Æ|<\Ù„_Bp|˜ÂB¡goÞÆÚÅŠ¼6 ç. Qîv¤ô)¢0t#FOWÕV¡P4ùì«IDQ–à"†¡W 4·î'4q ÌN¾í_ŠŸ R(š‹ Y."dó§ÏNb±(ŠàtXHçŒðò5+|-ÝìõEp:¬L„Ò ßO<^ŽÇS»›l|ò—LNç˳3è&+à"²v¶ìnJGq`0¸axy®V)X- õN /·ÛW…#²zn¸p|Î9TE#Éo ."L„øãNŠv¿™haU¸¬%p²’ƒË.>Ü4¼Üp®ÄqŒ¤8ܽƒ©Ù¦ 9`-á{ÆFïãò´¢Zj6 /¯Ý³ÛFワì«__³¾8?ý>CQ+ ?ÆånAµÖl½‰<'óØmÊ*§@õþÇGJ–ª…O‰h]+l¾ÚžÿûÚußÍ­¯€¦¡››¤ÞÕŒªVo|ÝcX¾À>D”’Ddš:—ÕR½%p6"ÐäïJ•HDCì¬÷¢ZªŸ.OÛ‚åÃÓü"¥çw2ÂYïAU­ÏßÐ,ÞD“T|ÇNwIâ?Âáoxûž9H±NIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/facebook.png0000755000176200001440000000067512452540640023722 0ustar liggesusers‰PNG  IHDR szzô„IDATxœí–M/Q†Ÿw4,*¡%¢©†DX`á_XYÛúR]ÙÙÚøú?‘F#!ñB‹¨µµh*©v¦sgzuã¬&÷œÌóÎyϽw´±[.ÓÆpÚ ÿ û‚fÆa2=ÝíªÍg²H°²£1÷šûó=FR‹®ùPÌ&¼á’(\Ø0=æ£H xuØ0Ê‚þhýZ±ôJz;¤¸ä ‰‡ë#†s5õ;Щ àïpƒƒÄãM®5>>¯{Á‘âéö8¼×hGBrx¾;±$À¼ºV*œ"ÓË(½l&fm+ÏÛûW¼úlý(ö‚Ãð‚Ëqì ð‚ ™D™,.öAbg}¾.¿º™k8pàøÄ‚kÎ.…° ž¬ÿúŠÿp+»ÀªîüÃÏ@¾á–:àniüÃíX`·cÜŽpÉ ÷O˜ÉÂKñ Ó¶·tƆ§ÃÕªë¸o0ÞÒ!ìHÑøê@^W’r%IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/friendster.png0000755000176200001440000000244712452540640024315 0ustar liggesusers‰PNG  IHDR szzôîIDATxœí—KlTUÆÿ{ïÌÜigné»Ƕˆ-϶Bj!!ÅIQQ4&ÆDCÂÂ…1º11Ƹ0&.XHÔ#Ô@"Œˆ  J(}?§¯iç=÷¸˜v„郚°álÎâÜs~ßù¾ó¿÷\yOý¨x„M{”ðÇ 0ò°‰ƒ øXG1>²É À8a:¡™é$HtÞkÊ|˰–RvQI.™tG†ŒŒ²ÉuZøÜù Û¥™sZÛ¼Ì逯±žmTRQöþÅ©ÞËô„‡ÑŒ©¹³Ù’»–ú¢¼mlIJhp_ÁföýÍéÀël Žr®‡»ùºùg¢£ˆ®¡6ˆ : P D„<—žÒTYeœ»Ê!«9¹‹4mÖCXC u”s3Üç—~`È  âÐ*2‹ùlå[|øôn²ü±_Ün )ÐÆ¶¬uT÷d3› i˜8ØM5!åË«‰ê6‰XÝe$w«@wèì-}‘µÞ6e¯âÕâÍ Bœû;~%ñfáb­þ´"Ò Xl28Úû7þX{ žì(•\1šW d£ñ ¿ ýC–‘É&ïJFoô,L@5˰QœèiM¨É-g¯o[—VcÇâh.¶­8ÐqŒ £791t™ÃýçAÎŒ^#®ÔXO¡”b¬µ÷>NÚ*x‚lz#à DÆ(4—ðqÅ ÑÙÎz£c\ë@sÜžìã«¶#(Ô=pDŽOÒñSj"š ŒßêÃZQ4·&á14CÃm¸0DOyÄD K 9  MÓRðU+3}ˆÀPln¦Æ”‚À¹ ’ùvEýüÔušî°Ÿc¹<~l…:v<î4P€h‚ÇpóIÙ>x²DRïiWDL´ÍA€¹®,P Pê?Ëá¾óÄI¤¬V¶¦ëØqÝ™ì+­2bp'ÜhB¾ÃbÒ§àhS"”b²ÓŸÞ.FXfæ’of%ËHè39OŸv¥š®aÇm\.¯äÕðÛÈ%ܺ Ÿ+öÈà=𙹳DÐD7ºhlÍ«LCO-0“«Âe8y· Ž³€›¡nš‚íÔ-Y‹Ct'Ûîƒ#‚h’>‚F:Øi¯¡¾¨–?ýW‰O`jNê k ÚQÚBýí0Í Ä]Èöœ*ÊÌBFâìï=ŽÇ0y)çYÆ!Î[Gf"ÆšxÇØÄûËëùüÖ!rœ^ömN7…–`ú~g(>ÎGË^ÆÒ3ønð$vøp‘ù|ŒBUÔ¹WÓh㛎ãä8½TYe”˜XF1£;:Âʼn[\ uá5Löíà™Ì2NZøvè´pDæ !ì[Í Y•â!Îrf´…I;2³ÈTùmÍZîœ,=ƒÓ¾÷ÿI;-œù8€‚êÞÞÈžl‡Ü ÷ãM€(r /ef‚0žÒ0r“æYw>=6ï â­Ã<ç­`ƒµœR³¯îF‰íÑA.MÞå|°•À,™ß×"`JÄèždIþ7ËÔù\pDx+X²ª8yûà 0ղʗ¢é²h¸È"þ ¬Ehº¶(øC;0Ý¼Ë ’".‹à)É›±p8ÿðËî»iÌe–IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/odnoklassniki.png0000755000176200001440000000204412452540640025011 0ustar liggesusers‰PNG  IHDR szzôëIDATxœí–MLeÇïÌîÌìvù”B)´`?Bb¥"M¡µ¶éÅÏÔÄX&z1ojóüþù¿ÿçÖ'OXÜÇGºŸðÿü'x\¿¬€]OAÍ>ÐJÀÈB| "`ââ¿, r/z|¡Âujf¥ÿ+´«¹jéü|¡B¸e’ž› —ˆÛ%ZË3ÌÔw%À¹»Ÿ´á©Ù1"_œ&9=ŒG RÛÙEÍÁµw1pö[ö–;këÌ!AM+–¡é~å‰A,#‡žŒsëÂo]À(Å[½›þñåMàQA- ›X  ˆÛú,Þ¼l—«Å¬è“‹p&ÀÔAÏ®jñ¡n À…øÊêìr#“D‚Œnr}j}Î9¬¹adÅÇöã¯"yUj>@xÏa,#G*:”߃LÎäÆtâ®­‡P } Û;AÊ[ލl`i¼%¦´ùB’˜¿ÖC6µHAV7þ-ISUàξn¾†™ŸEm{é®û©©¿|öFzцKy—àS$+ E¸ºˆÔ_2‹l=‰¿ªÑ^×ÓK, ôí9‡•K¯ —$È꣱ å~û]gì<[‘˜¸ÈÐT‚\ñ6´’jÌ\šôô0f&,¥úðËH²‡ÉoÞ/€ B€$ªWb[ØçB@×yðhdoö¡Œ÷12ø3ñù²WÅW^OÉÎG)k}o0 –ɵÓGÖ„ßΆꕩ i`ò2Ô@iì€Æ;³˜™Hd-XPž[ž_.IÝ0™ú}Å¡€¾˜¦¤õñªu²‚ìWî(]½ÄLï¹uáаœOeAdQE©ÛGð&¶ìhC ×b™:‹C?²%9v…ttÈ|5¨nîÍůGjr€â¦öü†Dfa‚ØOŸnhûßá’îÆPØÓòÆcïà †ók•/"+³?œuÂí/YYâØ)ž[šË\Ýj{žª£¯»ƒ áB@xy´Õ¦gFùø¦¿?c—„öŸ òñ×dÙܹ²‡Þ_‰ ÿõó·1 įt3Óû¡]Zºÿ9Švq8 ¡eBrÃdenŒñîS‰y;pñKç‘„ Ô~¿Ž7‚KB¸ÃÑX’TÖüGi_î&„B@Cy€ *o\¸ a¾a}™Ÿ€âÙ¸ë1Ì7® û¨ž{†»và¯"¶–jøùžàø:¾I±ôj>IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/digg.png0000755000176200001440000000115512452540640023055 0ustar liggesusers‰PNG  IHDR szzô4IDATxœí–_KQÆŸçè] ZÒ"iViI”0…”èmhâ7h»XºèJ¡ë$У‹>A ÍG01‰Z½¨¬\ Ý2!º*½˜=3gΜ³³ëŽJàs3ïá¼óþžyÏ{`xïÕÞŽQâ8á'N ü?²ýÀ‹t8>2Ý ÷¹ùiÞ‹·VŽÎ€T}’NbëóbÍê«IþûH/$‚$Šù%$RñÈöûm×åŒÝÜyòî^A_{S('ãØkdœàÚx6¸ûå~l‚ÀöÚ²µÆÏÕhR·¿v[îS•È'Þapò½Ñèðô ?û¨l ì|ÏWf€êëk-V÷ô<Õ¬ÌÝÝümÀ2Å, ¥q å’ ±[,DÐ Ó# ^Wu-á²3×eÛ.5÷ðšÁ¸«™lgx¯§å 8£7¬…õùÐlÛ‹*pDwÀW®°ãÎ~ †¦V\#¥6Ï>èö #Ï¿xG ¼¼ßᙓpÐb ãÅü’?@r’I =Íy/«ðÐ (ðÀž'ËA"5€_ßàÞ´—â±t½—Œm½ÕŠž § •}8Éò·àìåëV¸Â_^ÿ ’FøÊÆŸ$XÉoùöš½í„¶VÛ® œ": ÕÜÞ{(p Qùÿ@s²'vxä è:sñj¬ðŠ@Õéó]±ÁQm¤šÚ:c“UÌ€®Æs©šáUÏ€®†–Žšà>‚€‰DòÀp€ØÛ´a‹L0ÊûIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/pinterest.png0000755000176200001440000000177312452540640024166 0ustar liggesusers‰PNG  IHDR szzôÂIDATxœí–OLUÇ?¿7;³ËÈŸ•nëZ$H«Õ¨m‰¦)i´ø'ÚŒL¼˜x“´7O&=˜xÐ5ѨQjªG5¶"¢5 .ſѤåO‹-»3Ë.³³;–\KY0½ôw™Ì›÷Þçû~ï}óÄ{¶Ëㆺ–ðë® ­y„ÙX-Þmm¨[š‘ê*¼|/iÁ™³È¯º4÷ÿp¢U¨§žDßyûòvßÀü罄{¿F˺'ÀiÙŠÑÝJ‘³m¦{¿`nøœË 4CǼy u÷ï§úÎ;0yˆÌŽí,ySé+Î+«)DépˆŠ×_.?ÁèûáØ)êîÝMó‹Ý Â\ß·h£Ê_u0—Ï¡ww³Ç¿áÏ7Þöá¡Hd Ná9ûÃ)&{> Ú±Éj+ë°ÐPG¨©Ïuy÷=<-Ï<Í]o¾F}{aßEÄÏÈlÿ÷þøºCI&°³Ù`B÷µp黜ôÜÔ±—úÇňmbÛázÉväRóä’IÌÖVaÔZ^DYƃ°þ:ƒJi4:èϧ3ˆRÿ: ‚¼\®0t¿}ÜN’rKE¬ºåÓiA èÑ¿=94D~!»Pa­²²0.ëøí‚0a[¤Ü%{–àœèÀljDò™ ‰Ÿâþ÷¿ûúKà‚ªˆ zÁ~Ù©¿½Øïœm1¿(¢¬·€ÍˆTšd&§Ó’'uv¤.æÖF¼5/  D˜œ·I»ny‘ó3¤úÐ**ˆîº¡f±f¦§qS™ÒŠPÿÄãK~¼^|ŸNÏ—¯„J)ô£Ÿr!‘ 14LH×¹a{ši¢éžãù“Æö¶ijàò—_‘KZËÂÕ¢mWUŠ QTÖËxÒÆÜÒ€2 ôh”mÏ?ÇÔ±OÀƒØÃlê,¸Æ½ÈÌ=+ÂEdõÿ‚ˆ¦±³6Æ……Õ»I ;'Ú±ê=»JúfFǘxùx+ÃWb„5úö=ÈØão½ÃÜÉSÔ>°}s çÜyìÁ8Ö`·,\­%ÅÐÛnÀþíwÈC2~+>ŒR‚x\õÀ-܈$)8ýs©ÿÀE$Ø•ÌM$HO\áÿµÃ ˜î9 yÖ  °ù¤Å\ÿÉ K ¨Ã/¡‰lxP£¥&Zð@x 3ðßh®ªAS*\þN13Ý}1\fIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/sharethis.png0000755000176200001440000000147712452540640024144 0ustar liggesusers‰PNG  IHDR szzôIDATxœí–ËkQ‡¿“×$“¤OÛ¦µÅR­¢âÁ… .TPê® ˆ‚kÁµk®Üª hEÿA¡¢VE Ö¢¨4Ú4}Øi2yÌÄEL4Í̤¦-nzVÃÍÜóýæœß¹7r±0Tà?†ëÂ׬ ð¬d²&úÙL|dއ|b–Ìê è@å*» â-¯í£­f×Íaâk+Ö‚Ólª€—"äòq|¡‹œ–^]Ûh±ýmW¸‹ùÏäô•ÄËYzPp;¿(‚ö%N~‘ˆº= àæ(QŽÐM FšwÚwD¤(b¤§¸›fÆH[Ã]6ºp&¥/Ttô{-έØs43ñu}ôGvW 4 Ü"kš‘åÚÄS¾åæ¬+äôŸ0÷3ÅìØxyS¹”"Ü>Nµïàäºíø]ÕwÀßñ2ãFâ™e{boƒJÓ–h\DÐ 9$Þpyì§GìðGl½Qó.ð†U{»mGM3³ÜN¼ mæì“”ÞwUçXÒeä hèYïèö‘TÜvÿHzÒ^³‹E„7wÚŽÚƒoÑŒlÕ>ÍÌòp~Äî8v‘_ЙÿZýE"B‹/È@ë^¶ø‹ÇøX&Éݹ·Ì˜º%¼æØŠHéhãSµ›²—Ö—ìÅáQý„¢íˆÿ“ªE(»Û–_Ò:Š(»Zë†/«¥pû}¨‘–ºàu{ÀJD £ùŸáˆð dqôïDÚÝIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/google_play.png0000755000176200001440000000200712452540640024441 0ustar liggesusers‰PNG  IHDR szzôÎIDATxœí—ÍkuÇ?Ïïeö7³›tóÖ4M›˜4mSñEГ­ö ˆè?à? ¢=/žÁKo‚àAÁƒ"¾bS°"B ML[ÛfmLò²1/M6»3;?kbÁÝš´½ôf†™çûáû<3óûI©TòÜÇP÷SüÀSï†w¿ö˜7¤ÃF÷àóáiÖlµò,¯ôöp|ï9Ü;€={,¥UÅ•Kž¯¢£¥ žo9ÊcùƒR÷ñºQwl¨É䕊ed4ÃRœr®t‘§Îreõ©Oï.€vãAN(û€_ÇB’Ø¢Â~* óuqˆb¼p÷ŒS˜Pcœ&“U”|†óW#’$ -„õÌç+C\Xû…¿x2 n¤Æ5 KiÈ7W›)šФ¬“Œ¦?r T“Õ]pj‹ Öi¬bÙ;¾(´p+ hs)M'Œ<²~™øÛ3ø‹ç )ïÀfëô¿N8… .§X”ˆÏþlg¥êÈÐZªÐ;T ¿P$¸þœ;ƒŸ4Ù‰)‚¨`"‰462dsв|4ÓÍÒ’¡çìu²‹køÊ‚“9\áSdäC¼ßþ¯ßØ[ÖRÿÓëÖ Ú A«EÏW©¾ý3f|i·Hè‘Èã£\Œ ߢî—Ä8Ác”Bi%ˆQP :goñê_Ò=v“©)aßkÝ=ŸVHÃ,‹ÙÇ)ÒOµR¥P(Ð×ׇˆ4î€AXkCÍúÚ@JK†Îå/¿÷==—çHr¾˜0ÿÉk,ï}‚káI&ˇY¯D„4M™˜˜ØâD}2 +­Ñ‚(!4í³e^8=ÄþKóT€ ‰©âIºù#ÿk«y”RˆÈf*¥HÓ”ÉÉI8€ˆÔ°Nat­¢ ­SeŽŸ:Oר_Ä.ÀÇ%ü£¡Oá™SÃtŽ.SqÓ`_ޏ¿“X+þSüv'fffêh£Ð* MÅ„'ß¡õÂ2ëަ`ž>HµÁjPüv'ê¢Èߌyø­«4_^Åœì!÷ì>t‹Û,v§âçu* ¢9áÐ;7Øß¬i=} »×m)ôÅÂÁ¢£òþŽÈÑ<m)²SqAêîŒ<ü6:Fê«»/.ÒÀªXàè±#Xkw]¼1ÀÃÀáMˆ]Wªñ}1†C‡0ÖìšxÃl„Öšþþþ-íØ‰øl@ôööbÌ;±Ýµ¿mh>¿áK•–IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/bebo.png0000755000176200001440000000127512452540640023055 0ustar liggesusers‰PNG  IHDR szzô„IDATxœí–¿KaÇ?Ï›„†Æœ:´ÔÁKÔjPqqq1“ƒ›ƒ:+ø7¸‰DÅEÁEgAEÄ¥I[±Jµ”K4¥Ü5×!Éõ4?.E)øÂq÷Þ=Ïûýð}Ÿ÷áÄšš²xÆ¡žSüàà?ƒD"r¿âq¬xœãlö‰PùQŠs]ç8~B€{CDø–Í>*„ßk‚¯''ad¤ô£iÂÑìïÃÎär …ëÝðp…Õü‹A,†98ˆ/‘@\Üò¶¶a}Ë4«Æú£Q~OOc(—:÷ ‚_——9[Y±)¾wtÐ2>ŽÖß@0å¼·—·*€xvÀ âW"dS)NæçÑwwíœæxœÏºŽQ¡‰€'étYˆê†qgê{õÊU\D0./ÿ ƒHÁþ/™L DuÓ„LÆž†ÚÚ\Ŷ´Ø9Òi$—C‰€g77˜÷-8=µ['&\Å•oFGíœl2™uÄßÞÚîÛÛö£ÖÓÃǹ9´în”RwUJÑÐÕEdv–ðÀ€£on–@S訦e!µü”33úú\Yï}k‹«ÅŲŽ)5ž‚ÀÂ7‡‡5 [¦ÉÕU®––*ЍɀœeqÖÞNÓСÎNüšVc\_ó+™äçÆÆÅEUq)8Ps'T"´¦R|ÚÛÂò…X|W¡Pï‹ï5%B¬¹ŸÈ£ˆ utB%BWS>çѪSܳNˆŽÆÆ<ÄÄërÀ Õ4|Ž~àY¼^œÂáüBuˆ?È'D¤¡¡â6T¯»ÊA¼…ò̓¸·õ°CN_ƒIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/vimeo.png0000755000176200001440000000154112452540640023261 0ustar liggesusers‰PNG  IHDR szzô(IDATxœí–¿oeÇ?Ï›scûòÓ n‡Ò¡òC ‰Â  b`a«:õ/@BbíPueF²´* ba(HPP*ÔÚPDj'Nê8±;þq>ßÝËÐÆ­ugû.ºäÙü¼_¿Ÿ¯_ßçN.ÝÕšgXêY 86`„fâðÞ,·v!ßök”Àû)ø`¦ h»°nÁw%ذ‚÷•0ƒèÃçà£ô“ÏŽ§ùò^‹meöé.fàÿ÷³•6W `Œ'ü¦‡ Ïûá†^§Šµ·Óë½9 x9ÇÚx€ÛñÃ@1—ž‡ ÓÁëçfMjùûX{ Oæÿ%BÒ€zqÕg"Ð@LÁå3ðÆäàMOOÆA„zá_ÒÝ¿îÂrn Ûõõ®‡ö<ö7ò¸vg¸WCÛÕ,綸¸ü÷ý‰ËL%ˆ)"ÜÉýÃ÷ÙMn”~\­ø´U«‹ãˆ µGãa¡g"Ѐ§á«5X¾¿CÍS|½Rði”™é$ˆ "4Ë›ˆR8±¸O{w»‰ˆ<Ò*…Öšfi·ÛBf—^ÅH˜ÜÞjѰŸd)e>ÙXk»Ä…´?é?üWéÁA´Ö´Ê›#‘³/¾ÂX"ÉJ©î[~éäDÂÛ‹3d’ý£åV±F¾Þéƒ?}£'¡3gϓݳ Àã±1>}m¡oÝr<¾ÉnÂŒ‡Å"¬ÅOùÚçfÌ%ÇA„Ëoear¼oýÛ\™]Û ?ŠwºBÕÖ¤NH¯§DøüÝ%ÆDXœê_¶Òâ§µ½¡pQ*ÚÃèï–øz/L'|ðªåpíÏ <†Ã ý<®\c´Æv5W~/Rïz#áá3ð¸î5͈Aåxš«ÉïwBÁ#Ÿ@Ó…•z°Ëñ¸r»ÈVh¸HÄ \/ uÛí땚6_üRைp$Â-8¨² ×x|œj3ožàçõ7W«Ø‘á"î…$¨ºÍ}¥õ¡CfÉ Ìôâ¡á&„~&fzáPð#ŸÀA “äÜ|dø‘2à3O’8y*\DøYßäpü:IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/wordpress.png0000755000176200001440000000231112452540640024166 0ustar liggesusers‰PNG  IHDR szzôIDATxœí—ÏoiÇ?Ï †!™a1T 4¶6ýa–º<˜˜¬îeu£7ñ쵉G/íÉÕ4=Hš–"Öb” ÂÐ ¶Ãìa¶ãšµHë&^|“¹Ì¼ïóý¼Ï¯÷yüø±Ëwê{Šÿø<Ëd!‘HJ¥ÐuH$@·ÛŲ,jµõz×½°FÐuB¡@4àððF£Á`0  111ÁÄÄ­V‹b±ˆeYÿ€ˆÍfÉår¸®ËÚÚëëët»]®ëbׯ_§P(póæM677©V«ß0;;K&“¡Ñh°¼¼ì ‹ƒÁ€@ €R Û²Y]]¥T*q÷÷»\½zawww¨ý¡I˜J¥Èd24›M–––°mÛßq0DDp]AP…RŠÛ¿Þ&ò“— hšv>(¥˜ ðèÑ#Úí6+++LOO377çX–ÅÓ§O±m›KñKŸÙ¹qãKKKŒŸÍããã„Ãaúý>/^$³²²‚eY‹E666ˆÇã$ Ö××i5[ôû}Êå²o£Ýn£ë:étšZ­vv×uyòä ð)•R8ŽÃ«Ê+¿Üf¦g@¼uÏþzæ¿ñâétÇqØßß Òét(•J~Iåóyo‘(,Ûò³ ã84›Íáý~]×888ð©óù<‚`D Âá0[[[^2^’É$š¦ù†axåûøÉ3 hµZ§˜¦I,ó \|¡Ë—/£…5òù<•JÅoÉd’|>ÏÞÞ¶mF1 ƒf³ù™ø‰gƒÁé'e³0¿¥RÉo@étšl6Ëöö6ûûû˜¦é{'›Íú»ŸŸŸàÍ›7ÿ”¨Óöööèõz\ûå†aг{~Ö~. …xÿþ="B©T`nnMÓØÙÙÁÐ fffèv»¼~ýú‹âÈ lmm¡i< ¤…|w'’ ^¾|éJ)Þ½{ÇñÑ1w~»Ã… X[[óÚõÄEdxÔj5Êå2cccÜ¿ŸN»ÃǨT*¾ÁÃÃC?dõz{Ü#S,ýÝI\D¾~–ËeLÓdqq‘‡>äèèˆV«E»Ýþ,®oß¾%•J±¸¸ˆã8<þœ¡â2êÁ‡¸uëñx€^¯G·ÛEDˆÅbƒÞ^«««þ·¡â£xàd„Ãa–——™šš"—ˉDH&“€×'LÓdww×?ÿG?x÷ƒjµÊÎÎÎ'÷ÿ«ÃVj§‰5 Oƒ8¹Œ|«ø¹À;ªƒà7‹ ç¯øž8§øÐF4ʈÇã>ÄyÄÏ‚±±1ÿ–|VqáoNè©‘Â{¥IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/reddit.png0000755000176200001440000000256512452540640023424 0ustar liggesusers‰PNG  IHDR szzô½d-O±É§)þ?À@ý‹6h8ÜÏÄ`*?ŽC¾ò/„ìï‚T¢ËàJ_2|öÛ$¯tGÙ—jàä-¥ÝšùÁÛ}°)d96˜á“ïG8yþ&aeùnp„™bÀÙÑeºãarã#^­ 9l€çǸ‘™g¦`¸~§ÀÄl‘·vµÓ¼õBŠ©…2Ör7k 6Р«ßLn„ÀŠpüÂ$±°æèÁ^"Ž_Ì k 3“·|ou å@p¿†J)ðË%Üpä=Íç§ÓX „!q…u,Öæ¦ÆˆoîÅQQO)޹°3›!ª†`¥Ë>Ù%.¦—É.•q”Â÷Ê8üÀV!ÔýýZ‹t­Ýë;ŠÂ¡hA%€Ë9h A ä+–ëS²óy&gó`:Z£´7GØÕÛÊË[ã\ËT!öo‹ã*ÉÒ]§›»‡ãh¬­:±0=Që€ðÁNHÏ{ÿùG^H±w{;¹eÓ×g™@+©]làcÁXƒ@ •Ã+}q $iŠh®eò¿áà@»{šùèÛQ,¢ê„Ä:9 e5¹NüòÝIönogpdš/ÇÀÑ4D›¸w·€–GiŒ AÂ7–Á›s Ý^äè-<×cb®…_FæÙ¿½hXS,Xcp´Æ[{ <e?×Î;»S O-sì\šÀBª‘÷÷u²«¯ƒÀ÷ L€ãh¤RlÛÜ̇·ðlGžoùâçÛ¤gŠy>É¡ *¾¡ä„)1AJ§ÀZøuÒòÚŽv"®â›Á4R)‚ƒ;;èk±gKn$‚ñ|‚ÀÇQŠýI¶u4q`G„À7–¯.e‘B°§¯™¯‡r BJ@ „ÀZ³~ÞXÄݽ͒™| @*ÅOײH)8s5‹W*¡Ã ø•2FJÎÞ\Ä÷Îίîré®Ïl¡Â­\‘?§ ˆW§xDPa¤ôTZc.r#;²ÚçWJ¸á¼J™Ñlž[¹"ï!¤\#€Šo×B>¼f‹ÐV´Ä«“Œ5t·5!¥\íó*%ÜP‰á™Ö0*^×JÒÕd—+늋G90¹ …²áÍ]›9v~ 8BòÞëÝËCéy¦K„”C²9̾þ6”||ê6B‡0ÇK=›(û†ôli]ñGø.ܼ±µÑl+ã‹àã“ÃìíoãÅÞE]"®Ãôb™Ñ\®ÎáùŽRt%bˆóÓða]q„øçRürü¯vG8;2éËYcïÇveAñ`Ì¥dgg#ïîNqe²È©«³ÀCÄ i§y÷Å~`[àÏÌ2‹w}ò%!%m!\íÐÕá¥ÞM$b.g†87º„”²ZôևǨ̦ÙÑ¡7ÑHO¢íÔæo¡ðÛØ¿ß.pï~ÑA¤¬ÞZ5âRÖwæÆoà{•ZÛׄâaÙþ·kÄ…¨ïA’ìîG»áºÅ…X@®ŒYsŒë~%ºúÐ:T—øÊXkA:Îßý<@¼s Ê Õ%¾²sÖ:ñ$¬Btô ÜP]âbBÊj‚>)@Kª ¥ÝºÄW€¡ ±áÿ‚æd'Žvë_Éà/¿!¦SJ°IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/skype.png0000755000176200001440000000166212452540640023301 0ustar liggesusers‰PNG  IHDR szzôyIDATxœí–=l[U†Ÿïø^Û±ãÄv‚Mš6®ÓÊ€€JV°”Q~*„˜Ø*º3 HÌ0°!11¡N¨$~…„(T]¨„ !©óSÒÔnÿÄÿöõe05‰}Oì8H]úN–ϹßóúýÎw®åü‚ms¥î&üž{Œ½Mç'àQ?DÜp£ßgáê6 ˆ˜àQP°`½Í!æItc8¢àí˜rV¨bÙ\+ _mÁF}pÚœ0âæÆà½£ðr¨9poµûž ïÖ™û Î…Ë(ú÷DkÀçêZΕXȹ]îÍüñIgÝYèsÑjaªÓçµb•¯,±˜-"¤ßÃû§"è5;ûÎÄBüøóuò‘c âXK›À—½ë./và³!?J)2•©®$”¯&"d“óÚ$´ \+µÇÊè2¾¾]a9_Î=ãÅãQ µ&cžÞrLŽâ!·¼@0þ@OÚ¦=½p¿itbÿb)Å«›”–#ÀíR÷_]êIBk ¬É&è5yîXDÈT|tu׿ý ó4[Î1OŒ¸ÿýå6…É]&†ºŠÏŸˆñîS N ¡”¢fÙ|¶˜æ“?njžh'†Ø6Ûë+ZÙæÞ&NDÇxëä,?û0‰ð("Âå›yǽùºÕnª,n¬më ¬U¡d9G:Ÿ)r=W ì5‰úÛ·pµäv­ï$”ný­Ÿ‚ð[Qxr¼þÎ¥EDÃ¥yM6«Máé#!ÇZs‘¿¤K¸ˆíÏ{ž¯·è9Xñq§AˆÍj¥ÏÌ„yíÁ¨c—⡸("{¿ŽÓ øü¶Å+Ñÿ¶y Å›sqZ¶ÍR®ÀäˆIxÇ Ø­)Ÿé—~¾ËLØeNßïÛõ½!òižÚ­b³åïÛ‚;ºPðñéBšºÕØ­+é²#|`?I„7.%ùf%ÃVµÑ³^×\Bë¥WóŽpAôÿˆtÊ&ÿËâpÀ‹Çp©Jƒ²es*à…XxÀCªÒä×L™‹+ˆ3\©ýÈ-ÿvkWÑî9×õ|'|_-Ø©`<ÆáCŸ9Þ6q¸ÄÀØáYÄ0‡†(; LÇ—1\ø ŒNA”±o8"ü,ÎKì@±IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/delicious.png0000755000176200001440000000040212452540640024115 0ustar liggesusers‰PNG  IHDR szzôÉIDATxœíW± à ¼Cš Âii3ë¬âÂuÊŒŠÈI"l)Žh|H Šÿ;Ýßÿ NÓô„ð%xåÃ{_àx~TÇ\N·Ï]¢@ŒQK€ RJ: @ó})@ÂÐ)ÁIjK #ÁU¼Áu%@#%ðÀb…ª“]‡¡:f»ò€tš¾ ÿ|J Î¼{¸þœÆ—-SN°_ïu\™ss:çvÿZkí.à$ñ¶JÇÎø#ÂIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/stumbleupon.png0000755000176200001440000000142612452540640024521 0ustar liggesusers‰PNG  IHDR szzôÝIDATxœí—ÍkÓpÇ¿O6Û®MÖne×ùrñ"Èp—é@ð0D<ø¾ÁăÂ@Ð?À‹‚GÊ;xÐ*¢Lt AƱ›Sa(xæË6œ«]ÛeIÓ6m=4I“&i–­e—=§ðäéóýü¾¿'¿¥âKE¬c0ë)¾°nPÜÛ : …˹d}™¨/@±óèØSžBaàÄEðrÜ·IW®¶€zOU}ßtä,¦|ýàgµGYà1}ÿ.d¡,ØÈrX%üpázÔ˜¼vBìý(º‡žky"BBÊ€I;CœcŸU@•y%—”²˜I-×@"2"†D„¤”ÅìRuˆ58P'¿"€ß‘MœÈ””Ã/ØöYõ ”Eñè(££&qu›øL b ç7õY»d´½RœQr|6‡ùeÑÔÇÚëCåç›—­tâûŸaöÑ :úúñõÊiM|ϧZý÷«ç de,i´š´¼£ã3 6å•@G_)¯[¹>XÈÊø'J+ >Ìš!ô¶WÖ«¶›KbNF\p@Éîs1‹™…Ýpûg"-ç‘Hgœ¿‚®ÛøEkWOŊʧݷîŸGsçþŠz#ä¼ €¸¬ûm^çÞ0íyGC tì6X„zz õ7‰«3a¹Å7öŽÀü‹ˆaOc#«Ö'^>¶'µ4ÅR:oïIxÃíZ>_ÀßWOš|kØÓÔÄP( |ô 6µ¶iõ¹Å–^CüôÎRœ jÿ ~&y$ÒÇCÆ®¹Ó{[ÔØâÀ(—J=Ä»ÐÇŽ ‹Ÿ§.âD´²»`{E‹Ï[sq‚‹Ëh[s!Ÿ·¦â+v@­œAŸ§fâ®Pc3ëGÐën&ìÄm"§hg›ÀyÏüfvÞY9æry‚Qž$ü©ÀS€X؉/²‹&6&ãì'Gnó'—8Ó±@¨F™d‚ÃÌ”®òzórè%Ç.&(ý»Ü±@`£L2Æ>LGgnú!ýoä×Íù¤ðõš±ŽÆ?0Ź@ß Œ2Æ> »Ž¢¢´½ìå=¶ª;çú6pŸY¾X„*`8”@·’àÃWެ;¾.Ú0—m–Ò¹¤÷¸ ¾QÚÁ½±YkP]4üføÃiÿôÌjù 8®ÓîÝ«Öð°1ù™ãØŽÕvñoçŽò{é'ŠõÐì¥usêÍê†po¸ÜQ¦8^þ˜—õq^ÍŽ“Kc4u.Ü?MÅ.ñÝü±Öb‰m(|J¦+€ÞÔ|á¢H¸íØí×ùÃ>Ëùé“­E!—|ž·òï³£o7Õ†Êç7qié{Þyö Z£ä —0 xIç’ˆ"”çª +'¿;üC©•·eO,ƒˆ Ú ­sJvÑ.²/=ƒ Ô»5D„mÉ—øæî—\Ó~|¢Ðš_4oùÂE‰ÐÀj A-Öhº éfOv’–¤b½lïÙ °òý`]÷…µ/[â pE=Çžì$CɆ’k7® åSØ®á ô ¬“ÈÆ¹X>Ee¡Äk™·Évçqq˜7f¸¬ýÈßúÅ@8"ÈfÿšÕU“å‡í¯4¾™¼$3q¡ºhD†‡~Jô­ìzµRð=_ , xI¤» V6CÃ;þl”xº ¡®š¡à"ð06 bö¹ŽIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/blogger.png0000644000176200001440000000247312452540640023565 0ustar liggesusers‰PNG  IHDR szzôþIDATx^½•ßoUÇ?÷Îìî¶ l RJ¡Ú6%Q h¢46>(‰Æô„Ä‚1´j¢£ú‰&苼!hâ¨&A#€±µ(Ji·;íܦ7;;Ùì4T>ÉÍ9{sÏ9ßs欠¶ƒo_٘‚»‰1mLÿÇÛÀÀ±Ë§ÂÞ¡‰€¿J)pißCX‹À≺MJÁBèjJÑr÷õïîm.ûCÃöû‘I†J O€/ð=QqRTž¡êLTlQÀ"²Ý‚®Bšž¦»žjÞ;G/m?=^î=zµŒ¬\$„Û±Ô^¹°ÖƱN)æÖüp}FSðg¿út@N+M94` ֔šÍܲh ÆZ¬{®­©uvxŒµó.m %eð#Rb´v55ÄÜ;Âe%!=`¥DP‹Œ²1ãî™!™ ¡©`-Ì(í"s*H‰çØ›{‚ÔÅ› ž`>‚YClƃŽ""呈ՔBME|œ$Î9QÉ0RÀcePæåž<ë:ÚHIjp=‚¨–ëÄðMöü4J0xÛÙ\ý )ˆ”eVB¥+ à Q Ün‘ =yÉ[›Ú)æë³‘ ÝÞ»f)­‹²¼·ÿæF5à0T¹9«ÐTpTÓÖ|éñþ¦,kðëW¨¯õã4ðÂúiö¹…,BˆêWQÖ– ’¹ŠpìJ`qà‚`KGî%¹Ä¬‚ùRðʆvöÿ: Z»žŠ/+"´6q(c\”±\†§W-¡)“ávèZV`UsCÊ ÒçØÜMßÃmÔÒÖª¬C÷@R¶ǧY½¸8mšëS3m,ÇG'飖@” mã9@˜Pÿ+S3u¶¾µ­¬jÊ02D.íólgsýÂåIJBCHå˸–z¾9w…-kWÔÙŸè(ò_Ù{nM-a4ŠÁ2«4R)b໳£œ›¢ki#ÿ‡ÃƒWÙò"‚ZŒ’H mêixcß J³ŠÛåø¥ ^ß{œD¢9–´†„ ~ç¥/ŽðÑ‹ñ`ë"Ê äó#ƒìüá<3Úˆ¬ó@(ÉÄ žÙõ#]-,kÌ0ù´Ç¢|†±›džÇo­\¥ñÅîÃç·¿¶÷d¿2–{I>›fÛº–^qjäÚÁ7¿=Ó{àô(÷’­ëÛø¬ïQ¼ßíÿ²»_ãjÙr/x¤%ÅŽÍ­ |€–ŒaÇciæ±i” Êw’lCßOѳ4ÇÆ®å¤S©èŸRRln¦#T<—Íòd©D¹ ÂÙꌗBàvÏg!]߀žç“ËçÈçó,_ÞÊ’%E¤”ü ™pí ¦IEND®B`‚1335BayesFactor/vignettes/extra/socialmedia/png/32x32/rss.png0000755000176200001440000000217612452540640022756 0ustar liggesusers‰PNG  IHDR szzôEIDATxœí–[l“eÇÏûµ_×uÖR6&[;˜ `Œ…³…¨7ŠW&bQ£W˜¹"F4Ę(‰Á LàBD Šà‚ƒÈáÆ8lŒu‡nƒv[»~¯eÝÞukë Á ¿¤É÷æyž÷ÿËsú*ú‹ÕšGø¨G)þ?ÀÀ5£åÕ3ï±DÛ¡ã$\ûîÝyh2ãL˜ò辫ȕïáâaHÆ`V%@=¬} çÅ#8+^™}%gŽŒEò{JPkwÜr='4+€™Kœj¡½¼sCT44l܈7X7­¯“ˆ3öó{Ø]­`"™J»ˆ@q°ŽÍo\µ9ËW;)â-{ñ]:ððN_OC "à«^LxóNJë³üûÛƒÿê7Ô=O†}x\’ˆw]ââ—Ûè:¾/Ë¿â©t”­) ÿÆ"Ðy Úq¶õwF†‡I—c<#Æg mýå.Ê„§Fîrkÿ6ª3'@þ øæAÃ&xz+Þ>Bõšç q¢çàú¡wÐN*f•Rµe7—{’0Ù¹´ŠÚ­»XúÚì²à}ˆôoèÒ1îýÔð/ªZLÉÒ\ŒÎ ÷"ÉXÿ´¦’Ð*–¼~oå"#=-_q¯í¤álÞŽ£\\ë™"ç\èfÌWÍÜÆ Ì_ÿ .o¹aOuó÷çÏ‘ŠG@)ðøk©ó;ÄrgüzŽ~Ì`ë~Ü– ØfXþ˜wü6]Ç÷qnw3ýç4ìî²Jê^ú ¥,”Jg"½ÅÀ_ß~sV½€¤´æf¢p€eÕ^Jl…NÓ~ð]nÿò‰a÷լĿr“Ù”­_› þZ¼ ÀÑÐ90ј5áÒj/>[!Ýì£ïÌ!Ã>¯y;Êegš2½ÉHÇ9çxÑ:D%àhM×`2@IlØ›Þö²¤a!>B€Û?}ÄØ¤u—URZ¿ÎرËÇŒëŠjŸ@M²;º‡Ær¬jšÒï5MŒ¬û€º€‡b…NÄéûÓLsÙ²g2—+†oœ6ìö¼Ç³ö‡£u€ÊåÆÑS½œË‘QÂ~ŸG1xÁlHߦŒ¸ŒõµvUTnˆ‹€’\%è¾`c·Îâ8š¶ÞQjü6®áɉ5kWdÄE@'â¤âQ㎩â"’àÄ.âm-ܽÒBÇá(Ž£iïMPSáÆ‰õN0¿:aþ]›*.äYD‰”æJ÷()Ggæ|<Ðe á€Í¾Q@²ÄÕ”ó´â9KØ–ÐPéÁí’¬‹œûK%ð`©Ù‰çp[B}ЃËRF ZCG4AM…=QÓ!.¸ˆÜ–°p®ËcÔD@ TØY™È'ž» §l\JŒn@#ÜL2¿Ü]ãâg`2DÈofb<íˆ %©*sgÊO\þ÷`USÀ1IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/addthis.png0000755000176200001440000000065412452540640023566 0ustar liggesusers‰PNG  IHDR szzôsIDATxœí–ËJÃ@†ÿ?¸´6¶5*^(‚¸‘"ÅñìÆWpcßAð!|""¢nŠàÂZÔ˜j[t]MJ.“´3 ™MÏ&—™äûæÌœI8º8Ac:ás¹,(?y~¼n6”^“YZ[¯ ܼÉKd'€$n»_šȉÄÝ»£AÀ“àøüþ£—³€îeãáó;O Ü;>ÙÉŒý†ë«¹àãðOÄâò]×xä€!ë¬ïsxÀ¡pÀ9;B÷€=l?r:šƒ²lf"¥K^1ØÞ€½ÃЖp·5ñáË$ˆûs-˜]_£«õ:º{A”Ÿg(/LßÀ@ˆ*.= Ñd@·ÞÄ>ú‰Ì¤e¨nÁÔžñœk{Z–XÀêÒ‡ªo‘”nEDáœîÇÖóÝí¤wx–RkZì¼pQFlK¬,rNDø=Õ‡c¼‡”œ 2ŠêñT91ÝŠÁǯŽÇôÌs8ß›îW÷È«¸JÆ¡>ÐИõº™ì þR‰ÀüH;‹SßÐ\ (ƒ‘ì#õX*¯|° ¥A_Óù>êØ¸ ×ÖÜÌE[qøi[:«D(ª»Keãs jn#ºÆÌÐ[Üïé@)ÏG"h@¥þ&IüáÒ‹÷NÝh º&«ÎiLy$˜rÈ.kðÅíý>¸R#1•@$Ä  áWE„±Îgh.æ²+”\~ä‡Oõ2Ùù$®” Ñþ ßwMøàÞ1òŽZàžŠ²6Æí#Á”‹R4×<îÅépxÔç«,›†+%èÚ ®¹a–g£ÃEÖoÂsÇ,›‚û!Vó@øºðª¶"{çàjƒ xUsÔ¼#pÙ¨:]–µýðXJ¨“¥¶þOðêxIæöÁ7c ²8c[à1MA4•¦oëDS©5mKð-eÀ«’‚ÔMÃá4’¸í¹‰IJIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/vkontakte.png0000755000176200001440000000121212452540640024143 0ustar liggesusers‰PNG  IHDR szzôQIDATxœí•MOQ†Ÿ3íP(‰©¨­Š%  6teŒ®Ý˜¸qáJ]¸ô?èÎ+ÿ„‰n51¸ð#F‰Ѧ«|¬Å´Vhç^m‘2f˜iÓ '™ÌÍÌ™û¼÷žóÞ‘{SZÓÆ0Ú ß°+ è&éîyw“¥ó)Àì $2àÆ_®¸hwù:±¾¤‹³Êz©Öf!Ó.b4á¨ø\DPHÝ? ÜŸ ¶ÁÅ0ïÐiÚ§t‚‹ˆ÷xpcÜöLÕY~î¯å÷U‚zaˆýßÿêëoG¸¿&tÓ©Ïf²Žp_%pŠ?éµ"/“k¼OåÂq+àþ XH¼ckÃm?^YÍ ¾£8<<ÖtøŽmxhh´©pOM;zªipÁ£ ¢ý#M‹áã8ÐwÜ7þýﬥCàÉ—IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/orkut.png0000755000176200001440000000162012452540640023304 0ustar liggesusers‰PNG  IHDR szzôWIDATxœí—ÏoEÇ?o×?³þ‘ĆØNÛ¤%ôÐ PÛ½UB¤Jý‚Z¹qè©âÒž‘8#Tq ÁˆPiDA@!iìÔÄuâØŽã:Îz—ƒëqÓØëuBÕKßvfvÞû|çÍÎ[­ØïÌÚéï o&¬4àk¹2Sn ÃJß·ìš¹4àÖ„Ö¶´­9´›¡‘hÐV­ñúó:µj…Ò´µ€fìÞO (Ü™†kc¥}\ÄãL`a9ÉÂò&B’ЋÛÔ«:å\Æ|¼LÁÜHû³™°‹™0dÊu>m Jx\Ξ­f’„èjÙ'™ ,%aÚ«3Þ¿íÝ‚Y·3p3­p~_­h.ðà<€Iáÿ0jÅØBBa¾V ]a°’Ò:±XÚì¢@Fë·X-À£/%T½úׯÛáBHÖ}àmÑÃü‹¤ÕÛÄyÔj­#Ür(.xxyìÀpµb°ÏšÂ-Kft7^CÕ «a¦YŒgÉ” S¸­À·Ÿ7?”xß"UÔÃc‰<Ï¿æ-áBgÇq¯Ç‡¡ô╵½X"Ïý)[¸°™'›NŸ-¸Ys'o.„V+p=Ú8Ž&–È;ªy+!V?&µô:gu¦†ý ùd¢A^ÙEZÕIiÒj…xFã]RµüÔLáv…Í5ôBŽÖ^Þé`9|þ‘(}þ’M'lÆ72†Ü¬ëpG}`Gb8‚ì vnÛŠ÷Æ;tÙèÜÑØ%<Šì t.„à|GÔQ ".•IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/livejournal.png0000755000176200001440000000330012452540640024467 0ustar liggesusers‰PNG  IHDR szzô‡IDATxœí—KlT瀿só¸3ã±ÇãGýˆmÊØ—¡@L° nQH”„¦A *UiÓ6YVYDê¢]e“6bQ)ê‚´•ÒHT†G¬$”E\ ¥"&¸Å`°ñk<Ø{f<;÷þ] ¸$x°¥.ÒEÏjwÎ÷éœÿüG#¿x×V|…¡}•ðÿ üOûRØÐ¤Ñ¹Jˆ†„K7]ŽýÝ]ðÙ ÊüB$S)˜Í(RÙÿBÀcÀþí:e~8}y†ljš}»šˆÝIð×ÁrÂljÖXÿˆ Y[á3‹¯oOºœº¢¸/=h%v­Õxáµ?ô²²ÑÏ ºÆ“[¢ŒÄX×ÚÌÆfþ±G>dp8ÎødAÐ ƒÎuQžÞ^Ç ;<»áÒ¹ GJݯÞ>=BYeýÒ*¶à§ß†Æ“¼þÇË<ûÍj*}<ÞOCuŸÿ`CãÚíYÎôNsñj ǯGã{]´//çW‡®³¬Îbÿ®^yós _˜P¤nžSr gæà½ 6«šÂ´6•sâÌA¿Éε O¤yçäM\¥è>;BOo %& €"_€wþr›lÞa÷Ö*nŽÍaer™$©éñÅú' þ5œã¥ï®¦,àáàñk<ÑQOK]s½qÎ\ŽóâžåT†=¸Žƒnx@”BDãöD–Æ*‹TÆ@) !—M’JĨ!/Ãw²¼ü\+éŒÃ['®óã=+ x }<ÈÔlžŸìYŽi®ë ëw%P„9Û%h¸J‘Ì@AÈgS¤g&J è<·EãÏ=)º{ÆYÑXÆÞ®&úG’\ì›äµ—ÚyuõUËê‚<º&Š@QÂ0ñš: Õ~ú†RÔG-â ÛAŠ"ä³éÒ­ÔèQô^ígß·›éîãñGëh_a0–ÆchüíŸSüöèuþÑŸ 6â»›\Çeûú*Î÷Ͱ¥5̵áôà ˆ¦-<†Úê…G†ÙñFFãINœ£PpùÑÓ˹9–bôN†“c ÂÆ•j#¾ùÄ!Ë`÷æ(Ÿ|6í(Ö·„8pdð¸ W`ý#®;Ì%§Øµ©‚îó“(ÇáËqFS´5‡Mcš:‚É;ÔD|ÅÄ"|ÿñR™]ˆ³sC%Cñ,ƒ¹àˆ,\¯W oŸŠ³au7F’Ä'g1}ì|†ß8Ì“[s<¶¶’Ž5•ô &i_À44žïª§¹ÖâõC”Lvo®ä7G‡„K)¾Q—Tr†5[齕„‚ÅôX¤æ²ù4Æñ3£l^¡kcš—ÏË϶PSáåÍcC$Ò?ÛÛȹ¾Æ3 ¡„ÀgC _°‚š°ðñ;›Æ±s˜^‹B>KA79weŠsW¦YÞ¤s]%åA“_ÿé&³‡g:ª1táèÙxIxÉ X¡J‚Øù®CQ"7‡“ÏbzýìºáÅulnŒÎ10–-&¡sm›V†8pä6v’p‘‡ð^d :uQ ·Çu<Þ ˆ+áñ£”ƒnzÑæá]"ìÙVÅ[Œ‘ʸ…³˜ÀxBѹ¾ 4 ×Îãº<¾P”0<~”Rè†ÝÐx~G-ÛÖ”óÆá!F'ó‹Â­Àùж¦Ïl«EÓt\ÇÆuLŸ…Á)ؘ?Ëj½¼ºo–OçÃCÄg K‚—<„÷b*¥8Ü“goG5[Z+øäò$Ãñ¶Òñy,šªuÖµ„ù Þ?‡Kד Þó>[Ê?#Kì\­Óü5‹š /9Ûe"a3>mséZ‚«ƒsw€h, ^ò"úrÌ©rÞí™`.9ü…§‰š~w š®%(î„Åà²X î@¸LjjþÇ ÐP zq±+Mæ…ŠœÒð%W`¾eQ!›šžOªhˆh(¹÷¤ Ú=%ὈJJ„*²é÷n8  iJÝmÂý°/¿_ê” 0¹Ìì|B X ùÏdË}­X."ü 1„ï CdIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/dribbble.png0000755000176200001440000000245612452540640023715 0ustar liggesusers‰PNG  IHDR szzôõIDATxœí—ÛoTEÀßœ³—n»mw»-t» mé…B•‹¥J@‰|¼DBâ›oj4$jBü|ÒDã%ø"Ѥh0D Ò ´´ÐRiiéuÛn÷Ò={Ž … íR ‰/ÌÓÉÌ™ùýæË÷MfÄÚÓ`ñ?6õ <Ðèoo6Ô•Ã?ä¹ÒÇB¸Ø g;Sßs* k°i)Ô—ƒVÒ$r­—ñ®›ˆ€Ã›KnõÔÚ*¬Õ˜§ÚÑŽ¶BÒœ—ÞX %Œ¡qbá rΧç÷&†šZÀ²”®S´¦ÿKk°¯­&Vœ‹ã§3HÜȸ|æÐÔ|¤©•¦O¾¤í‹Œ‰(»¶à*ñ¡”BH&8vžæ=ßïá\TLäÕådŽBfK¡ÄCèÌe.}µI$‰Žrõë_QvŠ·_Ní^ ‚ l:Ámëqå“…É®2´*€a&BÀ› õ壴|{ EÒ4±i:î2xº™ì`EÏ- òjJ©Ùý&«k¹ñó Z?ÝK"¦pãJ®&B3JÌ,°¢4EgÃQ˜4¦àI3‰MÓéÚwc"F`ë³,~oUïnCÏrÐñù~ú5bF'é?؈rØÈº†¶ÁÓJÌœ„5~¬„Á@c3X + ÝëÆ»`Y çã.-N-í$+XÄõþ`è¯fH&aôlþíÈ]VÁÐás\î£Â[Œ®îì{f‚¬„Á“»w’]RˆèÚÔOîìeðøy¼õ‹Q;Ã'/¥Á0#qbÝ8ƒ>”¤ò¤c¤Ežùh·$2–al ÄDWÃgZ1"qŒñ“!¢=ƒScl‚Àö ^{>U’S³+a JM»%‚Ðê§,¿M©ÌáÎ^:¾?x vgÁUâcÞæUxVV¥¶¦€Äð8F8н -ÛyG箹J„GYçË,àð¸ïkv%¯¬¡hS¢„±æk(»NNe€Ö¿Á §J?ÜÃïM뻽^÷ØPþ1Ü•4› Ë0Ýå¤â­¸«‚„ÛºéÞw„xï0žúr*äÖ–3rüÂHweá,ñ½Öw|JhF¶>”MÇ÷Ì’ÔÎvªßß»*È̓\ùìGâ½Ãˆዘ wmY(íPB¤¹kzxFƬ¤‰Ëj4§²]/â Ñ{à$½¿œHÏöØ$‘örªhºžŠ–; Ϻe˜ñã§Z¦… ™Æ£˜'.ãðå±ä£·ð¬¬bäÌenþv: ~;G¢}ˆM'«t¢ Å;7£åº:‹™œ.rŸ2ÔŽ·óçá¬ôc™½ûM b×úp?Q†ï…:\‹ƒD.u1zôüŒðÌHš8Î1ÑÞƒ(¡òƒ×ñ­[†fÓÓàJ„d8€gã \5 ˆ´\g`ïIJf„‹2›wAB,†ëJ(Üüʦc™±îâ=ƒØòrp|蹩’O0úç?„ÿ}8ÌN ‘4è0Fñ®_NÞŠ ì…ùiã“ý!Âç®0~òæX4cØoÕ¨Ù ¤$’´Ý€™jz–}SpyÀ[±MÓ¨ôùç ~ÿ$œNBiTxçÏ <óI˜¡éJ£Ü3/u’=\x„‡‰®4æ>ü¡#p·D0¯à¡á‚ðò˜Ã¹ IEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/android.png0000755000176200001440000000155112452540640023563 0ustar liggesusers‰PNG  IHDR szzô0IDATxœí—KhTWÇß¹so&'NóPŒ6hÒ•«®J¡›.º1]J7A ‚ˆnÝ í¦ºÒ…¢Z …>¤t-t!!%¥±‚&jœL4:Ž&÷yn“™8grÏ(¸é·ºœsîùÿÎ÷ºçÊïåÃ1oÑÔÛÿÀÀ’ ¶ìn=OWÛù×v&8Ò3 ‘óŠl =—ØoA&Ïë” Àrð#Î1g‰»Ù—> À½àg²j„¬uˆ_ÿ<—ò:à`Yòf‚¸Ì¡ü§ c»Nà†k °ñ"¢xÇgh¿ƒÚ"q2j/…ÌÕǵ›Sü47YŸ»6?Å/O’NõñÙáïèÁ]×}tÔ>‰FÓ§èVï"(b ÊÚš6šq82|p×5+Kí!$i'ü8{=q†»a™Ë3”‚X ;c‘ßk¿2‰s`v}ŠÅÛ.±®¡o\¤ê©?TÇb %ÞzÀêý€Á=Í-=0š>Å>g‚Eÿþq¿æ“Þ¿’²ðÍQ>zïcùqæ‹W¹±ôÝ»ýCNCøZæÀ°ó9 ›a{‚•%ßHÀVÝŒåÇ«‡G)ð6bÖŠZo­k ›S"OŠ1€¥ìm "໚'+[ɪ`ç~²ã;òRÎ^Ly5Dë„"æÛ_©‰+µé OóìQØ Â ÔnÓfILãÇ1ºA¼V%¯[,¸(UnñÇ¿_vMÈìòyÊÞæ^lQÒ¾=-…”îûˆÀÉŒ.ͽßäö&qvhD¹| =0/Ã$â" ’07˜bpÃݵë‰Å—+3‰ÄƒoÁ³Ç!•RšÉÂl}ìÛ™1Dàø·ð£ Óó…äâbð-èíOa[ËE@m÷¡¸ˆ˜]ÉvåâjI:ªâ" åf".ÊðNáq×û€ù•«õözkušH»,<þÑH\Lràe{Z x^Ö íÕôäµ5ýäò6Ùw¬×GÄüRZ³ÝÕ±QÑ‹wì:DŠž^«cq£2leÙ> ¸Ï#cqÞ@6g¡ÜÛÃÑ^\þnõÚK„þIEND®B`‚BayesFactor/vignettes/extra/socialmedia/png/32x32/google_plus.png0000755000176200001440000000234212452540640024461 0ustar liggesusers‰PNG  IHDR szzô©IDATxœí–MlTUÇçÞ™éôËRúA¡±´SŠ)Z Q$jDY5¸Ã( ÄhhüZhˆaáFMÀè¢)!1!JŒ®0DÓH”ÄHŒ ¦P(i‰”¶S:3Î{ï^oúlK;35$l¼‹™7ïÝwþ¿{îÿÜ3bßÞi¹ƒCÝIñÿBÿé­pDüï™#•[¸­ ¨Y›·Be5XK—òhãÃÃöþ‰wüÂ"·àñm°f#g?|Ÿä…^ëQÖ£õ÷ˆTT’qδ;§"fIy)aUØîæŸuï*ؼ•ï?ÇxX É>.v ¨fM{ÞÄ5†1ÇáïD Ç˜Û O< @âÒE,D²/ £Ý¿‘èë ,ÖB4Ö‚ëY‡«‰ñ‚ rè—Šû÷¬E” â§OÓK–4àZƒk|ˆkÉqÜ<y´Ÿ xq=ˆH!@²ÿR0݉!®1xÖ̸y!r¸NpY½z"@XkTÖðf"MªïBö9¸ÆúŽË`*='Dnσžî µë7ùüOKil9—ÂK&AG1Ö’r]nŒ§qÍ­çCþ*8þ5™kWˆíØMÕš Á*«×m¢nËSôw~ÂÐ]ÓÄ%‹èY‹g,ã®ÇÐ,ùÏ›q8°Ÿ+«7QùàôìnÇ{a*BB!.9ÄÐÉnŸÜÉB(cw]†Óiª¢Qtv‚ÚŽ'¿<œe­èò ¢uõ”·­Â$Çcð’ ¡¨f 6l¦vûn|q˜äï§æ%.Hî2tµæúò•ToÙF¤¶î–çÎð RݧíúgðêüÅ%O3 y5g~¥÷§.¬:A´FŒÁº™ÀpJþ!ÍG<· ³#¬- +Ѐu2Øô8Ö™˜æö¬´2ñÜe8B)š+ïBO 2ÓíÈ¿ /(S!b ÊQ¢r–3 r‰ f`r„”¢©¢ ¥dVq™‘O\þ õÃQ-S‚{IEND®B`‚BayesFactor/vignettes/extra/socialmedia/readme.txt0000644000176200001440000000200312452540640022054 0ustar liggesusers------------------------------------------------------------------- Flat Shadow Social Media Icons by Lokas Software http://www.awicons.com/ ------------------------------------------------------------------- All icons of this download package are published under the CC Attribution 3.0: http://creativecommons.org/licenses/by/3.0/ If you want to use these icons in your project, software, application or website, you need to maintain an active "DoFollow" link to http://www.awicons.com/, with the link text: "Icons by Lokas Software". If you enjoy these icons please feel free to Twitter, Digg or recommend the icons on http://www.awicons.com/ For questions, comments, please contact us: http://www.awicons.com/support/ ------------------------------------------------------------------- Custom Design Service ------------------------------------------------------------------- Need a custom design? Icons, websites, boxshots, logotypes: http://www.insoftadesign.com/ BayesFactor/vignettes/extra/manual.css0000644000176200001440000000347412452540640017610 0ustar liggesusersbody, td { font-family: sans-serif; background-color: white; font-size: 12px; margin: 8px; } span.socialtext { position:absolute; top:50%; height:1em; margin-top:-.5em; text-decoration:none; color: black; } .social { position:relative; } div.socialsep { height:1em; } a:link {color: #3DA6CC;} a:visited {color: #CA17E6;} tt, code, pre { font-family: monospace; } h1 { font-size:2.2em; } h2 { font-size:1.8em; } h3 { font-size:1.4em; } h4 { font-size:1.0em; } h5 { font-size:0.9em; } h6 { font-size:0.8em; } pre { margin-top: 0; max-width: 95%; border: 1px solid #ccc; white-space: pre-wrap; } pre code { display: block; padding: 0.5em; } code.r, code.cpp { background-color: #F8F8F8; } table, td, th { border: none; } blockquote { color:#666666; margin:0; padding-left: 1em; border-left: 0.5em #EEE solid; } hr { height: 0px; border-bottom: none; border-top-width: thin; border-top-style: dotted; border-top-color: #999999; } @media print { * { background: transparent !important; color: black !important; filter:none !important; -ms-filter: none !important; } body { font-size:12pt; max-width:100%; } a, a:visited { text-decoration: underline; } hr { visibility: hidden; page-break-before: always; } pre, blockquote { padding-right: 1em; page-break-inside: avoid; } tr, img { page-break-inside: avoid; } img { max-width: 100% !important; } @page :left { margin: 15mm 20mm 15mm 10mm; } @page :right { margin: 15mm 10mm 15mm 20mm; } p, h2, h3 { orphans: 3; widows: 3; } h2, h3 { page-break-after: avoid; } } BayesFactor/vignettes/index.Rmd0000644000176200001440000000070312476040463016245 0ustar liggesusers ![alt text](extra/logo.png) ------ BayesFactor manual files ------ ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) ``` * [Main manual](manual.html) * [Posterior odds and probabilities](odds_probs.html) * [Prior checks](priors.html) * [Comparison to arm/lmer](compare_lme4.html) BayesFactor/vignettes/compare_lme4.Rmd0000644000176200001440000002352213274043465017513 0ustar liggesusers ![alt text](extra/logo.png) ------ ```{r echo=FALSE,message=FALSE,results='hide'} library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ``` Comparison of BayesFactor against other packages ======================================================== This R markdown file runs a series of tests to ensure that the BayesFactor package is giving correct answers, and can gracefully handle probable input. ```{r message=FALSE,warning=FALSE} library(arm) library(lme4) ``` ANOVA ---------- First we generate some data. ```{r} # Number of participants N <- 20 sig2 <- 1 sig2ID <- 1 # 3x3x3 design, with participant as random factor effects <- expand.grid(A = c("A1","A2","A3"), B = c("B1","B2","B3"), C = c("C1","C2","C3"), ID = paste("Sub",1:N,sep="") ) Xdata <- model.matrix(~ A*B*C + ID, data=effects) beta <- matrix(c(50, -.2,.2, 0,0, .1,-.1, rnorm(N-1,0,sqrt(sig2ID)), 0,0,0,0, -.1,.1,.1,-.1, 0,0,0,0, 0,0,0,0,0,0,0,0), ncol=1) effects$y = rnorm(Xdata%*%beta,Xdata%*%beta,sqrt(sig2)) ``` ```{r} # Typical repeated measures ANOVA summary(fullaov <- aov(y ~ A*B*C + Error(ID/(A*B*C)),data=effects)) ``` We can plot the data with standard errors: ```{r fig.width=10,fig.height=4} mns <- tapply(effects$y,list(effects$A,effects$B,effects$C),mean) stderr = sqrt((sum(resid(fullaov[[3]])^2)/fullaov[[3]]$df.resid)/N) par(mfrow=c(1,3),cex=1.1) for(i in 1:3){ matplot(mns[,,i],xaxt='n',typ='b',xlab="A",main=paste("C",i), ylim=range(mns)+c(-1,1)*stderr,ylab="y") axis(1,at=1:3,lab=1:3) segments(1:3 + mns[,,i]*0,mns[,,i] + stderr,1:3 + mns[,,i]*0,mns[,,i] - stderr,col=rgb(0,0,0,.3)) } ``` ### Bayes factor Compute the Bayes factors, while testing the Laplace approximation ```{r} t.is = system.time(bfs.is <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID") ) t.la = system.time(bfs.la <- anovaBF(y ~ A*B*C + ID, data = effects, whichRandom="ID", method = "laplace") ) ``` ```{r fig.width=6,fig.height=6} t.is t.la plot(log(extractBF(sort(bfs.is))$bf),log(extractBF(sort(bfs.la))$bf), xlab="Default Sampler",ylab="Laplace approximation", pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2) abline(0,1) bfs.is ``` Comparison to lmer and arm ------ We can use samples from the posterior distribution to compare `BayesFactor` with `lmer` and `arm`. ```{r message=FALSE} chains <- lmBF(y ~ A + B + C + ID, data=effects, whichRandom = "ID", posterior=TRUE, iterations=10000) lmerObj <- lmer(y ~ A + B + C + (1|ID), data=effects) # Use arm function sim() to sample from posterior chainsLmer = sim(lmerObj,n.sims=10000) ``` Compare estimates of variance ```{r} BF.sig2 <- chains[,colnames(chains)=="sig2"] AG.sig2 <- (chainsLmer@sigma)^2 qqplot(log(BF.sig2),log(AG.sig2),pch=21,bg=rgb(0,0,1,.2), col=NULL,asp=TRUE,cex=1,xlab="BayesFactor samples", ylab="arm samples",main="Posterior samples of\nerror variance") abline(0,1) ``` Compare estimates of participant effects: ```{r} AG.raneff <- chainsLmer@ranef$ID[,,1] BF.raneff <- chains[,grep('ID-',colnames(chains),fixed='TRUE')] plot(colMeans(BF.raneff),colMeans(AG.raneff),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Random effect posterior means") abline(0,1) ``` Compare estimates of fixed effects: ```{r tidy=FALSE} AG.fixeff <- chainsLmer@fixef BF.fixeff <- chains[,1:10] # Adjust AG results from reference cell to sum to 0 Z = c(1, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3, 0, 0, 0, 0, 0, 0, 0, -1/3, -1/3, 0, 0, 0, 0, 0, 2/3, -1/3, 0, 0, 0, 0, 0, -1/3, 2/3) dim(Z) = c(7,10) Z = t(Z) AG.fixeff2 = t(Z%*%t(AG.fixeff)) ## Our grand mean has heavier tails qqplot(BF.fixeff[,1],AG.fixeff2[,1],pch=21,bg=rgb(0,0,1,.2),col=NULL,asp=TRUE,cex=1,xlab="BayesFactor estimate",ylab="arm estimate",main="Grand mean posterior samples") abline(0,1) plot(colMeans(BF.fixeff[,-1]),colMeans(AG.fixeff2[,-1]),pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2,xlab="BayesFactor estimate",ylab="arm estimate",main="Fixed effect posterior means") abline(0,1) ## Compare posterior standard deviations BFsd = apply(BF.fixeff[,-1],2,sd) AGsd = apply(AG.fixeff2[,-1],2,sd) plot(sort(AGsd/BFsd),pch=21,bg=rgb(0,0,1,.2),col="black",cex=1.2,ylab="Ratio of posterior standard deviations (arm/BF)",xlab="Fixed effect index") ## AG estimates are slightly larger, consistent with sig2 estimates ## probably due to prior ``` Another comparison with lmer ----------- We begin by loading required packages... ```{r message=FALSE,warning=FALSE} library(languageR) library(xtable) ``` ...and creating the data set to analyze. ```{r} data(primingHeidPrevRT) primingHeidPrevRT$lRTmin1 <- log(primingHeidPrevRT$RTmin1) ###Frequentist lr4 <- lmer(RT ~ Condition + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime + ResponseToPrime*RTtoPrime +BaseFrequency ,primingHeidPrevRT) # Get rid rid of some outlying response times INDOL <- which(scale(resid(lr4)) < 2.5) primHeidOL <- primingHeidPrevRT[INDOL,] ``` The first thing we have to do is center the continuous variables. This is done automatically by lmBF(), as required by Liang et al. (2008). This, of course, changes the definition of the intercept. ```{r} # Center continuous variables primHeidOL$BaseFrequency <- primHeidOL$BaseFrequency - mean(primHeidOL$BaseFrequency) primHeidOL$lRTmin1 <- primHeidOL$lRTmin1 - mean(primHeidOL$lRTmin1) primHeidOL$RTtoPrime <- primHeidOL$RTtoPrime - mean(primHeidOL$RTtoPrime) ``` Now we perform both analyses on the same data, and place the fixed effect estimates for both packages into their own vectors. ```{r} # LMER lr4b <- lmer( RT ~ Condition + ResponseToPrime + (1|Word)+ (1|Subject) + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL) # BayesFactor B5out <- lmBF( RT ~ Condition + ResponseToPrime + Word + Subject + lRTmin1 + RTtoPrime + ResponseToPrime*RTtoPrime + BaseFrequency , primHeidOL , whichRandom = c("Word", "Subject"), posterior = TRUE, iteration = 50000,columnFilter=c("Word","Subject")) lmerEff <- fixef(lr4b) bfEff <- colMeans(B5out[,1:10]) ``` `lmer` uses a "reference cell" parameterization, rather than imposing sum-to-0 constraints. We can tell what the reference cell is by looking at the parameter names. ```{r results='asis'} print(xtable(cbind("lmer fixed effects"=names(lmerEff))), type='html') ``` Notice what's missing: for the categorical parameters, we are missing `Conditionbaseheid` and `ResponseToPrimecorrect`. For the slope parameters, we are missing `ResponseToPrimecorrect:RTtoPrime`. The missing effects tell us what the reference cells are. Since the reference cell parameterization is just a linear transformation of the sum-to-0 parameterization, we can create a matrix that allows us to move from one to the other. We call this $10 \times 7$ matrix `Z`. It takes the 7 "reference-cell" parameters from `lmer` and maps them into the 10 linearly constrained parameters from `lmBF`. The first row of `Z` transforms the intercept (reference cell) to the grand mean (sum-to-0). We have to add half of the two fixed effects back into the intercept. The second and third row divide the totl effect of `Condition` into two equal parts, one for `baseheid` and one for `heid`. Rows four and five do the same for `ResponseToPrime`. The slopes that do not enter into interactions are fine as they are; however, `ResponseToPrimecorrect:RTtoPrime` serves as our reference cell for the `ResponseToPrime:RTtoPrime` interaction. We treat these slopes analogously to the grand mean; we take `RTtoPrime` and add half the `ResponseToPrimeincorrect:RTtoPrime` effect to it, to make it a grand mean slope. The last two rows divide up the `ResponseToPrimeincorrect:RTtoPrime` effect between `ResponseToPrimeincorrect:RTtoPrime` and `ResponseToPrimecorrect:RTtoPrime`. ```{r tidy=FALSE} # Adjust lmer results from reference cell to sum to 0 Z = c(1, 1/2, 1/2, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0,-1/2, 0, 0, 0, 0, 0, 0, 1/2, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1/2, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, -1/2, 0, 0, 0, 0, 0, 0, 1/2) dim(Z) = c(7,10) Z = t(Z) # Do reparameterization by pre-multimplying the parameter vector by Z reparLmer <- Z %*% matrix(lmerEff,ncol=1) # put results in data.frame for comparison sideBySide <- data.frame(BayesFactor=bfEff,lmer=reparLmer) ``` We can look at them side by side for comparison: ```{r results='asis'} print(xtable(sideBySide,digits=4), type='html') ``` ...and plot them: ```{r} # Notice Bayesian shrinkage par(cex=1.5) plot(sideBySide[-1,],pch=21,bg=rgb(0,0,1,.2),col="black",asp=TRUE,cex=1.2, main="fixed effects\n (excluding grand mean)") abline(0,1, lty=2) ``` The results are quite close to one another, with a bit of Bayesian shrinkage. ------- *This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/vignettes/manual.Rmd0000644000176200001440000017651313274102703016421 0ustar liggesusers Fork me on GitHub ![BayesFactor logo](extra/logo.png) ------ Using the 'BayesFactor' package, version 0.9.2+ =============================== Richard D. Morey -----------------
Share via
---- Stable version: [CRAN page](https://cran.r-project.org/package=BayesFactor) - [Package NEWS (including version changes)](https://CRAN.R-project.org/package=BayesFactor/NEWS) Development version: [Development page](https://github.com/richarddmorey/BayesFactor) - [Development package NEWS](https://github.com/richarddmorey/BayesFactor/blob/master/pkg/BayesFactor/NEWS) ### Table of Contents * Introductory material * [Getting help](#help) * [Introduction](#intro) * [Loading the package](#loading) * [Useful functions](#functions) * Performing analyses * [One-sample (and two-sample paired), and manipulating Bayes factor objects](#onesample) * [Two independent samples](#twosample) * [Meta-analytic t tests (0.9.8+)](#metat) * [ANOVA, fixed-effects](#fixed) * [ANOVA, mixed models (including repeated measures)](#mixed) * [Regression](#regression) * [General linear models: mixing continuous and categorical covariates](#glm) * [Linear correlations](#lincor) * [Tests of single proportions (0.9.9+)](#proptest) * [Contingency Tables (0.9.9+)](#ctables) * Additional tips and tricks (0.9.4+) * [Testing restrictions on linear models: generalTestBF()](#generalTestBF) * [Saving time: Pre-culling Bayes factor objects](#preculltricks) * [Saving memory: Thinning and filtering MCMC chains](#mcmctricks) * [Fine-tuning of prior scales (0.9.12-2+)](#priorscales) * [References](#references) ### Getting help * [Help forums](https://forum.cogsci.nl/index.php?p=/categories/jasp-bayesfactor) * [Bug reports](https://github.com/richarddmorey/BayesFactor/issues?state=open) * [Developer email (richarddmorey at gmail.com)](mailto:richarddmorey@gmail.com) ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) opts_chunk$set(dpi = 200, out.width = "67%") options(digits=3) require(graphics) set.seed(2) ``` ### Introduction The `BayesFactor` package enables the computation of Bayes factors in standard designs, such as one- and two- sample designs, ANOVA designs, and regression. The Bayes factors are based on work spread across several papers. This document is designed to show users how to compute Bayes factors using the package by example. It is not designed to present the models used in the comparisons in detail; for that, see the `BayesFactor` help and especially the references listed in this manual. Complete references are given at the [end of this document](#references). If you need help or think you've found a bug, please use the links at the top of this document to contact the developers. When asking a question or reporting a bug, please send example code and data, the exact errors you're seeing (a cut-and-paste from the R console will work) and instructions for reproducing it. Also, report the output of `BFInfo()` and `sessionInfo()`, and let us know what operating system you're running. ### Loading the package The `BayesFactor` package must be installed and loaded before it can be used. Installing the package can be done in several ways and will not be covered here. Once it is installed, use the `library` function to load it: ```{r message=FALSE} library(BayesFactor) ``` ```{r echo=FALSE,message=FALSE,results='hide'} options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ``` This command will make the `BayesFactor` package ready to use. ### Some useful functions The table below lists some of the functions in the `BayesFactor` package that will be demonstrated in this manual. For more complete help on the use of these functions, see the corresponding `help()` page in R. Function | Description -------------------------|------------- `ttestBF` | Bayes factors for one- and two- sample designs `anovaBF` | Bayes factors comparing many ANOVA models `regressionBF` | Bayes factors comparing many linear regression models `generalTestBF` | Bayes factors for all restrictions on a full model (0.9.4+) `lmBF` | Bayes factors for specific linear models (ANOVA or regression) `correlationBF` | Bayes factors for linear correlations `proportionBF` | Bayes factors for tests of single proportions `contingencyTableBF` | Bayes factors for contingency tables `posterior` | Sample from the posterior distribution of the numerator of a Bayes factor object `recompute` | Recompute a Bayes factor or MCMC chain, possibly increasing the precision of the estimate `compare` | Compare two models; typically used to compare two models in `BayesFactor` MCMC objects #### Functions to manipulate Bayes factor objects The t test section below has examples showing how to manipulate Bayes factor objects, but all these functions will work with Bayes factors generated from any function in the `BayesFactor` package. Function | Description -------------------------|------------ `/` | Divide two Bayes factor objects to create new model comparisons, or invert with `1/` `t` | "Flip" (transpose) a Bayes factor object `c` | Concatenate two Bayes factor objects together, assuming they have the same denominator `[` | Use indexing to select a subset of the Bayes factors `plot` | plot a Bayes factor object `sort` | Sort a Bayes factor object `is.na` | Determine whether a Bayes factor object contains missing values `head`,`tail` | Return the `n` highest or lowest Bayes factor in an object `max`, `min` | Return the highest or lowest Bayes factor in an object `which.max`,`which.min` | Return the index of the highest or lowest Bayes factor `as.vector` | Convert to a simple vector (denominator will be lost!) `as.data.frame` | Convert to data.frame (denominator will be lost!) ### One- and two-sample designs (t tests) The `ttestBF` function is used to obtain Bayes factors corresponding to tests of a single sample's mean, or tests that two independent samples have the same mean. #### One-sample tests (and paired) We use the `sleep` data set in R to demonstrate a one-sample t test. This is a paired design; for details about the data set, see `?sleep`. One way of analyzing these data is to compute difference scores by subtracting a participant's score in one condition from their score in the other: ```{r onesampdata} data(sleep) ## Compute difference scores diffScores = sleep$extra[1:10] - sleep$extra[11:20] ## Traditional two-tailed t test t.test(diffScores) ``` We can do a Bayesian version of this analysis using the `ttestBF` function, which performs the "JZS" t test described by [Rouder, Speckman, Sun, Morey, and Iverson (2009)](#Rouderttest). In this model, the true standardized difference $latex \delta=(\mu-\mu_0)/\sigma_\epsilon$ is assumed to be 0 under the null hypothesis, and \(\text{Cauchy}(\text{scale}=r)\) under the alternative. The default \(r\) scale in `BayesFactor` for t tests is \(\sqrt{2}/2\). See `?ttestBF` for more details. ```{r onesampt} bf = ttestBF(x = diffScores) ## Equivalently: ## bf = ttestBF(x = sleep$extra[1:10],y=sleep$extra[11:20], paired=TRUE) bf ``` The `bf` object contains the Bayes factor, and shows the numerator and denominator models for the Bayes factor comparison. In our case, the Bayes factor for the comparison of the alternative versus the null is `r as.vector(bf)`. After the Bayes factor is a proportional error estimate on the Bayes factor. There are a number of operations we can perform on our Bayes factor, such as taking the reciprocal: ```{r recip} 1 / bf ``` or sampling from the posterior of the numerator model: ```{r tsamp} chains = posterior(bf, iterations = 1000) summary(chains) ``` The `posterior` function returns a object of type `BFmcmc`, which inherits the methods of the `mcmc` class from the [`coda` package](https://cran.r-project.org/package=coda). We can thus use `summary`, `plot`, and other useful methods on the result of `posterior`. If we were unhappy with the number of iterations we sampled for `chains`, we can `recompute` with more iterations, and then `plot` the results: ```{r tsamplplot,fig.width=10} chains2 = recompute(chains, iterations = 10000) plot(chains2[,1:2]) ``` Directional hypotheses can also be tested with `ttestBF` ([Morey & Rouder, 2011](#Moreyarea)). The argument `nullInterval` can be passed as a vector of length 2, and defines an interval to compare to the point null. If null interval is defined, _two_ Bayes factors are returned: the Bayes factor of the null interval against the alternative, and the Bayes factor of the _complement_ of the interval to the point null. Suppose, for instance, we wanted to test the one-sided hypotheses that \(\delta<0\) versus the point null. We set `nullInterval` to `c(-Inf,0)`: ```{r onesamptinterval} bfInterval = ttestBF(x = diffScores, nullInterval=c(-Inf,0)) bfInterval ``` We may not be interested in tests against the point null. If we are interested in the Bayes factor test that \(\delta<0\) versus \(\delta>0\) we can compute it using the result above. Since the object contains two Bayes factors, both with the same denominator, and $$ \left.\frac{A}{C}\middle/\frac{B}{C}\right. = \frac{A}{B}, $$ we can divide the two Bayes factors in `bfInferval` to obtain the desired test: ```{r onesampledivide} bfInterval[1] / bfInterval[2] ``` The Bayes factor is about 340. When we have multiple Bayes factors that all have the same denominator, we can concatenate them into one object using the `c` function. Since `bf` and `bfInterval` both share the point null denominator, we can do this: ```{r onesampcat} allbf = c(bf, bfInterval) allbf ``` The object `allbf` now contains three Bayes factors, all of which share the same denominator. If you try to concatenate Bayes factors that do _not_ share the same denominator, `BayesFactor` will return an error. When you have a Bayes factor object with several numerators, there are several interesting ways to manipulate them. For instance, we can plot the Bayes factor object to obtain a graphical representation of the Bayes factors: ```{r plotonesamp,fig.width=10,fig.height=5} plot(allbf) ``` We can also divide a Bayes factor object by itself — or by a subset of itself — to obtain pairwise comparisons: ```{r onesamplist} bfmat = allbf / allbf bfmat ``` The resulting object is of type `BFBayesFactorList`, and is a list of Bayes factor comparisons all of the same numerators compared to different denominators. The resulting matrix can be subsetted to return individual Bayes factor objects, or new `BFBayesFactorList`s: ```{r onesamplist2} bfmat[,2] bfmat[1,] ``` and they can also be transposed: ```{r onesamplist3} bfmat[,1:2] t(bfmat[,1:2]) ``` If these values are desired in matrix form, the `as.matrix` function can be used to obtain a matrix. #### Two-sample test (independent groups) The `ttestBF` function can also be used to compute Bayes factors in the two sample case as well. We use the `chickwts` data set to demonstrate the two-sample t test. The `chickwts` data set has six groups, but we reduce it to two for the demonstration. ```{r twosampledata} data(chickwts) ## Restrict to two groups chickwts = chickwts[chickwts$feed %in% c("horsebean","linseed"),] ## Drop unused factor levels chickwts$feed = factor(chickwts$feed) ## Plot data plot(weight ~ feed, data = chickwts, main = "Chick weights") ``` Chick weight appears to be affected by the feed type. ```{r} ## traditional t test t.test(weight ~ feed, data = chickwts, var.eq=TRUE) ``` We can also compute the corresponding Bayes factor. There are two ways of specifying a two-sample test: the formula interface and through the `x` and `y` arguments. We show the formula interface here: ```{r twosamplet} ## Compute Bayes factor bf = ttestBF(formula = weight ~ feed, data = chickwts) bf ``` As before, we can sample from the posterior distribution for the numerator model: ```{r twosampletsamp,fig.width=10} chains = posterior(bf, iterations = 10000) plot(chains[,2]) ``` Note that the samples assume an (equivalent) ANOVA model; see `?ttestBF` and for notes on the differences in interpretation of the \(r\) scale parameter between the two models. ### Meta-analytic t tests (0.9.8+) Rouder and Morey (2011; [link](#RouderMetat)) discuss a meta-analytic extension of the $t$ test, whereby multiple $t$ statistics, along with their corresponding sample sizes, are combined in a single meta-analytic analysis. The $t$ statistics are assumed to arise from a a common effect size $\delta$. The prior for the effect size $\delta$ is the same as that for the $t$ tests described above. The `meta.ttestBF` function is used to perform meta-analytic $t$ tests. It requires as input a vector of $t$ statistics, and one or two vectors of sample sizes (arguments `n1` and `n2`). For a set of one-sample $t$ statistics, `n1` should be provided; for two-sample analyses, both `n1` and `n2` should be provided. As an example, we will replicate the analysis of Rouder & Morey (2011), using $t$ statistics from Bem (2010; see Rouder & Morey for reference). We begin by defining the one-sample $t$ statistics and sample sizes: ```{r bemdata} ## Bem's t statistics from four selected experiments t = c(-.15, 2.39, 2.42, 2.43) N = c(100, 150, 97, 99) ``` Rouder and Morey opted for a one-sided analysis, and used an $r$ scale parameter of 1 (instead of the current default in `BayesFactor` of $\sqrt{2}/2$). ```{r bemanalysis1} bf = meta.ttestBF(t=t, n1=N, nullInterval=c(0,Inf), rscale=1) bf ``` Notice that as above, the analysis yields a Bayes factor for our selected interval against the null, as well as the Bayes factor for the complement of the interval against the null. We can also sample from the posterior distribution of the standardized effect size $\delta$, as above, using the `posterior` function: ```{r bemposterior,fig.width=10} ## Do analysis again, without nullInterval restriction bf = meta.ttestBF(t=t, n1=N, rscale=1) ## Obtain posterior samples chains = posterior(bf, iterations = 10000) plot(chains) ``` Notice that the posterior samples will respect the `nullInterval` argument if given; in order to get unrestricted samples, perform an analysis with no interval restriction and pass it to the `posterior` function. See `?meta.ttestBF` for more information. ### ANOVA The `BayesFactor` package has two main functions that allow the comparison of models with factors as predictors (ANOVA): `anovaBF`, which computes several model estimates at once, and `lmBF`, which computes one comparison at a time. We begin by demonstrating a 3x2 fixed-effect ANOVA using the `ToothGrowth` data set. For details about the data set, see `?ToothGrowth`. #### Fixed-effects ANOVA The `ToothGrowth` data set contains three columns: `len`, the dependent variable, each of which is the length of a guinea pig's tooth after treatment with Vitamin C; `supp`, which is the supplement type (orange juice or ascorbic acid); and `dose`, which is the amount of Vitamin C administered. ```{r fixeddata,fig.width=10,fig.height=5} data(ToothGrowth) ## Example plot from ?ToothGrowth coplot(len ~ dose | supp, data = ToothGrowth, panel = panel.smooth, xlab = "ToothGrowth data: length vs dose, given type of supplement") ## Treat dose as a factor ToothGrowth$dose = factor(ToothGrowth$dose) levels(ToothGrowth$dose) = c("Low", "Medium", "High") summary(aov(len ~ supp*dose, data=ToothGrowth)) ``` There appears to be a large effect of the dosage, a small effect of the supplement type, and perhaps a hint of an interaction. The `anovaBF` function will compute the Bayes factors of all models against the intercept-only model; by default, it will choose the subset of all models in which which an interaction can only be included if all constituent effects or interactions are included (argument `whichModels` is set to `withmain`, indicating that interactions can only enter in with their main effects). However, this setting can be changed, as we will demonstrate. First, we show the default behavior. ```{r } bf = anovaBF(len ~ supp*dose, data=ToothGrowth) bf ``` The function will build the requested models from the terms included in the right-hand side of the formula; we could have specified the sum of the two terms, and we would have gotten the same models. The Bayes factor analysis is consistent with the classical ANOVA analysis; the favored model is the full model, with both main effects and the two-way interaction. Suppose we were interested in comparing the two main-effects model and the full model to the `dose`-only model. We could use indexing and division, along with the `plot` function, to see a graphical representation of these comparisons: ```{r fixedbf,fig.width=10,fig.height=5} plot(bf[3:4] / bf[2]) ``` The model with the main effect of `supp` and the `supp:dose` interaction is preferred quite strongly over the `dose`-only model. There are a number of other options for how to select subsets of models to test. The `whichModels` argument to `anovaBF` controls which subsets are tested. As described previously, the default is `withmain`, where interactions are only allowed if all constituent sub-effects are included. The other three options currently available are `all`, which tests all models; `top`, which includes the full model and all models that can be formed by removing one interaction or main effect; and `bottom`, which adds single effects one at a time to the null model. The argument `whichModels='all'` should be used with caution: a three-way ANOVA model will contain \(2^{2^3-1}-1 = 127\) model comparisons; a four-way ANOVA, \(2^{2^4-1}-1 = 32767\) models, and a five-way ANOVA just over 2.1 billion models. Depending on the speed of your computer, a four-way ANOVA may take several hours to a day, but a five-way ANOVA is probably not feasible. One alternative is `whichModels='top'`, which reduces the number of comparisons to \(2^k-1\), where \(k\) is the number of factors, which is manageable. In orthogonal designs, one can construct tests of each main effect or interaction by comparing the full model to the model with all effects except the one of interest: ```{r } bf = anovaBF(len ~ supp*dose, data=ToothGrowth, whichModels="top") bf ``` Note that all of the Bayes factors are less than 1, indicating that removing any effect from the full model is deleterious. Another way we can reduce the number of models tested is simply to test only specific models of interest. In the example above, for instance, we might want to compare the model with the interaction to the model with only the main effects, if our effect of interest was the interaction. We can do this with the `lmBF` function. ```{r} bfMainEffects = lmBF(len ~ supp + dose, data = ToothGrowth) bfInteraction = lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth) ## Compare the two models bf = bfInteraction / bfMainEffects bf ``` The model with the interaction effect is preferred by a factor of about 3. Suppose that we were unhappy with the ~`r round(extractBF(bf)$error*100,1)`% proportional error on the Bayes factor `bf`. `anovaBF` and `lmBF` use Monte Carlo integration to estimate the Bayes factors. The default number of Monte Carlo samples is 10,000 but this can be increased. We could use the `recompute` to reduce the error. The `recompute` function performs the sampling required to build the Bayes factor object again: ```{r} newbf = recompute(bf, iterations = 500000) newbf ``` The proportional error is now below 1%. As before, we can use MCMC methods to estimate parameters through the `posterior` function: ```{r} ## Sample from the posterior of the full model chains = posterior(bfInteraction, iterations = 10000) ## 1:13 are the only "interesting" parameters summary(chains[,1:13]) ``` And we can plot the posteriors of some selected effects: ```{r} plot(chains[,4:6]) ``` #### Mixed models (including repeated measures) In order to demonstrate the analysis of mixed models using `BayesFactor`, we will load the `puzzles` data set, which is part of the `BayesFactor` package. See `?puzzles` for details. The data set consists of four columns: `RT` the dependent variable, which is the number of seconds that it took to complete a puzzle; `ID` which is a participant identifier; and `shape` and `color`, which are two factors that describe the type of puzzle solved. `shape` and `color` each have two levels, and each of 12 participants completed puzzles within combination of `shape` and `color`. The design is thus 2x2 factorial within-subjects. We first load the data, then perform a traditional within-subjects ANOVA. ```{r } data(puzzles) ``` ```{r puzzlesplot,fig.width=7,fig.height=5,echo=FALSE} ## plot the data aovObj = aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles) matplot(t(matrix(puzzles$RT,12,4)),ty='b',pch=19,lwd=1,lty=1,col=rgb(0,0,0,.2), ylab="Completion time", xlab="Condition",xaxt='n') axis(1,at=1:4,lab=c("round&mono","square&mono","round&color","square&color")) mns = tapply(puzzles$RT,list(puzzles$color,puzzles$shape),mean)[c(2,4,1,3)] points(1:4,mns,pch=22,col="red",bg=rgb(1,0,0,.6),cex=2) # within-subject standard error, uses MSE from ANOVA stderr = sqrt(sum(aovObj[[5]]$residuals^2)/11)/sqrt(12) segments(1:4,mns + stderr,1:4,mns - stderr,col="red") ``` (Code for plot omitted) Individual circles joined by lines show participants; red squares/lines show the means and within-subject standard errors. From the plot, there appear to be main effects of `color` and shape, but no interaction. ```{r} summary(aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles)) ``` The classical ANOVA appears to corroborate the impression from the plot. In order to compute the Bayes factor, we must tell `anovaBF` that `ID` is an additive effect on top of the other effects (as is typically assumed) and is a random factor. The `anovaBF` call below shows how this is done: ```{r tidy=FALSE} bf = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID") ``` We alert `anovaBF` to the random factor using the `whichRandom` argument. `whichRandom` should contain a character vector with the names of all random factors in it. All other factors are assumed to be fixed. The `anovaBF` will find all the fixed effects in the formula, and compute the Bayes factor for the subset of combinations determined by the `whichModels` argument (see the previous section). Note that `anovaBF` does not test random factors; they are assumed to be nuisance factors. The null model in a test with random factors is not the intercept-only model; it is the model containing the random effects. The Bayes factor object `bf` thus now contains Bayes factors comparing various combinations of the fixed effects and an additive effect of `ID` against a denominator containing only `ID`: ```{r} bf ``` The main effects model is preferred against all models. We can plot the Bayes factor object to obtain a graphical representation of the model comparisons: ```{r testplot,fig.width=10,fig.height=5} plot(bf) ``` Because the `anovaBF` function does not test random factors, we must use `lmBF` to build such tests. Doing so is straightforward. Suppose that we wished to test the random effect `ID` in the `puzzles` example. We might compare the full model `shape + color + shape:color + ID` to the same model without `ID`: ```{r} bfWithoutID = lmBF(RT ~ shape*color, data = puzzles) bfWithoutID ``` But notice that the denominator model is the intercept-only model; the denominator in the previous analysis was the `ID` only model. We need to compare the model with no `ID` effect to the model with only `ID`: ```{r} bfOnlyID = lmBF(RT ~ ID, whichRandom="ID",data = puzzles) bf2 = bfWithoutID / bfOnlyID bf2 ``` Since our `bf` object and `bf2` object now have the same denominator, we can concatenate them into one Bayes factor object: ```{r} bfall = c(bf,bf2) ``` and we can compare them by dividing: ```{r} bf[4] / bf2 ``` The model with `ID` is preferred by a factor of over 1 million, which is not surprising. Any model that is a combination of fixed and random factors, including interations between fixed and random factors, can be constructed and tested with `lmBF`. `anovaBF` is designed to be a convenience function as is therefore somewhat limited in flexibility with respect to the models types it can test; however, because random effects are often nuisance effects, we believe `anovaBF` will be sufficient for most researchers' use. ### Linear regression Model comparison in multiple linear regression using `BayesFactor` is done via the approach of [Liang, Paulo, Molina, Clyde, and Berger (2008)](#Liangetal). Further discussion can be found in [Rouder & Morey (in press)](#Rouderregression). To demonstrate Bayes factor model comparison in a linear regression context, we use the `attitude` data set in R. See `?attitude`. The `attitude` consists of the dependent variable `rating`, along with 6 predictors. We can use `BayesFactor` to compute the Bayes factors for many models simultaneously, or single Bayes factors against the model containing no predictors. ```{r regressData} data(attitude) ## Traditional multiple regression analysis lmObj = lm(rating ~ ., data = attitude) summary(lmObj) ``` The period (`.`) is shorthand for all remaining columns, besides `rating`. The predictors `complaints` and `learning` appear most stongly related to the dependent variable, especially `complaints`. In order to compute the Bayes factors for many model comparisons at onces, we use the `regressionBF` function. The most obvious set of all model comparisons is all possible additive models, which is returned by default: ```{r regressAll} bf = regressionBF(rating ~ ., data = attitude) length(bf) ``` The object `bf` now contains \(2^p-1\), or `r length(bf)`, model comparisons. Large numbers of comparisons can get unweildy, so we can use the functions built into R to manipulate the Bayes factor object. ```{r regressSelect} ## Choose a specific model bf["privileges + learning + raises + critical + advance"] ## Best 6 models head(bf, n=6) ## Worst 4 models tail(bf, n=4) ``` ```{r regressSelectwhichmax,eval=FALSE} ## which model index is the best? which.max(bf) ``` ```{r regressSelectwhichmaxFake,echo=FALSE} ## which model index is the best? BayesFactor::which.max(bf) ``` ```{r regressSelect2} ## Compare the 5 best models to the best bf2 = head(bf) / max(bf) bf2 plot(bf2) ``` The model preferred by Bayes factor is the `complaints`-only model, followed by the `complaints + learning` model, as might have been expected by the classical analysis. We might also be interested in comparing the most complex model to all models that can be formed by removing a single covariate, or, similarly, comparing the intercept-only model to all models that can be formed by added a covariate. These comparisons can be done by setting the `whichModels` argument to `'top'` and `'bottom'`, respectively. For example, for testing against the most complex model: ```{r regresstop, fig.width=10, fig.height=5} bf = regressionBF(rating ~ ., data = attitude, whichModels = "top") ## The seventh model is the most complex bf plot(bf) ``` With all other covariates in the model, the model containing `complaints` is preferred to the model not containing `complaints` by a factor of almost 80. The model containing `learning`, is only barely favored to the one without (a factor of about 1.3). A similar "bottom-up" test can be done, by setting `whichModels` to `'bottom'`. ```{r regressbottom, fig.width=10, fig.height=5} bf = regressionBF(rating ~ ., data = attitude, whichModels = "bottom") plot(bf) ``` The mismatch between the tests of all models, the "top-down" test, and the "bottom-up" test shows that the covariates share variance with one another. As always, whether these tests are interpretable or useful will depend on the data at hand. In cases where it is desired to only compare a small number of models, the `lmBF` function can be used. Consider the case that we wish to compare the model containing only `complaints` to the model containing `complaints` and `learning`: ```{r lmregress1} complaintsOnlyBf = lmBF(rating ~ complaints, data = attitude) complaintsLearningBf = lmBF(rating ~ complaints + learning, data = attitude) ## Compare the two models complaintsOnlyBf / complaintsLearningBf ``` The `complaints`-only model is slightly preferred. As with the other Bayes factors, it is possible to sample from the posterior distribution of a particular model under consideration. If we wanted to sample from the posterior distribution of the `complaints + learning` model, we could use the `posterior` function: ```{r lmposterior} chains = posterior(complaintsLearningBf, iterations = 10000) summary(chains) ``` Compare these to the corresponding results from the classical regression analysis: ```{r lmregressclassical} summary(lm(rating ~ complaints + learning, data = attitude)) ``` The results are quite similar, apart from the intercept. This is due to the Bayesian model centering the covariates before analysis, so the `mu` parameter is the mean of $y$ rather than the expected value of the response variable when all uncentered covariates are equal to 0. General linear models: mixing continuous and categorical covariates -------- The `anovaBF` and `regressionBF` functions are convenience functions designed to test several hypotheses of a particular type at once. Neither function allows the mixing of continuous and categorical covariates. If it is desired to test a model including both kinds of covariates, `lmBF` function must be used. We will continue the `ToothGrowth` example, this time without converting `dose` to a categorical variable. Instead, we will model the logarithm of the dose. ```{r echo=FALSE,results='hide'} rm(ToothGrowth) ``` ```{r GLMdata} data(ToothGrowth) # model log2 of dose instead of dose directly ToothGrowth$dose = log2(ToothGrowth$dose) # Classical analysis for comparison lmToothGrowth <- lm(len ~ supp + dose + supp:dose, data=ToothGrowth) summary(lmToothGrowth) ``` The classical analysis, presented for comparison, reveals extremely low p values for the effects of the supplement type and of the dose, but the interaction p value is more moderate, at about 0.03. We can use the `lmBF` function to compute the Bayes factors for all models of interest against the null model, which in this case is the intercept-only model. We then concatenate them into a single Bayes factor object for convenience. ```{r GLMs} full <- lmBF(len ~ supp + dose + supp:dose, data=ToothGrowth) noInteraction <- lmBF(len ~ supp + dose, data=ToothGrowth) onlyDose <- lmBF(len ~ dose, data=ToothGrowth) onlySupp <- lmBF(len ~ supp, data=ToothGrowth) allBFs <- c(full, noInteraction, onlyDose, onlySupp) allBFs ``` The highest two Bayes factors belong to the full model and the model with no interaction. We can directly compute the Bayes factor for the simpler model with no interaction against the full model: ```{r GLMs2} full / noInteraction ``` The evidence here is clearly equivocal. We can also use the `posterior` function to compute parameter estimates. ```{r GLMposterior1} chainsFull <- posterior(full, iterations = 10000) # summary of the "interesting" parameters summary(chainsFull[,1:7]) ``` The left panel of the figure below shows the data and linear fits. The green points represent guinea pigs given the orange juice supplement (OJ); red points represent guinea pigs given the vitamin C supplement. The solid lines show the posterior means from the Bayesian model; the dashed lines show the classical least-squares fit when applied to each supplement separately. The fits are quite close. ```{r GLMposterior2,results='hide',echo=FALSE} chainsNoInt <- posterior(noInteraction, iterations = 10000) ``` ```{r GLMplot,echo=FALSE,fig.width=10, fig.height=5} ToothGrowth$dose <- ToothGrowth$dose - mean(ToothGrowth$dose) cmeans <- colMeans(chainsFull)[1:6] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] + c(-1, 1) * cmeans[5] par(cex=1.8, mfrow=c(1,2)) plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps[1],col=2) abline(a=ints[2],b=slps[2],col=3) axis(1,at=-1:1,lab=2^(-1:1)) dataVC <- ToothGrowth[ToothGrowth$supp=="VC",] dataOJ <- ToothGrowth[ToothGrowth$supp=="OJ",] lmVC <- lm(len ~ dose, data=dataVC) lmOJ <- lm(len ~ dose, data=dataOJ) abline(lmVC,col=2,lty=2) abline(lmOJ,col=3,lty=2) mtext("Interaction",3,.1,adj=1,cex=1.3) # Do single slope cmeans <- colMeans(chainsNoInt)[1:4] ints <- cmeans[1] + c(-1, 1) * cmeans[2] slps <- cmeans[4] plot(len ~ dose, data=ToothGrowth, pch=as.integer(ToothGrowth$supp)+20, bg = rgb(as.integer(ToothGrowth$supp)-1,2-as.integer(ToothGrowth$supp),0,.5),col=NULL,xaxt="n",ylab="Tooth length",xlab="Vitamin C dose (mg)") abline(a=ints[1],b=slps,col=2) abline(a=ints[2],b=slps,col=3) axis(1,at=-1:1,lab=2^(-1:1)) mtext("No interaction",3,.1,adj=1,cex=1.3) ``` Because the no-interaction model fares so well against the interaction model, it may be instructive to examine the fit of the no-interaction model. We sample from the no-interaction model with the `posterior` function: ```{r eval=FALSE} chainsNoInt <- posterior(noInteraction, iterations = 10000) # summary of the "interesting" parameters summary(chainsNoInt[,1:5]) ``` ```{r echo=FALSE} summary(chainsNoInt[,1:5]) ``` The right panel of the figure above shows the fit of the no-interaction model to the data. This model appears to account for the data satisfactorily. Though the moderate p value of the classical result might lead us to reject the no-interaction model, the Bayes factor and the visual fit appear to agree that the evidence is equivocal at best. We have now analyzed the `ToothGrowth` data using both ANOVA (with `dose` as a factor) and regression (with `dose` as a continuous covariate). We may wish to compare the two approaches. We first create a column of the data with `dose` as a factor, then use `anovaBF`: ```{r} ToothGrowth$doseAsFactor <- factor(ToothGrowth$dose) levels(ToothGrowth$doseAsFactor) <- c(.5,1,2) aovBFs <- anovaBF(len ~ doseAsFactor + supp + doseAsFactor:supp, data = ToothGrowth) ``` Because all models we've considered are compared to the null intercept-only model, we can concatenate the `aovBFs` object with the Bayes factors we previously computed in this section: ```{r} allBFs <- c(aovBFs, full, noInteraction, onlyDose) ## eliminate the supp-only model, since it performs so badly allBFs <- allBFs[-1] ## Compare to best model allBFs / max(allBFs) ``` Two of the models score essentially equally well in terms of Bayes factors: `supp + dose + supp:dose` and `supp + dose`, suggesting that the interaction adds little. The Bayes factors where dose is treated as a factor are all worse than when dose is treated as a continuous covariate. This is likely due to a the added flexibility allowed by including more parameters. Plotting the Bayes factors shows how large the differences are: ```{r GLMplot2,echo=FALSE,fig.width=10, fig.height=5} plot(allBFs / max(allBFs)) ``` #### Linear correlation (0.9.12-4+) Ly, Verhagen, and Wagenmakers (2015; [link](#LyCor)) present a Bayes factor test for linear correlation. The `BayesFactor` package allows the computing of the Bayes factor and sampling from the posterior of the Bayes factor. Note that the model and priors are somewhat different from those used in the linear regression models presented above; further discussion can be found in Ly et al. We demonstrate the use of the `correlationBF` function using Fisher's `iris` data set built into `R`. See the help (`?iris` in R) for more details. We will focus on the correlation between `Sepal.Length` and `Sepal.Width`. First, we create a scatterplot. ```{r} plot(Sepal.Width ~ Sepal.Length, data = iris) abline(lm(Sepal.Width ~ Sepal.Length, data = iris), col = "red") ``` There does not appear to be a substantial correlation between these two variables. We can compute a classical test of the correlation using `R`'s `cor.test` function: ```{r} cor.test(y = iris$Sepal.Length, x = iris$Sepal.Width) ``` The $p$ value is nonsignificant at typical $\alpha$ levels, and the point estimate is not terribly impressive at -0.12. To compute the corresponding Bayes factor test, we use the `correlationBF` function (note the default prior scale). ```{r} bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) bf ``` As would be expected from the middling $p$ value in the classical test, the Bayes factor test shows little evidence either way (about `r round(as.vector(1/bf),1)` in favor of the null). If we'd like to estimate the correlation on the assumption that it is non-zero, we can sample from the posterior distribution using the `posterior` function. ```{r} samples = posterior(bf, iterations = 10000) ``` The important parameter is `rho`, the estimate of the true linear correlation. ```{r} summary(samples) ``` The posterior mean and credible interval for `rho` are very close to the point estimate and confidence interval obtained from `cor.test`. We can also plot the full posterior distribution, if we like: ```{r} plot(samples[,"rho"]) ``` ### Tests of single proportions (0.9.9+) The default test for a proportion assumes that all observations were independent with fixed probability $\pi$. The rule for stopping can be fixed $N$ ([binomial sampling](http://en.wikipedia.org/wiki/Binomial_distribution)) or a fixed number of successes ([negative binomial sampling](http://en.wikipedia.org/wiki/Negative_binomial_distribution)); unlike a significance test, the Bayes factor does not depend on the stopping rule. For the Bayes factor test of a single proportion, there are two hypotheses; the null hypothesis assumes that the probability $\pi$ is a fixed, known value $p$; under the alternative, the log-odds corresponding to $\pi$, denoted $\omega = \log(\pi/(1-\pi))$, has a logistic distribution centered on the log-odds corresponding to the null value $p$ (denoted $\omega_0 = \log(p/(1-p))$: \[ \omega \sim \mbox{logistic}(\mbox{mean}=\omega_0, \mbox{scale}=r) \] The default prior $r$ scale is 1/2. The figure below shows the prior distribution assuming the null hypothesis $p=0.5$, for the three named prior scale settings $r$ ("medium", "wide", and "ultrawide"). The default is "medium": ```{r propprior,echo=FALSE,fig.width=10, fig.height=5} p0 = .5 rnames = c("medium","wide","ultrawide") r = sapply(rnames,function(rname) BayesFactor:::rpriorValues("proptest",,rname)) leg_names = paste(rnames," (r=",round(r,3), ")", sep="") omega = seq(-5,5,len=100) pp = dlogis(omega,qlogis(p0),r[1]) plot(omega,pp, col="black", typ = 'l', lty=1, lwd=2, ylab="Prior density", xlab=expression(paste("True log odds ", omega)), yaxt='n') pp = dlogis(omega,qlogis(p0),r[2]) lines(omega, pp, col = "red",lty=1, lwd=2) pp = dlogis(omega,qlogis(p0),r[3]) lines(omega, pp, col = "blue",lty=1,lwd=2) axis(3,at = -2:2 * 2, labels=round(plogis(-2:2*2),2)) mtext(expression(paste("True probability ", pi)),3,2,adj=.5) legend(-5,.5,legend = leg_names, col=c("black","red","blue"), lwd=2,lty=1) ``` The following example is taken from `?binom.test`, which cites [Conover (1971)](#Conover). > Under (the assumption of) simple Mendelian inheritance, a cross between plants of two particular genotypes produces progeny 1/4 of which are "dwarf" and 3/4 of which are "giant", respectively. In an experiment to determine if this assumption is reasonable, a cross results in progeny having 243 dwarf and 682 giant plants. If "giant" is taken as success, the null hypothesis is that $p = 3/4$ and the alternative that $p \neq 3/4$. ```{r} bf = proportionBF( 682, 682 + 243, p = 3/4) 1 / bf ``` The Bayes factor favors the null hypothesis by a factor of about 7 (which is not surprising given that the observed proportion is 73.7%). In contrast, the best we can say about the classical result is that it is not statistically "significant": ```{r} binom.test(682, 682 + 243, p = 3/4) ``` Using the `posterior` function, we can draw samples from the posterior distribution of the true log odds and true probability and plot the estimate of the posterior. ```{r proppost,fig.width=10, fig.height=5} chains = posterior(bf, iterations = 10000) plot(chains[,"p"], main = "Posterior of true probability\nof 'giant' progeny") ``` ### Contingency tables (0.9.9+) The `BayesFactor` package implements versions of [Gunel and Dickey's (1974)](#GunelDickey) contingency table Bayes factor tests. Bayes factors for contingency tests are computed using the `contingencyTableBF` function. The necessary arguments are a matrix of cell frequencies and details about the sampling plan that produced the data. Here, we provide an example analysis of [Hraba and Grant's (1970)](#HrabaGrant) data, included as part of the `BayesFactor` package as the `raceDolls` data set. 71 white children and 89 black children from Lincoln, Nebraska were offered two dolls, one of whose "race" was the same as the child's and one that was different (either white or black). The children were then asked to select one of the dolls, with prompts such as "Give me the doll that is a nice doll." 50 of the 71 white children (70%) selected the white doll, while 48 of the 89 black children (54%) selected the black doll. These data are shown in the table below: ```{r results='asis', echo=FALSE} data(raceDolls) kable(raceDolls) ``` We can perform a Bayes factor analysis using the `contingencyTableBF` function: ```{r} bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") bf ``` Here we used `sampleType="indepMulti"` and `fixedMargin="cols"` to specify that the columns are assumed to be sampled as independent multinomials with their total fixed. See the help at `?contingencyTableBF` for more details about possible sampling plans and the priors. The Bayes factor in favor of the alternative that the factors are not independent is just shy of 2, which is not very much evidence against the null hypothesis. For comparison, consider the results classical chi-square test, with continuity correction: ```{r} chisq.test(raceDolls) ``` The classical test is just barely statistically significant. We can also use the `posterior` function to estimate the difference in probabilities of selecing a doll of the same race between white and black children, assuming the non-independence alternative: ```{r} chains = posterior(bf, iterations = 10000) ``` For the independent multinomial sampling plan, the chains will contain the individual cell probabilities and the marginal column probabilities. We first need to compute the conditional probabilities from the results: ```{r} sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"] sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"] ``` ...and then plot the MCMC estimate of the difference: ```{r ctablechains,fig.width=10, fig.height=5} plot(mcmc(sameRaceGivenWhite - sameRaceGivenBlack), main = "Increase in probability of child picking\nsame race doll (white - black)") ``` For more information, see `?contingencyTableBF`. Additional tips and tricks (0.9.4+) --------- In this section, tricks to help save time and memory are described. These tricks work with version BayesFactor version 0.9.4+, unless otherwise indicated. ### Testing restrictions on linear models: generalTestBF The convienience functions `anovaBF` and `regressionBF` are specifically designed for cetagorical and continuous covariates respectively, and have limitations that make those functions easier to use. For instance, `anovaBF` cannot incorporate continuous covariates, and treats random effects as untested nuissance parameters. The `regressionBF` on the other hand, being strictly for multiple regression, cannot incorporate categorical covariates. These functions exist for particular purposes, since guessing what model comparisons a user wants in general is difficult. The `lmBF` function, on the other hand, can handle any model but is limited to a single model comparison: the specified model against the intercept-only model. The `generalTestBF` function allows the testing of groups of models (like `anovaBF` and `regressionBF`) but can handle any kind of model (like `lmBF`). Users specify a full model, and `generalTestBF` successively removes terms from that model and tests the resulting submodels. For example, using the `puzzles` data set described above: ```{r} data(puzzles) puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID") puzzleGenBF ``` The resulting 9 models are the full model, plus the models that can be built by removing a single term at a time from the full model. By default, the `generalTestBF` function will not eliminate a term that is involved in a higher-order interaction (for instance, we will not remove `shape` unless the `shape:color` interaction is also removed); this behavior can be modified through the `whichModels` argument. It is often the case that some terms are nuisance terms that we would like to always keep in the model. For instance, `ID` in the `puzzles` data set is a participant effect; we would not generally consider models without a participant effect to be plausible. We can use the `neverExclude` argument to the function to specify a set of search terms (technically, [extended regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html)) that, if matched, will specify that the term is always to be kept, and never excluded. To keep the `ID` term: ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ``` The function now only considers models that contain `ID`. In some cases — especially when variable names are short, or a term to be kept is part of an interaction term that can be eliminated — we need to be careful in specifying search terms using `neverExclude`. For instance, suppose we are interested in testing the `ID:shape` interaction ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="ID") puzzleGenBF ``` The `shape:ID` interaction is never eliminated, because it matches the `ID` search term from `neverExclude`. [Regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html) are useful here. There are special characters representing the beginning and ending of a string (`^` and `$`, respectively) that we can use to construct a regular expression that will match `ID` but not `shape:ID`: ```{r} puzzleGenBF <- generalTestBF(RT ~ shape + color + shape:color + shape:ID + ID, data=puzzles, whichRandom="ID", neverExclude="^ID$") puzzleGenBF ``` The `shape:ID` interaction term is now eliminated in some models, because it does not match `"^ID$"`. Multiple terms may be provided to `neverExclude` by providing a character vector; terms which match any element in the vector will always be included in model comparisons. ### Saving time: Pre-culling Bayes factor objects In cases where the default analysis produces many models to compare, the sampling approach to computing Bayes factors can be time consuming. The `BayesFactor` package identifies situations where sampling is not needed and thus saves time, but any model in which there is more than one categorical factor or a mix of categorical and continuous predictors will require sampling. When a default analysis produces many models that are not of interest, much of the time spent sampling may be wasted. The main functions in the `BayesFactor` package include the `noSample` argument which, if true, will prevent sampling. If a Bayes factor can be computed without sampling, the package will compute it, returning `NA` for Bayes factors that would require sampling. Continuing using the `puzzles` dataset: ```{r} puzzleCullBF <- generalTestBF(RT ~ shape + color + shape:color + ID, data=puzzles, whichRandom="ID", noSample=TRUE,whichModels='all') puzzleCullBF ``` Here we use `whichModels='all'` for demonstration, in order to obtain more possible model comparisons. Notice that several of the Bayes factors were computable without sampling, and are reported. The others have missing values, because the Bayes factor would have required sampling to compute. For now, we can separate the missing and non-missing Bayes factors in separate variables. This is made easy by the `is.na` method for BayesFactor objects: ```{r} missing = puzzleCullBF[ is.na(puzzleCullBF) ] done = puzzleCullBF[ !is.na(puzzleCullBF) ] missing ``` The variable `missing` now contains all models for which we lack a Bayes factor. At this point, we decide which of the Bayes factors we would like to compute. We can do this in any way we like: we could simple specify a subset, like `missing[1:3]` or we could do something more complicated. Here, we will include based on the model formula, using the R function `grepl` ([?grepl](http://stat.ethz.ch/R-manual/R-devel/library/base/html/grep.html)). Suppose we only wanted models that did not include *both* `shape` and `color`. First, we obtain the names of the models in `missing`, and then test the names to see if they match our restriction with `grepl`. We can use the result to restrict the models to compare to only those of interest. ```{r} # get the names of the numerator models missingModels = names(missing)$numerator # search them to see if they contain "shape" or "color" - # results are logical vectors containsShape = grepl("shape",missingModels) containsColor = grepl("color",missingModels) # anything that does not contain "shape" and "color" containsOnlyOne = !(containsShape & containsColor) # restrict missing to only those of interest missingOfInterest = missing[containsOnlyOne] missingOfInterest ``` We have restricted our set down to `r length(missingOfInterest)` items from `r length(missing)` items. We can now use `recompute` to compute the missing Bayes factors: ```{r} # recompute the Bayes factors for the missing models of interest sampledBayesFactors = recompute(missingOfInterest) sampledBayesFactors # Add them together with our other Bayes factors, already computed: completeBayesFactors = c(done, sampledBayesFactors) completeBayesFactors ``` Note that we're still left with one model that contains both `shape` and `color`, because it was computed without sampling. Assuming that we were not interested in any model containing both `shape` and `color`, however, we may have saved considerable time by not sampling to estimate their Bayes factors. The `noSample` argument will also work with the sampling of posteriors. This is especially useful, for instance, if one would like to know what order the MCMC chain results will be output in before sampling. ### Saving memory: Thinning and filtering MCMC chains Modern computer systems, which have many gigabytes of RAM, contain sufficient memory to perform analyses of moderate scale using the `BayesFactor` package. Some systems — particularly older 32-bit systems — are limited in the amount of memory that can address. Posterior sampling can create output that is hundreds of megabytes in size. If a user conducts several of these analyses, R may not have sufficient memory to store the results. Consider, for instance, an analysis with 100 participants, 100 items, and two fixed effects with 3 levels each. We include all main effects in the model, as well as all two-way interactions (excluding the participant by item interaction). This results in 619 parameters. Because each number stored in an MCMC chain uses 8 bytes of memory, each iterations of the chain uses 8*619=4952 bytes. If a user then requests a 100,000 iteration MCMC chain — a large, but not unreasonably, sized MCMC chain — the resulting object will use about 500Mb of memory. This is most of the memory available to the default installation of R on a 32-bit Windows system. Even if a computer has a lot of memory, many of the parameters may not be interesting to the analyst. The participant and item effects, for instance, may be nuisance variation. If a user is not interested in the estimates, it is a waste of memory to include them in the MCMC chain. The `BayesFactor` package includes several methods for reducing the size of MCMC chains: column filtering and chain thinning. Column filtering ensures that certain parameters do not appear in the output; thinning reduces the length of MCMC chains by only keeping some of the iterations. #### Column filtering Consider again the `puzzles` data set. We begin by sampling from the MCMC chain of the model with the main effect of `shape` and `color`, along with their interaction, plus a participant effect: ```{r} data(puzzles) # Get MCMC chains corresponding to "full" model # We prevent sampling so we can see the parameter names # iterations argument is necessary, but not used fullModel = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3) fullModel ``` Notice that the participant effects, which are often regarded as nuisance, are included in the chain. These parameters double the size of the MCMC object; if we are not interested in the parameter values, we could eliminate them from the output for a considerable savings. This does not mean, however, that the parameters are not estimated; they will still be used by `BayesFactor`, but will not be reported. To do this, we pass the `columnFilter` argument to the sampler, which surpresses output of any columns that arise from a term matched by an element in `columnFilter.` ```{r} fullModelFiltered = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, noSample=TRUE, posterior = TRUE, iterations=3,columnFilter="ID") fullModelFiltered ``` Like the `neverExclude` argument discussed [above](#generalTestBF), the `columnFilter` argument is a character vector of [extended regular expressions](http://stat.ethz.ch/R-manual/R-patched/library/base/html/regex.html). If a model term is matched by a search term in `columnFilter`, then all columns for term are eliminated from the MCMC output. Remember that `"ID"` will match anything containing letters `ID`; it would, for instance, also eliminate terms `GID` and `ID:shape`, if they existed. See the [manual section on `generalTestBF`](#generalTestBF) for details about how to use specific regular expressions to avoid eliminating columns by accident. #### Chain thinning MCMC chains are characterized by the fact that successive iterations are correlated with one another: that is, they are not indepenedent samples from the posterior distribution. To see this, we sample from the posterior of the full model and plot the results: ```{r} # Sample 10000 iterations, eliminating ID columns chains = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, posterior = TRUE, iterations=10000,columnFilter="ID") ``` The figure below shows the first 1000 iterations of the MCMC chain for a selected parameter (left), and the *autocorrelation function* [[CRAN](http://stat.ethz.ch/R-manual/R-patched/library/stats/html/acf.html) / [Wikipedia](http://en.wikipedia.org/wiki/Autocorrelation)] for the same parameter (right). ```{r acfplot,fig.width=10,fig.height=5,echo=FALSE} par(mfrow=c(1,2)) plot(as.vector(chains[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chains[,"shape-round"]) ``` The autocorrelation here is minimal, which will be the case in general for chains from the `BayesFactor` package. If we wanted to reduce it even further, we might consider *thinning* the chain: that is, keeping only every \(k\) iterations. Thinning throws away information, and is generally not necessary or recommended; however, if memory is at a premium, we might prefer storing nearly independent samples to storing somewhat dependent samples. The autocorrelation plot shows that the autocorrelation is reduced to 0 after 2 iterations. To get nearly independent samples, then, we could thin to every \(k=2\) iterations using the `thin` argument: ```{r} chainsThinned = recompute(chains, iterations=20000, thin=2) # check size of MCMC chain dim(chainsThinned) ``` Notice that we are left with 10,000 iterations, instead of the 20,000 we sampled, because half were thinned. The figure below shows the resulting MCMC chain and autocorrelation functions. The MCMC chain does not visually look very different, because the autocorrelation was minimal in the first place. However, the autocorrelation function no longer shows autocorrelation from one iteration to the next, implying that we have obtained 10,000 nearly independent samples. ```{r acfplot2,fig.width=10,fig.height=5,echo=FALSE} par(mfrow=c(1,2)) plot(as.vector(chainsThinned[1:1000,"shape-round"]),type="l",xlab="Iterations",ylab="parameter shape-round") acf(chainsThinned[,"shape-round"]) ``` ### Fine-tuning of prior scales (0.9.12-2+) Previous to version `0.9.12-2`, it was only possible to change the priors on a per-effect-type basis; ie, fixed effects all had the same prior scale, random effects had a different prior scale, and slopes had third prior scale. As of `0.9.12-2`, it is possible to change the prior on a per-effect basis for fixed and random effects (slopes still share a common prior, due to the use of the Liang et al. hyper-g priors for the slopes). This is accomplished via the `rscaleEffects` argument to `lmBF`, `anovaBF`, and `generalTestBF`. The `rscaleEffects` argument is a named vector. The names correspond to the effect you'd for which you'd like to set the prior, and the value is the prior scale value. Any settings in `rscaleEffects` will override the settings in `rscaleFixed` and `rscaleRandom`; if no settings are found in `rscaleEffects`, then the settings in `rscaleFixed` and `rscaleRandom` are used. We can demonstrate using the `puzzles` data set. Suppose we prefer a prior on the `color` main effect of $r=1$, a prior twice as wide as the default in `rscaleFixed`, $r=.5$. We set the prior scale for `color` using the `rscaleEffects` argument: ```{r tidy=FALSE} newprior.bf = anovaBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID",rscaleEffects = c( color = 1 )) newprior.bf ``` The other fixed effects, `shape` and `shape:color`, retain the prior scale of $r=.5$ from `rscaleFixed`. Compare these Bayes factors to the ones with in the [mixed modeling](#mixed) section above. References --------- Conover, W. J. (1971), Practical nonparametric statistics. New York: John Wiley & Sons. Pages 97–104. Gunel, E. and Dickey, J. (1974) Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557. ([JSTOR](http://www.jstor.org/stable/2334738)) Hraba, J. and Grant, G. (1970). Black is Beautiful: A reexamination of racial preference and identification. Journal of Personality and Social Psychology, 16, 398-402. [psychnet.apa.org](http://psycnet.apa.org/psycinfo/1971-03987-001) Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 ([Publisher](https://www.tandfonline.com/doi/abs/10.1198/016214507000001337)) Morey, R. D. and Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, pp. 406-419 ([Publisher](http://psycnet.apa.org/buy/2011-15467-001)) Morey, R. D. and Rouder, J. N. and Pratte, M. S. and Speckman, P. L. (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. Journal of Mathematical Psychology, 55, pp. 368-378 ([Publisher](https://www.sciencedirect.com/science/article/pii/S0022249611000666)) Rouder, J. N. and Morey, R. D. (2013) Default Bayes Factors for Model Selection in Regression, Multivariate Behavioral Research, 47, pp. 877-903 ([Publisher](https://www.tandfonline.com/doi/abs/10.1080/00273171.2012.734737)) Rouder, J. N. and Morey, R. D. and Speckman, P. L. and Province, J. M. (2012), Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology, 56, pp. 356–374 ([Publisher](https://www.sciencedirect.com/science/article/pii/S0022249612000806)) Rouder, J. N. and Speckman, P. L. and Sun, D. and Morey, R. D. and Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin and Review, 16, pp. 225-237 ([Publisher](https://link.springer.com/article/10.3758/PBR.16.2.225)) Rouder, J. N. and Morey, R. D. (2011). A Bayes Factor Meta-Analysis of Bem's ESP Claim. Psychonomic Bulletin & Review 18, pp. 682-689 ([Publisher](https://link.springer.com/article/10.3758%2Fs13423-011-0088-7)) Ly, A., Verhagen, A. J. & Wagenmakers, E.-J. (2015). Harold Jeffreys's Default Bayes Factor Hypothesis Tests: Explanation, Extension, and Application in Psychology. Journal of Mathematical Psychology ([Publisher](http://dx.doi.org/10.1016/j.jmp.2015.06.004)) -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/vignettes/odds_probs.Rmd0000644000176200001440000001145213274042462017275 0ustar liggesusers Fork me on GitHub ![BayesFactor logo](extra/logo.png) ------ Odds and probabilities using BayesFactor =============================== Richard D. Morey -----------------
Share via
---- ```{r echo=FALSE,message=FALSE,results='hide'} options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) options(digits=3) require(graphics) set.seed(2) ``` ```{r message=FALSE,results='hide',echo=FALSE} library(BayesFactor) options(BFprogress = FALSE) bfversion = BFInfo() session = sessionInfo()[[1]] rversion = paste(session$version.string," on ",session$platform,sep="") ``` The Bayes factor is only one part of Bayesian model comparison. The Bayes factor represents the relative evidence between two models -- that is, the change in the model odds due to the data -- but the odds are what are being changed. For any two models ${\cal M}_0$ and ${\cal M}_1$ and data $y$, \[ \frac{P({\cal M}_1\mid y)}{P({\cal M}_0\mid y)} = \frac{P(y \mid {\cal M}_1)}{P(y\mid{\cal M}_0)} \times\frac{P({\cal M}_1)}{P({\cal M}_0)}; \] that is, the posterior odds are equal to the Bayes factor times the prior odds. Further, these odds can be converted to probabilities, if we assume that all the models sum to known probability. ### Prior odds with BayesFactor ```{r} data(puzzles) bf = anovaBF(RT ~ shape*color + ID, whichRandom = "ID", data = puzzles) bf ``` With the addition of `BFodds` objects, we can compute prior and posterior odds. A prior odds object can be created from the structure of an existing BayesFactor object: ```{r} prior.odds = newPriorOdds(bf, type = "equal") prior.odds ``` For now, the only type of prior odds is "equal". However, we can change the prior odds to whatever we like with the `priorOdds` function: ```{r} priorOdds(prior.odds) <- c(4,3,2,1) prior.odds ``` ### Posterior odds with BayesFactor We can multiply the prior odds by the Bayes factor to obtain posterior odds: ```{r} post.odds = prior.odds * bf post.odds ``` ### Prior/posterior probabilities with BayesFactor Odds objects can be converted to probabilities: ```{r} post.prob = as.BFprobability(post.odds) post.prob ``` By default the probabilities sum to 1, but we can change this by renormalizing. Note that this normalizing constant is arbitrary, but it can be helpful to set it to specific values. ```{r} post.prob / .5 ``` In addition, we can select subsets of the probabilities, and the normalizing constant is adjusted to the sum of the model probabilities: ```{r} post.prob[1:3] ``` ...which can, in turn, be renormalized: ```{r} post.prob[1:3] / 1 ``` In the future, the ability to filter these objects will be added, as well as model averaging based on posterior probabilities and samples. -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/MD50000644000176200001440000003420613300035654012770 0ustar liggesuserscfe8d6d0f23df800cea270cea7b926dc *DESCRIPTION 95366d8415ab5bc2015b009e0fd2a932 *NAMESPACE 81148e022101a781a9f29d5755c475a9 *NEWS 491d8e8953ebaa3af17133c1cbe77d94 *R/BayesFactorPCL-package.R c07f5aa20300bf63952c1c2fc4e5fac2 *R/RcppExports.R 440b11c82aa5d6e6a426221b7435ff7c *R/aaClasses.R 8699eea296aefd7c890042d7e385e876 *R/aaGenerics.R 3312436b5ce39545c9109fb3e486f134 *R/anovaBF-utility.R d3f84797cdec5890206515a25001af84 *R/anovaBF.R dde5b596c6782568c436f0f1dc47b06e *R/base64.R 1be5d759583f09815cb80d5393d2ed3b *R/checkCallback.R 1560d86e1a26310db8dc52a69682a222 *R/checking.R 32ef3e5315e7f1ec1f4d2b292285eb60 *R/common.R 57ee5fb0c2644f81b44a22cd0bd7c8bf *R/contingency-utility.R 50cf75291caa64e26d8db561245c9340 *R/contingency.R 41a3f1f3b48d80ddc822d3e8e3f00c45 *R/correlation-JASP.R de449f5e87d84c81e5849ce2c5b63bd7 *R/correlation-utility.R 510bc1a9ea7843caed39de5e479112c9 *R/correlationBF.R 5989fe681407b2aff91bbf43c30f756b *R/gaussApproxAOV.R e523fb9ec5fed0a0ba0d9fdc69b85bd1 *R/generalTest-utility.R eb679a7adf63d6453d65ce3c0f76d20c *R/generalTestBF.R f869444c0bf4c2f2221970709a6fcf7a *R/linearReg_R2stat.R ec8d3e7822ed8c22a3551a9a0185c5f9 *R/lmBF.R 510723f520e6ca9f467b26ba2405d376 *R/logMean.R 59d4101f9f7b26ba0467381f299c66b4 *R/manual.R c488eb69b07bd56e604e2143a9010974 *R/meta-ttest-utility.R a539ddc21c1855655b4372859ee3221b *R/meta.ttestBF.R d941da35744649a097144508439719fe *R/methods-BFBayesFactor.R 351c517b90c8322480531b95d2c633a1 *R/methods-BFBayesFactorList.R c874c7488f6d3fe7406a436e0661fd7f *R/methods-BFBayesFactorTop.R d162e21b9a2b872b0b70b062b159bc9b *R/methods-BFlinearModel-compare.R 16687a3c1e3546c60d2c02b6126775f1 *R/methods-BFmodel.R 11eb8c271af8af5984032d7f979562b0 *R/methods-BFmodelSample.R 5c8a04159cb36b9b8e823fc6372d9750 *R/methods-BFodds.R bd5263aad01b6e00efbc9d6159b7ec07 *R/methods-BFprobability.R 8b87339cdcbb6929443818948cff254a *R/model.matrix.R d3a3a42c4daddfb23c930a741be94bd1 *R/nWayAOV-utility.R 83ad6c926ea1477192841e733b8cfd7a *R/nWayAOV.R 87f85018a46f1850dd9349ee2a91c8bb *R/newPriorOdds.R 72d4724676f93a7f48062d6a7634f5b8 *R/onAttach.R 1876b783c276f40803cb52fe58ce44df *R/oneWayAOV-utility.R cff8d846d5fbc42dddaedc56adbbd198 *R/oneWayAOV_Fstat.R 6ad0e0aedf8931c2f2b6bf41c20ebb27 *R/plot-BFBayesFactor.R c172596ccd038db6c887f7cbc5d0f63b *R/plot-BFBayesFactorTop.R ecf7fc8ec1cfbe1678f2598f80e4e117 *R/proportion-utility.R 0a7759325bb77ccd3250540117186590 *R/proportionBF.R 5e7aeead5a96bd842d16105e0d2d77ca *R/regressionBF-utility.R a6a1818ebc9ac61187a58fe4299fb21a *R/regressionBF.R 5fa5118919d2383c679c1026f352bb98 *R/ttest-informed-JASP.R c9335d41e54f65cad72dc6cb55aaf5d2 *R/ttest-utility.R 06bd67841415908465b3c316d606c04e *R/ttestBF.R c38ff0bdd26bd9b3769304e9419e40c8 *R/ttest_tstat.R cce3e64b98c058acf95f32ff45c104a8 *R/version.R 925ebefcb6e7fe95caf5d3162ff16715 *build/vignette.rds 84361c38301923ed3ebe640721267746 *data/puzzles.rda 94e24dbb4ed809a1ac870cdb432ed510 *data/raceDolls.rda 1ccf4cdfbb6ee831b5c60dc2ca0d04ca *inst/doc/compare_lme4.R 664d69ff793b89ef5cb940b5c31a9d94 *inst/doc/compare_lme4.Rmd e90b86302e89d96e0cd97a0513819584 *inst/doc/compare_lme4.html 3444667beceae04bc51450d8537a4954 *inst/doc/index.R ab8952192cc7b37a4343c4fedf54a791 *inst/doc/index.Rmd 7fbf239f48829fef418ac580858b3b34 *inst/doc/index.html 2d29f2810c40e744c87d3c326553efc7 *inst/doc/manual.R a7b4cbadefef5294e9e4d273fbb280f4 *inst/doc/manual.Rmd 4f97b016e04857b94623b04f7ca1cf86 *inst/doc/manual.html 4152a2af90c99e372f47508e1ec3f6f4 *inst/doc/odds_probs.R 12a83925c5eb48221cea2851782311aa *inst/doc/odds_probs.Rmd f9bf5c511d1310a38a3ea461bed0d584 *inst/doc/odds_probs.html 58f497699627aeed95274ddbc16df40c *inst/doc/priors.R 00453f4aedb7029cdcb99427110a9d34 *inst/doc/priors.Rmd 070cbb131001c03a28d9922b4c15ebd6 *inst/doc/priors.html e9400e851188414778e46499702c6108 *inst/include/BayesFactor.h bc49293e445773685371f62db735b84e *inst/include/BayesFactor_RcppExports.h b668c9d076209546253781c4d10668de *inst/tests/test-anovaBF.R 9dd30981551e25568fb2f498924c21e0 *inst/tests/test-contingencyBF.R bcf381239db591a3ebe16269abbda0e7 *inst/tests/test-correlationBF.R df20cb9ef3ab26cd5418e118843e0ff0 *inst/tests/test-generalTestBF.R 86419ffa0e666b4b91414d7964244a45 *inst/tests/test-proportionBF.R cafcb77fd27165c1d7b1c02d5a0cee96 *inst/tests/test-regressionBF.R 6a7c443745adfd210ad0bfb31aa4386c *inst/tests/test-specialchars.R ad11ca0444322892a1c6f42e0d4f674a *inst/tests/test-ttest.R b8385f6b77a6cc5586bf20d291d8cc80 *man/BFBayesFactor-class.Rd 2b12ed5e93a8aa529a667989815fbc58 *man/BFBayesFactorList-class.Rd 0ea0328d7de7a2874a16dc9c461ce8c4 *man/BFInfo.Rd f0b76247ecba5ad3dff41cb8110c5fde *man/BFManual.Rd 4b64080b5990a403e688aec94ed7d596 *man/BFodds-class.Rd 9304ffca3dde3d69feaa44a40e1888d0 *man/BFprobability-class.Rd 17ad812613d2590083d93d592a968270 *man/BayesFactor-package.Rd 44d8b51b16971e22a6b4fbc4ed9d1372 *man/anovaBF.Rd 96031aed3232a0c95b3f7e03c82cb447 *man/as.BFBayesFactor.Rd b9af1dff97bc70504d84797e7d0e8bfd *man/as.BFprobability.Rd 516658e9117c6df5ed3a76be1fa07bd1 *man/compare-methods.Rd f43bce252ed131e6c628b78b46292309 *man/contingencyTableBF.Rd 7f4b3f3a1d57f0d6d6dcbd500d8fa865 *man/correlationBF.Rd b00ed4df2228e7bf15d237ffdef5b264 *man/enumerateGeneralModels.Rd a455451d173c3da00f6a26b6bc33da49 *man/extractBF-methods.Rd abac6655113636ef43d0852e2b6bc91c *man/extractOdds-methods.Rd 1889db93b2fcabfd5c11ff8f09a22708 *man/extractProbabilities-methods.Rd 02df908faa1900c2460a2552d4bbf862 *man/filterBF.Rd 9949ef913fafb31696d7cbfd79d83784 *man/generalTestBF.Rd 147b243d710949259c114db2811abaa2 *man/grapes-same-grapes.Rd 4bf8253732d254fa6a784d1e6ee2b4ca *man/grapes-termin-grapes.Rd c035793a63b1633e993f7755d4044777 *man/linearReg.R2stat.Rd 0b7bbfcfad9da3174a047d934227de1c *man/lmBF.Rd e142e7b64a53fdee081c36096dd641c6 *man/logMeanExpLogs.Rd 79493065f7f15bdae22f7a5d955bd861 *man/meta.ttestBF.Rd ac3732942abacd1c02ee4116b00e11bd *man/model-classes.Rd 3432211b0566c07c57855ada1c5baf29 *man/model.matrix-methods.Rd 71aab955dc3f4ea4339ee03d1dff5a95 *man/nWayAOV.Rd 4a8529a0ec67ac669b64575d3b114bb8 *man/newPriorOdds.Rd 7c320f0ca546ddfdbf558916cfa814bd *man/oneWayAOV.Fstat.Rd acfee0c7b0fccf4d2c775c1cba70e697 *man/options-BayesFactor.Rd 5c3e20760f8a99b853470c7a804193cb *man/plot.BFBayesFactor.Rd ad68f149318c27fc6744826eae2c03c5 *man/plot.BFBayesFactorTop.Rd f1dd7ed3b4d209d9686fb97b2fb50e95 *man/posterior-methods.Rd e7e0a66ffbd74ccf90ee34e5a50b24b6 *man/priorLogodds-method.Rd 5e13942f8591e3d23cb7157defcaeafb *man/priorOdds-method.Rd ed2d44a7a7a5e8045a40edf82d334f23 *man/proportionBF.Rd bd3fd09900c1f219574e5509074d8914 *man/puzzles.Rd 97dad51b55fe47461bd67b939fa123f0 *man/raceDolls.Rd c88b84670252fa37824f50594416f2d8 *man/recompute-methods.Rd 6c3b6340938faeafce8380e4139853b8 *man/regressionBF.Rd 8d677ba1ce9e73342dda9d53573ec908 *man/ttest.tstat.Rd 355b051d665ad2435964de578dfe1c86 *man/ttestBF.Rd 7484c794e068f0f0b773d67328778336 *src/RcppCallback.cpp 402a02d08f1ec534e863d085e0a4d27e *src/RcppExports.cpp cd40a4d89842450277508d0ae22d3933 *src/bfcommon.h d14368c4a1e2cd464c68087174d0d2a3 *src/corr.cpp 6da84348ccc705c261aa769904cff53f *src/dinvgamma.cpp f90adad6b8d2b196e492d0692a747282 *src/genhypergeo_series_pos.cpp d9e574331b181fd8193e4006ca4506eb *src/interruptable_progress_monitor.h f1e03bbe1a2447bb1a81f85bac0ae7c5 *src/interrupts.cpp bc59a64d2e4892e0035300804ee5b1a3 *src/interrupts.h 151f8f86b418b15110634ad2d4ee8122 *src/jzs_Gauss_approx_aov.cpp 3af99cd279ca8be4276b8f54fb2cbe10 *src/jzs_Gibbs.cpp bb4b7b6a005325108404fe742480a382 *src/jzs_bf_samplers.cpp b07139f1bb218821daa53407301725db *src/jzs_marg_like.cpp d40c49c6774ce3b89212b4dec70ac2c7 *src/linearRegGibbsRcpp.cpp 0b1c7d0074f9b252c3fd308d289db0f4 *src/logDeterminant.cpp 3f0ba07672318764c04231b54c817b55 *src/logRepresentedReal.cpp 9ec47b6a605b28bcc21d5421eebe33d7 *src/logRepresentedReal.h 3bb0803385c7b213b839956a9444d3bb *src/logSummaryStats.cpp 8fb1127f33c7823ed7d1780f97b2845f *src/logUtility.cpp f798d4a788dcde608cfcb6c320ec0f7a *src/metattest.cpp 6a212c285b0775a7fa73418ffc2e0c1f *src/progress.cpp 5dc79805599ea7f30493fb68e4bec666 *src/progress.h 609c48b8936bfd93aa8d6caa71d6669a *src/proportion.cpp 7a3aec551441e2b3a0c7c5707da6b6d7 *src/rmvnorm.cpp 529528f24f00037c1c8ea5b3f81994b0 *src/ttestIndepRcpp.cpp 90216ff6ac99895044e9dd0e3e9a5f8f *src/ttestRcpp.cpp 39a3174f994e89ffa5456ea9d59e49c0 *tests/run-all.R 664d69ff793b89ef5cb940b5c31a9d94 *vignettes/compare_lme4.Rmd 043d3860bbe29a3196e6caee9de34104 *vignettes/extra/github.png a3d91ba43b1c49f690673453833f3bdf *vignettes/extra/logo.png 99ee8052eb29f0e923ee83e58a100f08 *vignettes/extra/manual.css 20a557edd8b4d533b430662daf89b04d *vignettes/extra/socialmedia/png/32x32/addthis.png 52295e10951b468edaa5011519a048d2 *vignettes/extra/socialmedia/png/32x32/android.png 3ad393e532071144b4588d843bd8d7bf *vignettes/extra/socialmedia/png/32x32/app_store.png c1afbc9bd1ed21006a176ff9176bc6e9 *vignettes/extra/socialmedia/png/32x32/apple.png 15a72e672bf0c74292f2b9aad2c695ba *vignettes/extra/socialmedia/png/32x32/bebo.png 3fd1ac12162e9f07046524ecbe0df6e7 *vignettes/extra/socialmedia/png/32x32/blogger.png 955608d569f8b5a7d5a65319325187e8 *vignettes/extra/socialmedia/png/32x32/delicious.png 1e62e2e051077434124b0472e9fca75a *vignettes/extra/socialmedia/png/32x32/deviantart.png d1ccf510417643ba4c4b7623ff11343a *vignettes/extra/socialmedia/png/32x32/digg.png 0d0aa14c43e23a3a821650038747874f *vignettes/extra/socialmedia/png/32x32/dribbble.png df6f925d33886984c5f571a3b29e7b5d *vignettes/extra/socialmedia/png/32x32/email.png d518544f4e36bf8b0ef310266e05eddf *vignettes/extra/socialmedia/png/32x32/evernote.png b37ee8fd6a928842151c77d8c1dc076d *vignettes/extra/socialmedia/png/32x32/facebook.png b715e399b6e198bd86108f7b773e4d51 *vignettes/extra/socialmedia/png/32x32/friendster.png 701a8ed635fd697038050bff018f1ef5 *vignettes/extra/socialmedia/png/32x32/google_play.png f7551d6100399386611300c4457c0509 *vignettes/extra/socialmedia/png/32x32/google_plus.png b97bd7456188efaaded31e3272e91fdc *vignettes/extra/socialmedia/png/32x32/hi5.png a7797a7fea391046cd650e5064a8b33d *vignettes/extra/socialmedia/png/32x32/linkedin.png 7a89548bcd0bc41ec83312a583b6cc8c *vignettes/extra/socialmedia/png/32x32/livejournal.png 5cfadffc396bf3011c84ecedbb259b3f *vignettes/extra/socialmedia/png/32x32/myspace.png 2f8024d27771605f36b210f5499fcd7c *vignettes/extra/socialmedia/png/32x32/odnoklassniki.png ce462734f9550976a40ceb69135a7e7b *vignettes/extra/socialmedia/png/32x32/orkut.png dab3696378d471b67c0a0ce92947164f *vignettes/extra/socialmedia/png/32x32/pinterest.png 5a6c4b6af6eb582f15d83c27b92da98c *vignettes/extra/socialmedia/png/32x32/reddit.png bde314fd0a7be899d5d5456705e2d549 *vignettes/extra/socialmedia/png/32x32/rss.png 1fb239d2f9e856e44a79d4af9516b7ae *vignettes/extra/socialmedia/png/32x32/sharethis.png 3805797101752437521329160cc75442 *vignettes/extra/socialmedia/png/32x32/skype.png 5058fca0c0017f1f008732c4f15dad31 *vignettes/extra/socialmedia/png/32x32/stumbleupon.png dca781271955e0af02183c271e96b280 *vignettes/extra/socialmedia/png/32x32/twitter.png 6c87f571e590109bff579bce5020b648 *vignettes/extra/socialmedia/png/32x32/vimeo.png 38f8423cf08d66ac6d549e9823de4f98 *vignettes/extra/socialmedia/png/32x32/vkontakte.png 0b3167532fc691d0410d24437d36c64d *vignettes/extra/socialmedia/png/32x32/wordpress.png c72bb27cc58e5d1cf4893a40c3c731ea *vignettes/extra/socialmedia/png/32x32/youtube.png b54e4856eef22bc1b138aa297e303a4e *vignettes/extra/socialmedia/png/48x48/addthis.png 2eacaa13c169ff7e0ec098ea85b8845b *vignettes/extra/socialmedia/png/48x48/android.png 91b27039a93b0573ee7352b2fc069012 *vignettes/extra/socialmedia/png/48x48/app_store.png 44b58b6353e8e79e368d76ecc93dd171 *vignettes/extra/socialmedia/png/48x48/apple.png e017715fa19a7ba1a3654638b6117eaf *vignettes/extra/socialmedia/png/48x48/bebo.png 93f726c29e9534ecf65f3e676847fa24 *vignettes/extra/socialmedia/png/48x48/blogger.png 213133ca579fc20705bac284f2f72dbb *vignettes/extra/socialmedia/png/48x48/delicious.png 214508592e8b3e2aa421412c584a4153 *vignettes/extra/socialmedia/png/48x48/deviantart.png e65628623b29eb5eb5e9dd13c480fded *vignettes/extra/socialmedia/png/48x48/digg.png 8d5178645f66eda19c92aa49c68c0447 *vignettes/extra/socialmedia/png/48x48/dribbble.png cc2865c01dc11cf374832e558010ffe7 *vignettes/extra/socialmedia/png/48x48/email.png 9c116bbcc9c8715e44b6c30e6808e46e *vignettes/extra/socialmedia/png/48x48/evernote.png 71fe6c7c287b3f034bdcb93cd834c34c *vignettes/extra/socialmedia/png/48x48/facebook.png a7b4b5a4d28c001166e0df80701830cc *vignettes/extra/socialmedia/png/48x48/friendster.png eb3b6cbae1e35d83d9f153fee2e91cfe *vignettes/extra/socialmedia/png/48x48/google_play.png 78b25ac0f73d1b87a9f95fe0ebb52834 *vignettes/extra/socialmedia/png/48x48/google_plus.png dc747edc3c236bc368c4271284697c63 *vignettes/extra/socialmedia/png/48x48/hi5.png ac49a75c8243dfe73b9d3b49315428ec *vignettes/extra/socialmedia/png/48x48/linkedin.png 5e21c507f4c914ee2c7d386843355c11 *vignettes/extra/socialmedia/png/48x48/livejournal.png 4a2f3129a60630f2d0e37f73e22ee2d4 *vignettes/extra/socialmedia/png/48x48/myspace.png 699a3496b801810571d1c15bfb5c7808 *vignettes/extra/socialmedia/png/48x48/odnoklassniki.png cacdb650d10c3ff939310dddf8d8ef29 *vignettes/extra/socialmedia/png/48x48/orkut.png bc5d6212aaa25bb537d92ad017220de9 *vignettes/extra/socialmedia/png/48x48/pinterest.png 27fa010156042ea1978f0894ea044082 *vignettes/extra/socialmedia/png/48x48/reddit.png ae2d67c158f84d1541391a54f4cf0a32 *vignettes/extra/socialmedia/png/48x48/rss.png 698747d654313f46b058270db72d7233 *vignettes/extra/socialmedia/png/48x48/sharethis.png 46c2a048dbfd5f93d756fc20fa1e9ebe *vignettes/extra/socialmedia/png/48x48/skype.png 11cc610474f87c8a8e7861c7e2bcd035 *vignettes/extra/socialmedia/png/48x48/stumbleupon.png 71f22a537152032b5b452c2cb87866f3 *vignettes/extra/socialmedia/png/48x48/twitter.png f9ab5d5d03670c4d08d78b51733fc7ec *vignettes/extra/socialmedia/png/48x48/vimeo.png f164d11f2d5214a1708e3e22911f436b *vignettes/extra/socialmedia/png/48x48/vkontakte.png 9b78a45d7bdf1f7685fd7b5ece78cc84 *vignettes/extra/socialmedia/png/48x48/wordpress.png af9eda2e703d11d8a204fc55f524d778 *vignettes/extra/socialmedia/png/48x48/youtube.png 1a6d575d5eed128f4c3cd02204ccb909 *vignettes/extra/socialmedia/readme.txt ab8952192cc7b37a4343c4fedf54a791 *vignettes/index.Rmd a7b4cbadefef5294e9e4d273fbb280f4 *vignettes/manual.Rmd 12a83925c5eb48221cea2851782311aa *vignettes/odds_probs.Rmd 00453f4aedb7029cdcb99427110a9d34 *vignettes/priors.Rmd BayesFactor/build/0000755000176200001440000000000013277750604013566 5ustar liggesusersBayesFactor/build/vignette.rds0000644000176200001440000000050613277750604016126 0ustar liggesusers‹•R±NÃ0u›¤4Ps6¶L|BÔ… b«Üø ±Ù© ÿDp_åt‚Á—»—˽{/~I!cD66 6Lì¹°'"!‰Û¼P¢¢Ö¥€ÛìA0‡Ç\2øð€DP¹£¥‡Ìcf]iµ1~_¥¹Ò=2¤ºÊA(“RÉÒž”%{9{æoêRr‡à“}cÒžÚ×÷–¶›ÒRÓ /yÍ眭Zú´ØBñnޏhÝÖG&½X9uj=èÜ“ëw:½4䛽uè‰sÖ•Sôø®bzjóEGБ?<ÿÙŽm9ÞHRèâÄá’—€ ¼>Á*_ºtt›C’áß™ÞÁç^i[‰b­ö’ÍÚkûeCÓ4ßÇ%5¸‚ £5Í^µýÞV?¿½…+«øBayesFactor/DESCRIPTION0000644000176200001440000000332613300035654014165 0ustar liggesusersPackage: BayesFactor Type: Package Title: Computation of Bayes Factors for Common Designs Version: 0.9.12-4.2 Date: 2018-05-09 Authors@R: c(person("Richard D.", "Morey", role = c("aut", "cre", "cph"), email = "richarddmorey@gmail.com"), person("Jeffrey N.", "Rouder", role = "aut", email = "jrouder@uci.edu"), person("Tahira", "Jamil", role = c("ctb","cph"), email = "tahjamil@gmail.com"), person("Simon", "Urbanek", role = c("ctb", "cph"), email = "simon.urbanek@r-project.org"), person("Karl", "Forner", role = c("ctb", "cph"), email = "karl.forner@gmail.com"), person("Alexander", "Ly", role = c("ctb", "cph"), email = "Alexander.Ly.NL@gmail.com")) Description: A suite of functions for computing various Bayes factors for simple designs, including contingency tables, one- and two-sample designs, one-way designs, general ANOVA designs, and linear regression. License: GPL-2 VignetteBuilder: knitr Depends: R (>= 3.2.0), coda, Matrix (>= 1.1-1) Imports: pbapply, mvtnorm, stringr, utils, graphics, gtools, MatrixModels, Rcpp (>= 0.11.2), methods, hypergeo Suggests: doMC, foreach, testthat, knitr, markdown, arm, lme4, xtable, languageR URL: https://richarddmorey.github.io/BayesFactor/ BugReports: https://github.com/richarddmorey/BayesFactor/issues LazyLoad: yes LinkingTo: Rcpp (>= 0.11.2), RcppEigen (>= 0.3.2.2.0) RoxygenNote: 6.0.1 NeedsCompilation: yes Packaged: 2018-05-19 07:25:56 UTC; richard Author: Richard D. Morey [aut, cre, cph], Jeffrey N. Rouder [aut], Tahira Jamil [ctb, cph], Simon Urbanek [ctb, cph], Karl Forner [ctb, cph], Alexander Ly [ctb, cph] Maintainer: Richard D. Morey Repository: CRAN Date/Publication: 2018-05-19 14:58:52 UTC BayesFactor/man/0000755000176200001440000000000013274242554013237 5ustar liggesusersBayesFactor/man/extractProbabilities-methods.Rd0000644000176200001440000000134613274042462021352 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFprobability.R \docType{methods} \name{extractProbabilities} \alias{extractProbabilities} \alias{extractProbabilities,BFprobability-method} \title{Extract the probabilities from an object} \usage{ extractProbabilities(x, logprobs = FALSE, onlyprobs = FALSE) \S4method{extractProbabilities}{BFprobability}(x, logprobs = FALSE, onlyprobs = FALSE) } \arguments{ \item{x}{object from which to extract} \item{logprobs}{return the logarithm} \item{onlyprobs}{return a vector of only the probabilities} } \value{ Returns an object containing probabilities extracted from the object } \description{ Extract the probabilities from an object } BayesFactor/man/model.matrix-methods.Rd0000644000176200001440000000264413274042462017574 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model.matrix.R \docType{methods} \name{model.matrix,BFBayesFactor-method} \alias{model.matrix,BFBayesFactor-method} \alias{model.matrix,BFBayesFactor} \alias{model.matrix,BFBayesFactorTop-method} \alias{model.matrix,BFBayesFactor} \title{Design matrices for Bayes factor linear models analyses.} \usage{ \S4method{model.matrix}{BFBayesFactor}(object, ...) \S4method{model.matrix}{BFBayesFactorTop}(object, ...) } \arguments{ \item{object}{a BayesFactor object with a single numerator} \item{...}{arguments passed to and from related methods} } \value{ Returns the design matrix for the corresponding model. The 'gMap' attribute of the returned matrix contains the mapping from columns of the design matrix to g parameters } \description{ This function returns the design matrix used for computation of the Bayes factor for the numerator of a \code{BFBayesFactor} object. There must not be more than one numerator in the \code{BFBayesFactor} object. } \examples{ ## Gets the design matrix for a simple analysis data(sleep) bf = anovaBF(extra ~ group + ID, data = sleep, whichRandom="ID", progress=FALSE) X = model.matrix(bf) ## Show dimensions of X (should be 20 by 12) dim(X) } \references{ Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. 56. p. 356-374. } BayesFactor/man/options-BayesFactor.Rd0000644000176200001440000000304713274042462017421 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/onAttach.R \name{options-BayesFactor} \alias{options-BayesFactor} \title{options() for package BayesFactor} \description{ Options that can be set for the BayesFactor package } \details{ The BayesFactor package has numerous options that can be set to globally change the behavior of the functions in the package. These options can be changed using \code{\link[base]{options}}(). \describe{ \item{\code{BFMaxModels}}{Integer; maximum number of models to analyze in \code{\link{anovaBF}} or \code{\link{regressionBF}}} \item{\code{BFprogress}}{If \code{TRUE}, progress bars are on by default; if \code{FALSE}, they are disabled by default.} \item{\code{BFpretestIterations}}{Integer; if sampling is needed to compute the Bayes factor, the package attempts to choose the most efficient sampler. This option controls the number of initial test iterations.} \item{\code{BFapproxOptimizer}}{\code{"nlm"} or \code{"optim"}; changes the optimization function used for the importance sampler. If one fails, try the other.} \item{\code{BFapproxLimits}}{Vector of length two containing the lower and upper limits on on \code{log(g)} before the the posterior returns \code{-Inf}. This only affects the initial optimization step for the importance sampler.} \item{\code{BFfactorsMax}}{Maximum number of factors to try to do enumeration with in generalTestBF.} \item{\code{BFcheckProbabilityList}}{Check for duplicate models when creating BFprobability objects?} } } \seealso{ \code{\link[base]{options}} } BayesFactor/man/enumerateGeneralModels.Rd0000644000176200001440000000154213274042462020153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generalTest-utility.R \name{enumerateGeneralModels} \alias{enumerateGeneralModels} \title{Function for generation of nested linear models} \usage{ enumerateGeneralModels(fmla, whichModels, neverExclude = NULL, includeBottom = TRUE, data = NULL) } \arguments{ \item{fmla}{formula for the "full" model} \item{whichModels}{which subsets of models to generate} \item{neverExclude}{a character vector of terms to never remove} \item{includeBottom}{Include the base model containing only \code{neverExclude} terms} \item{data}{a data frame containing the columns mentioned in \code{fmla}} } \description{ Generate lists of nested models, given a model formula } \details{ This is a backend function not intended for users. It is exposed for third-party applications. } \keyword{internal} BayesFactor/man/compare-methods.Rd0000644000176200001440000000362113274042462016613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R \docType{methods} \name{compare} \alias{compare} \alias{compare,BFoneSample,missing,data.frame-method} \alias{compare,BFlinearModel,BFlinearModel,data.frame-method} \alias{compare,BFindepSample,missing,data.frame-method} \alias{compare,BFlinearModel,missing,data.frame-method} \alias{compare,BFmetat,missing,data.frame-method} \alias{compare,BFproportion,missing,data.frame-method} \alias{compare,BFcontingencyTable,BFcontingencyTable,data.frame-method} \alias{compare,BFcontingencyTable,missing,data.frame-method} \alias{compare,BFcorrelation,missing,data.frame-method} \alias{compare,BFmcmc,BFmcmc,ANY-method} \alias{compare,BFmcmc,missing,ANY-method} \title{Compare two models, with respect to some data} \usage{ compare(numerator, denominator, data, ...) } \arguments{ \item{numerator}{first model} \item{denominator}{second model (if omitted, compare to predefined null)} \item{data}{data for the comparison} \item{...}{arguments passed to and from related methods} } \value{ The compare function will return a model comparison object, typically a Bayes factor } \description{ This method is used primarily in the backend, and will only rarely be called by the end user. But see the examples below for a demonstration. } \examples{ ## Sample from the posteriors for two models data(puzzles) ## Main effects model; result is a BFmcmc object, inheriting ## mcmc from the coda package mod1 = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID", progress = FALSE, posterior = TRUE, iterations = 1000) plot(mod1) ## Full model mod2 = lmBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress = FALSE, posterior = TRUE, iterations = 1000) ## Each BFmcmc object contains the model used to generate it, so we ## can compare them (data is not needed, it is contained in the objects): compare(mod1, mod2) } BayesFactor/man/priorLogodds-method.Rd0000644000176200001440000000075213274042462017453 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFodds.R \docType{methods} \name{priorLogodds<-} \alias{priorLogodds<-} \alias{priorLogodds<-,BFodds,numeric-method} \title{Set prior log odds in an object} \usage{ priorLogodds(object) <- value \S4method{priorLogodds}{BFodds,numeric}(object) <- value } \arguments{ \item{object}{object in which to set log odds} \item{value}{log odds} } \description{ Set prior log odds in an object } BayesFactor/man/BFBayesFactorList-class.Rd0000644000176200001440000000444613274042462020103 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFBayesFactorList.R \docType{class} \name{BFBayesFactorList-class} \alias{BFBayesFactorList-class} \alias{t,BFBayesFactorList-method} \alias{/,numeric,BFBayesFactorList-method} \alias{[,BFBayesFactorList,index,index,missing-method} \alias{[,BFBayesFactorList,index,missing,missing-method} \alias{[,BFBayesFactorList,missing,index,missing-method} \title{General S4 class for representing a collection of Bayes factor model comprisons, each against a different denominator} \usage{ \S4method{t}{BFBayesFactorList}(x) \S4method{/}{numeric,BFBayesFactorList}(e1, e2) \S4method{[}{BFBayesFactorList,index,index,missing}(x, i, j, ..., drop = TRUE) \S4method{[}{BFBayesFactorList,index,missing,missing}(x, i, j, ..., drop = TRUE) \S4method{[}{BFBayesFactorList,missing,index,missing}(x, i, j, ..., drop = TRUE) } \arguments{ \item{x}{a BFBayesFactorList object} \item{e1}{Numerator of the ratio} \item{e2}{Denominator of the ratio} \item{i}{indices specifying rows to extract} \item{j}{indices specifying columns to extract} \item{...}{further arguments passed to related methods} \item{drop}{unused} } \description{ The \code{BFBayesFactorList} class is a general S4 class for representing models model comparison via Bayes factor. See the examples for demonstrations of BFBayesFactorList methods. } \details{ \describe{ \code{BFBayesFactorList} objects inherit from lists, and contain a single slot: \item{version}{character string giving the version and revision number of the package that the model was created in} Each element of the list contains a single \code{"\link[=BFBayesFactor-class]{BFBayesFactor}"} object. Each element of the list must have the same numerators, in the same order, as all the others. The list object is displayed as a matrix of Bayes factors. } } \examples{ ## Compute some Bayes factors to demonstrate Bayes factor lists data(puzzles) bfs <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) ## Create a matrix of Bayes factors bfList <- bfs / bfs bfList ## Use indexing to select parts of the 'matrix' bfList[1,] bfList[,1] ## We can use the t (transpose) function as well, to get back a BFBayesFactor t(bfList[2,]) ## Or transpose the whole matrix t(bfList) } BayesFactor/man/anovaBF.Rd0000644000176200001440000002015613274042462015042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anovaBF.R \name{anovaBF} \alias{anovaBF} \title{Function to compute Bayes factors for ANOVA designs} \usage{ anovaBF(formula, data, whichRandom = NULL, whichModels = "withmain", iterations = 10000, progress = getOption("BFprogress", interactive()), rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleEffects = NULL, multicore = FALSE, method = "auto", noSample = FALSE, callback = function(...) as.integer(0)) } \arguments{ \item{formula}{a formula containing all factors to include in the analysis (see Examples)} \item{data}{a data frame containing data for all factors in the formula} \item{whichRandom}{a character vector specifying which factors are random} \item{whichModels}{which set of models to compare; see Details} \item{iterations}{How many Monte Carlo simulations to generate, if relevant} \item{progress}{if \code{TRUE}, show progress with a text progress bar} \item{rscaleFixed}{prior scale for standardized, reduced fixed effects. A number of preset values can be given as strings; see Details.} \item{rscaleRandom}{prior scale for standardized random effects} \item{rscaleEffects}{A named vector of prior settings for individual factors, overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names.} \item{multicore}{if \code{TRUE} use multiple cores through the \code{doMC} package. Unavailable on Windows.} \item{method}{approximation method, if needed. See \code{\link{nWayAOV}} for details.} \item{noSample}{if \code{TRUE}, do not sample, instead returning NA.} \item{callback}{callback function for third-party interfaces} } \value{ An object of class \code{BFBayesFactor}, containing the computed model comparisons } \description{ This function computes Bayes factors for all main-effects and interaction contrasts in an ANOVA design. } \details{ Models, priors, and methods of computation are provided in Rouder et al. (2012). The ANOVA model for a vector of observations \eqn{y} is \deqn{ y = \mu + X_1 \theta_1 + \ldots + X_p\theta_p +\epsilon,} where \eqn{\theta_1,\ldots,\theta_p} are vectors of main-effect and interaction effects, \eqn{X_1,\ldots,X_p} are corresponding design matrices, and \eqn{\epsilon} is a vector of zero-centered noise terms with variance \eqn{\sigma^2}. Zellner and Siow (1980) inspired g-priors are placed on effects, but with a separate g-prior parameter for each covariate: \deqn{\theta_1~N(0,g_1\sigma^2), \ldots, \theta_p~N(0,g_p \sigma^2).} A Jeffries prior is placed on \eqn{\mu} and \eqn{\sigma^2}. Independent scaled inverse-chi-square priors with one degree of freedom are placed on \eqn{g_1,\ldots,g_p}. The square-root of the scale for g's corresponding to fixed and random effects is given by \code{rscaleFixed} and \code{rscaleRandom}, respectively. When a factor is treated as random, there are as many main effect terms in the vector \eqn{\theta} as levels. When a factor is treated as fixed, the sums-to-zero linear constraint is enforced by centering the corresponding design matrix, and there is one fewer main effect terms as levels. The Cornfield-Tukey model of interactions is assumed. Details are provided in Rouder et al. (2012) Bayes factors are computed by integrating the likelihood with respect to the priors on parameters. The integration of all parameters except \eqn{g_1,\ldots,g_p} may be expressed in closed-form; the integration of \eqn{g_1,\ldots,g_p} is performed through Monte Carlo sampling, and \code{iterations} is the number of iterations used to estimate the Bayes factor. \code{anovaBF} computes Bayes factors for either all submodels or select submodels missing a single main effect or covariate, depending on the argument \code{whichModels}. If no random factors are specified, the null model assumed by \code{anovaBF} is the grand-mean only model. If random factors are specified, the null model is the model with an additive model on all random factors, plus a grand mean. Thus, \code{anovaBF} does not currently test random factors. Testing random factors is possible with \code{\link{lmBF}}. The argument \code{whichModels} controls which models are tested. Possible values are 'all', 'withmain', 'top', and 'bottom'. Setting \code{whichModels} to 'all' will test all models that can be created by including or not including a main effect or interaction. 'top' will test all models that can be created by removing or leaving in a main effect or interaction term from the full model. 'bottom' creates models by adding single factors or interactions to the null model. 'withmain' will test all models, with the constraint that if an interaction is included, the corresponding main effects are also included. For the \code{rscaleFixed} and \code{rscaleRandom} arguments, several named values are recognized: "medium", "wide", and "ultrawide", corresponding to \eqn{r} scale values of 1/2, \eqn{\sqrt{2}/2}{sqrt(2)/2}, and 1, respectively. In addition, \code{rscaleRandom} can be set to the "nuisance", which sets \eqn{r=1} (and is thus equivalent to "ultrawide"). The "nuisance" setting is for medium-to-large-sized effects assumed to be in the data but typically not of interest, such as variance due to participants. } \note{ The function \code{anovaBF} will compute Bayes factors for all possible combinations of fixed factors and interactions, against the null hypothesis that \emph{all} effects are 0. The total number of tests computed will be \eqn{2^{2^K - 1}}{2^(2^K - 1)} for \eqn{K} fixed factors. This number increases very quickly with the number of factors. For instance, for a five-way ANOVA, the total number of tests exceeds two billion. Even though each test takes a fraction of a second, the time taken for all tests could exceed your lifetime. An option is included to prevent this: \code{options('BFMaxModels')}, which defaults to 50,000, is the maximum number of models that `anovaBF` will analyze at once. This can be increased by increasing the option value. It is possible to reduce the number of models tested by only testing the most complex model and every restriction that can be formed by removing one factor or interaction using the \code{whichModels} argument. Setting this argument to 'top' reduces the number of tests to \eqn{2^K-1}, which is more manageable. The Bayes factor for each restriction against the most complex model can be interpreted as a test of the removed factor/interaction. Setting \code{whichModels} to 'withmain' will not reduce the number of tests as much as 'top' but the results may be more interpretable, since an interaction is only allowed when all interacting effects (main or interaction) are also included in the model. } \examples{ ## Classical example, taken from t.test() example ## Student's sleep data data(sleep) plot(extra ~ group, data = sleep) ## traditional ANOVA gives a p value of 0.00283 summary(aov(extra ~ group + Error(ID/group), data = sleep)) ## Gives a Bayes factor of about 11.6 ## in favor of the alternative hypothesis anovaBF(extra ~ group + ID, data = sleep, whichRandom = "ID", progress=FALSE) ## Demonstrate top-down testing data(puzzles) result = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", whichModels = 'top', progress=FALSE) result ## In orthogonal designs, the top down Bayes factor can be ## interpreted as a test of the omitted effect } \references{ Gelman, A. (2005) Analysis of Variance---why it is more important than ever. Annals of Statistics, 33, pp. 1-53. Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. 56. p. 356-374. Zellner, A. and Siow, A., (1980) Posterior Odds Ratios for Selected Regression Hypotheses. In Bayesian Statistics: Proceedings of the First Interanational Meeting held in Valencia (Spain). Bernardo, J. M., Lindley, D. V., and Smith A. F. M. (eds), pp. 585-603. University of Valencia. } \seealso{ \code{\link{lmBF}}, for testing specific models, and \code{\link{regressionBF}} for the function similar to \code{anovaBF} for linear regression models. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/BFBayesFactor-class.Rd0000644000176200001440000000554413274042462017247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFBayesFactor.R, % R/methods-BFBayesFactorTop.R \docType{class} \name{BFBayesFactor-class} \alias{BFBayesFactor-class} \alias{BFBayesFactorTop-class} \alias{/,numeric,BFBayesFactor-method} \alias{/,BFBayesFactor,BFBayesFactor-method} \alias{[,BFBayesFactor,index,missing,missing-method} \alias{t,BFBayesFactor-method} \alias{which.max,BFBayesFactor-method} \alias{which.min,BFBayesFactor-method} \alias{is.na,BFBayesFactor-method} \alias{*,BFBayesFactor,BFodds-method} \alias{[,BFBayesFactorTop,index,missing,missing-method} \title{General S4 class for representing multiple Bayes factor model comparisons, all against the same model} \usage{ \S4method{/}{numeric,BFBayesFactor}(e1, e2) \S4method{/}{BFBayesFactor,BFBayesFactor}(e1, e2) \S4method{[}{BFBayesFactor,index,missing,missing}(x, i, j, ..., drop = TRUE) \S4method{t}{BFBayesFactor}(x) \S4method{which.max}{BFBayesFactor}(x) \S4method{which.min}{BFBayesFactor}(x) \S4method{is.na}{BFBayesFactor}(x) \S4method{*}{BFBayesFactor,BFodds}(e1, e2) \S4method{[}{BFBayesFactorTop,index,missing,missing}(x, i, j, ..., drop = TRUE) } \arguments{ \item{e1}{Numerator of the ratio} \item{e2}{Denominator of the ratio} \item{x}{BFBayesFactor object} \item{i}{indices indicating elements to extract} \item{j}{unused for BFBayesFactor objects} \item{...}{further arguments passed to related methods} \item{drop}{unused} } \description{ The \code{BFBayesFactor} class is a general S4 class for representing models model comparison via Bayes factor. } \details{ \code{BFBayesFactor} objects can be inverted by taking the reciprocal and can be divided by one another, provided both objects have the same denominator. In addition, the \code{t} (transpose) method can be used to invert Bayes factor objects. \describe{ The \code{BFBayesFactor} class has the following slots defined: \item{numerator}{a list of models all inheriting \code{BFmodel}, each providing a single denominator} \item{denominator}{a single \code{BFmodel} object serving as the denominator for all model comparisons} \item{bayesFactor}{a data frame containing information about the comparison between each numerator and the denominator} \item{data}{a data frame containing the data used for the comparison} \item{version}{character string giving the version and revision number of the package that the model was created in} } } \examples{ ## Compute some Bayes factors to demonstrate division and indexing data(puzzles) bfs <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) ## First and second models can be separated; they remain BFBayesFactor objects b1 = bfs[1] b2 = bfs[2] b1 ## We can invert them, or divide them to obtain new model comparisons 1/b1 b1 / b2 ## Use transpose to create a BFBayesFactorList t(bfs) } BayesFactor/man/meta.ttestBF.Rd0000644000176200001440000000756113274042462016033 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/meta.ttestBF.R \name{meta.ttestBF} \alias{meta.ttestBF} \title{Function for Bayesian analysis of one- and two-sample designs} \usage{ meta.ttestBF(t, n1, n2 = NULL, nullInterval = NULL, rscale = "medium", posterior = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{t}{a vector of t statistics} \item{n1}{a vector of sample sizes for the first (or only) condition} \item{n2}{a vector of sample sizes. If \code{NULL}, a one-sample design is assumed} \item{nullInterval}{optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in standardized units} \item{rscale}{prior scale. A number of preset values can be given as strings; see Details.} \item{posterior}{if \code{TRUE}, return samples from the posterior instead of Bayes factor} \item{callback}{callback function for third-party interfaces} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor} containing the computed model comparisons is returned. If \code{nullInterval} is defined, then two Bayes factors will be computed: The Bayes factor for the interval against the null hypothesis that the standardized effect is 0, and the corresponding Bayes factor for the compliment of the interval. If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ This function computes mata-analytic Bayes factors, or samples from the posterior, for one- and two-sample designs where multiple t values have been observed. } \details{ The Bayes factor provided by \code{meta.ttestBF} tests the null hypothesis that the true effect size (or alternatively, the noncentrality parameters) underlying a set of t statistics is 0. Specifically, the Bayes factor compares two hypotheses: that the standardized effect size is 0, or that the standardized effect size is not 0. Note that there is assumed to be a single, common effect size \eqn{\delta}{delta} underlying all t statistics. For one-sample tests, the standardized effect size is \eqn{(\mu-\mu_0)/\sigma}{(mu-mu0)/sigma}; for two sample tests, the standardized effect size is \eqn{(\mu_2-\mu_1)/\sigma}{(mu2-mu1)/sigma}. A Cauchy prior is placed on the standardized effect size. The \code{rscale} argument controls the scale of the prior distribution, with \code{rscale=1} yielding a standard Cauchy prior. See the help for \code{\link{ttestBF}} and the references below for more details. The Bayes factor is computed via Gaussian quadrature. Posterior samples are drawn via independent-candidate Metropolis-Hastings. } \note{ To obtain the same Bayes factors as Rouder and Morey (2011), change the prior scale to 1. } \examples{ ## Bem's (2010) data (see Rouder & Morey, 2011) t=c(-.15,2.39,2.42,2.43) N=c(100,150,97,99) ## Using rscale=1 and one-sided test to be ## consistent with Rouder & Morey (2011) bf = meta.ttestBF(t, N, rscale=1, nullInterval=c(0, Inf)) bf[1] ## plot posterior distribution of delta, assuming alternative ## turn off progress bar for example samples = posterior(bf[1], iterations = 1000, progress = FALSE) ## Note that posterior() respects the nullInterval plot(samples) summary(samples) } \references{ Morey, R. D. & Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, 406-419 Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin & Review, 16, 225-237 Rouder, J. N. & Morey, R. D. (2011). A Bayes Factor Meta-Analysis of Bem's ESP Claim. Psychonomic Bulletin & Review, 18, 682-689 } \seealso{ \code{\link{ttestBF}} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/extractBF-methods.Rd0000644000176200001440000000155313274042462017051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFBayesFactor.R \docType{methods} \name{extractBF} \alias{extractBF} \alias{extractBF,BFBayesFactor-method} \title{Extract the Bayes factor from an object} \usage{ extractBF(x, logbf = FALSE, onlybf = FALSE) \S4method{extractBF}{BFBayesFactor}(x, logbf = FALSE, onlybf = FALSE) } \arguments{ \item{x}{object from which to extract the Bayes factors} \item{logbf}{return the logarithm of the Bayes factors} \item{onlybf}{return a vector of only the Bayes factors} } \value{ Returns an object containing Bayes factors extracted from the object } \description{ Extract the Bayes factor from an object } \examples{ ## Sample from the posteriors for two models data(puzzles) bf = lmBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", progress=FALSE) extractBF(bf) } BayesFactor/man/filterBF.Rd0000644000176200001440000000131413274042462015216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R \name{filterBF} \alias{filterBF} \title{Filter the elements of an object according to some pre-specified criteria} \usage{ filterBF(x, name, perl = FALSE, fixed = FALSE, ...) } \arguments{ \item{x}{object} \item{name}{regular expression to search name} \item{perl}{logical. Should perl-compatible regexps be used? See ?grepl for details.} \item{fixed}{logical. If TRUE, pattern is a string to be matched as is. See ?grepl for details.} \item{...}{arguments passed to and from related methods} } \value{ Returns a filtered object } \description{ Filter the elements of an object according to some pre-specified criteria } BayesFactor/man/linearReg.R2stat.Rd0000644000176200001440000000515213274042462016613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/linearReg_R2stat.R \name{linearReg.R2stat} \alias{linearReg.R2stat} \title{Use R^2 statistic to compute Bayes factor for regression designs} \usage{ linearReg.R2stat(N, p, R2, rscale = "medium", simple = FALSE) } \arguments{ \item{N}{number of observations} \item{p}{number of predictors in model, excluding intercept} \item{R2}{proportion of variance accounted for by the predictors, excluding intercept} \item{rscale}{numeric prior scale} \item{simple}{if \code{TRUE}, return only the Bayes factor} } \value{ If \code{simple} is \code{TRUE}, returns the Bayes factor (against the intercept-only null). If \code{FALSE}, the function returns a vector of length 3 containing the computed log(e) Bayes factor, along with a proportional error estimate on the Bayes factor and the method used to compute it. } \description{ Using the classical R^2 test statistic for (linear) regression designs, this function computes the corresponding Bayes factor test. } \details{ This function can be used to compute the Bayes factor corresponding to a multiple regression, using the classical R^2 (coefficient of determination) statistic. It can be used when you don't have access to the full data set for analysis by \code{\link{lmBF}}, but you do have the test statistic. For details about the model, see the help for \code{\link{regressionBF}}, and the references therein. The Bayes factor is computed via Gaussian quadrature. } \examples{ ## Use attitude data set data(attitude) ## Scatterplot lm1 = lm(rating~complaints,data=attitude) plot(attitude$complaints,attitude$rating) abline(lm1) ## Traditional analysis ## p value is highly significant summary(lm1) ## Bayes factor ## The Bayes factor is over 400,000; ## the data strongly favor hypothesis that ## the slope is not 0. result = linearReg.R2stat(30,1,0.6813) exp(result[['bf']]) } \references{ Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 Rouder, J. N. and Morey, R. D. (in press, Multivariate Behavioral Research). Bayesian testing in regression. Perception and Cognition Lab (University of Missouri): Bayes factor calculators. \url{http://pcl.missouri.edu/bayesfactor} } \seealso{ \code{\link{integrate}}, \code{\link{lm}}; see \code{\link{lmBF}} for the intended interface to this function, using the full data set. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) and Jeffrey N. Rouder (\email{rouderj@missouri.edu}) } \keyword{htest} BayesFactor/man/posterior-methods.Rd0000644000176200001440000001053213274042462017212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFmodelSample.R \docType{methods} \name{posterior} \alias{posterior} \alias{posterior,BFmodel,missing,data.frame,missing-method} \alias{posterior,BFBayesFactor,missing,missing,missing-method} \alias{posterior,BFBayesFactor,numeric,missing,numeric-method} \alias{posterior,BFBayesFactor,missing,missing,numeric-method} \alias{posterior,BFlinearModel,missing,data.frame,numeric-method} \alias{posterior,BFindepSample,missing,data.frame,numeric-method} \alias{posterior,BFcontingencyTable,missing,data.frame,numeric-method} \alias{posterior,BFoneSample,missing,data.frame,numeric-method} \alias{posterior,BFmetat,missing,data.frame,numeric-method} \alias{posterior,BFproportion,missing,data.frame,numeric-method} \alias{posterior,BFcorrelation,missing,data.frame,numeric-method} \title{Sample from the posterior distribution of one of several models.} \usage{ posterior(model, index, data, iterations, ...) \S4method{posterior}{BFmodel,missing,data.frame,missing}(model, index, data, iterations, ...) \S4method{posterior}{BFBayesFactor,missing,missing,missing}(model, index, data, iterations, ...) \S4method{posterior}{BFBayesFactor,numeric,missing,numeric}(model, index, data, iterations, ...) \S4method{posterior}{BFBayesFactor,missing,missing,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFlinearModel,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFindepSample,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFcontingencyTable,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFoneSample,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFmetat,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFproportion,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) \S4method{posterior}{BFcorrelation,missing,data.frame,numeric}(model, index = NULL, data, iterations, ...) } \arguments{ \item{model}{or set of models from which to sample} \item{index}{the index within the set of models giving the desired model} \item{data}{the data to be conditioned on} \item{iterations}{the number of iterations to sample} \item{...}{arguments passed to and from related methods} } \value{ Returns an object containing samples from the posterior distribution of the specified model } \description{ This function samples from the posterior distribution of a \code{BFmodel}, which can be obtained from a \code{BFBayesFactor} object. If there is more than one numerator in the \code{BFBayesFactor} object, the \code{index} argument can be passed to select one numerator. } \details{ The data argument is used internally, and will y not be needed by end-users. Note that if there are fixed effects in the model, the reduced parameterzation used internally (see help for \code{\link{anovaBF}}) is unreduced. For a factor with two levels, the chain will contain two effect estimates that sum to 0. Two useful arguments that can be passed to related methods are \code{thin} and \code{columnFilter}, currently implemented for methods using \code{nWayAOV} (models with more than one categorical covariate, or a mix of categorical and continuous covariates). \code{thin}, an integer, will keep only every \code{thin} iterations. The default is \code{thin=1}, which keeps all iterations. Argument \code{columnFilter} is either \code{NULL} (for no filtering) or a character vector of extended regular expressions (see \link{regex} help for details). Any column from an effect that matches one of the filters will not be saved. } \examples{ ## Sample from the posteriors for two models data(sleep) bf = lmBF(extra ~ group + ID, data = sleep, whichRandom="ID", progress=FALSE) ## sample from the posterior of the numerator model ## data argument not needed - it is included in the Bayes factor object chains = posterior(bf, iterations = 1000, progress = FALSE) plot(chains) ## demonstrate column filtering by filtering out participant effects data(puzzles) bf = lmBF(RT ~ shape + color + shape:color + ID, data=puzzles) chains = posterior(bf, iterations = 1000, progress = FALSE, columnFilter="^ID$") colnames(chains) # Contains no participant effects } BayesFactor/man/raceDolls.Rd0000644000176200001440000000237513274042462015441 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/BayesFactorPCL-package.R \docType{data} \name{raceDolls} \alias{raceDolls} \title{Hraba and Grant (1970) children's doll preference data} \format{A matrix with 2 rows and 2 columns. Rows give doll preference; colums give the race of the child.} \source{ Hraba, J. and Grant, G. (1970). Black is Beautiful: A reexamination of racial preference and identification. Journal of Personality and Social Psychology, 16, 398-402. } \description{ Hraba and Grant (1970) describe a replication of Clark and Clark (1947) in which black and white children from Lincoln, Nebraska were shown dolls that were either black or white. They were then asked a series of questions, including "Give me the doll that is a nice doll." This data set contains the frequency of children giving the same-race or different race doll in response to this question. } \examples{ data(raceDolls) ## chi-square test ## Barely significant with continuity correction chisq.test(raceDolls) ## Bayes factor test (assuming independent binomial sampling plan) ## Very little evidence for the alternative of lack of independence bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") bf } \keyword{datasets} BayesFactor/man/BFInfo.Rd0000644000176200001440000000125313274042462014626 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/version.R \name{BFInfo} \alias{BFInfo} \title{Prints the version information for the BayesFactor package} \usage{ BFInfo(print = TRUE) } \arguments{ \item{print}{if \code{TRUE}, print version information to the console} } \value{ \code{BFInfo} returns a character string containing the version and revision number of the package.. } \description{ Prints the version, revision, and date information for the BayesFactor package } \details{ This function prints the version and revision information for the BayesFactor package. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{misc} BayesFactor/man/priorOdds-method.Rd0000644000176200001440000000071313274042462016746 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFodds.R \docType{methods} \name{priorOdds<-} \alias{priorOdds<-} \alias{priorOdds<-,BFodds,numeric-method} \title{Set prior odds in an object} \usage{ priorOdds(object) <- value \S4method{priorOdds}{BFodds,numeric}(object) <- value } \arguments{ \item{object}{object in which to set odds} \item{value}{odds} } \description{ Set prior odds in an object } BayesFactor/man/grapes-termin-grapes.Rd0000644000176200001440000000073313274042462017561 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R \name{\%termin\%} \alias{\%termin\%} \title{Find a model term in a vector of model terms} \usage{ x \%termin\% table } \arguments{ \item{x}{the terms to be matched} \item{table}{the terms to be matched against} } \value{ A logical vector of the same length as x, indicating if a match was located for each element of x. } \description{ Find a model term in a vector of model terms } BayesFactor/man/newPriorOdds.Rd0000644000176200001440000000155213274042462016144 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/newPriorOdds.R \name{newPriorOdds} \alias{newPriorOdds} \title{Create prior odds from a Bayes factor object} \usage{ newPriorOdds(bf, type = "equal") } \arguments{ \item{bf}{A BFBayesFactor object, eg, from an analysis} \item{type}{The type of prior odds to create (by default "equal"; see details)} } \value{ A (prior) BFodds object, which can then be multiplied by the BFBayesFactor object to obtain posterior odds. } \description{ Create a prior odds object from a Bayes factor object } \details{ This function takes a Bayes factor object and, using its structure and specified type of prior odds, will create a prior odds object. For now, the only type is "equal", which assigns equal prior odds to all models. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{misc} BayesFactor/man/regressionBF.Rd0000644000176200001440000000777213274042462016127 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/regressionBF.R \name{regressionBF} \alias{regressionBF} \title{Function to compute Bayes factors for regression designs} \usage{ regressionBF(formula, data, whichModels = "all", progress = getOption("BFprogress", interactive()), rscaleCont = "medium", callback = function(...) as.integer(0), noSample = FALSE) } \arguments{ \item{formula}{a formula containing all covariates to include in the analysis (see Examples)} \item{data}{a data frame containing data for all factors in the formula} \item{whichModels}{which set of models to compare; see Details} \item{progress}{if \code{TRUE}, show progress with a text progress bar} \item{rscaleCont}{prior scale on all standardized slopes} \item{callback}{callback function for third-party interfaces} \item{noSample}{if \code{TRUE}, do not sample, instead returning NA.} } \value{ An object of class \code{BFBayesFactor}, containing the computed model comparisons } \description{ This function simultaneously computes Bayes factors for groups of models in regression designs } \details{ \code{regressionBF} computes Bayes factors to test the hypothesis that slopes are 0 against the alternative that all slopes are nonzero. The vector of observations \eqn{y} is assumed to be distributed as \deqn{y ~ Normal(\alpha 1 + X\beta, \sigma^2 I).} The joint prior on \eqn{\alpha,\sigma^2} is proportional to \eqn{1/\sigma^2}, the prior on \eqn{\beta} is \deqn{\beta ~ Normal(0, N g \sigma^2(X'X)^{-1}).} where \eqn{g ~ InverseGamma(1/2,r/2)}. See Liang et al. (2008) section 3 for details. Possible values for \code{whichModels} are 'all', 'top', and 'bottom', where 'all' computes Bayes factors for all models, 'top' computes the Bayes factors for models that have one covariate missing from the full model, and 'bottom' computes the Bayes factors for all models containing a single covariate. Caution should be used when interpreting the results; when the results of 'top' testing is interpreted as a test of each covariate, the test is conditional on all other covariates being in the model (and likewise 'bottom' testing is conditional on no other covariates being in the model). An option is included to prevent analyzing too many models at once: \code{options('BFMaxModels')}, which defaults to 50,000, is the maximum number of models that `regressionBF` will analyze at once. This can be increased by increasing the option value. For the \code{rscaleCont} argument, several named values are recongized: "medium", "wide", and "ultrawide", which correspond \eqn{r} scales of \eqn{\sqrt{2}/4}{sqrt(2)/4}, 1/2, and \eqn{\sqrt{2}/2}{sqrt(2)/2}, respectively. These values were chosen to yield consistent Bayes factors with \code{\link{anovaBF}}. } \examples{ ## See help(attitude) for details about the data set data(attitude) ## Classical regression summary(fm1 <- lm(rating ~ ., data = attitude)) ## Compute Bayes factors for all regression models output = regressionBF(rating ~ ., data = attitude, progress=FALSE) head(output) ## Best model is 'complaints' only ## Compute all Bayes factors against the full model, and ## look again at best models head(output / output[63]) } \references{ Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 Rouder, J. N. and Morey, R. D. (in press). Bayesian testing in regression. Multivariate Behavioral Research. Zellner, A. and Siow, A., (1980) Posterior Odds Ratios for Selected Regression Hypotheses. In Bayesian Statistics: Proceedings of the First Interanational Meeting held in Valencia (Spain). Bernardo, J. M., Lindley, D. V., and Smith A. F. M. (eds), pp. 585-603. University of Valencia. } \seealso{ \code{\link{lmBF}}, for testing specific models, and \code{\link{anovaBF}} for the function similar to \code{regressionBF} for ANOVA models. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/BayesFactor-package.Rd0000644000176200001440000000505613274334555017332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/BayesFactorPCL-package.R \docType{package} \name{BayesFactor-package} \alias{BayesFactor-package} \alias{BayesFactor} \title{Functions to compute Bayes factor hypothesis tests for common research designs and hypotheses.} \description{ This package contains function to compute Bayes factors for a number of research designs and hypotheses, including t tests, ANOVA, and linear regression, correlations, proportions, and contingency tables. } \details{ \tabular{ll}{ Package: \tab BayesFactor\cr Type: \tab Package\cr Version: \tab 0.9.12-4.2\cr Date: \tab 2018-5-09\cr License: \tab GPL 2.0\cr LazyLoad: \tab yes\cr } The following methods are currently implemented, with more to follow: general linear models (including linear mixed effects models): \code{\link{generalTestBF}}, \code{\link{lmBF}} linear regression: \code{\link{regressionBF}}, \code{\link{lmBF}}, \code{\link{linearReg.R2stat}}; linear correlation: \code{\link{correlationBF}}; t tests: \code{\link{ttestBF}}, \code{\link{ttest.tstat}}; meta-analytic t tests: \code{\link{meta.ttestBF}} ANOVA: \code{\link{anovaBF}}, \code{\link{lmBF}}, \code{\link{oneWayAOV.Fstat}}; contingency tables: \code{\link{contingencyTableBF}}; single proportions: \code{\link{proportionBF}}; linear correlations: \code{\link{correlationBF}}; Other useful functions: \code{\link{posterior}}, for sampling from posterior distributions; \code{\link{recompute}}, for re-estimating a Bayes factor or posterior distribution; \code{\link{compare}}, to compare two model posteriors; and \code{\link{plot.BFBayesFactor}}, for plotting Bayes factor objects. } \examples{ ## See specific functions for examples. } \references{ Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., \& Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin & Review, 16, 225-237 Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. 56. p. 356-374. Perception and Cognition Lab (University of Missouri): Bayes factor calculators. \url{http://pcl.missouri.edu/bayesfactor} } \author{ Richard D. Morey and Jeffrey N. Rouder (with contributions from Tahira Jamil) Maintainer: Richard D. Morey } \keyword{htest} BayesFactor/man/lmBF.Rd0000644000176200001440000000647613274042462014357 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lmBF.R \name{lmBF} \alias{lmBF} \title{Function to compute Bayes factors for specific linear models} \usage{ lmBF(formula, data, whichRandom = NULL, rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleCont = "medium", rscaleEffects = NULL, posterior = FALSE, progress = getOption("BFprogress", interactive()), ...) } \arguments{ \item{formula}{a formula containing all factors to include in the analysis (see Examples)} \item{data}{a data frame containing data for all factors in the formula} \item{whichRandom}{a character vector specifying which factors are random} \item{rscaleFixed}{prior scale for standardized, reduced fixed effects. A number of preset values can be given as strings; see Details.} \item{rscaleRandom}{prior scale for standardized random effects} \item{rscaleCont}{prior scale for standardized slopes. A number of preset values can be given as strings; see Details.} \item{rscaleEffects}{A named vector of prior settings for individual factors, overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names.} \item{posterior}{if \code{TRUE}, return samples from the posterior distribution instead of the Bayes factor} \item{progress}{if \code{TRUE}, show progress with a text progress bar} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor}, containing the computed model comparisons is returned. Otherwise, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ This function computes Bayes factors, or samples from the posterior, of specific linear models (either ANOVA or regression). } \details{ This function provides an interface for computing Bayes factors for specific linear models against the intercept-only null; other tests may be obtained by computing two models and dividing their Bayes factors. Specifics about the priors for regression models -- and possible settings for \code{rscaleCont} -- can be found in the help for \code{\link{regressionBF}}; likewise, details for ANOVA models -- and settings for \code{rscaleFixed} and \code{rscaleRandom} -- can be found in the help for \code{\link{anovaBF}}. Currently, the function does not allow for general linear models, containing both continuous and categorical predcitors, but this support will be added in the future. } \examples{ ## Puzzles data; see ?puzzles for details data(puzzles) ## Bayes factor of full model against null bfFull = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID") ## Bayes factor of main effects only against null bfMain = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID") ## Compare the main-effects only model to the full model bfMain / bfFull ## sample from the posterior of the full model samples = lmBF(RT ~ shape + color + shape:color + ID, data = puzzles, whichRandom = "ID", posterior = TRUE, iterations = 1000) ## Aother way to sample from the posterior of the full model samples2 = posterior(bfFull, iterations = 1000) } \seealso{ \code{\link{regressionBF}} and \code{anovaBF} for testing many regression or ANOVA models simultaneously. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/ttestBF.Rd0000644000176200001440000001117413274042462015101 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ttestBF.R \name{ttestBF} \alias{ttestBF} \title{Function for Bayesian analysis of one- and two-sample designs} \usage{ ttestBF(x = NULL, y = NULL, formula = NULL, mu = 0, nullInterval = NULL, paired = FALSE, data = NULL, rscale = "medium", posterior = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{x}{a vector of observations for the first (or only) group} \item{y}{a vector of observations for the second group (or condition, for paired)} \item{formula}{for independent-group designs, a (optional) formula describing the model} \item{mu}{for one-sample and paired designs, the null value of the mean (or mean difference)} \item{nullInterval}{optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in standardized units} \item{paired}{if \code{TRUE}, observations are paired} \item{data}{for use with \code{formula}, a data frame containing all the data} \item{rscale}{prior scale. A number of preset values can be given as strings; see Details.} \item{posterior}{if \code{TRUE}, return samples from the posterior instead of Bayes factor} \item{callback}{callback function for third-party interfaces} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor} containing the computed model comparisons is returned. If \code{nullInterval} is defined, then two Bayes factors will be computed: The Bayes factor for the interval against the null hypothesis that the standardized effect is 0, and the corresponding Bayes factor for the compliment of the interval. If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ This function computes Bayes factors, or samples from the posterior, for one- and two-sample designs. } \details{ The Bayes factor provided by \code{ttestBF} tests the null hypothesis that the mean (or mean difference) of a normal population is \eqn{\mu_0}{mu0} (argument \code{mu}). Specifically, the Bayes factor compares two hypotheses: that the standardized effect size is 0, or that the standardized effect size is not 0. For one-sample tests, the standardized effect size is \eqn{(\mu-\mu_0)/\sigma}{(mu-mu0)/sigma}; for two sample tests, the standardized effect size is \eqn{(\mu_2-\mu_1)/\sigma}{(mu2-mu1)/sigma}. A noninformative Jeffreys prior is placed on the variance of the normal population, while a Cauchy prior is placed on the standardized effect size. The \code{rscale} argument controls the scale of the prior distribution, with \code{rscale=1} yielding a standard Cauchy prior. See the references below for more details. For the \code{rscale} argument, several named values are recognized: "medium", "wide", and "ultrawide". These correspond to \eqn{r} scale values of \eqn{\sqrt{2}/2}{sqrt(2)/2}, 1, and \eqn{\sqrt{2}}{sqrt(2)} respectively. The Bayes factor is computed via Gaussian quadrature. } \note{ The default priors have changed from 1 to \eqn{\sqrt{2}/2}. The factor of \eqn{\sqrt{2}} is to be consistent with Morey et al. (2011) and Rouder et al. (2012), and the factor of \eqn{1/2} in both is to better scale the expected effect sizes; the previous scaling put more weight on larger effect sizes. To obtain the same Bayes factors as Rouder et al. (2009), change the prior scale to 1. } \examples{ ## Sleep data from t test example data(sleep) plot(extra ~ group, data = sleep) ## paired t test ttestBF(x = sleep$extra[sleep$group==1], y = sleep$extra[sleep$group==2], paired=TRUE) ## Sample from the corresponding posterior distribution samples = ttestBF(x = sleep$extra[sleep$group==1], y = sleep$extra[sleep$group==2], paired=TRUE, posterior = TRUE, iterations = 1000) plot(samples[,"mu"]) } \references{ Morey, R. D., Rouder, J. N., Pratte, M. S., & Speckman, P. L. (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. Journal of Mathematical Psychology, 55, 368-378 Morey, R. D. \& Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, 406-419 Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin & Review, 16, 225-237 Perception and Cognition Lab (University of Missouri): Bayes factor calculators. \url{http://pcl.missouri.edu/bayesfactor} } \seealso{ \code{\link{integrate}}, \code{\link{t.test}} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/plot.BFBayesFactor.Rd0000644000176200001440000000321213274042462017107 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot-BFBayesFactor.R \name{plot.BFBayesFactor} \alias{plot.BFBayesFactor} \title{Plot a Bayes factor object} \usage{ \method{plot}{BFBayesFactor}(x, include1 = TRUE, addDenom = FALSE, sortbf = TRUE, logbase = c("log10", "log2", "ln"), marginExpand = 0.4, cols = c("wheat", "lightslateblue"), main = paste("vs.", x@denominator@longName), pars = NULL, ...) } \arguments{ \item{x}{a BFBayesFactor object} \item{include1}{if \code{TRUE}, ensure that Bayes factor = 1 is on the plot} \item{addDenom}{if \code{TRUE}, add the denominator model into the group} \item{sortbf}{sort the Bayes factors before plotting them? Defaults to \code{TRUE}} \item{logbase}{the base of the log Bayes factors in the plot} \item{marginExpand}{an expansion factor for the left margin, in case more space is needed for model names} \item{cols}{a vector of length two of valid color names or numbers} \item{main}{a character vector for the plot title} \item{pars}{a list of par() settings} \item{...}{additional arguments to pass to barplot()} } \description{ Plot a Bayes factor object } \details{ This function creates a barplot of the (log) Bayes factors in a Bayes factor object. Error bars are added (though in many cases they may be too small to see) in red to show the error in estimation of the Bayes factor. If a red question mark appears next to a bar, then that Bayes factor has no error estimate available. } \examples{ data(puzzles) bfs = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", progress=FALSE) plot(bfs) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } BayesFactor/man/nWayAOV.Rd0000644000176200001440000001363713274042462015020 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/nWayAOV.R \name{nWayAOV} \alias{nWayAOV} \title{Use ANOVA design matrix to compute Bayes factors or sample posterior} \usage{ nWayAOV(y, X, gMap, rscale, iterations = 10000, progress = getOption("BFprogress", interactive()), callback = function(...) as.integer(0), gibbs = NULL, posterior = FALSE, ignoreCols = NULL, thin = 1, method = "auto", continuous = FALSE, noSample = FALSE) } \arguments{ \item{y}{vector of observations} \item{X}{design matrix whose number of rows match \code{length(y)}.} \item{gMap}{vector grouping the columns of \code{X} (see Details).} \item{rscale}{a vector of prior scale(s) of appropriate length (see Details).} \item{iterations}{Number of Monte Carlo samples used to estimate Bayes factor or posterior} \item{progress}{if \code{TRUE}, show progress with a text progress bar} \item{callback}{callback function for third-party interfaces} \item{gibbs}{will be deprecated. See \code{posterior}} \item{posterior}{if \code{TRUE}, return samples from the posterior using Gibbs sampling, instead of the Bayes factor} \item{ignoreCols}{if \code{NULL} and \code{posterior=TRUE}, all parameter estimates are returned in the MCMC object. If not \code{NULL}, a vector of length P-1 (where P is number of columns in the design matrix) giving which effect estimates to ignore in output} \item{thin}{MCMC chain to every \code{thin} iterations. Default of 1 means no thinning. Only used if \code{posterior=TRUE}} \item{method}{the integration method (only valid if \code{posterior=FALSE}); one of "simple", "importance", "laplace", or "auto"} \item{continuous}{either FALSE if no continuous covariates are included, or a logical vector of length equal to number of columns of X indicating which columns of the design matrix represent continuous covariates} \item{noSample}{if \code{TRUE}, do not sample, instead returning NA. This is intended to be used with functions generating and testing many models at one time, such as \code{\link{anovaBF}}} } \value{ If \code{posterior} is \code{FALSE}, a vector of length 2 containing the computed log(e) Bayes factor (against the intercept-only null), along with a proportional error estimate on the Bayes factor. Otherwise, an object of class \code{mcmc}, containing MCMC samples from the posterior is returned. } \description{ Computes a single Bayes factor, or samples from the posterior, for an ANOVA model defined by a design matrix } \details{ This function is not meant to be called by end-users, although technically-minded users can call this function for flexibility beyond what the other functions in this package provide. See \code{\link{lmBF}} for a user-friendly front-end to this function. Details about the priors can be found in the help for \code{\link{anovaBF}} and the references therein. Argument \code{gMap} provides a way of grouping columns of the design matrix as a factor; the effects in each group will share a common \eqn{g} parameter. \code{gMap} should be a vector of the same length as the number of nonconstant rows in \code{X}. It will contain all integers from 0 to \eqn{N_g-1}{Ng-1}, where \eqn{N_g}{Ng} is the total number of \eqn{g} parameters. Each element of \code{gMap} specifies the group to which that column belongs. If all columns belonging to a group are adjacent, \code{struc} can instead be used to compactly represent the groupings. \code{struc} is a vector of length \eqn{N_g}{Ng}. Each element specifies the number columns in the group. The vector \code{rscale} should be of length \eqn{N_g}{Ng}, and contain the prior scales of the standardized effects. See Rouder et al. (2012) for more details and the help for \code{\link{anovaBF}} for some typical values. The method used to estimate the Bayes factor depends on the \code{method} argument. "simple" is most accurate for small to moderate sample sizes, and uses the Monte Carlo sampling method described in Rouder et al. (2012). "importance" uses an importance sampling algorithm with an importance distribution that is multivariate normal on log(g). "laplace" does not sample, but uses a Laplace approximation to the integral. It is expected to be more accurate for large sample sizes, where MC sampling is slow. If \code{method="auto"}, then an initial run with both samplers is done, and the sampling method that yields the least-variable samples is chosen. The number of initial test iterations is determined by \code{options(BFpretestIterations)}. If posterior samples are requested, the posterior is sampled with a Gibbs sampler. } \note{ Argument \code{struc} has been deprecated. Use \code{gMap}, which is the \code{\link{inverse.rle}} of \code{struc}, minus 1. } \examples{ ## Classical example, taken from t.test() example ## Student's sleep data data(sleep) plot(extra ~ group, data = sleep) ## traditional ANOVA gives a p value of 0.00283 summary(aov(extra ~ group + Error(ID/group), data = sleep)) ## Build design matrix group.column <- rep(1/c(-sqrt(2),sqrt(2)),each=10) subject.matrix <- model.matrix(~sleep$ID - 1,data=sleep$ID) ## Note that we include no constant column X <- cbind(group.column, subject.matrix) ## (log) Bayes factor of full model against grand-mean only model bf.full <- nWayAOV(y = sleep$extra, X = X, gMap = c(0,rep(1,10)), rscale=c(.5,1)) exp(bf.full[['bf']]) ## Compare with lmBF result (should be about the same, give or take 1\%) bf.full2 <- lmBF(extra ~ group + ID, data = sleep, whichRandom = "ID") bf.full2 } \references{ Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. 56. p. 356-374. } \seealso{ See \code{\link{lmBF}} for the user-friendly front end to this function; see \code{\link{regressionBF}} and \code{anovaBF} for testing many regression or ANOVA models simultaneously. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}), Jeffery N. Rouder (\email{rouderj@missouri.edu}) } \keyword{htest} BayesFactor/man/contingencyTableBF.Rd0000644000176200001440000000761513274042462017233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contingency.R \name{contingencyTableBF} \alias{contingencyTableBF} \title{Function for Bayesian analysis of one- and two-sample designs} \usage{ contingencyTableBF(x, sampleType, fixedMargin = NULL, priorConcentration = 1, posterior = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{x}{an m by n matrix of counts (integers m,n > 1)} \item{sampleType}{the sampling plan (see details)} \item{fixedMargin}{for the independent multinomial sampling plan, which margin is fixed ("rows" or "cols")} \item{priorConcentration}{prior concentration parameter, set to 1 by default (see details)} \item{posterior}{if \code{TRUE}, return samples from the posterior instead of Bayes factor} \item{callback}{callback function for third-party interfaces} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor} containing the computed model comparisons is returned. If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ This function computes Bayes factors for contingency tables. } \details{ The Bayes factor provided by \code{contingencyTableBF} tests the independence assumption in contingency tables under various sampling plans, each of which is described below. See Gunel and Dickey (1974) for more details. For \code{sampleType="poisson"}, the sampling plan is assumed to be one in which observations occur as a poisson process with an overall rate, and then assignment to particular factor levels occurs with fixed probability. Under the null hypothesis, the assignments to the two factors are independent. Importantly, the total N is not fixed. For \code{sampleType="jointMulti"} (joint multinomial), the sampling plan is assumed to be one in which the total N is fixed, and observations are assigned to cells with fixed probability. Under the null hypothesis, the assignments to the two factors are independent. For \code{sampleType="indepMulti"} (independent multinomial), the sampling plan is assumed to be one in which row or column totals are fixed, and the each row or column is assumed to be multinomially distributed. Under the null hypothesis, each row or column is assumed to have the same multinomial probabilities. The fixed margin must be given by the \code{fixedMargin} argument. For \code{sampleType="hypergeom"} (hypergeometric), the sampling plan is assumed to be one in which both the row and column totals are fixed. Under the null hypothesis, the cell counts are assumed to be governed by the hypergeometric distribution. For all models, the argument \code{priorConcentration} indexes the expected deviation from the null hypothesis under the alternative, and corresponds to Gunel and Dickey's (1974) "a" parameter. } \note{ Posterior sampling for the hypergeometric model under the alternative has not yet been implemented. } \examples{ ## Hraba and Grant (1970) doll race data data(raceDolls) ## Compute Bayes factor for independent binomial design, with ## columns as the fixed margin bf = contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") bf ## Posterior distribution of difference in probabilities, under alternative chains = posterior(bf, iterations = 10000) sameRaceGivenWhite = chains[,"pi[1,1]"] / chains[,"pi[*,1]"] sameRaceGivenBlack = chains[,"pi[1,2]"] / chains[,"pi[*,2]"] hist(sameRaceGivenWhite - sameRaceGivenBlack, xlab = "Probability increase", main = "Increase in probability of child picking\\nsame race doll (white - black)", freq=FALSE, yaxt='n') box() } \references{ Gunel, E. and Dickey, J., (1974) Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557 } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) Tahira Jamil (\email{tahjamil@gmail.com}) } \keyword{htest} BayesFactor/man/grapes-same-grapes.Rd0000644000176200001440000000070113274042462017203 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R \name{\%same\%} \alias{\%same\%} \title{Compare two objects to see if they are the 'same', for some loose definition of same} \usage{ x \%same\% y } \arguments{ \item{x}{first object} \item{y}{second object} } \value{ Returns \code{TRUE} or \code{FALSE} } \description{ Compare two objects to see if they are the 'same', for some loose definition of same } BayesFactor/man/generalTestBF.Rd0000644000176200001440000001012513274042462016206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generalTestBF.R \name{generalTestBF} \alias{generalTestBF} \title{Function to compute Bayes factors for general designs} \usage{ generalTestBF(formula, data, whichRandom = NULL, whichModels = "withmain", neverExclude = NULL, iterations = 10000, progress = getOption("BFprogress", interactive()), rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleCont = "medium", rscaleEffects = NULL, multicore = FALSE, method = "auto", noSample = FALSE, callback = function(...) as.integer(0)) } \arguments{ \item{formula}{a formula containing the full model for the analysis (see Examples)} \item{data}{a data frame containing data for all factors in the formula} \item{whichRandom}{a character vector specifying which factors are random} \item{whichModels}{which set of models to compare; see Details} \item{neverExclude}{a character vector containing a regular expression (see help for \link{regex} for details) that indicates which terms to always keep in the analysis} \item{iterations}{How many Monte Carlo simulations to generate, if relevant} \item{progress}{if \code{TRUE}, show progress with a text progress bar} \item{rscaleFixed}{prior scale for standardized, reduced fixed effects. A number of preset values can be given as strings; see Details.} \item{rscaleRandom}{prior scale for standardized random effects} \item{rscaleCont}{prior scale for standardized slopes} \item{rscaleEffects}{A named vector of prior settings for individual factors, overriding rscaleFixed and rscaleRandom. Values are scales, names are factor names.} \item{multicore}{if \code{TRUE} use multiple cores through the \code{doMC} package. Unavailable on Windows.} \item{method}{approximation method, if needed. See \code{\link{nWayAOV}} for details.} \item{noSample}{if \code{TRUE}, do not sample, instead returning NA.} \item{callback}{callback function for third-party interfaces} } \value{ An object of class \code{BFBayesFactor}, containing the computed model comparisons } \description{ This function computes Bayes factors corresponding to restrictions on a full model. } \details{ See the help for \code{\link{anovaBF}} and \code{\link{anovaBF}} or details. Models, priors, and methods of computation are provided in Rouder et al. (2012) and Liang et al (2008). } \note{ The function \code{generalTestBF} can compute Bayes factors for all restrictions of a full model against the null hypothesis that all effects are 0. The total number of tests computed -- if all tests are requested -- will be \eqn{2^K-1}{2^K - 1} for \eqn{K} factors or covariates. This number increases very quickly with the number of tested predictors. An option is included to prevent testing too many models: \code{options('BFMaxModels')}, which defaults to 50,000, is the maximum number of models that will be analyzed at once. This can be increased by increased using \code{\link{options}}. It is possible to reduce the number of models tested by only testing the most complex model and every restriction that can be formed by removing one factor or interaction using the \code{whichModels} argument. See the help for \code{\link{anovaBF}} for details. } \examples{ ## Puzzles example: see ?puzzles and ?anovaBF data(puzzles) ## neverExclude argument makes sure that participant factor ID ## is in all models result = generalTestBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", neverExclude="ID", progress=FALSE) result } \references{ Rouder, J. N., Morey, R. D., Speckman, P. L., Province, J. M., (2012) Default Bayes Factors for ANOVA Designs. Journal of Mathematical Psychology. 56. p. 356-374. Liang, F. and Paulo, R. and Molina, G. and Clyde, M. A. and Berger, J. O. (2008). Mixtures of g-priors for Bayesian Variable Selection. Journal of the American Statistical Association, 103, pp. 410-423 } \seealso{ \code{\link{lmBF}}, for testing specific models, and \code{\link{regressionBF}} and \code{anovaBF} for other functions for testing multiple models simultaneously. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/ttest.tstat.Rd0000644000176200001440000000630413274042462016026 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ttest_tstat.R \name{ttest.tstat} \alias{ttest.tstat} \title{Use t statistic to compute Bayes factor for one- and two- sample designs} \usage{ ttest.tstat(t, n1, n2 = 0, nullInterval = NULL, rscale = "medium", complement = FALSE, simple = FALSE) } \arguments{ \item{t}{classical t statistic} \item{n1}{size of first group (or only group, for one-sample tests)} \item{n2}{size of second group, for independent-groups tests} \item{nullInterval}{optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in standardized units} \item{rscale}{numeric prior scale} \item{complement}{if \code{TRUE}, compute the Bayes factor against the complement of the interval} \item{simple}{if \code{TRUE}, return only the Bayes factor} } \value{ If \code{simple} is \code{TRUE}, returns the Bayes factor (against the null). If \code{FALSE}, the function returns a vector of length 3 containing the computed log(e) Bayes factor, along with a proportional error estimate on the Bayes factor and the method used to compute it. } \description{ Using the classical t test statistic for a one- or two-sample design, this function computes the corresponding Bayes factor test. } \details{ This function can be used to compute the Bayes factor corresponding to a one-sample, a paired-sample, or an independent-groups t test, using the classical t statistic. It can be used when you don't have access to the full data set for analysis by \code{\link{ttestBF}}, but you do have the test statistic. For details about the model, see the help for \code{\link{ttestBF}}, and the references therein. The Bayes factor is computed via Gaussian quadrature. } \note{ In version 0.9.9, the behaviour of this function has changed in order to produce more uniform results. In version 0.9.8 and before, this function returned two Bayes factors when \code{nullInterval} was non-\code{NULL}: the Bayes factor for the interval versus the null, and the Bayes factor for the complement of the interval versus the null. Starting in version 0.9.9, in order to get the Bayes factor for the complement, it is required to set the \code{complement} argument to \code{TRUE}, and the function only returns one Bayes factor. } \examples{ ## Classical example: Student's sleep data data(sleep) plot(extra ~ group, data = sleep) ## t.test() gives a t value of -4.0621 t.test(extra ~ group, data = sleep, paired=TRUE) ## Gives a Bayes factor of about 15 ## in favor of the alternative hypothesis result <- ttest.tstat(t = -4.0621, n1 = 10) exp(result[['bf']]) } \references{ Morey, R. D. & Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, 406-419 Rouder, J. N., Speckman, P. L., Sun, D., Morey, R. D., & Iverson, G. (2009). Bayesian t-tests for accepting and rejecting the null hypothesis. Psychonomic Bulletin & Review, 16, 225-237 } \seealso{ \code{\link{integrate}}, \code{\link{t.test}}; see \code{\link{ttestBF}} for the intended interface to this function, using the full data set. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) and Jeffrey N. Rouder (\email{rouderj@missouri.edu}) } \keyword{htest} BayesFactor/man/BFManual.Rd0000644000176200001440000000105713274042462015152 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/manual.R \name{BFManual} \alias{BFManual} \title{Opens the HTML manual for the BayesFactor package} \usage{ BFManual() } \value{ \code{BFManual} returns \code{NULL} invisibly. } \description{ This function opens the HTML manual for the BayesFactor package in whatever browser is configured. } \details{ This function opens the HTML manual for the BayesFactor package in whatever browser is configured. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{misc} BayesFactor/man/recompute-methods.Rd0000644000176200001440000000464713274042462017201 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFBayesFactor.R, % R/methods-BFBayesFactorTop.R, R/methods-BFmodelSample.R, R/methods-BFodds.R \docType{methods} \name{recompute} \alias{recompute} \alias{recompute,BFBayesFactor-method} \alias{recompute,BFBayesFactorTop-method} \alias{recompute,BFBayesFactor-method} \alias{recompute,BFmcmc-method} \alias{recompute,BFodds-method} \title{Recompute a Bayes factor computation or MCMC object.} \usage{ recompute(x, progress = getOption("BFprogress", interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFBayesFactor}(x, progress = getOption("BFprogress", interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFBayesFactorTop}(x, progress = getOption("BFprogress", interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFmcmc}(x, progress = getOption("BFprogress", interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFodds}(x, progress = getOption("BFprogress", interactive()), multicore = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{x}{object to recompute} \item{progress}{report progress of the computation?} \item{multicore}{Use multicore, if available} \item{callback}{callback function for third-party interfaces} \item{...}{arguments passed to and from related methods} } \value{ Returns an object of the same type, after repeating the sampling (perhaps with more iterations) } \description{ Take an object and redo the computation (useful for sampling). In cases where sampling is used to compute the Bayes factor, the estimate of the precision of new samples will be added to the estimate precision of the old sample will be added to produce a new estimate of the precision. } \examples{ ## Sample from the posteriors for two models data(puzzles) ## Main effects model; result is a BFmcmc object, inheriting ## mcmc from the coda package bf = lmBF(RT ~ shape + color + ID, data = puzzles, whichRandom = "ID", progress = FALSE) ## recompute Bayes factor object recompute(bf, iterations = 1000, progress = FALSE) ## Sample from posterior distribution of model above, and recompute: chains = posterior(bf, iterations = 1000, progress = FALSE) newChains = recompute(chains, iterations = 1000, progress=FALSE) } BayesFactor/man/extractOdds-methods.Rd0000644000176200001440000000117013274042462017446 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFodds.R \docType{methods} \name{extractOdds} \alias{extractOdds} \alias{extractOdds,BFodds-method} \title{Extract the odds from an object} \usage{ extractOdds(x, logodds = FALSE, onlyodds = FALSE) \S4method{extractOdds}{BFodds}(x, logodds = FALSE, onlyodds = FALSE) } \arguments{ \item{x}{object from which to extract} \item{logodds}{return the logarithm} \item{onlyodds}{return a vector of only the odds} } \value{ Returns an object containing odds extracted from the object } \description{ Extract the odds from an object } BayesFactor/man/puzzles.Rd0000644000176200001440000000240713274042462015241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/BayesFactorPCL-package.R \docType{data} \name{puzzles} \alias{puzzles} \title{Puzzle completion times from Hays (1994)} \format{A data frame with 48 observations on 3 variables. \describe{ \item{RT}{Puzzle completion time, in minutes} \item{ID}{the subject identifier} \item{shape}{shape of the puzzle (round or square)} \item{color}{color content of the puzzle (monochromatic or color)} }} \source{ Hays, W. L. (1994), Statistics (5th edition), Harcourt Brace, Fort Worth, Texas } \description{ Puzzle completion time example data from Hays (1994). } \details{ Hays (1994; section 13.21, table 13.21.2, p. 570) describes a experiment wherein 12 participants complete four puzzles each. Puzzles could be either square or round, and either monochromatic or in color. Each participant completed every combination of the two factors. } \examples{ data(puzzles) ## classical ANOVA ## Both color and shape are significant, interaction is not classical <- aov(RT ~ shape*color + Error(ID/(shape*color)), data=puzzles) summary(classical) ## Bayes Factor ## Best model is main effects model, no interaction anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID", progress=FALSE) } \keyword{datasets} BayesFactor/man/proportionBF.Rd0000644000176200001440000000546413274042462016156 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/proportionBF.R \name{proportionBF} \alias{proportionBF} \title{Function for Bayesian analysis of proportions} \usage{ proportionBF(y, N, p, rscale = "medium", nullInterval = NULL, posterior = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{y}{a vector of successes} \item{N}{a vector of total number of observations} \item{p}{the null value for the probability of a success to be tested against} \item{rscale}{prior scale. A number of preset values can be given as strings; see Details.} \item{nullInterval}{optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in probability units} \item{posterior}{if \code{TRUE}, return samples from the posterior instead of Bayes factor} \item{callback}{callback function for third-party interfaces} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor} containing the computed model comparisons is returned. If \code{nullInterval} is defined, then two Bayes factors will be computed: The Bayes factor for the interval against the null hypothesis that the probability is \eqn{p_0}{p0}, and the corresponding Bayes factor for the compliment of the interval. If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ Bayes factors or posterior samples for binomial, geometric, or neg. binomial data. } \details{ Given count data modeled as a binomial, geometric, or negative binomial random variable, the Bayes factor provided by \code{proportionBF} tests the null hypothesis that the probability of a success is \eqn{p_0}{p_0} (argument \code{p}). Specifically, the Bayes factor compares two hypotheses: that the probability is \eqn{p_0}{p_0}, or probability is not \eqn{p_0}{p_0}. Currently, the default alternative is that \deqn{\lambda~logistic(\lambda_0,r)} where \eqn{\lambda_0=logit(p_0)}{lambda_0=logit(p_0)} and \eqn{\lambda=logit(p)}{lambda=logit(p)}. \eqn{r}{r} serves as a prior scale parameter. For the \code{rscale} argument, several named values are recognized: "medium", "wide", and "ultrawide". These correspond to \eqn{r} scale values of \eqn{1/2}{1/2}, \eqn{\sqrt{2}/2}{sqrt(2)/2}, and 1, respectively. The Bayes factor is computed via Gaussian quadrature, and posterior samples are drawn via independence Metropolis-Hastings. } \examples{ bf = proportionBF(y = 15, N = 25, p = .5) bf ## Sample from the corresponding posterior distribution samples =proportionBF(y = 15, N = 25, p = .5, posterior = TRUE, iterations = 10000) plot(samples[,"p"]) } \seealso{ \code{\link{prop.test}} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/as.BFBayesFactor.Rd0000644000176200001440000000170713274042462016543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/methods-BFBayesFactor.R \name{as.BFBayesFactor} \alias{as.BFBayesFactor} \title{Function to coerce objects to the BFBayesFactor class} \usage{ as.BFBayesFactor(object) } \arguments{ \item{object}{an object of appropriate class (for now, BFBayesFactorTop)} } \value{ An object of class \code{BFBayesFactor} } \description{ This function coerces objects to the BFBayesFactor class } \details{ Function to coerce objects to the BFBayesFactor class Currently, this function will only work with objects of class \code{BFBayesFactorTop}, which are output from the functions \code{anovaBF} and \code{regressionBF} when the \code{whichModels} argument is set to \code{'top'} } \seealso{ \code{\link{regressionBF}}, \code{anovaBF} whose output is appropriate for use with this function when \code{whichModels='top'} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{misc} BayesFactor/man/model-classes.Rd0000644000176200001440000000260713274042462016262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaClasses.R \docType{class} \name{BFmodel-class} \alias{BFmodel-class} \alias{BFcorrelation-class} \alias{BFproportion-class} \alias{BFcontingencyTable-class} \alias{BFlinearModel-class} \alias{BFoneSample-class} \alias{BFoneSample-class} \alias{BFindepSample-class} \title{General S4 classes for representing models for comparison} \description{ The \code{BFmodel} is a general S4 class for representing models for comparison. The more classes \code{BFlinearModel}, \code{BFindepSample}, and \code{BFoneSample} inherit directly from \code{BFmodel}. } \details{ \describe{ These model classes all have the following slots defined: \item{type}{Model type} \item{identifier}{a list uniquely identifying the model from other models of the same type} \item{prior}{list giving appropriate prior settings for the model} \item{dataTypes}{a character vector whose names are possible columns in the data; elements specify the corresponding data type, currently one of c("fixed","random","continuous")} \item{shortName}{a short, readable identifying string} \item{longName}{a longer, readable identifying string} \item{analysis}{object storing information about a previous analysis of this model} \item{version}{character string giving the version and revision number of the package that the model was created in} } } BayesFactor/man/BFprobability-class.Rd0000644000176200001440000000336213274042462017361 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFprobability.R \docType{class} \name{BFprobability-class} \alias{BFprobability-class} \alias{/,BFprobability,numeric-method} \alias{-,BFprobability,numeric-method} \alias{[,BFprobability,index,missing,missing-method} \alias{filterBF,BFprobability,character-method} \title{General S4 class for representing multiple model probability comparisons} \usage{ \S4method{/}{BFprobability,numeric}(e1, e2) \S4method{-}{BFprobability,numeric}(e1, e2) \S4method{[}{BFprobability,index,missing,missing}(x, i, j, ..., drop = TRUE) \S4method{filterBF}{BFprobability,character}(x, name, perl = FALSE, fixed = FALSE, ...) } \arguments{ \item{e1}{BFprobability object} \item{e2}{new normalization constant} \item{x}{BFprobability object} \item{i}{indices indicating elements to extract} \item{j}{unused for BFprobability objects} \item{...}{further arguments passed to related methods} \item{drop}{unused} \item{name}{regular expression to search name} \item{perl}{logical. Should perl-compatible regexps be used? See ?grepl for details.} \item{fixed}{logical. If TRUE, pattern is a string to be matched as is. See ?grepl for details.} } \description{ The \code{BFprobability} class is a general S4 class for representing models model comparison via prior or posterior probabilities. } \details{ \describe{ The \code{BFprobability} class has the following slots defined: \item{odds}{A BFodds object containing the models from which to compute the probabilities} \item{normalize}{the sum of the probabilities of all models (will often be 1.0)} \item{version}{character string giving the version and revision number of the package that the model was created in} } } BayesFactor/man/as.BFprobability.Rd0000644000176200001440000000161213274042462016654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/methods-BFprobability.R \name{as.BFprobability} \alias{as.BFprobability} \title{Function to coerce objects to the BFprobability class} \usage{ as.BFprobability(object, normalize = NULL, lognormalize = NULL) } \arguments{ \item{object}{an object of appropriate class (BFodds)} \item{normalize}{the sum of the probabilities for all models in the object (1 by default)} \item{lognormalize}{alternative to \code{normalize}; the logarithm of the normalization constant (0 by default)} } \value{ An object of class \code{BFprobability} } \description{ This function coerces objects to the BFprobability class } \details{ Function to coerce objects to the BFprobability class Currently, this function will only work with objects of class \code{BFOdds}. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{misc} BayesFactor/man/plot.BFBayesFactorTop.Rd0000644000176200001440000000277213274042462017604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot-BFBayesFactorTop.R \name{plot.BFBayesFactorTop} \alias{plot.BFBayesFactorTop} \title{Plot a Bayes factor top-down object} \usage{ \method{plot}{BFBayesFactorTop}(x, include1 = TRUE, addDenom = FALSE, sortbf = FALSE, logbase = c("log10", "log2", "ln"), marginExpand = 0.4, pars = NULL, ...) } \arguments{ \item{x}{a BFBayesFactorTop object} \item{include1}{if \code{TRUE}, ensure that Bayes factor = 1 is on the plot} \item{addDenom}{if \code{TRUE}, add the denominator model into the group} \item{sortbf}{sort the Bayes factors before plotting them? Defaults to \code{TRUE}} \item{logbase}{the base of the log Bayes factors in the plot} \item{marginExpand}{an expansion factor for the left margin, in case more space is needed for model names} \item{pars}{a list of par() settings} \item{...}{additional arguments to pass to barplot()} } \description{ Plot a Bayes factor top-down object } \details{ This function creates a barplot of the (log) Bayes factors in a Bayes factor object. Error bars are added (though in many cases they may be too small to see) in red to show the error in estimation of the Bayes factor. If a red question mark appears next to a bar, then that Bayes factor has no error estimate available. } \examples{ data(puzzles) bfs = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID", whichModels='top', progress=FALSE) plot(bfs) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } BayesFactor/man/logMeanExpLogs.Rd0000644000176200001440000000377713274042462016424 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/logMean.R \name{logMeanExpLogs} \alias{logMeanExpLogs} \alias{logCumMeanExpLogs} \alias{logSummaryStats} \title{Functions to compute the logarithm of the mean (and cumulative means) of vectors of logarithms} \usage{ logMeanExpLogs(v) } \arguments{ \item{v}{A vector of (log) values} } \value{ \code{logMeanExpLogs} returns a single value, \code{logCumMeanExpLogs} returns a vector of values of the same length as \var{v}, and \code{logSummaryStats} returns a list of the log mean, log variance, and cumulative log means. } \description{ Given a vector of numeric values of real values represented in log form, \code{logMeanExpLogs} computes the logarithm of the mean of the (exponentiated) values. \code{logCumMeanExpLogs} computes the logarithm of the cumulative mean. } \details{ Given a vector of values of log values \var{v}, one could compute \code{log(mean(exp(v)))} in R. However, exponentiating and summing will cause a loss of precision, and possibly an overflow. These functions use the identity \deqn{\log(e^a + e^b) = a + \log(1+e^{b-a})}{log(e^a + e^b) = a + log[ 1 + e^(b-a) ]} and the method of computing \eqn{\log(1+e^x)}{log(1+e^x)} that avoids overflow (see the references). The code is written in C for very fast computations. } \examples{ # Sample 100 values y = log(rexp(100,1)) # These will give the same value, # since e^y is "small" logMeanExpLogs(y) log(mean(exp(y))) # We can make e^x overflow by multiplying # e^y by e^1000 largeVals = y + 1000 # This will return 1000 + log(mean(exp(y))) logMeanExpLogs(largeVals) # This will overflow log(mean(exp(largeVals))) } \references{ For details of the approximation of \eqn{\log(1+e^x)}{log(1+e^x)} used to prevent loss of precision, see \url{http://www.codeproject.com/Articles/25294/Avoiding-Overflow-Underflow-and-Loss-of-Precision} and \url{http://www.johndcook.com/blog/standard_deviation/}. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{arith} \keyword{misc} BayesFactor/man/correlationBF.Rd0000644000176200001440000000620313274042462016254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/correlationBF.R \name{correlationBF} \alias{correlationBF} \title{Function for Bayesian analysis of correlations} \usage{ correlationBF(y, x, rscale = "medium", nullInterval = NULL, posterior = FALSE, callback = function(...) as.integer(0), ...) } \arguments{ \item{y}{first continuous variable} \item{x}{second continuous variable} \item{rscale}{prior scale. A number of preset values can be given as strings; see Details.} \item{nullInterval}{optional vector of length 2 containing lower and upper bounds of an interval hypothesis to test, in correlation units} \item{posterior}{if \code{TRUE}, return samples from the posterior instead of Bayes factor} \item{callback}{callback function for third-party interfaces} \item{...}{further arguments to be passed to or from methods.} } \value{ If \code{posterior} is \code{FALSE}, an object of class \code{BFBayesFactor} containing the computed model comparisons is returned. If \code{nullInterval} is defined, then two Bayes factors will be computed: The Bayes factor for the interval against the null hypothesis that the probability is 0, and the corresponding Bayes factor for the complement of the interval. If \code{posterior} is \code{TRUE}, an object of class \code{BFmcmc}, containing MCMC samples from the posterior is returned. } \description{ Bayes factors or posterior samples for correlations. } \details{ The Bayes factor provided by \code{ttestBF} tests the null hypothesis that the true linear correlation \eqn{\rho}{rho} between two samples (\eqn{y}{y} and \eqn{x}{x}) of size \eqn{n}{n} from normal populations is equal to 0. The Bayes factor is based on Jeffreys (1961) test for linear correlation. Noninformative priors are assumed for the population means and variances of the two population; a shifted, scaled beta(1/rscale,1/rscale) prior distribution is assumed for \eqn{\rho}{rho} (note that \code{rscale} is called \eqn{\kappa}{kappa} by Ly et al. 2015; we call it \code{rscale} for consistency with other BayesFactor functions). For the \code{rscale} argument, several named values are recognized: "medium.narrow", "medium", "wide", and "ultrawide". These correspond to \eqn{r} scale values of \eqn{1/\sqrt(27)}{1/sqrt(27)}, \eqn{1/3}{1/3}, \eqn{1/\sqrt(3)}{1/sqrt(3)} and 1, respectively. The Bayes factor is computed via several different methods. } \examples{ bf = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) bf ## Sample from the corresponding posterior distribution samples = correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width, posterior = TRUE, iterations = 10000) plot(samples[,"rho"]) } \references{ Ly, A., Verhagen, A. J. & Wagenmakers, E.-J. (2015). Harold Jeffreys's Default Bayes Factor Hypothesis Tests: Explanation, Extension, and Application in Psychology. Journal of Mathematical Psychology, Available online 28 August 2015, http://dx.doi.org/10.1016/j.jmp.2015.06.004. Jeffreys, H. (1961). Theory of probability, 3rd edn. Oxford, UK: Oxford University Press. } \seealso{ \code{\link{cor.test}} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/oneWayAOV.Fstat.Rd0000644000176200001440000000505213274042462016414 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oneWayAOV_Fstat.R \name{oneWayAOV.Fstat} \alias{oneWayAOV.Fstat} \title{Use F statistic to compute Bayes factor for balanced one-way designs} \usage{ oneWayAOV.Fstat(F, N, J, rscale = "medium", simple = FALSE) } \arguments{ \item{F}{F statistic from classical ANOVA} \item{N}{number of observations per cell or group} \item{J}{number of cells or groups} \item{rscale}{numeric prior scale} \item{simple}{if \code{TRUE}, return only the Bayes factor} } \value{ If \code{simple} is \code{TRUE}, returns the Bayes factor (against the intercept-only null). If \code{FALSE}, the function returns a vector of length 3 containing the computed log(e) Bayes factor, along with a proportional error estimate on the Bayes factor and the method used to compute it. } \description{ Using the classical F test statistic for a balanced one-way design, this function computes the corresponding Bayes factor test. } \details{ For F statistics computed from balanced one-way designs, this function can be used to compute the Bayes factor testing the model that all group means are not equal to the grand mean, versus the null model that all group means are equal. It can be used when you don't have access to the full data set for analysis by \code{\link{lmBF}}, but you do have the test statistic. For details about the model, see the help for \code{\link{anovaBF}}, and the references therein. The Bayes factor is computed via Gaussian quadrature. } \note{ \code{oneWayAOV.Fstat} should only be used with F values obtained from balanced designs. } \examples{ ## Example data "InsectSprays" - see ?InsectSprays require(stats); require(graphics) boxplot(count ~ spray, data = InsectSprays, xlab = "Type of spray", ylab = "Insect count", main = "InsectSprays data", varwidth = TRUE, col = "lightgray") ## Classical analysis (with transformation) classical <- aov(sqrt(count) ~ spray, data = InsectSprays) plot(classical) summary(classical) ## Bayes factor (a very large number) Fvalue <- anova(classical)$"F value"[1] result <- oneWayAOV.Fstat(Fvalue, N=12, J=6) exp(result[['bf']]) } \references{ Morey, R. D., Rouder, J. N., Pratte, M. S., \& Speckman, P. L. (2011). Using MCMC chain outputs to efficiently estimate Bayes factors. Journal of Mathematical Psychology, 55, 368-378 } \seealso{ \code{\link{integrate}}, \code{\link{aov}}; see \code{\link{lmBF}} for the intended interface to this function, using the full data set. } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \keyword{htest} BayesFactor/man/BFodds-class.Rd0000644000176200001440000000355713274042462016000 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFodds.R \docType{class} \name{BFodds-class} \alias{BFodds-class} \alias{/,numeric,BFodds-method} \alias{/,BFodds,BFodds-method} \alias{*,BFodds,BFBayesFactor-method} \alias{[,BFodds,index,missing,missing-method} \title{General S4 class for representing multiple odds model comparisons, all against the same model} \usage{ \S4method{/}{numeric,BFodds}(e1, e2) \S4method{/}{BFodds,BFodds}(e1, e2) \S4method{*}{BFodds,BFBayesFactor}(e1, e2) \S4method{[}{BFodds,index,missing,missing}(x, i, j, ..., drop = TRUE) } \arguments{ \item{e1}{Numerator of the ratio} \item{e2}{Denominator of the ratio} \item{x}{BFodds object} \item{i}{indices indicating elements to extract} \item{j}{unused for BFodds objects} \item{...}{further arguments passed to related methods} \item{drop}{unused} } \description{ The \code{BFodds} class is a general S4 class for representing models model comparison via prior or posterior odds. } \details{ \code{BFodds} objects can be inverted by taking the reciprocal and can be divided by one another, provided both objects have the same denominator. In addition, the \code{t} (transpose) method can be used to invert odds objects. \describe{ The \code{BFodds} class has the following slots defined: \item{numerator}{a list of models all inheriting \code{BFmodel}, each providing a single numerator} \item{denominator}{a single \code{BFmodel} object serving as the denominator for all model comparisons} \item{logodds}{a data frame containing information about the (log) prior odds between each numerator and the denominator} \item{bayesFactor}{a \code{BFBayesFactor} object (possibly) containing the evidence from the data.} \item{version}{character string giving the version and revision number of the package that the model was created in} } }