BayesFactor/0000755000175100001440000000000012577320137012501 5ustar hornikusersBayesFactor/inst/0000755000175100001440000000000012577237621013463 5ustar hornikusersBayesFactor/inst/tests/0000755000175100001440000000000012452540640014613 5ustar hornikusersBayesFactor/inst/tests/test-anovaBF.R0000644000175100001440000000044512452540640017232 0ustar hornikuserscontext("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/doc/0000755000175100001440000000000012577237621014230 5ustar hornikusersBayesFactor/inst/doc/odds_probs.html0000644000175100001440000017612412577237621017267 0ustar hornikusers 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 bookmark on delicious 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-2 of BayesFactor (R Under development (unstable) (2015-09-14 r69389) on x86_64-apple-darwin13.4.0).

BayesFactor/inst/doc/index.html0000644000175100001440000010474112577237621016234 0ustar hornikusers BayesFactor manual files

alt text


BayesFactor manual files

BayesFactor/inst/doc/compare_lme4.R0000644000175100001440000001733012577237621016726 0ustar hornikusers## ----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) 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.Rmd0000644000175100001440000000741112577237621016215 0ustar hornikusers ![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) 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.R0000644000175100001440000000431512577237621015674 0ustar hornikusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- ## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) 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.html0000644000175100001440000116375512577237621017507 0ustar hornikusers 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 
##   9.208   0.044   9.271
t.la
##    user  system elapsed 
##   5.543   0.022   5.575
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"))
## Note: method with signature 'Matrix#ANY' chosen for function 'kronecker',
##  target signature 'dgeMatrix#dsyMatrix'.
##  "ANY#Matrix" would also be valid
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-2 of BayesFactor (R Under development (unstable) (2015-09-14 r69389) on x86_64-apple-darwin13.4.0).

BayesFactor/inst/doc/index.Rmd0000644000175100001440000000070312577237621016003 0ustar hornikusers ![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.html0000644000175100001440000014577212577237621016454 0ustar hornikusers 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-2 of BayesFactor (R Under development (unstable) (2015-09-14 r69389) on x86_64-apple-darwin13.4.0).

BayesFactor/inst/doc/compare_lme4.Rmd0000644000175100001440000002344312577237621017251 0ustar hornikusers ![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) 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.Rmd0000644000175100001440000017142712577237621016165 0ustar hornikusers 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 bookmark on delicious share by email ---- Stable version: [CRAN page](http://cran.r-project.org/package=BayesFactor) - [Package NEWS (including version changes)](http://cran.r-project.org/web/packages/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) * [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://r-forge.r-project.org/forum/?group_id=554) * [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) 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) `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](http://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 216. 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[,1:4]) ``` 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. 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)) ``` ### 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 ([PDF](http://www.isds.duke.edu/courses/Spring09/sta244/Handouts/hyper-g.pdf)) Morey, R. D. and Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, pp. 406-419 ([PDF](http://drsmorey.org/bibtex/upload/Morey:Rouder:2011.pdf)) 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 ([PDF](http://drsmorey.org/bibtex/upload/Morey:etal:2011a.pdf)) Rouder, J. N. and Morey, R. D. (2013) Default Bayes Factors for Model Selection in Regression, Multivariate Behavioral Research, 47, pp. 877-903 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.Morey_.MBR_.2012.pdf)) 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 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.JMP_.2012.pdf)) 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 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.bf_.pdf)) 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 ([PDF](http://drsmorey.org/bibtex/upload/Rouder:Morey:2011a.pdf)) -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/inst/doc/manual.R0000644000175100001440000004340212577237621015633 0ustar hornikusers## ----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------------------------------------------------------- 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[,1:4]) ## ----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)) ## ----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.R0000644000175100001440000000022312577237621015457 0ustar hornikusers## ----echo=FALSE,message=FALSE,results='hide'----------------------------- options(markdown.HTML.stylesheet = 'extra/manual.css') library(knitr) BayesFactor/inst/doc/manual.html0000644000175100001440000431465112577237621016411 0ustar hornikusers 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 bookmark on delicious 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)
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 216.

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[,1:4])

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)
## Note: method with signature 'Matrix#ANY' chosen for function 'kronecker',
##  target signature 'dgeMatrix#dgeMatrix'.
##  "ANY#Matrix" would also be valid
## 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
## complaints  0.615  0.124  0.00124        0.00132
## learning    0.202  0.137  0.00137        0.00137
## sig2       50.142 14.640  0.14640        0.17692
## g           2.198  8.798  0.08798        0.08798
## 
## 2. Quantiles for each variable:
## 
##               2.5%    25%    50%    75%  97.5%
## complaints  0.3683  0.536  0.615  0.694  0.859
## learning   -0.0676  0.115  0.200  0.291  0.473
## sig2       29.2640 39.885 47.681 57.692 84.818
## g           0.1757  0.481  0.878  1.780 11.041

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.

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.21%
## [2] supp + dose             : 1.58e+15 ±6.55%
## [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 : 0.999 ±6.67%
## 
## 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.00545
## supp-VC             -1.68 0.501  0.00501        0.00545
## dose-dose            7.62 0.608  0.00608        0.00623
## supp:dose-OJ.&.dose -1.31 0.596  0.00596        0.00596
## supp:dose-VC.&.dose  1.31 0.596  0.00596        0.00596
## sig2                14.70 2.903  0.02903        0.03298
## 
## 2. Quantiles for each variable:
## 
##                       2.5%    25%   50%    75%  97.5%
## mu                  17.849 18.478 18.82 19.148 19.789
## supp-OJ              0.710  1.345  1.68  2.018  2.661
## supp-VC             -2.661 -2.018 -1.68 -1.345 -0.710
## dose-dose            6.437  7.212  7.62  8.031  8.811
## supp:dose-OJ.&.dose -2.481 -1.703 -1.32 -0.919 -0.117
## supp:dose-VC.&.dose  0.117  0.919  1.32  1.703  2.481
## sig2                10.098 12.641 14.36 16.384 21.259

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.509  0.00509        0.00509
## supp-OJ    1.67 0.512  0.00512        0.00568
## supp-VC   -1.67 0.512  0.00512        0.00568
## dose-dose  7.66 0.633  0.00633        0.00633
## sig2      15.70 3.075  0.03075        0.03422
## 
## 2. Quantiles for each variable:
## 
##             2.5%   25%   50%   75%  97.5%
## mu        17.814 18.47 18.81 19.15 19.824
## supp-OJ    0.676  1.33  1.67  2.01  2.683
## supp-VC   -2.683 -2.01 -1.67 -1.33 -0.676
## dose-dose  6.444  7.23  7.65  8.08  8.923
## sig2      10.805 13.52 15.29 17.45 22.666

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.00316 ±6.55%
## [2] supp + doseAsFactor                     : 0.184   ±6.87%
## [3] supp + doseAsFactor + supp:doseAsFactor : 0.502   ±7.49%
## [4] supp + dose + supp:dose                 : 0.999   ±6.67%
## [5] supp + dose                             : 1       ±0%
## [6] dose                                    : 0.0176  ±6.55%
## 
## Against denominator:
##   len ~ 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

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%
## 
## 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: 96%
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.393   ±4.48%
## [4] shape + color + shape:color      : 0.137   ±1.89%
## [5] ID                               : 111517  ±0%
## [6] shape + ID                       : 315328  ±1.19%
## [7] color + ID                       : 317212  ±1.4%
## [8] shape + color + ID               : 1321638 ±2.04%
## [9] shape + color + shape:color + ID : 495160  ±3.13%
## 
## 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                       : 313207  ±0.84%
## [2] color + ID                       : 322064  ±1.33%
## [3] shape + color + ID               : 1293818 ±1.71%
## [4] shape + color + shape:color + ID : 495916  ±1.98%
## [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               : 170730 ±1.2%
## [2] color + color:shape + shape + ID + shape:ID : 63641  ±2.76%
## [3] shape + ID + shape:ID                       : 28822  ±1.1%
## 
## 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                                  : 323927  ±2.01%
## [2] color + ID                                  : 312961  ±0.91%
## [3] shape + color + ID                          : 1261106 ±0.99%
## [4] shape + color + shape:color + ID            : 520716  ±9.67%
## [5] shape + shape:ID + ID                       : 29796   ±3.39%
## [6] shape + color + shape:ID + ID               : 172260  ±2.19%
## [7] shape + color + shape:color + shape:ID + ID : 64445   ±3.76%
## [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 : 315853 ±1.19%
## [2] color + ID : 317826 ±1.07%
## 
## 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  : 315853 ±1.19%
## [6] color + ID  : 317826 ±1.07%
## 
## 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.83 ±0.92%
## [2] color + ID                       : 2.15 ±1.73%
## [3] shape + color + ID               : 8.89 ±1.53%
## [4] shape + color + shape:color + ID : 3.44 ±2.15%
## 
## 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 (PDF)

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

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 (PDF)

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

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 (PDF)

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 (PDF)

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 (PDF)


Social media icons by Lokas Software.

This document was compiled with version 0.9.12-2 of BayesFactor (R Under development (unstable) (2015-09-14 r69389) on x86_64-apple-darwin13.4.0).

BayesFactor/inst/doc/odds_probs.Rmd0000644000175100001440000001202612577237621017033 0ustar hornikusers 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 bookmark on delicious 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.R0000644000175100001440000000255512577237621016520 0ustar hornikusers## ----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/tests/0000755000175100001440000000000012452540640013636 5ustar hornikusersBayesFactor/tests/run-all.R0000644000175100001440000000010312452540640015325 0ustar hornikuserslibrary(testthat) library(BayesFactor) test_package("BayesFactor")BayesFactor/src/0000755000175100001440000000000012577237621013275 5ustar hornikusersBayesFactor/src/linearRegGibbsRcpp.cpp0000644000175100001440000000644412577237622017516 0ustar hornikusers#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.h0000644000175100001440000000467012577237622015256 0ustar hornikusers#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); #endif //BFCOMMON_HPP_ BayesFactor/src/logSummaryStats.cpp0000644000175100001440000000262412577237622017164 0ustar hornikusers#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.cpp0000644000175100001440000001015412577237622017571 0ustar hornikusers#include #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.cpp0000644000175100001440000000174312577237622016154 0ustar hornikusers#include #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/interrupts.h0000644000175100001440000000142412577237622015667 0ustar hornikusers/* * 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.h0000644000175100001440000000477412577237622015327 0ustar hornikusers/* * 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 #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.cpp0000644000175100001440000000046312577237622015651 0ustar hornikusers/* * 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 #include "progress.h" InterruptableProgressMonitor* Progress::_monitor_singleton = 0; BayesFactor/src/interruptable_progress_monitor.h0000644000175100001440000001275512577237622022034 0ustar hornikusers/* * 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 #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.cpp0000644000175100001440000000746312577237622016634 0ustar hornikusers#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.h0000644000175100001440000000471412577237622017243 0ustar hornikusers#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.cpp0000644000175100001440000000203712577237622015747 0ustar hornikusers#include 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.cpp0000644000175100001440000000071412577237622015504 0ustar hornikusers#include #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.cpp0000644000175100001440000001400212577237622015767 0ustar hornikusers#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.cpp0000644000175100001440000001350112577237622017165 0ustar hornikusers#include "progress.h" #include "bfcommon.h" #include #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.cpp0000644000175100001440000000064212577237622016325 0ustar hornikusers#include #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.cpp0000644000175100001440000000173112577237622016223 0ustar hornikusers/* * 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.cpp0000644000175100001440000000747112577237622016025 0ustar hornikusers#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.cpp0000644000175100001440000001567212577237622016765 0ustar hornikusers#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/jzs_Gauss_approx_aov.cpp0000644000175100001440000001037712577237622020220 0ustar hornikusers#include "bfcommon.h" #include 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.cpp0000644000175100001440000004370112577237622016300 0ustar hornikusers// This file was generated by Rcpp::compileAttributes // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include #include using namespace 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(dinvgamma1_Rcpp(x, a, b)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(dinvgamma1_logx_Rcpp(x, a, b)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(ddinvgamma1_Rcpp(x, a, b)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(d2dinvgamma1_Rcpp(x, a, b)); return __result; END_RCPP } // 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(jzs_sampler(iterations, y, X, rscale, gMap, incCont, importanceMu, importanceSig, progress, callback, callbackInterval, which)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(jzs_log_marginal_posterior_logg(q, sumSq, N, XtCnX0, CnytCnX0, rscale, gMap, gMapCounts, priorX, incCont, limit, limits, which)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(jzs_Gibbs(iterations, y, X, rscale, sig2start, gMap, gMapCounts, incCont, nullModel, ignoreCols, thin, progress, callback, callbackInterval)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(GibbsLinearRegRcpp(iterations, y, X, r, sig2start, nullModel, progress, callback, callbackInterval)); return __result; 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 __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< Eigen::MatrixXd >::type A(ASEXP); __result = Rcpp::wrap(log_determinant_pos_def(A)); return __result; END_RCPP } // logSummaryStats List logSummaryStats(NumericVector x); RcppExport SEXP BayesFactor_logSummaryStats(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); __result = Rcpp::wrap(logSummaryStats(x)); return __result; END_RCPP } // log1pExp double log1pExp(double x); RcppExport SEXP BayesFactor_log1pExp(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< double >::type x(xSEXP); __result = Rcpp::wrap(log1pExp(x)); return __result; END_RCPP } // logExpXplusExpY double logExpXplusExpY(const double x, const double y); RcppExport SEXP BayesFactor_logExpXplusExpY(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type y(ySEXP); __result = Rcpp::wrap(logExpXplusExpY(x, y)); return __result; END_RCPP } // logExpXminusExpY double logExpXminusExpY(const double x, const double y); RcppExport SEXP BayesFactor_logExpXminusExpY(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< const double >::type x(xSEXP); Rcpp::traits::input_parameter< const double >::type y(ySEXP); __result = Rcpp::wrap(logExpXminusExpY(x, y)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(metropMetaTRcpp(t, n1, n2, twoSample, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(metropProportionRcpp(y, n, p0, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(gibbsTwoSampleRcpp(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return __result; 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(gibbsOneSampleRcpp(ybar, s2, N, rscale, iterations, doInterval, interval, intervalCompl, nullModel, progress, callback, callbackInterval)); return __result; END_RCPP } BayesFactor/src/proportion.cpp0000644000175100001440000000714012577237622016217 0ustar hornikusers#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 ) - log( sum(n) + 2 ); 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 ) - 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.cpp0000644000175100001440000000042512577237622016757 0ustar hornikusers#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.cpp0000644000175100001440000001065512577237622015725 0ustar hornikusers#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 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/NAMESPACE0000644000175100001440000000631212577235600013722 0ustar hornikusersuseDynLib(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<-") 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") importFrom("utils", "combn", "setTxtProgressBar", "txtProgressBar", "vignette") 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/NEWS0000644000175100001440000002247212577227565013222 0ustar hornikusers 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/0000755000175100001440000000000012452540640013405 5ustar hornikusersBayesFactor/data/puzzles.rda0000644000175100001440000000055512452540640015616 0ustar hornikusersRN@REM|"x%nJ &m[ЄQf-d'V&73SϞ @\Dj <`Aegl0h^79$>V?q|'<N,ʛ~\8Qi!ڈǨG|8ƺ=p뵸mD<"Dn#rO)[2% "Q.esTlfP&_-CO:QZaa$ӟRc7&oJ",PzJTHU,W_zcW"ˢ5{0[ehf`Ot 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)){ #### 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(all(continuous)){ chains = linearReg.Gibbs(y, X, iterations = iterations, rscale = rscale, progress = progress, callback = callback) return(chains) } 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.R0000644000175100001440000003145512476033341017104 0ustar hornikusers # 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 = options()$BFprogress, 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.R0000644000175100001440000002761312577227523014357 0ustar hornikusers ##' 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 = options()$BFprogress, rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleEffects = NULL, multicore = FALSE, method="auto", noSample=FALSE, callback=function(...) as.integer(0)) { 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)>options()$BFMaxModels) stop("Maximum number of models exceeded (", length(models), " > ",options()$BFMaxModels ,"). ", "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.R0000644000175100001440000000134312452540640014506 0ustar hornikusers#'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.R0000644000175100001440000000476312473412213015432 0ustar hornikusers 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.R0000644000175100001440000000774512577227532015431 0ustar hornikusers##' 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,(n1*n2)/(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.R0000644000175100001440000000761412452540640017737 0ustar hornikusers 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/oneWayAOV_Fstat.R0000644000175100001440000000610012577227532016000 0ustar hornikusers ##' 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.R0000644000175100001440000000615612473412213014600 0ustar hornikuserscreateDataTypes <- function(formula, whichRandom, data, analysis){ factors <- rownames(attr(terms(formula, data = data),"factors"))[-1] 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")) vars = rownames(attr(terms(formula, data = data),"factors")) 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]]) if( grepl(":",RHS,fixed=TRUE) ) 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(terms) > 1 ) stop("Indep. groups t test can only support 1 factor as predictor.") if(length(grep(":",terms,fixed=TRUE))) 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.R0000644000175100001440000003616312577227532016030 0ustar hornikuserssingleGBayesFactor <- 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 = options()$BFpretestIterations 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 = strsplit(term, ":", fixed=TRUE)[[1]] prod(nXcols[constit]) }, nXcols = nXcols) } termTypes <- function(formula, data, dataTypes){ trms = attr(terms(formula, data = data),"term.labels") sapply(trms, function(term, dataTypes){ constit = strsplit(term, ":", fixed=TRUE)[[1]] 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(strsplit(trm, ":", fixed = TRUE)) #check to ensure all terms are in data checkEffects(effects, data, dataTypes) if(length(effects) == 1){ effect = paste("~",effects,"-1") X = model.Matrix(formula(effect),data = data, sparse = sparse) if(dataTypes[effects] == "fixed"){ X = X %*% fixedFromRandomProjection(ncol(X), sparse = sparse) colnames(X) = paste(effects,"_redu_",1:ncol(X),sep="") } return(X) }else{ Xs = lapply(effects, function(trm, data, dataTypes, sparse){ 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)) } }) return(data.frame(mycols)) } 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.R0000644000175100001440000000665612452540640017573 0ustar hornikusersBFBayesFactorTop <- 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.") 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 = options()$BFprogress, 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.R0000644000175100001440000000454512522424725014574 0ustar hornikusers.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) setOptions() } #'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 setOptions <- function(){ if(is.null(options()$BFMaxModels)) options(BFMaxModels = 50000) if(is.null(options()$BFpretestIterations)) options(BFpretestIterations = 100) if(is.null(options()$BFapproxOptimizer)) options(BFapproxOptimizer = "optim") if(is.null(options()$BFapproxLimits)) options(BFapproxLimits = c(-15,15)) if(is.null(options()$BFprogress)) options(BFprogress = interactive()) if(is.null(options()$BFfactorsMax)) options(BFfactorsMax = 5) if(is.null(options()$BFcheckProbabilityList)) options(BFcheckProbabilityList = TRUE) } BayesFactor/R/oneWayAOV-utility.R0000644000175100001440000000044412473412213016330 0ustar hornikusers 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.R0000644000175100001440000001065512473412213015447 0ustar hornikusers##' 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(!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.R0000644000175100001440000001154312577227532016752 0ustar hornikusersmakePropHypothesisNames = 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.R0000644000175100001440000001731312475542374014737 0ustar hornikusers# 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 BFcontingencyTable-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.R0000644000175100001440000002733712476025773015651 0ustar hornikusers# 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 = options()$BFprogress, 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/plot-BFBayesFactor.R0000644000175100001440000000725612452540640016420 0ustar hornikusers## 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 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, 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 = 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=rownames(bfs), horiz=TRUE, axes=FALSE, xlim=range(yaxes), main = paste("vs.",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/aaGenerics.R0000644000175100001440000002157312513676140015074 0ustar hornikusers#' 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,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=options()$BFprogress, 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.R0000644000175100001440000001064212577227523013655 0ustar hornikusers##' 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=options()$BFprogress, ...) { 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.R0000644000175100001440000001604012577227532016623 0ustar hornikusersmakeMetaTtestHypothesisNames = 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=options()$BFprogress, 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.R0000644000175100001440000002611312577227532014325 0ustar hornikusersif(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){ rownames(attr(terms(formula, data = data),"factors")) } 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.") ) ) } 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] paste(trms,collapse=":") } 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 } BayesFactor/R/manual.R0000644000175100001440000000074312452540640014301 0ustar hornikusers #'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.R0000644000175100001440000000730112562700540015311 0ustar hornikusers# This file was generated by Rcpp::compileAttributes # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 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) } 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) } BayesFactor/R/newPriorOdds.R0000644000175100001440000000135212475323636015451 0ustar hornikusers#'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/contingency-utility.R0000644000175100001440000003052412577227523017057 0ustar hornikusers# 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.R0000644000175100001440000002055412577227523017153 0ustar hornikuserssetMethod('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]]) 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) }) ########### ## 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.R0000644000175100001440000000502012562700540017105 0ustar hornikusersenumerateRegressionModels = function(fmla, whichModels, data){ trms <- attr(terms(fmla, data = data), "term.labels") ntrms <- length(trms) dv = stringFromFormula(fmla[[2]]) 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] dv = stringFromFormula(formula[[2]]) 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 = options()$BFprogress, callback=function(...) as.integer(0), noSample=FALSE, callbackInterval = 1, ...){ rscale = rpriorValues("regression",,rscale) X = apply(covariates,2,function(v) v - mean(v)) y = matrix(y,ncol=1) N = length(y) 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){ chains = matrix(NA,ncol(covariates)+2,2) }else{ chains = GibbsLinearRegRcpp(as.integer(iterations), y, X, rscale, sig2start, FALSE, progress, callback, callbackInterval) } colnames(chains) = c(colnames(covariates),"sig2","g") return(mcmc(chains)) } BayesFactor/R/linearReg_R2stat.R0000644000175100001440000000727412577227532016213 0ustar hornikusers##' 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 almost 80,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.R0000644000175100001440000000570412473412213015705 0ustar hornikusersQg <- function(q,sumSq,N,XtCnX,CnytCnX,rscale,gMap,gMapCounts,priorX=NULL,incCont=0,limit=TRUE) { qLimits = options()$BFapproxLimits 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 = options()$BFapproxOptimizer # 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.R0000644000175100001440000001516412562471164017013 0ustar hornikusersrequiredFor = 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]]) 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(strsplit(trms,":",fixed=TRUE))) 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>options()$BFfactorsMax){ 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.R0000644000175100001440000002161412562413564017223 0ustar hornikusers# constructor BFprobability <- function(odds, normalize = 0){ ## Add denominator if(options()$BFcheckProbabilityList){ ## 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(options()$BFcheckProbabilityList){ 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/BayesFactorPCL-package.R0000644000175100001440000001143112513537111017147 0ustar hornikusers #'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, and contingency tables. #' #'\tabular{ll}{ Package: \tab BayesFactor\cr Type: \tab Package\cr Version: \tab #'0.9.12\cr Date: \tab 2015-4-20\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}}; #' #'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}}; #' #'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.R0000644000175100001440000000751412452540640017100 0ustar hornikusers## 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.R0000644000175100001440000004045112577227532016007 0ustar hornikusers# 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)) } 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 }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]]) 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 }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 }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 = "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 }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.R0000644000175100001440000001074312577227532020567 0ustar hornikusers ############### 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]]) 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.R0000644000175100001440000001263012473412213015407 0ustar hornikusers ##' 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=options()$BFprogress, rscaleCont = "medium", callback = function(...) as.integer(0), noSample=FALSE) { 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)>options()$BFMaxModels) stop("Maximum number of models exceeded (", length(models), " > ",options()$BFMaxModels ,"). ", "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.R0000644000175100001440000000336112452540640016040 0ustar hornikusers 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]]) 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(fixedFactors,collapse="*") # get LHS of formula dv = stringFromFormula(formula[[2]]) 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]]) if(null){ ret = formula(paste(dv, "~", randomPart, collapse="")) }else{ ret = formula(paste(fmla, "+", randomPart, collapse="")) } return(ret) } BayesFactor/R/generalTestBF.R0000644000175100001440000001571312577227523015526 0ustar hornikusers##' 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 = options()$BFprogress, rscaleFixed = "medium", rscaleRandom = "nuisance", rscaleCont="medium", rscaleEffects = NULL, multicore = FALSE, method="auto", noSample=FALSE, callback=function(...) as.integer(0)) { 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)>options()$BFMaxModels) stop("Maximum number of models exceeded (", length(models), " > ",options()$BFMaxModels ,"). ", "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/0000755000175100001440000000000012577237621014516 5ustar hornikusersBayesFactor/vignettes/priors.Rmd0000644000175100001440000000741112452540640016471 0ustar hornikusers ![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) 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/0000755000175100001440000000000012452540640015627 5ustar hornikusersBayesFactor/vignettes/extra/logo.png0000644000175100001440000005737712452540640017320 0ustar hornikusersPNG  IHDR}W AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2: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& cIi` ȅ @pLHރ% cؖP$ lVV:I3߻yovM]Ae G#p8 }#p8BޚaX`owk+bܡXֿ%ϗZsx9G#`5Bk[={<:K)I/.>9ԩnT 'z=bIse*p8ֈ@QfΜԱEEnط3`s͚o?g̀e8G]  f&/>@MGο2t!C=gy p8G! M<{wtp64x,?~Ăi.{/ 4M#pZ;Q\x9s]^bG,}ƚp8щ@T(&N..:ŗ)3{9GuO䮝d1We s:تfHen~G#hpgo9t,#)l{6-LY@}X̓oqѡ\.N:vG#hpEgӻ;;z鷶?ncg$,|a(q{ȻN?Mv8PSҁX6Cg{X?;$&s)Vp8@4 , 嗟CǦh ʽWzI|+; أ{mÆ4yG#6E(+8g; 6ĞŮj^sEItNc-<np8@(%%Z0 j_mkzu>W#p8ggv(.>3p`Y~j^s%{'}#p8"zj@gLd?zf[oX|ɮ$Կ_w/^Rp8 Z03SXxFg_͆Qz?Hp8@kArd-Cj9<^(C{+ʛ%eG#p K̝:0g{O[gkY8pNp̵{f/ yy,UdAi8q[}0v(##˛o~T)p8m%ǻT97"5&0hB\>>,gBW+ ;2.m梂%APS`$cv777h> y@@"VΛ! ;C +` r$?ZɄWWJeD3j$&2} d}qMvA Q$7k&#A b84D^>Ҳ oaw.,Wq߰m/aMԦٷoF_XѦ* }pdyKN.x#&,XҦʪO#00S\= '#7 QՂׅ+ ]FG[cڌD &ue#GCbinLS.cQKgr"*v&hytM@ g`1 Qm|޵7>e}Gv?x`߿=p,o^ڼg/9_$\ҵɰRGĤf,;l(ii:y e{*rԗucg^p8t+oU +yӆ}]1M6f܋V3C~8%;lc/za[; ܪy@D sAv qCc]Wň\sUm_ĸ'NT=:mIMNǟ7,\G-" or`X6^ C t9ku&{%x6 Ȅ];:ƎbeA~rcFs>G#|ܚOS|?FA*SCa,FRn(;AS,tIUOL7|Gm pm;e7m*t'#$ #)߽k4 G|$-.oji&aҍYDtr|ݕiE;rnS3i}gllsfcr*uK;A7742n#\1ufC6PBVW:[ir_^8oL2?^E>s50}IaJ&%:]qbDz~6[ { Eۤ (‛c"{#^k_f jQv``38CX\KQ Sw\L E8Ѱg#x/*#BͷÌ_,M]}.ݱ*.8ȳ$& Pq:R Mf&,e}[xKTp$ c0k[;Z&Ԧ/W"(&&UZTZzrщK\:p zOAū.gOn>(_lsWI.X| Ix^nn\BQaSp*MǨFhLTi\*15Eܔ|'>bK++PS1*wN߀'3{IG3yLv""4y5*GƢP8t! x=K@ $w]r/$kO+ItUI(ǡbvB> c4 qW껹a̒UV' 1NK5x"܏,~26 PfFNek|oۿThK :@7>;W֩['LsLuuuѣGǨXƊSJ)=xA ADAdYd[#66f`]_tFJNy%&/60~mtԊ/9;3:8^kLؖ2d+)tFg6jQnNsKzvN`p:&>Fc`D[GӖc gg,: 3>tQ(uODGs>)tv7ژp >v=˓:qvDKߔOk Aꋚ ȌGF)D.t ܝ?y@D] QLϣ:$ WQY:aQ! h"@i)H--\.J U|Yѧ61J'NI;sh^{xdge-.*~]o:9h f/Jڇ쁛hE%&.j$c.ˇ ջÓҀbW M#t#FJmSpgG['~UVZ¨PYZ>_!O?=rZL{f`V`05ᯪz3uٌ*%lɺjgVm;[yXS>on2p9s1%RCͦC7'f|^lfZd|C`%wfvxF~j>3e;T|t6tMVZ U쪡N~>7Bở2 i)!.N+v|.IAmpw D nuI&SiCs[GBt:y "=ؔ[[SqOefwS^jŭU[ ޟ183;3wNJ6ޝض ީ1`[7'7=6~l~J-W(%;O4u}ꪬq?j⬑up\7*붝g^1T>LP,.SM#1S3ՙr̀F:33Kj_ 3҉Fa|-l-hysVg{!I*śF$?QvY{z:1>ktyw~3L[zS4+sJ 8To|:A8`r<_v>׮z?FRx'^.a{VBcXR8#j/ϫk>) &EJ%ґw?1q]mjM&ssuJ<^p{Ƞ wNs_/{1y_MnnZfFܳdj?JTZe#+2]׍KOVǟny"SBg`MJ}d(c5ҏ\Pp؈4^WݵxT; u4ߤZVȝgL۱7/ ytuGx3ҎNb|B훜x{4f;pkMtI\qnƀ=<`*246(`9, @nY.Z5ة.+A#ۈe/ۍ+tVe~q_>D( 7N)7I!=d 騭{/()7cvlWہaZ[ugmN\/kq쿩zW k3cUǶK:y~DM]uT!FK=-lSv`~G'-SEX4i; |ƚ;aRɻ ɝ;~o`k ?a+Qc'N Zqg8Xi0ھa] 8P_X%e|H[s3{.ݙ u;^{z|%T97DkaM_\8*ϬFaeY7`+IRC+=q{]Rka$ZrX-PW=Y۵U3Mthi0x˶ 5Sj쓗柆ܦɍ'.A GXE7`LA"`Ѷ%˗l2?`袚^oXFy}ZꎤF֩M΍@7_ */}9md}(񡷕MFD9 ̜Ws٥ftc˖V^n/`X.9ŪZ]DsB#wᒒI݀^ N.|{e}-)\<.s<嬱G}e,t NlSJ%*Ku%vC`zοBD0 q軲K6RKioDH @֖\&5~K ~ KWC{!M14 Htq]7ѐTϑ\FG^u,tu1Ցi"K1 S쪾q &HmMv,l⋹Yh(u6uFE6GEef.cMPG?+=2XOugU ܍uNW7JEֳH>Ɔ\%4 GpGfLSl_h=?l`Ņ&w50+Ѹ#1"%:[:~LuMmD[,̛"S/֝G_0(k롬MM\^*)t0yQA|ʺZ/ nә-6Lym\q 1t`']E  ba$ǃx|)# ?XIqӳj4+B_G-,Ǡ3Gu0݄&`1I;LK+f8%oF%,N1s,W~O{zϣA#EStvNrm!9]&*4lfl89!+PAJ6::r< 6\C}0=N ǽD4c=Ê88QzM7Mj%'9ݎsE]/C`J-*0N']ΚX[~ޜA ]ppt Gʼ 1aʍx-4 J*w52]:g7mHlBW:&%}x(C9kqt(aY9*>q \ QBca9):)39j+.bkf|v?^>xn֎ktz>{͉ ;+e|U{qC1~ٻεow 6ͧ/~_MYQ.^2s#]ҝzi57/wN귶xn 5m`꒝8j)u%C얦%"i8(ޭb#?injOXף3:,?z9>5ZoϽJQG]R/=L [qyi7d:چV/(Sbױ0Y PgSONúA'/gi[M;ơxrC- I)\pּ!e(4ᖪx/6+9\6*V(VgW6 %=,W0Mip_F@ױceP[].CvQ?+Bj\1^ȶ^g=}]n,?0M>ӯt/ɡ8l8@m;Y)@1bikYˍnWKՀS2k v$`J1~% $61@*cL 4v ۧ.o1&in]-C#pN./PƼ`iJ3~b|K~t:eNcE ;1la %MY=AX &paK[2fn*TqySs-Y%20+ 97|(~va'j#E|5 =`M F`Xeۂ=^~ T4:щpxrik-x0mYHP5nBg蘥Atb!qgΤ%LG1sg}t]~AOSSj'Gr]'yij|f;DgPq# ZKGb0w# %O-J.*yQ;|)wGpr?ʍPA[ʹPPr)P 4K 푼EV KW!!W|%MO_q FF}ѭK@vcso3ȇlFZF` ~AGދ0ӖF4 &Mfً.5B'|&Ķ!G y)L2 4<EA]i b->䙁>]weZi$EDbu]b_.{醏 $}#`,Nf_knQrމ,?i?]v;)PYxB7h V߻-pf1 “Y6:⧤yEm0S},**FbFɘro3Y0q1@2S!xg|NM~ևCC,2X|7a(hqvo-_Q0:FfE=aCFqePEաU#@N_Co|H#)م7tq]me^S&͆ UM-7 '; Z#jl7PՎT-Ӕ;2r֟jt~{gתy1cq4ڷbo ŷIbFK|R//mB uP8؀1~u egϞmSڪ=cIDLO[by,8Q=zNOFqRL TwB'. *O[)8 }ܩK :L' $_'a2W1' @SP{L{LDو>߂C$h_rɟE[Q)$sg7z1]`zožR_J'İ mh69>gfݳI'oO \npÎF f|pLE[]%7?dB5G;*:5Ǟ@ lcAY7 QIwR1v _QBK~WEvSc g]XVVidCH/#+0b0\E-oB|r/i&笟Y6@nWd}dQ(V*܌h$O 8A0HIDIܨR>VSpOigWw(O ๊u4eoL{~0h khsGS]qeNx𻢼prNOzP!IjGyKPͯϏ :kri뭧-)an 3R^2pM~^9iKQB lNO5U#;)ןt+nС%ا/rd7şOK.ʢMdZ3ѐG y:'·hhYv:&\[vb$͝;~/p唤5ʔ^(/"p(=[^%>܃UF< ymh3n^ /"Wd \[}@ $o Gbj玮f޸-% Iv`jYr|?'L%Zxwp7d܆$z 5nW+SmHCs}鲡w gK!6?O:K .JݥB>F1 %x [r><&P-)"c7թVxe91sE (u\,`3H А2a+ꞟ?[$ݸd6_#*I A#6麚 OH)<)% \Mo8;#k±fq&ɀ,:>x\O{bukA.\&A6⬾ՙK/\5_z F ;.gFa~TP O|&,Fc]ŷrn𦽁%VɫJ`?pҏrp+}Sp@ TѳZN@=Bznߠ͕];yQ.y͐ʠ2vT>~VT^t}f gn@pih)ky'J&dffZh5FMr 6/Ѐ`c{/N2" +v؝LПѩ-Qw‹{4 %PM(h9u(ҚiDk$JVv?˄ۙPH1'vt zgPӠZ}=ONmEWܭ/⚿vvZh{p M \؃ov>B*Ɗ}J/d"it9@w]ָcvȘ o+Y7&^5O. e?#Vcíp !3_9Ëasb5?Ng]{tb'J'NP;nSSJVMy@_]9/հW0*2G4:ќܴ#NSX4/tрI5?/#^fM gtGi?:jf;1Sr[/{ZJRF<1zN1C?iY@ 0:)÷5!q8*bֺjԇD( )oeM:?Gq8XwH[E!w^_)yߠPwATQN~z)=㰉c׭WPm'jRf\rM}kHf gy?⡷FJc zaݘ&QT8ZisI8&xAPşMg҉G> !LL<넋V!?TA+w32;Lz{B-4{#.[wnpp^W`]pp/F7pbGy^rcbId,٥eA#A[FW^G2=X8 mG(_/xtxM#.+<,W.p½_}k-쓳fݻ>6R5!@Ǫ*~4lD>ˆp8@ ,_gHDoBِVZZ6rօd:v8sp8&\(+l"$ud4%6Clչ<1aW%%i/{p8A0}[ИtflItvl 4@G%ҲSgƖӝ-vslD'9k!WÊxjMXe&VACUw-΢Ÿp8X:u~'Hy I.cpE->tf4(ӽ>p_sG]kqEqv`Ag K)YpZ͟G#`Kn7sY: ;%h݌) J4*cl_G#H*@feN;fFHb]8Nppy_g7 p8Xnd ͷFfū?ձo6K'>p9P6lR:HcJ,G#hXo.jj+>;HWm6H%}%yLJDK;XqG#KTD޳ǽobCWY( u1ǵ|n9gj&m4cccF;9G D, ;%W ͗ʀPHzi>`W8Q/~F>,D3.'=fG#p**'Nݾ}=wl2+fĄua3mp8Y,Uvuv^j6Szr'y+.e=dYv>|囵p8 n[72X{8m1e{v-ѣ]?nÛo#PqG#s,U.||6H2# BɕZ7ꏏ=;9f1ƶk8PC\qG#~,Ubbb:t?qTfAb';b h z$9?ڱ?ӯ9G#yِ?hΝ;df M]=nìP6q%%哶m*p{{B&  5z h9 S33`JeE2pB>f 7eztWˀ8-YMK|M9qz'7>kv³mCmi٩[{V+~ٶ@ hۥ tEB` t=7}$,\!&dCV$r(.PF,BOis a -TuLFO)-.9qu矌5~䟸cXTvQEVOHmmvHouU8E8{O=>@%>: z4ڒ#)Ƃ^p-QJtzP:ܪYw;ֽ-3gsiA}=qΝ(]{݌4F48“M=@y5 Qz 7dPo\"s7跪0zd.Uהwe*—:HfB4ēA%u=q f+>GDq@|ɫ_6U7){@p;mo`_"\;xd!P($P"Vd33S=P*Թ_wl/bݔ)SڟٖBx & Dc8u9F?uCGɟP!w=:fzASxW:"z;4s@q:MQȽxNIA}DAȘMbʊ'#;ME8r+Wr_-Þ8&h}@F)^n?uX~ x A`OfDN]޿) Oenĕ KtϞ0}PֻpI h'/QI3'R*q^ <6b8BQևWps<*VF kiG-bMxܘ3Y: LsѺ 5gPQQ^M=d>S<\tFM`,Шt5&O#I<͘O![N4&L][ rv V:#sJִq LL : ܇BQR o6)58&w.ATv0H17љ]LqFfDV0:pDj11 ;HW-% .rt @ +5zy=^gз z/> i󇸮iR/ #C C l zŠf łhkL'XoKG{fHX* * Qǵ FI[mB)G6% DkTﮆ?3E0#\n^ EhYp' GayrSAÞ:4cLOTu M'*_HЄr/׀G]DŽ'C2Z=xPXXKӍ"ЈVH h,diS:߁EHGMKϤl@@!=JDFӨ ɘ14r6Mmi~p(<:{@4|ް I#E0gw< urd*E!(+AH#hf~ lxzӸ!>/h' mS0рD@hF"8326@}4oSׄF7"3*x{9|qkE(Q'i X IA)o2?Ŧ"Ach: __{OAso6M䅦}Ǔ:Ag_QRdJ(M?zygluV]^O 䉂"nPF]Cf `jѸ`#NR,nK45Hϐ@)4((0p󉮉#CAeYFǓ; 31Hk I pzş}[hQPidI?dMKA3 :@& گE:1:Bx1b =J-pSȎFҠQ)П 7O2҄|gR>G\ ZHe݋pU|15ߌAp"s]>Fȁ Z d ;4~B<(o;HmLㆼ$Q@IwRШfro%ȓ?F&$t"iJHД|;fHWփ -3DÈ [nԚrg#p1HHπO5ToP'{H-ċ7`f6:*B_ {!W'-_e+:)?,Fq4] ZWMkoA&McS߂YxJr4e{ C@40 ~nthP25jpQy)_!P 6S"B'hgz6B EhD@ a,vl3˅nS!/ Nk(^2~DgM~^yMy|$rB{%ܣT<χbBMD<=q)I%[ς~PM _ '&  S崌"HI=5*<#-W?P=F.i: O cSZ I.Y)O^}C᫟!F d|N J^-@4LL_HNP¨KAqȘ.?iO#r Ң"/ rǔxOaȎp!|x> R61En];m=qb&q>G#`9Dwh`#H}8Q!|N%n!y.M;B5ևfPޣw?X2jGm!@&JhhݑqzD3 ;[]'On|Z&CSWGZ]}0#Q;otIl)+9#t࿆XZAi:=xPmB= M#[nt6Z7M?sNh)1AwqX/%nB@ n8nZ[}-fbc[lwo'p8(@Eؚ(g#p8IkFp]3+ǙG#Dl1Tb!lylG#hX\ @bb =/9G#pZfPuz޽XyG#It7uŋup8G#X$e69ʓp8G @wXRRj;vL0dX A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs  iTXtXML:com.adobe.xmp 2014-01-26T18:01:77 Pixelmator 3.1 1 5 1 72 72 82 1 32 IDATX Y_pcz1DBED\H  %S\Hn"Ûم1}ZRRJ,1Tի *ԩS'Oo߾ݰaCH?!A>Xb7oVZLYIN7W[}*)m2D1PY3 RErBB$fIl$O 0~KSe?ߺ\9+W~z.]&LPr團;H]\Nʠksyv=@y͛aÆm޼YCVvJ###+7xF2RG~˗/_SO٭~K-[ֵkW6n#|cǎ9 #`dﴜ}:عsgZ֯_ΝQF]x[n $gϞݸq>GU{^Ν;WvmPa!58<3mRѷtA7nԨݻw[l҅$"K"pիv gWՊHpǎk׮0`ۧN*)3.\РAKJY!JGDqV aNT%uؑYU\ɓ'Def4kLs΅ЪU֭[_|ڵkgC!G ACZpÇ׭[Wmڴ@;(E;`e4̈%n~Ĉ\֨QcBeQ uV "`T픗/_o^UWرc^{n68p_R,u^xqNv,D?ig1 v PӧO2.0stݻw_~x Fޖػwo^f=z\r71c03L޽{nݲ8hz(؀Rm(^_xqС={W8O^l$¯MW*,Oۘ Pʩ,çy8τ!+"B(HY\mGvHB :]j"(>K=b@fE }д.6l8{ݡB2r4+|J/*5 '04.':f+j?t889b?zU;?M$}F8&B!`hvJD&=y7t2c<;gάP(>s̾}VZf;Y. 2h nno:%(CHzr;ܻwu뤬EKNCtK4in80+\ziTFjp6mڠ'LK;q?w1aMhyoI޹sgr?Rv=z(FXP#G\d:o۶m˖-~Xq,2K-4}4%24W#˩-MSXaORf g?pOZ(ؑl&(,է;ʔu=^B§,+ ̙3](6mZ ?g2^=㰑ArčS'3ɜp++{X|U%waZaN3h?6ٵ˒A!8}Nځ\!Ba({j{GiHV as55 FnQ&8 @J*)eӾo1 Yh!oObX(G?^/RIENDB`BayesFactor/vignettes/extra/socialmedia/0000755000175100001440000000000012452540640020101 5ustar hornikusersBayesFactor/vignettes/extra/socialmedia/png/0000755000175100001440000000000012452540640020665 5ustar hornikusersBayesFactor/vignettes/extra/socialmedia/png/48x48/0000755000175100001440000000000012452540640021464 5ustar hornikusersBayesFactor/vignettes/extra/socialmedia/png/48x48/myspace.png0000755000175100001440000000104012452540640023631 0ustar hornikusersPNG  IHDR00WIDATxˎ0FLT.5^54]|*k!t ~iKҦ\.i#;F@w1ctGYl6CuJ*|>(az]xid`D p< k !WV{( I%&* "\.6n}ĿBD ?B?ɕ'+( ~,{.sJc8VK܍zjo%<&xѱh4@6m+^|5 `ٖ2OGU/EKX=,< lHy2ӌ1m)Mm`bmIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/deviantart.png0000755000175100001440000000307612452540640024344 0ustar hornikusersPNG  IHDR00WIDATxkl[uNB:J+#lEJ &1mB+N6iI>Lci&!6M+*mYiU%Ii|[9ĵ)/y}}+?FK,f|^mlmlmlmlml;.-.t]8LdD!};8k aEĽ+R/a4MsTwM/_a!zoo, W^ݹ(XT66yW4;Zi81K1`igl`vX^!W7d@|+nqPQF]a~%Օe"z҉x{ `aǐ}dcgfIM@Ga}8dCzm݈@~΀A>J\Ÿ+] } ƃo<õ NGpj6r ƪ\Q5#0ѕEsu:jrΧZ/Qr w}USƣ{KR D _?3'?^db~ufjJ>˛/E 3wb!t|͘CCo])dL2`xm_Ţ^w*A4TyO_k=rl{`1+b,F3>o/BG/^<^,6$ }}f@8USՉg?:5y4G'{yz5sRQak|?Skid ciYwL?woc2Wk4-_|G9|f/0:cӪ])h|KLĦYD(UU3V۵la0}7 1Wfg)PX]&nl\Vmo4sxh?o$v%IbƢ^Yt^DMni̯Pv0JGW:h@$h I s7d6/`,Mi{ 8EgF MqEYix0}cq# x#LE/Ws%l`xD0Q.q ` 68|ڻȪ/ȺIl*Z)x)*dr Jx ƇG,d!^*F/Be&vHGz^4BPKG"I4$ ›:z7}jqotd0'S:eZlŴ'\OŹ`C쏛oG[2\<8Dk;x8X  Z0H`>v=ƃ ֌ΠAnV,)klx7l7? #)/l.5B8=(sSM䲥&F,MJLԵU.Qe|ۨŷT;xet"|6˱2}}xsid%xښB`.|uC\.qF o ҅-ՍԅX7:S.r<@56 <` um8x)yb૪ _u:6x!vbovR\s}#Eöfm[z|u'"&S](IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/youtube.png0000755000175100001440000000252712452540640023677 0ustar hornikusersPNG  IHDR00WIDATxmlSUm׵ev 0cA(001/MH4cԘ`P7cM x am׭-Cmwۻ _z={<7uqa) P0ںoh{kޞ x M{4p Q! Xf.톅Wc8Gtf:[tx?u]?rSm|ruU:z<8ʣƥ?Nݻq( ˖'E8+ؗcD*'~';_@l`͆kTwADr\'dq͝G,F ,3ݶ#2mUzyلR.gL1ip[g951^\'l >i~IY(cbKe%рs#"XlXEx?2xjl6`TTU1ixf"U /~ZxfeGٹ=B!{'اjԀS҅X<ٛja27dTs1&7仯6v=xzWi+"LV,&xAFV{ط{fu[|r|gJ@UDR]|3y0' d @,8˨P^ %d3jkrN|1o&|,TȈ5ޢZ? 6[b o8M۱?֬d=߾*5ef*8΍-_~n%KNw78addKNaTecوBMZ*jٱn_k.(jb#jЁi޴jTq8tR}=E3g &|#a DpG"v+/Bٲ8c4 bį6^!xB(N{`f%5qHw 5 w>C`&!r" =@`o!jE ob^Cџ>M[8ZCrK7#S,xzW1) <7`_Ls(i!.׈ve5vDa4jM;󩹪jXp AqIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/email.png0000755000175100001440000000200712452540640023263 0ustar hornikusersPNG  IHDR00WIDATx]sUR iV핷\X?@hm!8m_X+H/S1ǽS-`Eʴb&!g7g^%ϓ'3*iFcO H:=C^95 /Eڀ\zn}1NB1wrǝzt8pUX_D%| "g>8yW*Q pa2f@yf l "Sǐ_t%n},|?T lSr V/?Hְ{==b. R(R͡o95  | _)w6S*AO_J#@JP)! |m4|~o (ެC0v=Hzw ͫU6)dm3Ҥ`iO,|)Di~ / >x[݇/(͡w#گVBˉ/(M8uL/#,$^Yl9>')oA?vXZ~ܒ"uzV|J|p=鶖 !WfJ%D6[" y뛉>uw-q)T]Gן$ ;MƓDxBGWƼIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/app_store.png0000755000175100001440000000333112452540640024171 0ustar hornikusersPNG  IHDR00WIDATxS[} ! (SM/Mpę%omз/}S>6ͥ6d(UH@I!(x0Y{K{k/h{)EK/&.ï߁O2V7k[tԷB_[n꒣盗OQ_ HmJlq処{Y0R0a}%5OD,!)x`}e%1%~:<\x=vЇcSD.ৣa{h91~ɇe U9Svh'U96Y⍋!BY{l9id+gX[`fAP]oo]iFQ%4-Kh! Cf1B]s^Sܩrԣ( B4U!R&N ;$D#AT6iO$U+pΊINS#/{r'd#y"Z "~~lnOCOn8w S:ϮupL+_޸\8W 񧏿"`f\0NWv?:o&Iz+߆MKTP [Mav*J~ wcا~.ykHgF+[u͊9J2:x/¸]6vRv5raȻٱ6LNP^2Ҋn+کr*|tk|^x6x> 'v6^smh:K[n{Q*+Bi p` 0;_tkwVsLU+šfVQ'ɣnGBPkFލMX-^ ?htYd#_oY8ue\ƒx~8 c%5SAj:` HUVxsgO#x] wNgᡊM`|n^ヿ<#QXe-~,>\jV ㋩n m,"v-{& !l2Ž ZNa* Fh}FH-m4T"b +Fe6_$N|sla*<c8 j6'ގ> ^]O",qL?ljE8hmE*Vَ;-(XՆSanAK[wY2H%X6Z|ex'r*!`4Z ֮})0VZ!ng?IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/facebook.png0000755000175100001440000000115312452540640023746 0ustar hornikusersPNG  IHDR00W2IDATxOAǿ` bm$ AR??A'^5/0i%@)M"h.C=Vvwo-Ii3;3 =S[HH[Ox~(|b)X3o!ˮckB+qɬ;x "w?U@dМye#q.U 30" B)U */3&1ԾRī{4Zff~?!:`G ܾվ] ;9شU@_3' xqdObxO9][g/0bڿ5Gq>)z=:Nj9G@FWJ )S(,.jPG`W%<-*՚5DWO3g/N,R!N_*|N|mdb_} F紈OMuQ#i>>/ dU:vI?.#[w`Tc3րEw3] Gm`t6/Ǒ!5VJpba7WtM v\;4nS߬rku]HbeC+蟸 {]ש}|,` Ƚx%\2eP*/ʏl6φn΁/WG )Ll.YGZIgx~gnpl% @G|oM;&0d<fU{"^dy kmOu\Gp%o9;5b#ȳܠ]{ , :r3e޲"!w7k 5$i.>BfnI- !:^5 Vkۖ zM?pg*|l6[ZP,zB(MߡՁA+7W9׍GL{)%Z;t%B~S1Nu=fa;1>YzyY5ǝS~Ad v:-tپUm2Sdɳ ߩ6)5Éؗ%й zP2wF8ܸ6k!vTGEZd:=ic&c %ᡌ47SNi۹ `0vuU Gs /q(;m~\*kBB{3ANľm6~ߍC.l&0k|\&k3K#ZUL#KD p31P1|$󖣓|4L䢺NqpD2,"ŕEy!x桻z\'y/Ӣ% <& |ĭi?J`.lc l >|J$, ЀCi_ׅQTRQǮ(ʆ Gh`S á^zJ&]% w9|Rw΃_h"BqdIhYT#e<*w>nFz<\Ɂy"(TՆ_(nP|UaF`F(a}JW%戰A2Ī#ڕmIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/odnoklassniki.png0000755000175100001440000000301312452540640025042 0ustar hornikusersPNG  IHDR00WIDATx[lUgn]eR)W[/@!`DA"A%'bB0!!*"F``%X@D i^mw[lw o3ẘq&o7`6nU@~9䖀5a6@ih<}]N) *`Kw[IˏكTؐ)Qf yq6dj)ܜŗA XCG:}N$،=Kn8 5u\7Jsc([j}[@ ĚwR[xV&u&[˩[fFЗBEa8ĥ ~fzZ.k3 +*үL * j*Q^gkBYQМ }L0l- w4za OQKÄ>fh6@`uy40 Cr,!3qE3Z!JHw#/#4o?>UC[v"]FӁOwO&;NuA e'[dd"B"7't&A(LC\dh>u @͵j`@ ",x[kB~s}'Z9$JzUh*>p0L#Z0ӹ=H-]|SW[%G.ZG@U/E ߠ; !vF;`"=jbXXgz46 `ر3 9=Ńn(|S>ٶ4 D[L)r 0/uݛ2|B4P•"ҺbՈ}5W|r&ܵ*]ّC*uǿFlM >[F#t]d0 3k7QDڐWvƿQBA@SG/ 2wpX4WRL^cvˆ4ed6^`|+֓;wŐ;KgʍH0x!|8M2 'kb$ ߾M04ޘxTM\U4I]$]71)`=L]>(?ߣuG։I j٢ ^^ۏCWnqm]ShƚA_~K Hź}Wm'prאC[n1 U\ F]t7l恵%{ѫL]`Nݧp-1|M ff|vȴ(p;92z|B7 9{oX jbL]a5uY:?CXcEIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/digg.png0000755000175100001440000000154712452540640023116 0ustar hornikusersPNG  IHDR00W.IDATxMhA/FD1JcC{" n ě30H.!dž_ 34P,}&0tnjO=Voų/}s'0r:*@ |K}BC0̀UR\me% Y˖;Q>+mc[dMn]Q|d@'NZx9w~4%LYp@ o=|w{Ny̾(VT6bI29ƽl;ddo Pbs|ZgZ&jLc.᫯5/?aLt{mnhFPWP<||lDqLD8te¼ϋ Jg9Exmt!9^NI箢qL\5butV5Bgt=>Ц `fBŠ"?W@ʥ]wal:>pyx]p'v/?oȍƃ6TKG~o~md806V{E\sUa k {16?՟lKϋ oҖҊN҆"*`.GqZp'XH@SkeGz/y 4my|=efQG0g9Z^>\23 bPw&FOk6UW b aW<6{ d#0BP|~$/ap8aQ0^m/ ~%Kqh ^rar$^bVEq*x#7 )* L`"Qc﮶V| m}>}dHOYx|˗/Pd=XSwG5S‹@EYǎϗj4+Mb?.==̽mc;vN i_ KSQշ$ c-<:qZb5ɲpڛ`|ŌE:.^~oz1Q8\..S{Ɯ57}{уGg_ ,p!{yP㾮%~޿E/l(~UnjEdvͪ"Mc0W*qϟGK/0#>T篢uS@p㋘ԌhVUZZ3-H&q8ژw=~-Rf/TJDT:qǁL=Jߦp}bxjw~x7Dv5x:;q( F"Ar~?$+l&k&@9{mAtb?p1QtPpL@ 0-(4ǃJEjnT3= Glr>0n#P?u۶5%e@}k[${laPCz\״ _6uB]- }`qsKCࡎ. 4.%4:  ވIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/sharethis.png0000755000175100001440000000236512452540640024175 0ustar hornikusersPNG  IHDR00WIDATxKlEz4iBMR%.pC N8ܐↄ"$T$-GAUA%)@CNql9IƎgJ_,fwvof,/+s˵]뭻[w xf L7:&Fs`;^S 0;Ѫnv"|\-i[1 ";nVpytVܦ8H?:ۄ7Of6."J0z\)hA"* 5ɧ̆]Ľb o YGD@D!n{G v Ak  lyR :`aFh2bNuqLh%yc,]=osWm R<7묛*o_9[ǹhmޣu)ãFkhoE\_=ȹGƏ޵q[]~eUtԄNI/XJ1S%K^$_@hϘQx5exBDA +(0e5&Vt)ɔj2<B\PׁFʧͭTh;[ԪBY 5ˎKbJt?;$'3V/ A\biNYe,r3;jNalYH*3?tZ}=ۙ{hy'؁(PN6A3q^wD HiNfNq~<9c)UhP3 8QH149Q{B LDR(QrDIfLŖFZH6y&ӤI1Ǒg[MjVA\c`,$Bfޜ`uEg.L>* fN!c#O*DJ9~7orTIsy&)"1Lb #KLLLׇ<5wⵑBJRNFK[tN19$.C>w,XtGGLNN>U'7]^K 9ΏxWoc aP1r(to|/NсRQR)DFtD*iy>ⶆO~ׯMݴ><4_n!&59̙^*SHСk1ID,b?c7PԱ1zB".,.05Eai[I"rxu,b!@&$Ln;%V"$t 9GD_G44/kv^^/_H~?w_4M\WT<=u UYc-n*+ϟWG`Ÿ*9U񺇇 BuJx٪BW3 RuL4n@k x@ƶ6 mo&ܥP;y38q*[;y$S,6a`~i߅ QO]==?_0?_ &륒GUMr4Ic1Wro/C!+JU۷5c0i6b " okd5~9{o7o;Mƴmy>]?m߃iρT 3;z ӧdrSS Wv/X}ǏxH t_Hߙ3s$/_[~#[4ržӧ=z bOoaЦ|/494LXv7RV={Z5?! |z##͙hMKn`0FATj9·d)lzix0Z1~·,~6!( T,D m(?f['NrnIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/vimeo.png0000755000175100001440000000244012452540640023314 0ustar hornikusersPNG  IHDR00WIDATxKoeoK[KӴi mJH b.ذE%$TH ,Pnv XJE"Bm4v{gXL֍3Ǎ*]f|yZu`I; Юv v v v 촞xJr}p<C^K *I#Z] {\ .Bq |0 ϕιhh^}npXERј9<@ẁ-Y6prDF.ܥ,G%L YYda) ec=$oR̦k5AnFA&D)o^ H7%R kLk/*!BDIoҀKDG> 8*&T29l_T.Ȯ-5ai6eenW"u;*g:6F^mFIӫ@ [4p%bR*oz&BD&SuKŞw$I{|60TlV TM:¿뙆M kuWJm÷ T (E 85e&H(e6 ,㧨".=~/g^U?e4ͦ E0%K89ч] ]t.̬|dL ,iuVdi;ún>/).Dz-Չ+ZR{~oN%T 1W:#%0G|H+"+m0Zմq`G>UچwQF]_UghEIʑMnmd[QxG恊J:|r}gYB~2g&]H/ZCw$I8c}cèc!x&F&CL8߱zD}<<h c;^B5&p!$K =j70T;Ķ T}Mx&,B IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/wordpress.png0000755000175100001440000000425712452540640024235 0ustar hornikusersPNG  IHDR00WvIDATxSG֌@`$ddK (_xlTdSyp\ˋ {f$] %3a][~4}9}NOK/:޷-C|H$|x<dYرc4 EZBP@UCy{ cbb3g IrZ2<?3rFaQ2dddfW.9~8|,Bʶg9NN>2(!4 MXY]ѣG;xI3k8VWWY__aXN޽{6;EUȲ(joM] ul6˓'Ol}.1+σQu%ijl~NDJbu2  -۷S\.f?91iR4≸U;q ȼi =J%^eg{{ T*ph,jͪ@Z%l'&&l=k5^>wiB$Iӧ~E8`\f,(Kv @>l nc77 uU}B@TO&v0ھn4h l6Zt:\.`X vx!2y]u_Q=n~6x!S>t]'LZz{{iۻ zuWZttqe#anllHf6?'Z NozfOj׋Sv0PȽ|}5x,#JvlζA,PӉecc( !G^φϞ|(Bv9ǃ#HXfFL4EQ25~ @A>'|WVWWQUgb<۶.*J#`B#ơG//!}|IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/reddit.png0000755000175100001440000000425112452540640023452 0ustar hornikusersPNG  IHDR00WpIDATxo\W?;>;^jgЖTF A п*( uAJAm.iI]'؞3=<\f8N'By;#/C; 㾀{= z"ngs:A}]#Q *`% <56 73EG<ĻKvDʾ #඙6xV6ޙZU4͂úo4ላg:wLo3zvB!z<~jMkhRz'WNH*43^xCmwO/b%o\䳫q @)DuOtm {=Q湼%'m8Jhص^ a/UP~xX?utAoTJ'|\FMX;k7z%e^{=Ro՚#\^.tq)UC1y<C!]UL-8FlMDž{yyܛ[$r9>dmJZGq-L rrK43kś-츏ρ78{5E"[|[ºU#S\eo&9јYmzeTt섏q2b`Mj{-ptKMv?2='t;R" ٻ !]hB)kI`swio{WhO\0r&hTJ}V;͔IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/skype.png0000755000175100001440000000265012452540640023333 0ustar hornikusersPNG  IHDR00WoIDATxKh\U;3Lf4i&j -U -Dwn,tʝ ZT`#IӦI&;b:L;1<8#Lhتn=2zd`6ܑ/a$(JdcU6z0+ya< gʆ!S^ tk\ ~L@i ^lW"Ưc 7܇v8-8P7l`PdHpp@$M6൘n۴/d*6+(F|>J$ .m* Ό9 50vcf#|]B!%XXߗR\8<\3mX}Mӯ#P(-Y>ߔuxy$%#8[?3oE^\^iUA T NHoi۹$OUxIsl.)ry}5L]憜cvkl4_04owU(.-Ԍ351}X8X8H]n?nA EXdôzř`#A*  x*y^eE pY,6@AQɑ] 7n&$o2Mf4[1j.v dcsa>y ^K^4}٢REUA.7Λ.+qj(ύpJk:)BVEc#|*J=ٺvԀ3e`^Y׹]Z&_ҘK+̥FejqzH$z>VR!̿J|љwP!6K^S!wݾNlׅ.0⩝HO<|3c:!s7Z89y~W^9tMPEe+wN1oku%]xH  ŭ'W*_҅-䭼;#*7p8xB-l"^9?)XNm.ftl@vTImw,.˜2rlh].v+vI "S cޚ4<{ O3 ȱ*@99}'DB-2T^lWUGP]zdw"@G[AVO_(XKᛲ mn/RxѪj*xh'&S&~@Moh‡5j*|Khl>I5 Zg-ȦKYKIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/delicious.png0000755000175100001440000000060112452540640024152 0ustar hornikusersPNG  IHDR00WHIDATxMN@gʃpl=ͬ=̰v k zڑDx t4K4?j࿑lSɺWjs<]*BY DuEJ$@/0K^^Ã^鹝S-L[E6"xH8H4j7}=Vx1Y ^U Gf-=0 D~q4(fbÃZm枉 ڑU ofR4YjWZBeY~bp*b"\IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/stumbleupon.png0000755000175100001440000000245512452540640024560 0ustar hornikusersPNG  IHDR00WIDATxoTU?gf:ځBQPGmhPVpnİҸ#!r(HLQ&P "P@%a:miW;7Lޛ7?Hys9{;{9 Pj/jy{\фڰ VKaxn^/k8)I\F=iF)]O3-O jPG^@w.bGY/]Á؋4/x–V&{D @[Ƿ{eM$%/}6o/zhc{D,@VM(Ým*jjȿqE(}'qO ]>@%ۏ8X.f}ޜV @_ 3"%;BH()Q9!hiM,W ?z-mކO|C4rP_Izx"!Fv2}40v&gK!d lZV=o|-DRDWx}u)=KsO-\@cOlW Mo||vЇ{xhqN]YO ؼjy"t3poѥCn{U){V= l}. m& .ݵgwk/TMU͆4^ײE@3AT"*X<$WYS `Uz{D]ˊ]oѷh l^[qӰͼ>7Xlb9uj֔`1!>s 1/XUHCE 3[61`|4&v.[&Nv3vaB=&Sxڟ<`5K0e#krU)--*֋ԷlYWO2vӃ]fkW7ٺږ8ŋE_"z(3)|UIeProv^x JкC*x2j%bC8x!GыS䮀"xt7NUB"Z.pTv e7,ƙQ W@/!wyhypӝru^'}<aIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/apple.png0000755000175100001440000000204612452540640023300 0ustar hornikusersPNG  IHDR00WIDATxmK*M1%R4}^} {B4E7sOtXcqC?ŝ.33#nnnL |7|w~;u(fIR(BVݵqNOOFnr+{ ÜOшvr  )+Fu"2Ng}$NW*h4;|ښ^5O' @4dYu_q$Au:www Bh[.8z{9$In7@up8L" ,JD"r9$pdh4#IiGr+vfB@&! 2vzU M;^oi WBP,ߟM$ ":R ]AX& >99Y I_pyyI`#~g  >e]kDžk(`0X#P(DXtO9'rr 0v%E&9q$f tt:ivu}#d2:_Yo_d2a8~zޑ@"O à,u]g?I8]yY~f UiK ؍zP04?0P'"Бih,J,[~j-uwO:eΦeafW \\\q$0 <T+ #x!3xJ(ǎ $KVsJBtIhZ~^{>*cxWk l6!ͦtZ5/h4\._I4Mĵ#IBIEQES5W⩄iT*vww t:Z-6at>d2nKZe2΅4Urt3`WK0P(36;|~ \nm lv-z0N}M`VOx_l666cH}%/آP>=IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/evernote.png0000755000175100001440000000246212452540640024030 0ustar hornikusersPNG  IHDR00WIDATxKlE]{mN@uUVBT(xI=!QEEUB+RʕWBCE% EZ"ʃ4؎!UDZc; Hf~7_?eC6[ lz;eqq<6C\bA+rh"!=`%)BexTL*›F^*OȑVQd Mm.S1 Y^ !@ MhYۄaϽr? d_3ƴ&@c&LS\K "s1)b//F:![݄i)G3Jfc O,,2t"Ct܄U#D+asLGNG%t"˒?!o SSޏ铸ն F2K,XN3u?]gʍdXP$ c!Ք'&|!2zD(erC~_n Pfr>}\>g}iB 2.j1D2~Mѳ1)xܲ^d?Vl{2B \ \D+Mt;h=.d../Do%]՝&8ʣMkкF׹n 'L0Uq~!)xJc-"\}[qv z;QJ, ,R5PwF|T%.uKh(?W™y)xEfn[w DH׼V&8D*n;s.|Hfԭ(#0oLH#Ҿݍ+b]: ", :lIlz |fhMh*F:!bzsUcW:КTIw7ixX=.SWf[1 BXϬuN<>B\ML\%G6F?7L k~]Jlsbs(ߐ̌::~#sw9PjC7$JLtڱՆoX =v 4~S 84TR# عEC)u#t"cIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/blogger.png0000644000175100001440000000520612452540640023616 0ustar hornikusersPNG  IHDR00W IIDATx^Y[\e{n~z?4Ж"h"cĈ ⃄#&/‹ꋂ@b!RhKsf\?~럽ηn}7n4yA!@rWg;q3h!j>{xg<0WOxB#@(,ͽm(?D" /$ŝźS0B#ŋ'j+:pBTq !r $v/a"#>|8YKn/>v]G hKp #^twp#6EVgO6W@=Vt6U.PU˻| T~[sϾ_Ƒ/;uLd6e_^֛U6Q.v@ Bw$%)QB R txQH bw|TAcH \+J AtNӇ@ҹZYQ`$dHt`APM*XP{ g5D C A0B&Ga\KPK jFю;" bRFZN 40zʕDr"03.;)y* C$-ɫ@ P$S.TpQ\uJV mdD&RBBU)3I]$rIRRT$|@(6餎/]2xD B@=%΍㾧8UNb8 Kؽp*%U$Hak-y⎫fd\QjXDN6N ņ-uHK}S!7mgƑ `%]+Xwåkʡ q`%@ʉ'Ў锬l=[N'A A,|!< yȗϿUR`?]TQ?*ۨ%dyrDNN:q"ZG7|16*YN36 0Bt7aH Bba (Uc̖hkFU309XBGjCJ/o !%:Y*kf&.C9N%U.ygBl# ]C*.tJg\F:3}O]ٷxR[B %]OW;>\%> 홅@ZԸ zGű:>l=]>Z/ov^JG;'7nT|Jy|!{OTB\Q 0fɩKq߿\=Nzja@2V dBSCXތ+f}:? Ͻy * =s*h,  } z]˵z)ٺj08Y3l.0B9]7罒O@"lA Ax8~ ]?0R\퓻}z>6ᰗmsڗgOm:8PEwzOW~痯ᄊ^8+;6޳}M7o[\~sg7`d$h4S%ƣllĺuGn-\W(")jI&y)(1 #a [ƅ;q h!$ C LOObc0!TPՐ)y)\>(P(`ll+W1"ژ_LR rzUEİ0F|A q.P5*A$@&E>C&$ƚB.l42[L2EIENDB`2690BayesFactor/vignettes/extra/socialmedia/png/48x48/rss.png0000755000175100001440000000335712452540640023014 0ustar hornikusersPNG  IHDR00WIDATxkl[g9[bǍѦ[;ڭ-Zi044qiR  MHHl@Q4X%*֍eӶV em&$'%>9c;ɪI}(Ϋys9''l>˵p톀myrݞgۂ30; SM&ċx=}1\(XD{?c&'K*5 "c~/]#ʶE,!> ƞCU9~/jzCͰg?Oi8_q? zV#(D]{h"2]!U%B,l$RAHe#7u[o z5,`hbg#!@Cr۞{j' kx5%`J:܄X$H߃#~w=L5KkAх6GdOxgcVC F_8f2.xAV[?O~O znN 1sp/]Kb3ur~r#'*)ճ{\[=3t6f?${GE pFx ,]&qW1d|Nom>'FrÞ)Ud?zGduW2XG ?_) {DݏQ-&3F]IO?< #g0,r$oa@Б2< /Co;xoE\swG+1mk ;׸L;OZ:t ȻexFѓw0r9(#z.xYJ+tj5 `7=CҔFUaMT.0s9ov`;- q'xy$Y Okb H)6 `.x!NVJmUx59("L{DۢQr5T0*|Ԅ4"/<'yLhIDqKlkYoBҷǶLԉ!F_x/`L5 ^MOf d]--DdaHzZJ`x(9@'MW*C>ʥmmogoycGs煢kL K1&PMcm:ꭱx›Fu16.@i{kqߨyo@Wx6{F$2T1P) H 6@2@Uh>nxt5 ;'ɀsV})L HCL“f煢j^Rzux*9|ثzHn#2H[ȪH#o!+堑WBVe<aO.NIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/hi5.png0000755000175100001440000000213112452540640022657 0ustar hornikusersPNG  IHDR00W IDATxOSg?ϡ( -heHPdSXTlnob̢^l˲]f^f,ٮ\6]\b:VXO۳ÏCP&ޝys>ym*ZXU΀Z9V+gj X3`{U-񮋛u_^}L4 =W7`=>NqmEANj%޴ x2gB7{|i}0(K;'ᣧ+uѼ[vDΘqD@D ;&5G <~F}M: ( o{Tx lv?P@4Źg4zN|ԣC t PAHN i PWccߺùwYLq5~ȷwfU JzGE=eYfs KĀùx4/L_ѸU-(@Ǖ{OQQE^<;B'%#ԜD+iB߾9Wlj);M $L<K߷0^V 4F X$ Gj4i6=')( r2~( &2hQT#fm$0Gjםa/uv"uN=>=<&iJ{rTJCxt{.\Kpn"`O"w)sB6Zlu9eaFQ_W;׿$Q́cgǺ 0kԬ<0tS~  N25ί-f [Ot$[2OݰJB> ]hciBze ^?MVkgP>)D'vo;u8rն"{q׶_wj=k[yg\^i~TZ_KT_a T ƺ-&6AkK7I5: >+הm mb#U:=Ҭ‹n IIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/vkontakte.png0000755000175100001440000000165012452540640024205 0ustar hornikusersPNG  IHDR00WoIDATxOOA"b5B@%ƆD=z`04`zlc&$P|Z̦h\t"P|oaCUx!̮0 5S D+}'˼|]fIL L(YhlJѳI2Zn|1=#}`hʱ} 64Sb36ic:nBy4d<΄cj܂6_=pb]IF2O%ڛ<\;݆2_MBJWM(i_kZzu 8h0 &|`ÑyNtbUQBAl^ct*M ㋦5=ME%D\Q ~Hu6T_RQTDRe5=`_O]uRQe ťfӪf ^ ԬB6y85-YG(2pzE-ptI2 *Ts$y-xe=RKYf_D6؊{/`˰T =(|UVP1x*sBqt᫾5l+{Qaq׶j5|rxe C)<S ~sIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/orkut.png0000755000175100001440000000263612452540640023350 0ustar hornikusersPNG  IHDR00WeIDATxݏUtnww,X%b"EQLPxT  @H4~%F%@\]`YN3v;Ƅ_/ڞ9s1#[oꮁ]뭻[Zma  eÔ%5 +^<Qhsסv$dJ ߺE< [/aea6bx6T" q{C(!UI ^5|Q)\x}:df $O]'ufL}: :P{hQW1=7QqR^2}2VP A B߾1z :o6|QWXse ~O/4"ӟ\b)ƒQoѮR/2OIn3 eY S^d%.#fJo*p_/'7&hÃ8}rKw: ''O /dDcE )0٥U×CV!Aѝ0OdZ4-(J0*aVHԌ#NVݹ|``9g R;Ӷy=0@\qSYOA6 ᚶ!QH+766v^bkX٢#/N^BO4fS:\,qy1>5K+- _hd\X0EQSxB7Zm+ߍ L"uOE=8dnExpėC#gBtW#NbzExqelqGo{&|6,g+‹BoνHﳛiUW SzjѾvz[+."U~]nlB8F'm`k =O}zxO׷}tc #[W vYۋ dS]8~?}|3STx7F.M6Po81iۚʗʼufwgOQ.-N*tnzWϻ_0ڽ4l dg&<;6`?i%bDp@8^Z؂k@oPH mo@-+U!I@PL'4 La !ZN ~NGu=|,c F.eDs`Q>txJUp,۟;mGZπɡ÷-L yAI|HKUe<IENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/livejournal.png0000755000175100001440000000571712452540640024541 0ustar hornikusersPNG  IHDR00W IDATxݙYpTWz޻nH"V+˔klc0UJW%rTRSJU^!0Jf⇉6q d$Rwv70ts}mg`_7?:1Lo^:BB|Dn)&Ak0gD14U*Eeepaח :^$®]GuK NRtw}n~vU^As 4W i '18n}QJ"PF[`χ"+?޼+RɺA7yJ&$&?s V6JV?֊۩WyA? MlY!ټLb`<:ﺣ\KֹfѻJַx`u5+%BW [FI:g^7 LMx0y0Lv&%{o c4(,o]M{5a^x>w]Y<uexW߻Ĺ+1~M~V)$nvkUO]AmIcHT 1>%go^毞^ʪ%:l^o8E"m354׹9~~TNawNpDZ=CWG5SClߴ搏)9XjmYOg6XAp_}8+pg.9{9iB6?LAjIIϥI԰9nݪ LJ6(loD:6MPgT$AFNV/ pq8O|ӓc9" $JAP ]j'zLXîi z!-"ԍNgOgxf @>4$Ooi { cSYZB^60DV7-ƒR$a[mx$ |ɓz&>!tՒwOĹ21ͱe]ޫ NFϘ BGr$33-!?O^AsȍHJJ)%,ш$M;|U9&Rj.@00fp<v #9 r vjiw(MF7Y4;+<,hmaAKptCgWSmdg&d?M ^U;g̓VOEBviDnVx!K E|g=4T=h]噇ck4A*XNZv?{?#7ɑtؽd+^{/~S#`Nya$\a"S}Z,ϿG[jٱk97+Iv=b#BU24γal p\Da^x!f i404,^P8K4G4iRi.f<6oٹWUq_IIǂzidNN/M)1_t%XeZ EOsKR,!x+ qR%PK"j)Mj`o+ Tͷq5`B{!SA6(,O D 0 xs)焯 R0KS*hTѾF:gX+T)'I[B.[If w^d=# &xtSݟP"B Sʉ+xFz0z/@ϰnc,s/^ISԣyCNX"\vwԱnQOr71#<ĝK86c{,L"c6Bhx-kl_`d*ϯM1/|1|'^>cr7TDT\be^#:>pvv!܍ud[gMdn<|q &zPj'6MbHh ?W/4+d O7l; \:lBA.=ۍ.\L+D!e_<|!t9=~=JKCi6xIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/dribbble.png0000755000175100001440000000420612452540640023744 0ustar hornikusersPNG  IHDR00WMIDATx[lTsv^^^{W0` $@ BhMDH-}UyXEBZ*R4U)M jB iQ@ LB}k{=ٵw`P%w~|Y9Nc6# xH6}zhvCC%M,SpkL~RB!M$Ho^@FceشlY՞ E}$:ˁl5cw{@9uMl ӶX@,PI%|ppW%>Fй;mI<ōNxp\1d"Iڦ{/ޠo FH|dj< <ٶv`3Q~O* uQ|d,xkU+4BkoYLc b> .3G P3?Tz|lO ߙ@Yyc_M.EAiF4P17 O ɅU'7TB4?͋ .L:CGmJ)q qlZjFvHcx4jr30#lU)$Q>!L$<0Fr: R̓H9ݹ @'H J֯,RGO'5_GF29d='Z:t4^>P"Zx zEwpd7R1u \A_ )]ـ yLщaEipdۋsFmZgѷ?&zǣmE0%;V0s'1[J)%Zbʂ_:c F7}/٣m\ҰEB ڐ֬ہ$͙,I4uMj|z~*>}ڂ:ńC2$냋 Jyc3ܾQsX.lW= +m\:#Rr/h|Q ڍG`tکho_' ,zHEzG4?uͫkiSK?Y^P'I^WbbՋi:_}X2#1\^j.M͵x]ut"{]#2ndSH T'- /a^bnk^8.{$'f|t$x!ʹR΄@&~JEbLw, ^+ֆԬ&(Vv:K_ʚ[H'Z}v#ͦT+T ՓK2籂O#;g/pW "rk̃d=JK#(sr=YQT]cܥ`.lĝ7yoٍqD 5v"QqfɟGh_s)_Q VwphX~$Ás *S1g"WZ&.24OyK7_afCa"cDǽcR{b`DS-Wy ENb[/zduZĮ8Nz7sė־WJ@i+Tn_) S`9T |J&k1lWJ➁Myn&uY6H+KrrZ[ٸL.^3qFUr>eIG+0IH5uky2zU2fv[9p,f/1[/n3u~TVi2ڢ*j;$lxiV@({#0u` "*=w{n-fA OExd`a6 >zw`HFOeѓ/J!o:EQ"V>dnP_cV[Y \=LV~ :0݀Lc:3Wg`.ϝ)Wλ*TiJ )tx|SgfD Kٖ;j)wi-4HHIJ-w=D"Z[.Pt-Pㆫ (#/NS@fpIENDB`BayesFactor/vignettes/extra/socialmedia/png/48x48/google_plus.png0000755000175100001440000000343312452540640024517 0ustar hornikusersPNG  IHDR00WIDATxkWyg\vva,lR($MSSiM4blb/ȇƘbACƘBm(ec l.e}6yw޽,3s=$̗0#a|- /iaHdtZDgXUdT|Q _S3-~AQA߻ Nng!7y %P\MI}]WLnfs'l6v/R½"r^F]J`?\a"}:y`E+49#.Ap~Gڿ윕*-4tOLzlKaËg%ͬ}q@OA_zSO'gb*R"6U1t>fYDENS`}Ӗ%WVC]UXDsy%k?Ow#O7S @"u90f$LŮ'(0{zuȐ.="rog@2q =3bu4Q=Ogv;yW~6>ӑ~ρWb#\>[Y/*}_BǢv7=  Ů!:XCcGC)݇y<;? 5]t(ԤuXICRNSr6vaC&XU`>,z2D+/Pxf :MSN5hKy2(V?4.pNlOS M[w|HͿ ^D0?em$Ũ:P ǷSP$>2Db|tAnǟ_&N_X,oodp11B:Ezo2f$L|x\2I=~wOuzĦ\R]npubqLf!L&$aX:_ف c+=4'pWӰlnp%!J0Ɛg ╵2dNr˙N2( ?/=PEQT $I✽\.OǺO^?rq+T]_n{U]|Q! <ځCp8=p/`yN;pHG{ 롵vKmkNVp+-j AfL 7"e IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/deviantart.png0000755000175100001440000000203612452540640024321 0ustar hornikusersPNG  IHDR szzIDATxOU|\)uVLEM[M[I/p­MĤ$֘4E&Ĵʥau;2̄N[# gu>wr˅o ^$Xczk5nFfS7W~$m" bLE.=pZ>:G[IUM"BfVkb3f#`=d= OwB\!&J9Fy3qv.teb OMM1:E0&M#-J^F[}Ŏb!ƷhܳwOY\7=~/?* a+f [g|1rھ"LJCWjv\7.ޥ}|0vl>WRj4KYғsj>P2ZNkjE˂G- %犱^yG Q-5Mtַc3UFt./o^?Q\YED_A vӔ馾Х <bKms훸(Hdxs{WIs+mx"0 8Yb;GD% 1\;*}wW/cdYfs̆{$C(-/ TY_B&@a φ')lH2T`I N2Uy"ư+ 2Lo_Ÿφ \l/.ܘ@Q{  .JG<-.7fX𱕊,"Fx( _n1p4HBɋHhstEJE4thJ u {iCPS$GxR<]ZS/aX@@4p]pAb߻gF'0<:y5o]`^+g8uЬQQ evpR+0'&ņsXCݸ5ۆͥ7.1Jq8̀Su8.*hDZnܲvR*<¥(T#Vm,;q ;Nirr7SQ5by y5 ?uYWqo(F~2fW,=w!>NϢIVv`#jݖ+ 0m;bF l95Ļ3³1?mNZy:F_ϞRt4_<IYh"Qe>mVᶷ!J-ඛ4Q vM,W.V8IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/email.png0000755000175100001440000000127312452540640023251 0ustar hornikusersPNG  IHDR szzIDATx;OQ8$r_/1V*jpђ,X X P KcL%bD#Ìً:N7g2y&#w&--+m(*. F"WKa$e btD.$ЪBx $CkL tD|em!@u3P2oο}@2T'S) N.ш$C?ga6W"|Db_C+> oH&L xCƢ*F>p\H^'[`eHDJh<<!+Q|.~L^ͱQ/Fk{{0 Ѻb}HͪD9[=c`bk'1<-9<;wm.@M6dIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/app_store.png0000755000175100001440000000221412452540640024152 0ustar hornikusersPNG  IHDR szzSIDATx՗O[ePuBKKW.andu'bL?/I>,:ef*cRFJ{.~(E*c#_{<ߛ&8^fC]ਚ>p %dl{LmI':;F[0xhl&Bċtx0-8VDf>Bln q?Ei>2(xsk&BV»}>@Ȥb$[/pUWo ?΄z"B&' m<.$&uw"BDl&N2>n^uCrAt^e>#=f7c:@g׎(§UJ̥u*P[SaMr= "UG6;ky7L6p SWYd-:PF,?dt*E7xfrm$ @[vW#F5~@Wt䇟mZZQ1 Ew5Lk\NTE5?.&N,ņnKaZWU  [=6:vhh"|<\ل_Bp|BgoŊ6 . Qv)0t#FOWVP4IDQ"W 4'4q N_ R( Y."dNb(tXH5+|-Ep:L O<^Sl|LN˳3&+"vnJGq`0axyV)X- N /W#znp|9TE#o ."LNvhaU%p.>4pq8ܽ 9`-{FZj6 /ݳF__8?>CQ+ ?nAl½<'m*@GJOh]+lڞuͭՌVo|cX>DDd:R%p6"JHDCZ.Oۂ"w2YAU,DT|NwI?ox9HNIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/facebook.png0000755000175100001440000000067512452540640023740 0ustar hornikusersPNG  IHDR szzIDATxM/Qw4,*%DX`_XYR]?F#!Bh*vsgzu&yϽw[.p  fa2=gH1=FRP&(\0=Hxu0ʂhZJz; #s5; pM5>>{8hGBrx;$V*"(l&fm+Wl(q D,.Abg}.k8pĂk. p+@:niX`c܎p OK ӶtƆժo0!HÑ@^Wr%IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/friendster.png0000755000175100001440000000244712452540640024333 0ustar hornikusersPNG  IHDR szzIDATxKlTU{ignǶ-϶Bj!!ŐIQQ4&DC…111Ƹ0&.XHԍ#@"  J(}?i=v郚ls~\yOxM{ 0򰉃 XG1> 8a:$Htk|˰RvQI.tGuZ sZۼmTRQũьْmlhp_flrg6:P D<žҝTYe!94mCXC us3ç~`*2l[|n_n)ƶuTd3 i8M5!˫6Xe$w@w-}6e B;~%fb" Xl287X{ (\1W d C&JFo,L@5˰QiM-go[Vch.8q 791tAΌ^#XOb>N*xlz# D(4q zc\@sܞ㫶#(=pDOSj"ZQ4&14Cm0DOyD K9  MRU+3}PlnƔvEuc<~l:v<4PhpI>xDRiWDLA,PP?IVqݙ+2bp'܁hBbhS"bӟށ.FXfof%H39Ovam\.%ܺ +=𙹳DD7hlͫLCO-0e8yn-YCt'#h>F:i?WO`jN k QB0͠]*BF=0y)Y![Gf"x!r^mN7`~g(>G^3n$vp|BUԹWh㛎8TYeXF1;:ʼn[\ u5L2NZv菴pD![ Y!rfI;2TmZî,=ӁI;-8l M(r /ef00rYw>=6 <`RFA.M|,"`J荞dI7\pDx+X8y 0ղʗh" Eh(C;0ݼ ".)ɛp8ieIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/odnoklassniki.png0000755000175100001440000000204412452540640025027 0ustar hornikusersPNG  IHDR szzIDATxMLevB)`?Bb"MX&z1oj'OXG'x\]OA>JB| "`,r/z|ujf+j|Be %Z3w%1"_&9=G REw1p[;k!AM+~A,#so]([MQA- X  ,޼lp&AϮjn r#Dnr}j}9ad"yUj>@xa,#G*:߃Lt⮭P } ;A[l`i%BC6HAV7-ISUξnEm{|FzцKyS$+ E_2l=^K, 9K $ ~]g<[T\6j\0f&,Ho/ B$Wb[B@yhdo123WW^OG)k}o0 ɵGքΆꕩ i`2@i;Hd-XP[_.I0}šuW(]LuOeAdQEG&hC b:C?%9vtt|5nGjrDfaOnhPc k/"+?u/YY)[\j{ B@xygF?cאdܹ_ 1 įt3]Z9vq8 eBrdenSy;pK瑄 ~7KBXTGi_&B@Cy*o\ aa}17 {v"j:Ij>IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/digg.png0000755000175100001440000000115512452540640023073 0ustar hornikusersPNG  IHDR szz4IDATx_KQƟ] Z"iViI0mh7hXJ$>AG01Z\ 2!*=3gΜJs3y{`xQ8'N ?t8>2 iދV΀T}NbbIH/$$%$Rmy^A_{S('kdx6~lڲύhRv[Sȏ'ap ?l |Wfk-V<լm2, q  [,D # ^Wu-3אe.5lgx 87lۋ*pDwW~ V\#6> #ϿxG ᙓpb ?@rI =y/ ('A"5_޴tmՊ }8V_^ FƟ$Xo턶Vۮ ": {(p Q@s'vx :sj@]Qm:cÙsUπ>Dp۴aL0IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/pinterest.png0000755000175100001440000000177312452540640024204 0ustar hornikusersPNG  IHDR szzIDATxOLU?7;ȟnZ$Hըm)i'Lx7O&=x5ѨQjG5"5 .ſO-3.;\KY0w̛~}{ yX-mm[*|/iȯ4pUDyv罄{F˺'iيJm{`n 4CǼy u;0y̎,yS++)Dp_.?)M \߷h_u0ϡwwǿ7Hd N9)&{> ڱj+PGuy=<-<]oF}{aElCI&`BpԱňmbzvRIVaZ^DYƃ:Ji4:ϧ3R: \0t}NrKEiA =94D~!Pa0.0a[%{ljD K z~٩m1(͝Td&Ӓ'uv.F5/ DIny3**ffqSPK~^|NϗJ)r! 14LH׹a{iij_KZբmWU QTxҀ2 hm?ԱOÝl,Ɲ=+Ed6ƅջI ;'ڱ=JfFǘxx+Wb5=oS>}s y8`,\%nwC2~+>Rx\-܈$)8sE$ؕM$HO\ 9 y  \ K /lxP&Z@x3hAS*\N13}1\fIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/sharethis.png0000755000175100001440000000147712452540640024162 0ustar hornikusersPNG  IHDR szzIDATxkQ$OۦR.TP kkܪ hEAVE ֢44}i2yEL4̤-nzV߹7r0T? d&L|d|b @* -fak+ւl"q|^]hmWYzPp;(%N~=(QMFwwD(bfH[]6ºp&/Tt{-έs43ñu}GvW 4 "kS+03xyS">N]w2Fe{boJӖh\D 9$pyGGlQ.U{mGM3N m쓔wUXe hYTvHz^E7wڎڃoьl>p~8v_ЙZE"B/@^X&ݹ̘%؊HhS֗QˆE(ۖ_:(Z/p}u{JD dqDIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/google_play.png0000755000175100001440000000200712452540640024457 0ustar hornikusersPNG  IHDR szzIDATxku?e7t4M4mSEГ ?? =/KoA"bS"B ML[fmL1/M63;?kbݚf<3ITPSSw7Filµ,p|9;={,UŕK o9cRQwled4RrtreO.vAN(_Bآ~* uqbpSPc&U|W#$-+C\Xx2 n5 Ki7W)?r T]pj i¬b;(p+ hs)M'<~3 )fN8 .XlgZ;T P$;4ى)`"462ds|4Ғukʂ9\SdC[R AEW3f|iH\ 8cBi%QP :go_=v)ak=VH,)ORP(ׇ4AXkC@JK/==Hr0k,}kI&ˇYD4MD}2 +т(!4e^8=KT€ I#kyRf*HӔI8Nat Se:O_.%OSt.Sq`_X+Sv'fffh* Mń'2`>HjPv'ߌy4_^Ŝ!>t,vu* 9;7߬i=} m)<m)SqA<6:F꫻/.X#Xkw]1M]W}1C0xl֚-؉l@b̝;ݵmh>KIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/bebo.png0000755000175100001440000000127512452540640023073 0ustar hornikusersPNG  IHDR szzIDATx햿Ka?ϛƜ:KjPqqq1:+7DEEgAEĥI[JK45!4?.E)q=}ĚxơS?D"rqxlPQs]8~B{CD>*k''adir pA,98/@\a}4Q~OOc(: _9[Y)wt2>@0強*xv W"dS)NwwxϺQ'tYqg{U\D0./ H/L DuӄLƞ\9i$Cg77-8=['&\ŕoFGl2uĝǹ9nRwUJEdvon@S訦e!33\Y}kŲ)575 [ɏU*eqNNVc\_+EUq)8Ps'T"R|ÂX|WP5%Bȣ utB%BWS>ѪSܳN<r 4|~Y^Bu?'D6TA̓CN_IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/vimeo.png0000755000175100001440000000154112452540640023277 0ustar hornikusersPNG  IHDR szz(IDATx햿oe?ϛsc nC  b`a:/@BbPueF* ba(HPP*PDj'N8;q>ƭug.__N.՚gXY 86`f,v!k)` hnw%ذ0ώ^me.f6W `' ^9 x9x@1 fMjX{ O%BҀzqg"@L3MOOAz_rn <7vgWC,綸L%)"Mn~\UえGag"Ѐ5XCS|Ri$ "4˛R8O{w<*֚fiBf^HjѰd)e>Xką??WAִʛ#/X"J[~Dۋ3dVF?}'3gϓݳ 1>}mor &~&fzP#A |d23O8y*\DYp:IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/wordpress.png0000755000175100001440000000231112452540640024204 0ustar hornikusersPNG  IHDR szzIDATxoi? !a1T46a( #6+++LOO377XӧOmKKٹqKKKa>/^$eYE666$ i5[}on:tZvvuy )R8ë+fg@uztq t(J~Iyo(,84~]888<`D 0[[[^2^$ax3 hZI, \|˗/5mF1 fg'e0Ro@tl66{'͛7z\aг{~~. x="BT`nnM fffv~Ȑ lmmi< |w' ^|J)޽{1w~Å X[[Edxj52cccܿNǏT*C?dz{#S,I\D~eLdqq>VE,o߾%J8<2ux^GEDb^xda"DH&'Ldww?G?xj'ÝVj5 O8|;7 8F4ʈ>y1|VqoN詑{IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/reddit.png0000755000175100001440000000256512452540640023442 0ustar hornikusersPNG  IHDR szzd-Oɧ)?@6h8`*?C/TJ_2|$tGٗj-ݚ})d96G8y&aenpbear#^ 9lǸg`~lvB2r7k 6РLnp$^"_ k 3|ou @pJ)%p=X !qu,ƈoQQO)3!`>Ù%..q8V!Zt;¡hA%9h A +Sy&g`:Z7G[\T!o*]h:0=QNH{G^Hw{;eg@+]lcX@+}q $ihe@{Q,:9e5NInogpd/4DwGi A7s ^-<cb_FٿhXS,Xcp[{ <e?;S O-s\Bu LhRl̇lGoۤgy>ɡ *)1AJZuڎv"4R);;kgKn$|QIu4q`G7.eBr BJ@ Z~X͒| @*OײH)8s5W* 2FJ\Ώίrl­\? WxDPaTZc.r#;WJJl["!\#oB>fV«5t5!\*%P0*^Jd+늋G90 ]9v~ 8BCyKC9̾6||6B0K=(li]G.l+oE]"b\Rt%ba]qRrvG8;2éYcveA`̥dgg#NqeȩC iy~`[2w}%!%m!\M$b.g87Z̦7HOo.p~AZ5Rwo{ZׄakąAGŅX@Ys~%:TXkA:<@s %s:$BtP]bBj>)@K ݺW d'v_/!SJIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/skype.png0000755000175100001440000000166212452540640023317 0ustar hornikusersPNG  IHDR szzyIDATx=l[U^۱vM6ʀJVQ~**3 H0!11N$~(T] !Sne05}O8H]NϹwms&{M'Q?Dpg6 QP`!Itc8rVb\+ _mF}p0ལr9po ֙ ΅(DkZΕX]IgYsja絍b,-"¤"5;Buc XK./v!?J)2$&"d$ \+2]a9_=Q &crL!@0@O=pitbb)#R_]IBk &5yXDT|tu׿ 4[1O6]&ϟS N f|?njh'6+Z&NDx,?0("yǽn,nm Ud9G:)r=W 5pv$n[QxrΥEDåyM6M#!ZsK{9XqAˆj̄yc("{ +y śsqZRIx ح)~LeN!iڭbۂ;PBح+#|`?I7.%f%Vѳ^\BWpAt&ppJes*XxCL+3\-vkW9|'|_-ة`<ƁC96qY0(; L1\ NAo8",K@IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/delicious.png0000755000175100001440000000040212452540640024133 0ustar hornikusersPNG  IHDR szzIDATxW C ii3uʌI"l)h|H ; N%x{_x~T\N]@QK RJ: @})@)IjK #Uu%@#%b]:ft |J{-SN_u\ss:vZk.$J#IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/stumbleupon.png0000755000175100001440000000142612452540640024537 0ustar hornikusersPNG  IHDR szzIDATxkpǿO6ۮMne×r"p@0D<ă@?G;x*LtASa(x6]eI6m=4I&ie='KEc0)nP : ˹d}/@SBaErܷIWzOU}t,|gGY1}.d,rX%pzԘvB(ky"BBʀI;CcU@y%I-@"2"DRu58P'"ߑMȔ/Y E(&quL b 7YdRQr|6eځC盗ta :iM|ϝZ de,i3 6@G_)[>X'J+ >̚!W֫KbNF\p@s1pg"-HgEkWOŊݷGsz# m^0yGCt6Xzz 73a7öaOc#'^>'4R:oIxZ>_WO|kP( | 6i^CRj ~&y$CƮ{[(J=ǎ .D`{E[sqh[s!+v@AfPc3Gn&m"hgyfvY9ryQ$SX؉/&6&'Gn'8ӱ@Fd̔zr%.&(ܱ@`L2>LGgn!o?0Ź@ 2> =;6pYX*`8@W;.0mҹ QYkP]4fij 81؎vo{'uspoQ8^q^͎Kc4u.?M.bm(|J+|H>铭E!|ﳣo7Ն7qi{y Z 0 xI璈" +';CeO, sJv./= Ի5Dmɗ\~|К_4oEj A-h fOv–bl `]/[ pE=Ǟ$Ck7 Sخ ƹX>Eekvqq7f@8"fU4$3qhD~JzR=_ , xIV6C;lx "06 bIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/blogger.png0000644000175100001440000000247312452540640023603 0ustar hornikusersPNG  IHDR szzIDATx^oU? l RJ6%Q h46>(1j&苼!h&A#(Ji;7;;4T>͝9{s9s欠¶o_٘1mLޡJ)piCX≺MJBjJѐrm.CIJ O/=QqRTLTlQ"݂Bj;G/m?=^=z\$۱^N)p}FSgt@N+M94` šܲh Z{uvx.m %e#Rbv55;e%!=`DP1! `-("s*H؛{ԍś `>YClƃ""呈ՔBME|$9Q0RceP<:HIjp=M4J0x\ )eVB+ Q n =y[)병 ޻f)F50T9TpT|,kW4i,BWQ֖pJ`q`KG%ĬRʆv: Z/+"6q(c\\W-)vZV`UsC Mm֪C@RǧY8mS3m,G'飖@m9@P+S3uj02D.lgsIJBCH˸z9w-kWٟ(_{nM-a424R)b໳ki#ÃW"ZH mixc J ^{D9 ~/ы`"ʍ #<3ڐ@( #]-,k0Ǣ|džo\緿d2{I>fۺ^qj7={(Q_jr/x%Ŏͭ |aci揱i wlCOѳ4ƮSRRln#TB qwN*fRe7{0ٹڭX}o1/ZLҍ\"X*~o"#=-_qlގ\\"\fW _ .oaOuϑG@)k;rgz~`~ܖ fXw6]qnw34J^ ,Jg"_~sVfpe^JlN~]naլĿrٔ_Z 90ј5j/>[!!>y;eg2H9çx:D%hM`2@Il؛a!>B?}ؤuURZnjj@M;rj5MbNLsٲg2+o6dzuSˑQ~G1xlH¦vUTn\%`c8Qj6Ɂ5kWdE@'Q㎩".m-ܽB(iMPSƉN0:a]*.YDJ()Gg|O]x!sxp9;B=l?r:lf"K^1ހЖp5$s-]_:{Ag(/L@*.= d@>̤enԞk{ZXonEDwxRkZpQFlK,rND=Շc 2T91݊ǯs8WȫJơ>И RH;S\ (#X*| A_>ظ ̏E[qi[:D(Kes jn#[@)G"h@&IҋNh &iLy$r.k>R#1@$ WEgh.+\~O2$ wM1Z6#R4zf!.b4\DPH?ܟ 0iڧtxpcLY~UzaoG&tөfp_%p?"/kOq+ XHckm?^Y 8< o&4k2Sn J߷4քֶ9hЍV:jҏfO (ܙkc}\L`a9&BЋԫ:\|LH0du>m Jx\fj' ,%aګ3޿݂Y3p3p~_h.dp8dA uQ^ ;<Ґ GJ>=BYe*Ɠ<j*};BOo %& "_wrla*naer$' 5ﮦ,kKA79wesWYs]%A_&g:1txIx XJCQ"7bzuln10-&smV8p6vp^d :uQ u< +񣔃nz]"V[ʸxBѹ 4 <P0<~Rx~G-֔!F'lEt\uL)ؘ?joOCg K[?#K\5 /9e"a3>msZswh, ^"r̩r`.9~w %(X @Ljj P zq+M慊%W`eQ!Ohh( =%JJ*n8 iJm/_ 0|BX d}X."1 CdIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/dribbble.png0000755000175100001440000000245612452540640023733 0ustar hornikusersPNG  IHDR szzIDATxoTEߜnmw-t mBJ@|DBoj4$jB|D%"Ѥh0D Riiun={ R/̙Mf`?6 <oo6ԕ?B g;Ss*ki)ԗV$r񮛈ÛKn*юBҜX %qb rΧ&ZSKk&V3Hȸ||O(*BH&8v=\TLdBfKCe.}I$r_Qv_N^ l:mqɮ2*a&B |{ E4i:2x`E- jJ&k Z?K"pJ&B3J,4EgQ4I3Mwc"F`,~oUnCr~5bF'?؈rJ̜5~@c3X+ ƻ`Y .-N-$+X`fH&al]Vs\[{fw]RԐOeyQ;'/0#qb8>cEh$2al DWgZ1"q!=Scl ^{>US+a JM%,M^:?x vgUcUxVV8F8 -yG箹JGY,kv%hSk(NNe֏ J?܁M뻽^P1ܕ4 0❭ۺwx0r*֖3rHwe,w|JhF>M̒Νv߁*̓\GÈዝ wmY(PBkzxFj4]/ {$H$rh; ϺeZ ƣ'.䣷benv: ~;G}M't ;7:.r2ԎcM bp?Q:\D.u1zH81ރ([fJd8g \5 \g`IJf2wAB,J(ʦc=rp|蹩O0?}8N 40F_Nފ i!0~X4coÕ $݀jz}Spy[MӨ ~$NBiTx #pD0 IENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/android.png0000755000175100001440000000155112452540640023601 0ustar hornikusersPNG  IHDR szz0IDATxKhTW߹so&'NP6hҕJ.1]J7A n ҅Z >t-t!!%&jL4:&yn8gr(鷺s1o n=OWv&83 l =oA& r#1gٗ> gju_<:`Yf̡ cNk "xgh"q2j/ǵS47Y6?/ON]}t>FӧV"(b ښ6q82|p5+K!$i'8{=qa3X;ck2s`v}.o\?Tb %z=-=0>>gEq޿͍Q>zcqWݻCNCZ9 a{%HV݌ǫG)6b֊Zok S"O1m "໚'+[ɪ`~;R^Ly5D"_+ OQ  nfIL1AV%[,(Unǿ_vMy^lQҾ=-.ͽ&qvhD| =0/$" 07bpݵŗ+3o!Rl}ۙ1D b-Oa[E@m]vjI:" f".NqzkuH, #cq@6g^\nKIENDB`BayesFactor/vignettes/extra/socialmedia/png/32x32/google_plus.png0000755000175100001440000000234212452540640024477 0ustar hornikusersPNG  IHDR szzIDATxMlTUޙRAS)Z Q$jDY5( hhZhaFM)!1!J0DHH P(iS:3{^olK;35$l7w{3biCIBpD#[ YBe5XKhÐw"mf#g?|^QTTq;"fIy)aUu*ؼ?xX Ɂ>.vfM{51D ǘ O< @E,D/ ݿ,B4ւY rE OK4Zk|kq<yxq=H!@R0݉!1x֐̸y!rNpYz"@XkTf"MB9`*='Dnσ 7OKil9K&AG1֒r]nqͭC*85kWM՚ *mnSw~Џ]%Yg,,ρq8+7Qôn{a*BB!.9nB(cw]iQtvڎ'<e u$c f 6lvn|q%.H2tToF Rݧg%O3 y5g~.:AFpJ!G< #- +Ѐu28֙2e8B)+BO 2ȿ /(S!b Qr3 r f`r dVqO\ Q-S{IENDB`BayesFactor/vignettes/extra/socialmedia/readme.txt0000644000175100001440000000200312452540640022072 0ustar hornikusers------------------------------------------------------------------- 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.css0000644000175100001440000000347412452540640017626 0ustar hornikusersbody, 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.Rmd0000644000175100001440000000070312476040463016263 0ustar hornikusers ![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.Rmd0000644000175100001440000002344312452540640017525 0ustar hornikusers ![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) 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.Rmd0000644000175100001440000017142712577227523016453 0ustar hornikusers 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](http://cran.r-project.org/package=BayesFactor) - [Package NEWS (including version changes)](http://cran.r-project.org/web/packages/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) * [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://r-forge.r-project.org/forum/?group_id=554) * [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) 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) `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](http://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 216. 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[,1:4]) ``` 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. 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)) ``` ### 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 ([PDF](http://www.isds.duke.edu/courses/Spring09/sta244/Handouts/hyper-g.pdf)) Morey, R. D. and Rouder, J. N. (2011). Bayes Factor Approaches for Testing Interval Null Hypotheses. Psychological Methods, 16, pp. 406-419 ([PDF](http://drsmorey.org/bibtex/upload/Morey:Rouder:2011.pdf)) 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 ([PDF](http://drsmorey.org/bibtex/upload/Morey:etal:2011a.pdf)) Rouder, J. N. and Morey, R. D. (2013) Default Bayes Factors for Model Selection in Regression, Multivariate Behavioral Research, 47, pp. 877-903 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.Morey_.MBR_.2012.pdf)) 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 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.JMP_.2012.pdf)) 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 ([PDF](http://pcl.missouri.edu/sites/default/files/Rouder.bf_.pdf)) 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 ([PDF](http://drsmorey.org/bibtex/upload/Rouder:Morey:2011a.pdf)) -------

Social media icons by Lokas Software.

*This document was compiled with version `r bfversion` of BayesFactor (`r rversion`).* BayesFactor/vignettes/odds_probs.Rmd0000644000175100001440000001202612476041671017315 0ustar hornikusers 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/MD50000644000175100001440000003221212577320137013011 0ustar hornikusers75d05d105bc9a97adaa5ad63290180e5 *DESCRIPTION 5341aad8a84635d667b2d303ae1101a5 *NAMESPACE 9de77eceb6234ec8784721a5cad1f064 *NEWS 3d253a645c133d4a99b8b1c191549bdd *R/BayesFactorPCL-package.R 998c90aba2e8e7a477d1972f5628cc22 *R/RcppExports.R 1c57a9978a6583d1b23adf02387cbbd7 *R/aaClasses.R 918909c14584d15dc760e9e533f75f72 *R/aaGenerics.R da82be16e0941cb3449cdc68edc5ba5c *R/anovaBF-utility.R 6284590c46b5b86e3072f68041d00707 *R/anovaBF.R 534a4d11a47227e54afa70d2253cba29 *R/checkCallback.R b2795f200af2edd99184a9bfa0baa4bb *R/checking.R 909014d216e48be2f6a6067ce2d1106f *R/common.R 6ddf9bed60f77c572ff477cf6b020025 *R/contingency-utility.R 966b063720318271a860834006d1c358 *R/contingency.R 2f8ea7d88e021faf98450569164dca12 *R/gaussApproxAOV.R 6aaa5a04ba41fe23ef5bae65760dd763 *R/generalTest-utility.R d080f93268a62219c84438c441e53a2e *R/generalTestBF.R 322ca1de3188a97eb73d2b8abca8a12f *R/linearReg_R2stat.R a6a4e9937168fb44f68c95515681124e *R/lmBF.R 07098b0eca6511e533c2cd7d609ff9bb *R/logMean.R 59d4101f9f7b26ba0467381f299c66b4 *R/manual.R 4fdbdfee1d2755a5d5c138d4b23e6329 *R/meta-ttest-utility.R 59670e2c7de5d527352862ff1237ff48 *R/meta.ttestBF.R c8ebeb8320a092401e7d3b885a08b424 *R/methods-BFBayesFactor.R 351c517b90c8322480531b95d2c633a1 *R/methods-BFBayesFactorList.R 079796107b6c52b8823ba2cb35811aed *R/methods-BFBayesFactorTop.R 85b93790f23a8334ea8cf48941fc4c84 *R/methods-BFlinearModel-compare.R b11f5ccf0ac9042b3bfafc6d2b069c31 *R/methods-BFmodel.R 220fb45f8ac36b3a2f096ddf3e64a7fc *R/methods-BFmodelSample.R ba32e889555e75923bd67853238a432e *R/methods-BFodds.R d1252b8141a7425cd8bd1bd817cf23af *R/methods-BFprobability.R 815b6f855c2b8ecbe987f905eade7854 *R/model.matrix.R 10ce03870c52263b31912ee961ca7ba6 *R/nWayAOV-utility.R 8d74ab81cfd4a2f691a09095e54dc159 *R/nWayAOV.R ae1839a9b19eef37aa03bdec0b570007 *R/newPriorOdds.R ed3e79dac5fc9e0363c838925352dda2 *R/onAttach.R 1876b783c276f40803cb52fe58ce44df *R/oneWayAOV-utility.R cff8d846d5fbc42dddaedc56adbbd198 *R/oneWayAOV_Fstat.R da62ad44da49b63cda69854af88ecd3e *R/plot-BFBayesFactor.R 716a09a72d95f00de6bcc906155ac045 *R/plot-BFBayesFactorTop.R 8b0b498eb7b0e43c8aab266f5759f3c7 *R/proportion-utility.R 4789bcd23d7b69419087fb7736d4b4ff *R/proportionBF.R 04282aff734e37ee40378f67a8efc736 *R/regressionBF-utility.R bc4c58a8d4d8cd812e279095b04c6809 *R/regressionBF.R 99479ea3db9c83a2b6cbd25377c7e62b *R/ttest-utility.R d8eae636b25335b53063c3cf561c3ea0 *R/ttestBF.R 5e0dff60619f19360c8a580d3f0f6435 *R/ttest_tstat.R 47d5ab8da825b888f76ad769cba64311 *R/version.R c0f2481e076290d00cd48fd4c76667f8 *build/vignette.rds 84361c38301923ed3ebe640721267746 *data/puzzles.rda 94e24dbb4ed809a1ac870cdb432ed510 *data/raceDolls.rda e3ba8ee6ff92ba406a9e7103a0474465 *inst/doc/compare_lme4.R 386fba7738b2cb5304ab3474a90091a9 *inst/doc/compare_lme4.Rmd 37298635929d350409022c12ea9b7efc *inst/doc/compare_lme4.html 3444667beceae04bc51450d8537a4954 *inst/doc/index.R ab8952192cc7b37a4343c4fedf54a791 *inst/doc/index.Rmd 7fbf239f48829fef418ac580858b3b34 *inst/doc/index.html 5963380ec1a7784a048c8e4b392e9331 *inst/doc/manual.R 9677360ec72d8c9c13781306856c39be *inst/doc/manual.Rmd 6f069515e7d0e11ece1023bed49b692a *inst/doc/manual.html 4152a2af90c99e372f47508e1ec3f6f4 *inst/doc/odds_probs.R 4cf6ac513ad86a9673b2e15b73a25ebb *inst/doc/odds_probs.Rmd 00168dad5a83a4a039720eeb0b5ff442 *inst/doc/odds_probs.html eb61cefb3d27d7f06b4f3145b1e1243b *inst/doc/priors.R ee031b08173f64d65fde5de57e73c483 *inst/doc/priors.Rmd a2eeeda649c7481ab769464823b5744c *inst/doc/priors.html 70aad7748c204bd6ff7a7937fd222f9b *inst/tests/test-anovaBF.R a2332f3f40a0270cb77cc43beb897f4c *man/BFBayesFactor-class.Rd 2033e5a72684774719823fc801382eb2 *man/BFBayesFactorList-class.Rd eebf331695bb15d9a1f0c2ab72f02951 *man/BFInfo.Rd 7c05712b8f295c908530bb0b25a6f584 *man/BFManual.Rd 1f1d24f535e0b4044fa289b268aae602 *man/BFodds-class.Rd e7226613df8fcd5f1f745dbc022d0ae7 *man/BFprobability-class.Rd 911d2e8e980178f7937a9e40064f199a *man/BayesFactor-package.Rd b144ccb440edcde4dc6d88169fbb07db *man/anovaBF.Rd fabfb77415f0f8189dabf1b3a9e7b2bc *man/as.BFBayesFactor.Rd edd46ffc0584f937148760c779d13c94 *man/as.BFprobability.Rd 5bbbaa197e3d9df3a5b4db4580ca2a13 *man/compare-methods.Rd 0635cfa2ac3a96387d2d4ad7bfa52539 *man/contingencyTableBF.Rd 2f07b358e1d58e8737bc89c1538c1dd2 *man/enumerateGeneralModels.Rd f2ba177457d6157934b2fe3b70d806ea *man/extractBF-methods.Rd 0ba4d5e439071be20a9f3ad30e4e8ab1 *man/extractOdds-methods.Rd 063f855dd9c3b36d68a38260d65ee695 *man/extractProbabilities-methods.Rd 13e3269d13cf6d650c64dca998fa91d1 *man/filterBF.Rd 9c18722303a9bb30e6e09d5a3207803d *man/generalTestBF.Rd c23d931070a60519cb2a84e5604c79c2 *man/grapes-same-grapes.Rd 4a4737f6f4042d06418ce851fd75c01a *man/grapes-termin-grapes.Rd 6b4504b471e49e75a0a7b1b5a1513bf1 *man/linearReg.R2stat.Rd 761d1e1bd7e0f05bdf7fc617897cf3ec *man/lmBF.Rd b32b46e3c5caa238acd24cece2423fbf *man/logMeanExpLogs.Rd 6024078e97b52d21a9ab8d003052a7a2 *man/meta.ttestBF.Rd aa05f33da1e75ac2f3883fdfc672000f *man/model-classes.Rd 1734bb05a763c9fa2e4d140f95a89f7a *man/model.matrix-methods.Rd d086dcec1eb9e40eb4d13de299e26347 *man/nWayAOV.Rd e0946b19d04a422960377889ee295ecb *man/newPriorOdds.Rd d4c122982af1688d457bb5907384c965 *man/oneWayAOV.Fstat.Rd 63b5ad9521b0394982372006ae36970b *man/options-BayesFactor.Rd cedaaf1ac2befa1c8fdee2856fdf20e2 *man/plot.BFBayesFactor.Rd a726d08b5f5f6701866901198e6fd898 *man/plot.BFBayesFactorTop.Rd 2303ede4c9ad5a63e0098cdbd51d7e3e *man/posterior-methods.Rd 795694a27443c3fd23bb23d0be1aa06c *man/priorLogodds-method.Rd 4e491dd5f0f268095e0fdb2e239516b7 *man/priorOdds-method.Rd 59bcc4663777647cc78654bbc3634304 *man/proportionBF.Rd de25bb30e33588ea89cdb71683a6a466 *man/puzzles.Rd 0812bf130e37396b6976f711af401e16 *man/raceDolls.Rd 9631da26e5fc38adf3ef120565d09ef1 *man/recompute-methods.Rd 35383341a817d72778d5568907a93f45 *man/regressionBF.Rd 636707e3b040f4aaa62e87adebae1c81 *man/ttest.tstat.Rd 392a7cca8b3450bee6de17bac746321b *man/ttestBF.Rd 6447577cf0d348d93980f48c8137685c *src/RcppCallback.cpp 6b7aecbc50a16b345d478eb87ce68795 *src/RcppExports.cpp e3cc535177976e2c2d712650fb036850 *src/bfcommon.h 628a43926165979de6117c0faa5b64db *src/dinvgamma.cpp 5b986179a08cc914fbe73eb04250ab3f *src/interruptable_progress_monitor.h f1e03bbe1a2447bb1a81f85bac0ae7c5 *src/interrupts.cpp e26b20f68b43abca35c2f5e31ec0136d *src/interrupts.h aa7411ed7be30ae782b3470d9a305485 *src/jzs_Gauss_approx_aov.cpp c905b8fa23cfd67f9fc471d59d697a49 *src/jzs_Gibbs.cpp 5bbf5d510ab6b279c7c7d1f15c5e0af2 *src/jzs_bf_samplers.cpp b07139f1bb218821daa53407301725db *src/jzs_marg_like.cpp d40c49c6774ce3b89212b4dec70ac2c7 *src/linearRegGibbsRcpp.cpp 0b1c7d0074f9b252c3fd308d289db0f4 *src/logDeterminant.cpp 47e6cb7361079169a300af9eb685cdf7 *src/logRepresentedReal.cpp 9ec47b6a605b28bcc21d5421eebe33d7 *src/logRepresentedReal.h 3bb0803385c7b213b839956a9444d3bb *src/logSummaryStats.cpp 015e7ca14a87b8bd30fa089fcb0444ec *src/logUtility.cpp f798d4a788dcde608cfcb6c320ec0f7a *src/metattest.cpp 0c7b419b7378acb97e5779a0fb37dc12 *src/progress.cpp c5a09a3cc9fe5e6aaf7e39029ca07ca6 *src/progress.h 5c8a2425c2016f5b8f65b4288964ccdd *src/proportion.cpp 89824a0e54ab13235c00b7309beb948d *src/rmvnorm.cpp 529528f24f00037c1c8ea5b3f81994b0 *src/ttestIndepRcpp.cpp 90216ff6ac99895044e9dd0e3e9a5f8f *src/ttestRcpp.cpp 39a3174f994e89ffa5456ea9d59e49c0 *tests/run-all.R 386fba7738b2cb5304ab3474a90091a9 *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 9677360ec72d8c9c13781306856c39be *vignettes/manual.Rmd 4cf6ac513ad86a9673b2e15b73a25ebb *vignettes/odds_probs.Rmd ee031b08173f64d65fde5de57e73c483 *vignettes/priors.Rmd BayesFactor/build/0000755000175100001440000000000012577237621013605 5ustar hornikusersBayesFactor/build/vignette.rds0000644000175100001440000000050612577237621016145 0ustar hornikusersRN0u4Ps6L|Bԅ bٮ Dq_t˽{/~I !CE.C cw.$M^*QS Jm .|@**@f1Z\S] ɨdYGʍƿ>7 B&@n|2oLQ{ѶSjpٲ h˞֍82ȩW@ܰm>߬GO( t{S[x$.=/x§j >wJOhˑl\/FeE n`ʨv߻wBayesFactor/DESCRIPTION0000644000175100001440000000247212577320137014214 0ustar hornikusersPackage: BayesFactor Type: Package Title: Computation of Bayes Factors for Common Designs Version: 0.9.12-2 Date: 2015-09-19 Authors@R: c(person("Richard D.", "Morey", role = c("aut", "cre"), email = "richarddmorey@gmail.com"), person("Jeffrey N.", "Rouder", role = "aut", email = "rouderj@missouri.edu"), person("Tahira", "Jamil", role = "ctb", email = "tahjamil@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.0.2), coda, Matrix (>= 1.1-1) Imports: pbapply, mvtnorm, stringr, utils, graphics, gtools, MatrixModels, Rcpp (>= 0.11.2), methods Suggests: doMC, foreach, testthat, knitr, markdown, arm, lme4, xtable, languageR URL: http://bayesfactorpcl.r-forge.r-project.org/ BugReports: https://github.com/richarddmorey/BayesFactor/issues LazyLoad: yes LinkingTo: Rcpp (>= 0.11.2), RcppEigen (>= 0.3.2.2.0) NeedsCompilation: yes Packaged: 2015-09-19 10:57:22 UTC; richard Author: Richard D. Morey [aut, cre], Jeffrey N. Rouder [aut], Tahira Jamil [ctb] Maintainer: Richard D. Morey Repository: CRAN Date/Publication: 2015-09-19 19:50:23 BayesFactor/man/0000755000175100001440000000000012577227532013261 5ustar hornikusersBayesFactor/man/extractProbabilities-methods.Rd0000644000175100001440000000135712562410371021367 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000261212562410371017602 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/model.matrix.R \docType{methods} \name{model.matrix,BFBayesFactor-method} \alias{model.matrix,BFBayesFactor} \alias{model.matrix,BFBayesFactor-method} \alias{model.matrix,BFBayesFactorTop-method} \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.Rd0000644000175100001440000000305412562410371017432 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000155312562471445020201 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000354212562410371016630 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaGenerics.R \docType{methods} \name{compare} \alias{compare} \alias{compare,BFcontingencyTable,BFcontingencyTable,data.frame-method} \alias{compare,BFcontingencyTable,missing,data.frame-method} \alias{compare,BFindepSample,missing,data.frame-method} \alias{compare,BFlinearModel,BFlinearModel,data.frame-method} \alias{compare,BFlinearModel,missing,data.frame-method} \alias{compare,BFmcmc,BFmcmc,ANY-method} \alias{compare,BFmcmc,missing,ANY-method} \alias{compare,BFmetat,missing,data.frame-method} \alias{compare,BFoneSample,missing,data.frame-method} \alias{compare,BFproportion,missing,data.frame-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.Rd0000644000175100001440000000076312562410371017470 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000445712562410371020120 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFBayesFactorList.R \docType{class} \name{BFBayesFactorList-class} \alias{/,numeric,BFBayesFactorList-method} \alias{BFBayesFactorList-class} \alias{[,BFBayesFactorList,index,index,missing-method} \alias{[,BFBayesFactorList,index,missing,missing-method} \alias{[,BFBayesFactorList,missing,index,missing-method} \alias{t,BFBayesFactorList-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.Rd0000644000175100001440000002014512577227523015066 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 = options()$BFprogress, 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 } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \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. } \keyword{htest} BayesFactor/man/BFBayesFactor-class.Rd0000644000175100001440000000555112562410371017260 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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,BFodds-method} \alias{/,BFBayesFactor,BFBayesFactor-method} \alias{/,numeric,BFBayesFactor-method} \alias{BFBayesFactor-class} \alias{BFBayesFactorTop-class} \alias{[,BFBayesFactor,index,missing,missing-method} \alias{[,BFBayesFactorTop,index,missing,missing-method} \alias{is.na,BFBayesFactor-method} \alias{t,BFBayesFactor-method} \alias{which.max,BFBayesFactor-method} \alias{which.min,BFBayesFactor-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.Rd0000644000175100001440000000757212562410371016050 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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) } \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 } \seealso{ \code{\link{ttestBF}} } \keyword{htest} BayesFactor/man/extractBF-methods.Rd0000644000175100001440000000156412562410371017066 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000132512562410371015233 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000516412577227532016644 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 almost 80,000; ## the data strongly favor hypothesis that ## the slope is not 0. result = linearReg.R2stat(30,1,0.6813) exp(result[['bf']]) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) and Jeffrey N. Rouder (\email{rouderj@missouri.edu}) } \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. } \keyword{htest} BayesFactor/man/posterior-methods.Rd0000644000175100001440000001026312562410371017226 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaGenerics.R, R/methods-BFmodelSample.R \docType{methods} \name{posterior} \alias{posterior} \alias{posterior,BFBayesFactor,missing,missing,missing-method} \alias{posterior,BFBayesFactor,missing,missing,numeric-method} \alias{posterior,BFBayesFactor,numeric,missing,numeric-method} \alias{posterior,BFcontingencyTable,missing,data.frame,numeric-method} \alias{posterior,BFindepSample,missing,data.frame,numeric-method} \alias{posterior,BFlinearModel,missing,data.frame,numeric-method} \alias{posterior,BFmetat,missing,data.frame,numeric-method} \alias{posterior,BFmodel,missing,data.frame,missing-method} \alias{posterior,BFoneSample,missing,data.frame,numeric-method} \alias{posterior,BFproportion,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, ...) } \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.Rd0000644000175100001440000000240512562410371015446 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000126412562410371014643 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000072412562410371016763 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000074412562410371017576 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000156312562410371016161 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000776012562410371016137 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 = options()$BFprogress, 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]) } \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. } \seealso{ \code{\link{lmBF}}, for testing specific models, and \code{\link{anovaBF}} for the function similar to \code{regressionBF} for ANOVA models. } \keyword{htest} BayesFactor/man/BayesFactor-package.Rd0000644000175100001440000000466112562410371017337 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/BayesFactorPCL-package.R \docType{package} \name{BayesFactor-package} \alias{BayesFactor} \alias{BayesFactor-package} \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, and contingency tables. } \details{ \tabular{ll}{ Package: \tab BayesFactor\cr Type: \tab Package\cr Version: \tab 0.9.12\cr Date: \tab 2015-4-20\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}}; 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}}; 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. } \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} } \keyword{htest} BayesFactor/man/lmBF.Rd0000644000175100001440000000646512577227523014403 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 = options()$BFprogress, ...) } \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) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \seealso{ \code{\link{regressionBF}} and \code{anovaBF} for testing many regression or ANOVA models simultaneously. } \keyword{htest} BayesFactor/man/ttestBF.Rd0000644000175100001440000001120512562410371015107 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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"]) } \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} } \seealso{ \code{\link{integrate}}, \code{\link{t.test}} } \keyword{htest} BayesFactor/man/plot.BFBayesFactor.Rd0000644000175100001440000000270612562410371017131 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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, 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{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.Rd0000644000175100001440000001362412562410371015027 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 = options()$BFprogress, 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 } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}), Jeffery N. Rouder (\email{rouderj@missouri.edu}) } \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. } \keyword{htest} BayesFactor/man/contingencyTableBF.Rd0000644000175100001440000000762512562410371017247 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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() } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) Tahira Jamil (\email{tahjamil@gmail.com}) } \references{ Gunel, E. and Dickey, J., (1974) Bayes Factors for Independence in Contingency Tables. Biometrika, 61, 545-557 } \keyword{htest} BayesFactor/man/grapes-same-grapes.Rd0000644000175100001440000000071212562410371017220 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000001011312577227523016231 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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 = options()$BFprogress, 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 } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \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. } \keyword{htest} BayesFactor/man/ttest.tstat.Rd0000644000175100001440000000631512577227532016056 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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']]) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) and Jeffrey N. Rouder (\email{rouderj@missouri.edu}) } \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. } \keyword{htest} BayesFactor/man/BFManual.Rd0000644000175100001440000000107012562410371015160 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000444312562410371017206 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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,BFmcmc-method} \alias{recompute,BFodds-method} \title{Recompute a Bayes factor computation or MCMC object.} \usage{ recompute(x, progress = options()$BFprogress, multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFBayesFactor}(x, progress = options()$BFprogress, multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFBayesFactorTop}(x, progress = options()$BFprogress, multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFmcmc}(x, progress = options()$BFprogress, multicore = FALSE, callback = function(...) as.integer(0), ...) \S4method{recompute}{BFodds}(x, progress = options()$BFprogress, 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.Rd0000644000175100001440000000120112562410371017454 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000241512562410371015253 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000547512562410371016173 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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"]) } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \seealso{ \code{\link{prop.test}} } \keyword{htest} BayesFactor/man/as.BFBayesFactor.Rd0000644000175100001440000000172012562410371016551 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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'} } \author{ Richard D. Morey (\email{richarddmorey@gmail.com}) } \seealso{ \code{\link{regressionBF}}, \code{anovaBF} whose output is appropriate for use with this function when \code{whichModels='top'} } \keyword{misc} BayesFactor/man/model-classes.Rd0000644000175100001440000000247712562410371016302 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaClasses.R \docType{class} \name{BFmodel-class} \alias{BFcontingencyTable-class} \alias{BFindepSample-class} \alias{BFlinearModel-class} \alias{BFmodel-class} \alias{BFoneSample-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.Rd0000644000175100001440000000337312562415271017402 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFprobability.R \docType{class} \name{BFprobability-class} \alias{-,BFprobability,numeric-method} \alias{/,BFprobability,numeric-method} \alias{BFprobability-class} \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.Rd0000644000175100001440000000162312562410371016671 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000300312562410371017603 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000175100001440000000400612562410371016421 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/logMean.R \name{logMeanExpLogs} \alias{logCumMeanExpLogs} \alias{logMeanExpLogs} \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))) } \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/}. } \keyword{arith} \keyword{misc} BayesFactor/man/oneWayAOV.Fstat.Rd0000644000175100001440000000505712577227532016447 0ustar hornikusers% Generated by roxygen2 (4.1.1): 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']]) } \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 } \seealso{ \code{\link{integrate}}, \code{\link{aov}}; see \code{\link{lmBF}} for the intended interface to this function, using the full data set. } \keyword{htest} BayesFactor/man/BFodds-class.Rd0000644000175100001440000000357012562410371016006 0ustar hornikusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/aaClasses.R, R/methods-BFodds.R \docType{class} \name{BFodds-class} \alias{*,BFodds,BFBayesFactor-method} \alias{/,BFodds,BFodds-method} \alias{/,numeric,BFodds-method} \alias{BFodds-class} \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} } } BayesFactor/.Rinstignore0000644000175100001440000000003712452540640015000 0ustar hornikusersMakefile BayesFactor-intro.Rnw