Practical Part in R

What are we gonna do?

  • Clean and plot a simplified version of the raw data

  • Simulate the simple RL model with the fitted parameters

  • Simulate the RL model that includes forgetting with the fitted parameters

1. Load raw data

setwd("/Users/sabrinaspoeri/Library/CloudStorage/OneDrive-UniversitätHamburg/01_Studium/Master/2. Semester/cognitive_modelling")
library(ggplot2)
library(dplyr)

raw_data <- read.csv("CollinsFrank_2012_EJoN.csv")
head(raw_data, 2)
  subno block ns time stimseq imageseq folderseq iterseq corAseq choice key cor
1     1     1  2    1       1        4         3       1       2      3  97   0
2     1     1  2    2       1        4         3       2       2      3  97   0
  rew        rt condition..HC.0.SZ.1. pcor delay
1   0 0.6300579                   NaN    0   NaN
2   0 0.8790611                   NaN    0   NaN

2. Select only the relevant conditions

clean_data <- raw_data %>%
  select(subno, ns, iterseq, cor) %>%
  filter(ns %in% c(2, 6))
head(clean_data)
  subno ns iterseq cor
1     1  2       1   0
2     1  2       2   0
3     1  2       1   0
4     1  2       3   0
5     1  2       2   0
6     1  2       3   0

3. Summarise correct responses per trial and set-size

observed_learning <- clean_data %>%
  group_by(ns, iterseq) %>%
  summarise(correct = mean(cor), .groups = "drop") %>%
  mutate(ns = factor(ns))
head(observed_learning)
# A tibble: 6 × 3
  ns    iterseq correct
  <fct>   <int>   <dbl>
1 2           1   0.334
2 2           2   0.664
3 2           3   0.933
4 2           4   0.964
5 2           5   0.965
6 2           6   0.968

4. Plot observed data

5. Define the RL model function

simulate_RL <- function(n_trials = 15,
                         alpha   = 0.38,  
                         beta    = 7.1,    
                         n_sims  = 500) {
  
  set.seed(42)
  n_actions <- 3
  results <- matrix(NA, nrow = n_sims, ncol = n_trials)
  
  for (i in 1:n_sims) {
    Q <- rep(1/n_actions, n_actions)      
    correct_action <- sample(1:n_actions, 1)
    
    for (t in 1:n_trials) { 
      exp_Q <- exp(beta * Q)
      probs <- exp_Q / sum(exp_Q)
      decision  <- sample(1:n_actions, 1, prob = probs)
      
      reward <- as.numeric(decision == correct_action)
      results[i, t] <- reward
      
      Q[decision] <- Q[decision] + alpha * (reward - Q[decision])
    }
  }
  data.frame(
    iterseq = 1:n_trials,
    correct = colMeans(results)
  )
}

6. Run the simulation

rl_curve <- simulate_RL()
print(rl_curve)
   iterseq correct
1        1   0.322
2        2   0.550
3        3   0.756
4        4   0.864
5        5   0.938
6        6   0.982
7        7   0.972
8        8   0.970
9        9   0.994
10      10   0.986
11      11   0.996
12      12   0.988
13      13   0.992
14      14   0.986
15      15   0.992

7. Plot the simple RL models learning curve

8. Simulate the three-parameter forgetful model (RLF)

simulate_RLF <- function(n_trials = 15,
                          alpha   = 0.29, 
                          beta    = 24.1,   
                          epsilon = 0.07, 
                          ns      = 2,    
                          n_sims  = 500) {
  set.seed(42)
  n_actions <- 3
  results <- matrix(NA, nrow = n_sims, ncol = n_trials)
  
  for (i in 1:n_sims) {
    Q <- matrix(1/n_actions, nrow = ns, ncol = n_actions)
    correct_actions <- sample(1:n_actions, ns, replace = TRUE)
    stimulus_order <- rep(1:ns, n_trials)[order(runif(ns * n_trials))]
    
    zaehler <- integer(ns)
    
    for (t in seq_along(stimulus_order)) {
      s <- stimulus_order[t]
      zaehler[s] <- zaehler[s] + 1
      if (zaehler[s] > n_trials) next

      exp_Q <- exp(beta * Q[s, ])
      probs <- exp_Q / sum(exp_Q)
      choice  <- sample(1:n_actions, 1, prob = probs)
      
      reward<- as.numeric(choice == correct_actions[s])
      results[i, zaehler[s]] <- reward
      
      Q[s, choice] <- Q[s, choice] + alpha * (reward - Q[s, choice])
      
      Q <- Q + epsilon * (1/n_actions - Q)
    }
  }
  
  data.frame(
    iterseq = 1:n_trials,
    correct = colMeans(results, na.rm = TRUE),
    ns      = factor(ns)
  )
}

9. Prepare RL model output for plotting

rlf_curves <- bind_rows(
  simulate_RLF(ns = 2),
  simulate_RLF(ns = 6)
)
print(rlf_curves)
   iterseq correct ns
1        1   0.364  2
2        2   0.640  2
3        3   0.870  2
4        4   0.968  2
5        5   0.994  2
6        6   1.000  2
7        7   1.000  2
8        8   1.000  2
9        9   1.000  2
10      10   1.000  2
11      11   1.000  2
12      12   1.000  2
13      13   1.000  2
14      14   1.000  2
15      15   1.000  2
16       1   0.328  6
17       2   0.532  6
18       3   0.718  6
19       4   0.840  6
20       5   0.886  6
21       6   0.926  6
22       7   0.958  6
23       8   0.950  6
24       9   0.962  6
25      10   0.970  6
26      11   0.976  6
27      12   0.974  6
28      13   0.962  6
29      14   0.962  6
30      15   0.966  6

10. Plot the three-parameter forgetful model (RLF)

11. Prepare for plotting

rl_plot <- bind_rows(
  mutate(rl_curve, ns = factor(2)),
  mutate(rl_curve, ns = factor(6))
)

plot_combined <- bind_rows(
  mutate(observed_learning, modell = "Observed data"),
  mutate(rl_plot,           modell = "RL model"),
  mutate(rlf_curves,        modell = "RLF model")
) %>%
  mutate(modell = factor(modell, levels = c("Observed data", "RL model", "RLF model")))

plot_combined %>%
  group_by(modell) %>%
  slice(1)
# A tibble: 3 × 4
# Groups:   modell [3]
  ns    iterseq correct modell       
  <fct>   <int>   <dbl> <fct>        
1 2           1   0.334 Observed data
2 2           1   0.322 RL model     
3 2           1   0.364 RLF model

12. Combined Plot

Thank you for your attention!