Lab meeting contrasts demo

contrast_demo.R

library(tidyverse)
library(lme4)

sgf <- read_csv("https://raw.githubusercontent.com/langcog/experimentology/main/data/tidyverse/stiller_scales_data.csv") |>
  mutate(age_group = cut(age, 2:5, include.lowest = TRUE), 
         condition_f = factor(ifelse(condition == "Label", 
                                     "Experimental", "Control")),
         age_centered = age - mean(age))

mod1 <- glmer(correct ~ age * condition + (1|subid) + (1|item), 
                   data = sgf, 
                   family = "binomial")

summary(mod1)

mean(sgf$age)

mod2 <- glmer(correct ~ age_centered * condition + (1|subid) + (1|item), 
              data = sgf, 
              family = "binomial")

summary(mod2)

# this model lets us test control vs. 50% AND experimental vs. control
mod3 <- glmer(correct ~ age_centered * condition_f + (1|subid) + (1|item), 
              data = sgf, 
              family = "binomial")

summary(mod3)

# this model lets us test experimental vs. 50% AND experimental vs. control
sgf$condition_fa <- fct_relevel(sgf$condition_f, "Experimental")
mod3a <- glmer(correct ~ age_centered * condition_fa + (1|subid) + (1|item), 
              data = sgf, 
              family = "binomial")

summary(mod3a)

# predictions
b <- fixef(mod3)

# y = inv.logit(b0 + ...) 
boot::inv.logit(b[1]) # prediction for control condition at age 3.5
boot::inv.logit(b[1] + b[3]) # prediction for experimental condition at age 3.5
boot::inv.logit(b[1] + b[2]*1.5) # prediction for control condition at age 5
boot::inv.logit(b[1] + b[2]*1.5 + b[3] + b[4]*1.5) # prediction for experimental condition at age 5

# use deviation coding
sgf$condition_deviation <- sgf$condition_f
contrasts(sgf$condition_deviation) <- contr.sum(2)/2
mod4 <- glmer(correct ~ age_centered * condition_deviation + (1|subid) + (1|item), 
               data = sgf, 
               family = "binomial")

summary(mod4)

# deviation coding with 1, -1
sgf$condition_deviation1 <- sgf$condition_f
contrasts(sgf$condition_deviation1) <- contr.sum(2)
mod4a <- glmer(correct ~ age_centered * condition_deviation1 + (1|subid) + (1|item), 
              data = sgf, 
              family = "binomial")

summary(mod4a)

# deviation coding with 1, -1
mod5 <- glmer(correct ~ age_centered * condition_f + (1|subid) + 
                (condition|item), 
               data = sgf, 
               family = "binomial")

summary(mod5)


ggplot(sgf, aes(x = age, y = correct, col = condition_f)) + 
  geom_jitter(width = .1, height = .05) + 
  geom_smooth(method = "lm") + 
  facet_wrap(~item)