-
Notifications
You must be signed in to change notification settings - Fork 49
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Sampling from Priors #131
Comments
Not currently, but given that they are just multivariate-Cauchy-distributed (as detailed in Rouder et al 2012) you could just sample directly and then multiply by the matrix of contrast codes. |
Using the For example: library(BayesFactor)
data(puzzles)
result <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
progress=FALSE)
chains <- as.data.frame(posterior(result,index = 4, iterations = 10000))
prior_samples_shape <- rcauchy(10000,scale = mean(chains$g_shape))
post_samples_shape_round <- chains$`shape-round`
# test if round parameter is different than 0?
SavageDickeyBF <- approxfun(density(post_samples_shape_round))(0) /
approxfun(density(prior_samples_shape))(0) Thanks! |
Sorry, should the scale of the cauchy be |
r is the scale of the Cauchy distribution. The resulting samples will be samples from the standardised contrast effect size (that is, the effect divided by the error standard deviation). But if you're using Savage-Dickey, you don't need the samples themselves; you only need the density at 0, which you can calculate analytically. |
Perhaps I'm missing something - the posterior samples don't seem to be standerdized - that is, they are affected by the scale of the DV: library(BayesFactor)
#> Loading required package: coda
#> Loading required package: Matrix
#> ************
#> Welcome to BayesFactor 0.9.12-4.2. If you have questions, please contact Richard Morey (richarddmorey@gmail.com).
#>
#> Type BFManual() to open the manual.
#> ************
data(puzzles)
result <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
progress=FALSE)
chains <- as.data.frame(posterior(result,index = 4, iterations = 10000))
puzzles$RT <- puzzles$RT*100
result2 <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
progress=FALSE)
chains2 <- as.data.frame(posterior(result2,index = 4, iterations = 10000))
plot(density(chains$`shape-round` - chains$`shape-square`)) plot(density(chains2$`shape-round` - chains2$`shape-square`)) c(desity_at_0_orig = approxfun(density(chains$`shape-round` - chains$`shape-square`))(0),
desity_at_0_trans = approxfun(density(chains2$`shape-round` - chains2$`shape-square`))(0))
#> desity_at_0_orig desity_at_0_trans
#> 0.0817700892 0.0007774765 Created on 2019-02-25 by the reprex package (v0.2.1) |
Ah, yes - good point ! |
Sorry - I completely misunderstood which part of my message you were replying to! If I understand correctly:
Like so: library(BayesFactor)
#> Loading required package: coda
#> Loading required package: Matrix
#> ************
#> Welcome to BayesFactor 0.9.12-4.2. If you have questions, please contact Richard Morey (richarddmorey@gmail.com).
#>
#> Type BFManual() to open the manual.
#> ************
data(puzzles)
result <- anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
progress=FALSE)
chains <- as.data.frame(posterior(result,index = 4, iterations = 10000))
post_samples_shape_round <- with(chains,(`shape-square` - `shape-round`)/sqrt(sig2))
# test if contrast is different than 0? (multiply scale by 2 for the contrast)
SavageDickeyBF <- dcauchy(0,scale = .5*2) / approxfun(density(post_samples_shape_round))(0)
SavageDickeyBF
#> [1] 2.908753 Created on 2019-02-25 by the reprex package (v0.2.1) Thanks! |
Yes, that's one way to do it. Here's my example: set.seed(1560)
N = 100
k = 2
dat = data.frame(grp = factor(rep(1:k, N)), y = rnorm(N*k))
# for the example
rscale = 1
bf = BayesFactor::lmBF(y ~ grp, data = dat, rscaleFixed = rscale)
chains = BayesFactor::posterior(bf, unreduce = FALSE, iterations = 10000)
# The Rouder et al (2012) priors are based on constrains formed by
# projecting k - 1 means into k dimensions. In reverse, these are essentially
# contrasts. "unreduce" above gives us the unprojected posterior, which we need.
# with k=2, this will be a scaled difference between the two conditions
eff_size = chains[,"grp_redu_1"]
# See Rouder et al for more on how this is done.
# logspline estimate
ls_obj = logspline::logspline(eff_size)
curve(logspline::dlogspline(x, ls_obj), min(eff_size), max(eff_size), col = "blue")
curve(dcauchy(x, scale = rscale), col = "red", add = TRUE)
abline(v = 0, lty = 2)
# Add prior
points(0, dcauchy(0, scale = rscale), pch = 19, col = "red")
# estimate of density at 0, for Savage-Dickey
est0 = logspline::dlogspline(0, ls_obj)
# add point
points(0, est0, col = "blue", pch = 19)
# Savage-Dickey estimate of BF
dcauchy(0, scale = rscale) / est0
# Gaussian quadrature estimate of BF
as.vector(bf)[1]
|
(Note that in my example I start with the standardised posterior samples, and your example starts with the unstandardised ones and "reduces"/standardises them ) |
Thanks Richard! |
If anyone ever ends up here - I've implemented this method in Thanks again! |
One more question regarding priors: |
I've build a function to recreate the prior distributions of the BFmodel parameters - can be found here ( If you get the chance to check this out, that would be amazing. Thanks! |
Seems that the rscale on interaction terms is a multiple of the rscale of the main effects: library(BayesFactor)
#> Loading required package: coda
#> Loading required package: Matrix
#> ************
#> Welcome to BayesFactor 0.9.12-4.2. If you have questions, please contact Richard Morey (richarddmorey@gmail.com).
#>
#> Type BFManual() to open the manual.
#> ************
data(puzzles)
set.seed(4)
result = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID")
set.seed(4)
result2 = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
rscaleEffects = c("shape:color" = (sqrt(2)/2)^2))
set.seed(4)
result3 = anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom = "ID",
rscaleEffects = c("shape:color" = sqrt(2)/2))
result[4]
#> Bayes factor analysis
#> --------------
#> [1] shape + color + shape:color + ID : 4.301216 ±2.34%
#>
#> Against denominator:
#> RT ~ ID
#> ---
#> Bayes factor type: BFlinearModel, JZS
result2[4]
#> Bayes factor analysis
#> --------------
#> [1] shape + color + shape:color + ID : 4.301216 ±2.34%
#>
#> Against denominator:
#> RT ~ ID
#> ---
#> Bayes factor type: BFlinearModel, JZS
result3[4]
#> Bayes factor analysis
#> --------------
#> [1] shape + color + shape:color + ID : 3.307638 ±2.37%
#>
#> Against denominator:
#> RT ~ ID
#> ---
#> Bayes factor type: BFlinearModel, JZS Created on 2019-05-23 by the reprex package (v0.2.1) |
The prior on an interaction is the same as the prior type it becomes: e.g., fixed by fixed interaction is fixed, so it gets the fixed prior; a fixed by random interaction is random, so it gets the random prior; a fixed by continuous interaction is continuous, so it gets the continuous prior. |
Thanks for the reply! If I understand correctly for what you say and from the following simulation:
library(BayesFactor)
#> Loading required package: coda
#> Loading required package: Matrix
#> ************
#> Welcome to BayesFactor 0.9.12-4.2. If you have questions, please contact Richard Morey (richarddmorey@gmail.com).
#>
#> Type BFManual() to open the manual.
#> ************
set.seed(4)
n <- 40
X <- rnorm(n)
X2 <- rnorm(n)
G <- rep(c(0,1), each = n/2)
G2 <- rep(c(0,1), times = n/2)
Y <- (X + G2)*(G + X2) + rnorm(n, sd = 0.5)
df <- data.frame(X = X,
X2 = X2,
G = factor(G),
G2 = factor(G2),
Y = Y)
# fixed by fixed ----------------------------------------------------------
set.seed(4)
BF1 <- lmBF(Y ~ G2*G, df, progress = FALSE)
set.seed(4)
BF2 <- lmBF(Y ~ G2*G, df, progress = FALSE,
rscaleEffects = c("G2:G" = (sqrt(2)/2) * (sqrt(2)/2)))
set.seed(4)
BF3 <- lmBF(Y ~ G2*G, df, progress = FALSE,
rscaleEffects = c("G2:G" = (sqrt(2)/2)))
extractBF(BF1)$bf # default
#> [1] 3.799659
extractBF(BF2)$bf # same as default
#> [1] 3.799659
extractBF(BF3)$bf
#> [1] 3.794392
# fixed by cont -----------------------------------------------------------
set.seed(4)
BF1 <- lmBF(Y ~ X*G, df, progress = FALSE)
set.seed(4)
BF2 <- lmBF(Y ~ X*G, df, progress = FALSE,
rscaleCont = c("X:G" = (sqrt(2)/4) * (sqrt(2)/2)))
set.seed(4)
BF3 <- lmBF(Y ~ X*G, df, progress = FALSE,
rscaleCont = c("X:G" = (sqrt(2)/4)))
extractBF(BF1)$bf # default
#> [1] 6.18353
extractBF(BF2)$bf
#> [1] 7.229012
extractBF(BF3)$bf # same as default
#> [1] 6.18353
# cont by cont ------------------------------------------------------------
set.seed(4)
BF1 <- lmBF(Y ~ X2*X, df, progress = FALSE)
set.seed(4)
BF2 <- lmBF(Y ~ X2*X, df, progress = FALSE,
rscaleCont = c("X2:X" = (sqrt(2)/4) * (sqrt(2)/4)))
set.seed(4)
BF3 <- lmBF(Y ~ X2*X, df, progress = FALSE,
rscaleCont = c("X2:X" = (sqrt(2)/4)))
extractBF(BF1)$bf # default
#> [1] 7850662
extractBF(BF2)$bf
#> [1] 3141049
extractBF(BF3)$bf # same as default
#> [1] 7850662 Created on 2019-06-02 by the reprex package (v0.3.0) |
The default scale for fixed factors is 1/2 (see BayesFactor/pkg/BayesFactor/R/common.R Lines 202 to 206 in 87013ba
|
Oh! Thanks as always for your patience, Richard! |
Hi Richard,
Is it currently possible to get samples for the prior distributions?
(What I would really like to do it compute a BF for a specific "contrast" using the Savage-Dickey density ratio method. I've read you post of equality constraints, but found the application very difficult when trying to break down an interaction by comparing two simple effects).
Thanks!
The text was updated successfully, but these errors were encountered: