https://github.com/michael-franke/faintr
R package 'faintr' for interpretation of BRMS model fits for data from factorial design experiment
https://github.com/michael-franke/faintr
bayesian brms contrast-coding factorial-design r-package regression rstats stan
Last synced: about 1 year ago
JSON representation
R package 'faintr' for interpretation of BRMS model fits for data from factorial design experiment
- Host: GitHub
- URL: https://github.com/michael-franke/faintr
- Owner: michael-franke
- License: other
- Created: 2022-01-11T13:45:21.000Z (over 4 years ago)
- Default Branch: main
- Last Pushed: 2023-04-12T07:55:59.000Z (about 3 years ago)
- Last Synced: 2024-03-19T03:32:52.970Z (about 2 years ago)
- Topics: bayesian, brms, contrast-coding, factorial-design, r-package, regression, rstats, stan
- Language: R
- Homepage: https://michael-franke.github.io/faintr/index.html
- Size: 10.4 MB
- Stars: 1
- Watchers: 4
- Forks: 1
- Open Issues: 7
-
Metadata Files:
- Readme: README.Rmd
- License: LICENSE
Awesome Lists containing this project
README
---
output: github_document
---
```{r setup, include = FALSE}
knitr::opts_chunk$set(
echo = TRUE,
warning = FALSE,
message = FALSE,
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
library(faintr)
library(brms)
library(posterior)
library(dplyr)
library(tidyr)
library(ggplot2)
library(aida)
theme_set(theme_bw() + theme(plot.background = element_blank()))
custom_palette <- c("#009E73", "#B22222", "#0072B2", "#D55E00")
scale_colour_discrete <- function(...) {
scale_colour_manual(..., values = custom_palette)
}
scale_fill_discrete <- function(...) {
scale_fill_manual(..., values = custom_palette)
}
```
# faintr 
[](https://github.com/michael-franke/faintr/actions)
[](https://app.codecov.io/gh/michael-franke/faintr?branch=main)
## Overview
The **faintr** (FActorINTerpreteR) package provides convenience functions for
interpreting [**brms**](https://paul-buerkner.github.io/brms/) model fits for data
from factorial designs. It allows for the extraction and comparison of posterior
draws for a given design cell, irrespective of the encoding scheme used in the model.
Currently, **faintr** provides the following functions:
* `get_cell_definitions` returns information on the predictor variables and how
they are encoded in the model.
* `extract_cell_draws` returns posterior draws and additional metadata
for all design cells.
* `filter_cell_draws` returns posterior draws and additional metadata
for one subset of design cells.
* `compare_groups` returns summary statistics of comparing two subsets of design cells.
## Installation
You can install the development version from GitHub with:
``` r
# install.packages("devtools")
devtools::install_github("michael-franke/faintr")
```
## Examples
In this section, we shortly introduce how to use the package. For a more detailed
overview, please refer to the [vignette](https://michael-franke.github.io/faintr/articles/faintr_basics.html).
We will use a preprocessed version of the mouse-tracking data set from the [**aida**](https://github.com/michael-franke/aida-package) package:
```{r data-import, echo=FALSE}
data <- aida::data_MT
data <- data %>%
mutate(
prototype_label = case_when(
prototype_label %in% c('curved', 'straight') ~ prototype_label,
TRUE ~ 'CoM'
),
prototype_label = factor(prototype_label,
levels = c('straight', 'curved', 'CoM')))
```
```{r data}
data %>%
select(RT, group, condition, prototype_label) %>%
head()
```
The variables relevant for us are:
* `RT`: Reaction time in milliseconds
* `group`: Whether a category is selected by click vs touch
* `condition`: Whether the animal is a typical vs atypical representative of its category
* `prototype_label`: The type of prototypical movement strategy (straight vs curved vs CoM)
Below, we regress the log-transformed reaction times as a function of factors
`group`, `condition`, `prototype_label`, and their three-way interaction using a
linear regression model fitted with [**brms**](https://paul-buerkner.github.io/brms/):
```{r model-fitting, results='hide'}
fit <- brms::brm(formula = log(RT) ~ group * condition * prototype_label,
data = data,
seed = 123
)
```
To obtain information on the factors and the coding scheme used in the model,
we can use `get_cell_definitions`:
```{r cell-defs}
get_cell_definitions(fit)
```
The output shows that factors `group`, `condition` and `prototype_label` are
dummy-coded, with `click`, `Atypical`, and `straight` being the reference levels, respectively.
To extract posterior draws for all design cells, we can use `extract_cell_draws`:
```{r extract-cell-draws}
extract_cell_draws(fit)
```
With `filter_cell_draws` we can obtain posterior draws for a specific design cell.
For instance, draws for typical exemplars in click trials, averaged over factor `prototype_label`,
can be extracted like so:
```{r filter-cell-draws}
filter_cell_draws(fit, condition == "Typical" & group == "click")
```
Parameter `colname` allows changing the default column name in the output, which
facilitates post-processing of cell draws, e.g., for plotting or summary statistics.
Here, we extract the draws for each level of `prototype_label` (averaged over `group`
and `condition`) and visualize the results:
```{r plot, out.width="70%"}
draws_straight <- filter_cell_draws(fit, prototype_label == "straight", colname = "straight")
draws_curved <- filter_cell_draws(fit, prototype_label == "curved", colname = "curved")
draws_CoM <- filter_cell_draws(fit, prototype_label == "CoM", colname = "CoM")
draws_prototype <- posterior::bind_draws(draws_straight, draws_curved, draws_CoM) %>%
pivot_longer(cols = posterior::variables(.), names_to = "prototype", values_to = "value")
draws_prototype %>%
ggplot(aes(x = value, color = prototype, fill = prototype)) +
geom_density(alpha = 0.4)
```
Finally, we can compare two subsets of design cells with `compare_groups`. Here,
we compare the estimates for atypical exemplars in click trials against typical
exemplars in click trials (averaged over the three prototypical movement strategies):
```{r group-comp}
compare_groups(fit,
higher = condition == "Atypical" & group == "click",
lower = condition == "Typical" & group == "click"
)
```
If one of two group specifications is left out, we compare against the grand mean:
```{r group-comp-grand-mean}
compare_groups(fit,
higher = group == "click"
)
```
If the Boolean flag `include_bf` is set to `TRUE` (default is `FALSE`), Bayes Factors
for the inequality (higher > lower) are approximated in comparison to the "negated hypothesis"
(lower <= higher). However, this requires specifying proper priors for all parameters:
```{r model-fitting-with-priors, results='hide'}
fit_with_priors <- brms::brm(formula = log(RT) ~ group * condition * prototype_label,
prior = prior(student_t(1, 0, 3), class = "b"),
data = data,
seed = 123
)
```
```{r group-comp-with-bf}
compare_groups(fit_with_priors,
higher = prototype_label != "straight",
lower = prototype_label == "straight",
include_bf = TRUE
)
```