I’m updating me response here to use ggdist
:
library(brms)
fit3way <- brm(count ~ zAge * visit * Trt,
data = subset(epilepsy, visit %in% c(1,2)),
backend = "cmdstanr", refresh = 0)
#> Start sampling
#> Running MCMC with 4 sequential chains...
#>
#> Chain 1 finished in 0.3 seconds.
#> Chain 2 finished in 0.3 seconds.
#> Chain 3 finished in 0.3 seconds.
#> Chain 4 finished in 0.2 seconds.
#>
#> All 4 chains finished successfully.
#> Mean chain execution time: 0.3 seconds.
#> Total execution time: 2.3 seconds.
library(emmeans)
# 1. estimate conditional means
em_ <- emmeans(fit3way, ~ Trt + visit + zAge,
cov.red = unique)
# 2. estimate the diff of diffs between `visit * Trt` conditional on `zAge`
c_ <- contrast(em_, interaction = c("pairwise", "pairwise"), by = "zAge")
# 3. Plot.... with ggdist!
library(ggplot2)
library(tidybayes)
#>
#> Attaching package: 'tidybayes'
#> The following objects are masked from 'package:brms':
#>
#> dstudent_t, pstudent_t, qstudent_t, rstudent_t
library(ggdist)
#>
#> Attaching package: 'ggdist'
#>
#> The following objects are masked from 'package:brms':
#>
#> dstudent_t, pstudent_t, qstudent_t, rstudent_t
c_draws <- gather_emmeans_draws(c_)
head(c_draws)
#> # A tibble: 6 × 7
#> # Groups: Trt_pairwise, visit_pairwise, zAge [1]
#> Trt_pairwise visit_pairwise zAge .chain .iteration .draw .value
#> <fct> <fct> <dbl> <int> <int> <int> <dbl>
#> 1 0 - 1 1 - 2 0.425 NA NA 1 -7.22
#> 2 0 - 1 1 - 2 0.425 NA NA 2 -4.80
#> 3 0 - 1 1 - 2 0.425 NA NA 3 9.56
#> 4 0 - 1 1 - 2 0.425 NA NA 4 6.91
#> 5 0 - 1 1 - 2 0.425 NA NA 5 -8.73
#> 6 0 - 1 1 - 2 0.425 NA NA 6 -4.80
ggplot(c_draws, aes(zAge, .value)) +
stat_slabinterval()

ggplot(c_draws, aes(zAge, .value)) +
stat_lineribbon()

curve_interval(c_draws, .along = zAge, .width = c(.5, .8, .95)) |>
ggplot(aes(zAge, .value)) +
geom_lineribbon(aes(ymin = .lower, ymax = .upper)) +
geom_line()

We can do the same thing with the new rvar:
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
c_draws_rvar <- c_draws |>
group_by(zAge) |>
summarise(.value = posterior::rvar(.value))
head(c_draws_rvar)
#> # A tibble: 6 × 2
#> zAge .value
#> <dbl> <rvar[1d]>
#> 1 -1.65 -3.1 ± 9.5
#> 2 -1.49 -2.8 ± 8.8
#> 3 -1.33 -2.4 ± 8.2
#> 4 -1.17 -2.0 ± 7.6
#> 5 -1.01 -1.7 ± 7.0
#> 6 -0.853 -1.3 ± 6.5
ggplot(c_draws_rvar, aes(zAge)) +
stat_slabinterval(aes(ydist = .value))

ggplot(c_draws_rvar, aes(zAge)) +
stat_lineribbon(aes(ydist = .value))

curve_interval(c_draws_rvar, .along = zAge, .width = c(.5, .8, .95)) |>
ggplot(aes(zAge, .value)) +
geom_lineribbon(aes(ymin = .lower, ymax = .upper)) +
geom_line()

Created on 2023-04-18 with reprex v2.0.2