In wjhopper/FAM: Forgetting and Memory, an Investigation of the Testing Effect

library(FAM)
library(dplyr)
library(tidyr)
library(whoppeR)
library(ggplot2)
library(grid)
library(gridExtra)
library(pander)
library(afex)
knitr::opts_chunk$set(echo = FALSE, message = FALSE, fig.align='center', fig.width = 8)

# IV <- summary(LB4L2_final, level = "group")
bySubject_group_prac_OCprac <- summary(LB4L2_final, level = "subject")
byGroup_prac_OCprac <- summary(bySubject_group_prac_OCprac)

bySubject_group_prac_WISE <- filter(bySubject_group_prac_OCprac, acc==1) %>%
  mutate(prac_cond = as.character(interaction(practice, OCpractice))) %>%
  WISEsummary(dependentvars = c("p", "logRT_mean"),
              withinvars = "prac_cond",
              betweenvars = "group",
              idvar = "subject",
              na.rm=TRUE) %>%
  rename_(.dots=setNames(names(.),
                         gsub("_mean$", "", names(.))
                         )
          ) %>%
  separate(prac_cond, into = c("practice", "OCpractice"),sep = "\\.") %>%
  recode_conditions() %>%
  select_(.dots = c("group", "practice", "cue_type", "p", "p_sem", "logRT_mean", "logRT_mean_sem"))

control <- filter(bySubject_group_prac_WISE, is.na(cue_type))
intervention <- filter(bySubject_group_prac_WISE, !is.na(cue_type))

plot_data <- bind_rows(intervention,
                       mutate(control, cue_type = "Same Cue"),
                       mutate(control, cue_type = "Other Cue")
                       )

theme_set(theme_bw(base_size = 16) +
          theme(plot.title = element_text(hjust = .5),
                panel.grid = element_blank(),
                axis.title = element_text(size=12)
                )
          )
acc <- ggplot(plot_data,
              aes(x=group, y=p,
                  ymax = p + p_sem,
                  ymin = p - p_sem,
                  shape = practice,
                  group = practice,
                  linetype = practice)) +
  geom_point(size = 2) +
  geom_line(size=.8) +
  geom_errorbar(width=.1, na.rm=TRUE, linetype=1) +
  facet_grid(cue_type ~ .) +
  scale_x_discrete("Group",
                   limits=c("immediate","delay"),
                   labels=c("Immediate","Delay"),
                   expand = c(.25,0)) + 
  scale_y_continuous("Proportion Correct") +
  scale_shape_discrete(guide=FALSE) +
  scale_linetype_manual(guide=FALSE,
                        values= c("solid","dotted","dashed")) +
  ggtitle("Accuracy") + 
  theme(strip.text.y = element_blank(),
        strip.background = element_blank())


RT <- acc %+%
  aes(y = logRT_mean,
      ymin = logRT_mean - logRT_mean_sem,
      ymax = logRT_mean + logRT_mean_sem) +
  scale_y_continuous("Recall Latency (log scale seconds)",
                     breaks = c(.2, .4, .6, .8, 1),
                     labels = as.character(round(exp(c(.2, .4, .6, .8, 1)), 2))
                     ) +
  scale_linetype_manual(name="Practice\nCondition",
                        labels=c("Baseline","Restudy","Test Practice"),
                        values= c("solid","dotted","dashed")) +  
  scale_shape_discrete(name="Practice\nCondition",
                       labels = c("Baseline","Restudy", "Test Practice")) +

  ggtitle("Recall Latency") +
  theme(strip.text.y = element_text(angle=0,
                                    size = 18,
                                    margin = margin(l=8)),
         legend.key.width = unit(2.6, "lines"),
        strip.background = element_blank(),
        legend.margin = margin(l=-90))

g <- arrangeGrob(acc, RT,
                 nrow = 1,
                 ncol = 2,
                 widths = c(.395, .605))
grid.draw(g)

Accuracy and RT by Experimental Condition

opts = options(stringsAsFactors = TRUE)
anova_data <- bySubject_group_prac_OCprac %>%
  filter(acc == 1) %>%
  mutate(subject = factor(subject),
         group = factor(group),
         condition = interaction( practice,  OCpractice )
         )
model <- . ~ group * condition + Error(subject/condition)

#### Accuracy ############################################
model[[2]] <- quote(p)

acc_anova <- aov_car(model, data = anova_data,
                     anova_table = list(es = 'pes'))
pander(nice(acc_anova), caption="Accuracy")

#### Median RT ###########################################
model[[2]] <- quote(RT_median)
RT_median_anova <- aov_car(model,
                           data = group_by(anova_data, subject) %>%
                             summarise(missing = anyNA(RT_median)) %>%
                             filter(!missing) %>%
                             inner_join(anova_data, by = "subject"),
                           anova_table = list(es = 'pes')
                           )
pander(nice(RT_median_anova), caption="Median RT")

model[[2]] <- quote(logRT_mean)
logRT_anova <- aov_car(model,
                       data = group_by(anova_data, subject) %>%
                         summarise(missing = anyNA(logRT_mean)) %>%
                         filter(!missing) %>%
                         inner_join(anova_data, by = "subject"),
                       anova_table = list(es = 'pes')
                       )
pander(nice(logRT_anova), caption="log RT")

logRT_anova_OC_only <- aov_car(model,
                               data = group_by(anova_data, subject) %>%
                                 summarise(missing = anyNA(logRT_mean)) %>%
                                 filter(!missing) %>%
                                 inner_join(anova_data, by = "subject") %>%
                                 ungroup() %>%
                                 filter((practice == "N" &  OCpractice == "N") | OCpractice %in% c("S", "T")),
                               anova_table = list(es = 'pes')
                               )
pander(nice(logRT_anova_OC_only), caption="Other-Cue Only log RT")

logRT_anova_SC_only <- aov_car(model,
                               data = group_by(anova_data, subject) %>%
                                 summarise(missing = anyNA(logRT_mean)) %>%
                                 filter(!missing) %>%
                                 inner_join(anova_data, by = "subject") %>%
                                 ungroup() %>%
                                 filter((practice == "N" &  OCpractice == "N") | practice %in% c("S", "T")),
                               anova_table = list(es = 'pes')
                               )
pander(nice(logRT_anova_SC_only), caption="Same-Cue Only log RT")
options(opts)

Conditional Accuracy and RT

tp_conditional_data <- LB4L2_tp %>%
  ungroup() %>%
  select(subject, group, list, round, target, sameCue, acc, RT) %>%
  rename(prac_RT = RT, prac_acc = acc) %>%
  ungroup() %>%
  gather(key = DV, value = value, prac_RT, prac_acc) %>%
  unite(col = DV, DV, round) %>%
  spread(key = DV, value = value)

final_conditional_data <- LB4L2_final %>%
  ungroup() %>%
  mutate(logRT = log(RT)) %>%  
  select(subject, group, list, target, practice, OCpractice, acc, RT, logRT) %>%
  filter(practice == "T" | OCpractice == "T") %>%
  select(-practice, -OCpractice) %>%
  rename(final_RT = RT, final_acc = acc, final_logRT = logRT)

raw_conditional <- full_join(tp_conditional_data,
                             final_conditional_data,
                             by = c("subject", "group", "list", "target")
                             )

conditional_bySubject <- raw_conditional %>%
  group_by(subject, group, sameCue, prac_acc_1) %>%
  summarise(acc_mean = mean(final_acc),
            acc_n = n(),
            RT_mean = mean(final_RT, na.rm=TRUE),
            logRT_mean = mean(final_logRT, na.rm=TRUE),
            RT_n = sum(!is.na(final_RT))
            ) %>%
  ungroup() %>%
  complete(nesting(subject, group), sameCue, prac_acc_1,
           fill = list(acc_mean = 0))

conditional <- conditional_bySubject %>%
  group_by(group, sameCue, prac_acc_1) %>%
  summarise(p_n = n(),
            p_sem = whoppeR::sem(acc_mean),
            p_CI_width = p_sem * qt(.975, p_n - 1),
            p = mean(acc_mean),
            RT_n = sum(!is.na(RT_mean)),
            RT_mean_sem =  whoppeR::sem(RT_mean, na.rm = TRUE),
            RT_CI_width = RT_mean_sem * qt(.975, RT_n - 1),
            RT_mean = mean(RT_mean, na.rm = TRUE),
            logRT_mean_sem =  whoppeR::sem(logRT_mean, na.rm = TRUE),
            logRT_CI_width = logRT_mean_sem * qt(.975, RT_n - 1),
            logRT_mean = mean(logRT_mean, na.rm = TRUE)
            ) %>%
  ungroup() %>%
  mutate(p_CI_upper = p  + p_CI_width,
         p_CI_lower = p - p_CI_width,
         RT_mean_CI_upper = RT_mean + RT_CI_width,
         RT_mean_CI_lower = RT_mean - RT_CI_width,
         logRT_mean_CI_upper = logRT_mean + logRT_CI_width,
         logRT_mean_CI_lower = logRT_mean - logRT_CI_width) %>%
  select(-contains("width"))

State-Trace Plots

SC_immediate <- filter(byGroup_prac_OCprac,
                       group == "immediate",
                       OCpractice == "N") %>%
  select(-OCpractice)
SC_immediate_conditional <- filter(conditional,
                                   group == "immediate",
                                   sameCue == "yes") %>%
  mutate(practice = recode(prac_acc_1, `0`="T_inc", `1`="T_cor")) %>%
  select(-prac_acc_1, -sameCue)
state_trace_data <- bind_rows(filter(SC_immediate, practice != "T") %>%
                                select(-contains("median"), -contains("recentered")),
                              SC_immediate_conditional)

state_trace_plot <- ggplot(state_trace_data,
                           aes(x=p, y=logRT_mean, shape=practice)) +
  geom_point(size=3) +
  geom_errorbar(aes(ymax=logRT_mean_CI_upper,
                    ymin=logRT_mean_CI_lower),
                width=.025) +
  geom_errorbarh(aes(xmax=p_CI_upper,
                     xmin=p_CI_lower),
                 height=.025) +
  scale_shape_manual("Practice\nCondition",
                     labels = c("Baseline", "Restudy", "Test (Correct)", "Test (Incorrect)"),
                     values = c(15,16,17,4)
                     ) +
  scale_x_continuous("Accuracy") + 
  scale_y_continuous("Recall Latency (log scale seconds)",
                     breaks = seq(.2, .8, by=.1),
                     labels = as.character(round(exp(seq(.2, .8, by=.1)), 2)))

print(state_trace_plot)

Joint Accuracy and RT

# joint_1 <- summary(LB4L2_final, level = "group", given_practice = 1)
# autoplot(joint_1, DV = "accuracy")
# autoplot(joint_1, DV = "RT")

Quantile Plots

calculate_quantiles <- function(data,
                                quantiles = c(.1, .3, .5, .7, .9)) {

  data <- group_by(data, group, practice, OCpractice)
  data <- do(data,
             data.frame(probability = quantile_points,
                        RT = quantile(.$RT,
                                      probs=quantile_points,
                                      names=FALSE)
                        )
             )
   data <- ungroup(data)
   data
}

quantile_points <- seq(.01,1,length.out = 100)
# 
# quantiles_correct <- IV_sub %>%
#   filter(final_acc == 1,
#          !is.na(RT)) %>%
#   calculate_quantiles(quantile_points) %>%
#   left_join(y = IV[IV$final_acc==1,
#                    c("group","practice","OCpractice","mean_p")],
#             by = c("group","practice","OCpractice")) %>%
#   mutate(probability = probability * mean_p) %>%
#   select(-mean_p)
# 
# practice_labels <- c(N.N = "Baseline",
#                      N.S = "Study, Other Cue",
#                      S.N = "Study, Same Cue",
#                      N.T = "Test, Other Cue",
#                      T.N = "Test, Same Cue")
# 
# capitalize <- function(string) {
#   substr(string, 1, 1) <- toupper(substr(string, 1, 1))
#   string
# }
# 
# quantile_plot <- ggplot(quantiles_correct,
#                         aes(x=RT,
#                             y=probability,
#                             color = interaction(practice, OCpractice)
#                             )
#                         ) +
#   geom_line(size=.75) +
#   facet_grid(.~ group,
#              labeller = labeller(.default = capitalize)
#              ) + 
#   scale_color_discrete(name="Condition",
#                        breaks = c("N.N","N.S","N.T","S.N","T.N"),
#                        labels = practice_labels) +
#   scale_x_continuous(breaks = 0:6,
#                      limits=c(0,6)) + 
#   theme_grey(base_size = 16)
# print(quantile_plot)

Pooled Quantiles

Quantiles are calculated using all observed RT's within a condition, pooled over subjects. They conditioned based on the observed accuracy in that condition. Thus, the quantile curves terminate at the observed accuracy for a particular condition, rather than 1.

# IV_acc_pooled <- LB4L2_final %>%
#   group_by(group,practice,OCpractice) %>%
#   summarise(acc=mean(acc))
#   
# pooled_quantiles_correct <- LB4L2_final %>%
#   filter(acc == 1) %>%
#   calculate_quantiles(quantile_points) %>%
#   left_join(y = IV_acc_pooled,
#             by = c("group","practice","OCpractice")) %>%
#   mutate(probability = probability * acc) %>%
#   select(-acc)
# 
# quantile_plot %+% pooled_quantiles_correct

x <- group_by(LB4L2_tp, subject, list, round) %>%
  mutate(duration = lead(onset) - onset) %>%
  ungroup() %>%  
  filter(!is.na(duration)) %>%
  summarise(avg_dur = mean(duration),
            avg_log_dur = mean(log(duration)))