Intro

These are the publication-quality graphics and extra analyses for the P034b project investigating the role of feedback in a many-to-one task. Including all data through February of 2025.

{r import_data, echo=FALSE, warning=FALSE, message=FALSE} # # Import data # my_options <- options(digits.secs = 6) # We have to set R's default time settings to include 6 decimal places for seconds # # combined_data <- "/Users/cyruskirkman/Desktop/P034 - Feedback in Memory Task/Analysis/P034b Analysis -IY_CK - 06_28_23/P034b_data" %>% # First, take the master directory of each file # fs::dir_ls(type = "directory")%>% # Create a list of each folder's directory # fs::dir_ls(regexp = "\\.csv$")%>% # Create a list of each file's directory # tibble(file_path = .) %>% # filter(!grepl("-DESKTOP-", file_path)) %>% # pull(file_path) %>% # tibble(file_path = .) %>% # filter(!grepl("TEST", file_path)) %>% # pull(file_path) %>% # map_dfr(function(file) { # data <- read_csv(file, show_col_types = FALSE) # if (!"StimulusSetNum" %in% names(data)) { # warning(sprintf("Variable StimulusSetNum not found in %s", file)) # data$StimulusSetNum <- NA # } # if (!"TrialSubStageTimer" %in% names(data)) { # warning(sprintf("Variable TrialSubStageTimer not found in %s", file)) # data$TrialSubStageTimer <- NA # } # mutate(data, # SessionTime = as.POSIXct(SessionTime, # format = "%H:%M:%S"), # Xcord = as.numeric(Xcord), # Ycord = as.numeric(Ycord), # TrialSubStage = as.character(TrialSubStage), # TrialTime = as.numeric(TrialTime), # TrialNum = as.numeric(TrialNum), # NonCPTrialNum = as.numeric(NonCPTrialNum), # DelayDuration = as.numeric(DelayDuration), # FeedbackDuration = as.numeric(FeedbackDuration), # SampleFR = as.numeric(SampleFR), # TrainingPhase = as.numeric(TrainingPhase), # Date = as.Date(Date, # format = "%Y-%m-%d"), # TrialSubStageTimer = as.numeric(TrialSubStageTimer), # StimulusSetNum = as.numeric(StimulusSetNum)) }) %>% # filter (!Subject %in% c("Jubilee", "Hawthorne")) # Remove some subjects #

phase_data <- data.frame(StimulusSetNum = c(3, 12, 2, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17))

# Make table...
phase_data %>%
  mutate(Category = case_when(
    StimulusSetNum %in% c(3, 12) ~ "i",
    StimulusSetNum %in% c(2, 4) ~ "ii",
    StimulusSetNum %in% c(5, 6, 7, 8, 9) ~ "iii",
    StimulusSetNum %in% c(10) ~ "iv",
    StimulusSetNum %in% c(11) ~ "v",
    StimulusSetNum %in% c(13) ~ "vi",
    StimulusSetNum %in% c(14) ~ "vii",
    StimulusSetNum %in% c(15) ~ "viii",
    StimulusSetNum %in% c(16, 17) ~ "ix",
    TRUE ~ NA_character_  # Handle other cases, if any
  )) %>%
  group_by(Category) %>%
  summarise(StimulusSets = toString(StimulusSetNum)) %>%
  gt() %>%
  #tab_spanner(label = "Stimulus Set", columns = c(StimulusSets)) %>%
  tab_header(
    title = "P034b Phases",
    subtitle = "Stimulus Set Numbers Per Phase"
  )
P034b Phases
Stimulus Set Numbers Per Phase
Category StimulusSets
i 3, 12
ii 2, 4
iii 5, 6, 7, 8, 9
iv 10
ix 16, 17
v 11
vi 13
vii 14
viii 15

P034b.i - Informative Feedback vs. Immediate Outcome (IFvIO)

P034b.ii - Informative feedback vs. non-informative feedback with identical control cues (IFvN-IF)

P034b.iii - Informative feedback vs. paired non-informative feedback (IFvPNIF)

4 pairs per group

8 pairs per group

16 pairs per group

P034b.iv - Informative feedback vs. varied non-informative feedback (IFvVNIF)

P034b.v - Informative feedback vs. blank interval (IFvBI)

P034b.vi - Informative feedback vs. paired categorical feedback (IFvPCF)

P034b.vii - Informative feedback vs. unpaired categorical feedback (IFvUPCF)

P034b.viii - Paired categorical feedback vs. unpaired categorical feedback (PCFvUPCF)

# {r P034b.PCFvUPCF_combined_by_stim_rolling_avg_with_mean_sessions, echo=FALSE, warning=FALSE, message=FALSE} # # This graph calculates is the same as above, except it now combines all averages together. # rolling_window_size <- 250 # phase_name <- substitute(paste(bold("P034b.viii (PCFvUPCF)"))) # stimulus_set_vec <- c(15) # fig_caption <- # "Figure 42. Combined learning curves showing change in performance (e.g., accuracy) # over time (e.g., fractions of total sessions) across the two conditions: Control and # Experimental. Accuracy is calculated via rolling averages (n = 250) and compared to # each other via Clopper-Pearson 'exact' method (shading shows 95% CI)." # # combined_data %>% # # Select the relevant columns # select(Event, SampleStimulus, StimulusCondition, TrialNum, Subject, # TrainingPhase, Date, StimulusSetNum) %>% # # Remove specific subject data # # filter(Subject %in% c("Peach"))%>% # # Remove sessions with too few trials # group_by(Subject, Date) %>% # mutate(MaxTrialsCompletedPerSession = max(TrialNum)) %>% # filter(strtoi(MaxTrialsCompletedPerSession) >= 72) %>% # # Filter one StimulusSetNum # filter(StimulusSetNum %in% stimulus_set_vec) %>% # # Select one data point per trial # filter(Event %in% c("correct_choice", # "incorrect_choice")) %>% # # Get session number from date # group_by(Subject, StimulusSetNum) %>% # mutate(SessionNum = dense_rank(Date)) %>% # ungroup() %>% # # Make all trials consecutive... # group_by(Subject, StimulusSetNum, StimulusCondition) %>% # mutate(TrialRank = (SessionNum * 100) + TrialNum, # Assumes fewer than 100 trials per session # TrialRank = dense_rank(TrialRank), # MaxTrial = max(TrialRank), # PropTrial = TrialRank / MaxTrial) %>% # # Convert choice to a binary # mutate(BinaryOutcome = ifelse(Event == "correct_choice", # 1, # 0)) %>% # # Sort by TrialRank within each group # group_by(StimulusCondition, StimulusSetNum) %>% # arrange(PropTrial) %>% # # Calculate rolling mean and confidence intervals using rollapply # mutate( # rolling_mean = rollapply(Event, # rolling_window_size, # FUN = function(x) mean(x == "correct_choice"), # fill = NA), # lower_CI = rollapply(BinaryOutcome, # rolling_window_size, # FUN = function(x) binom.confint(sum(x), # length(x), # method = "exact")$lower, # fill = NA), # upper_CI = rollapply(BinaryOutcome, # rolling_window_size, # FUN = function(x) binom.confint(sum(x), # length(x), # method = "exact")$upper, # fill = NA) # ) %>% # ungroup() %>% # #group_by(StimulusSetNum, StimulusCondition, TrialRank) %>% # # Then plot... # ggplot(aes(x = PropTrial, # fill = StimulusCondition)) + # geom_hline(yintercept = 0.5, # linetype = "dotted") + # geom_hline(yintercept = 0.8, # linetype = "dashed") + # geom_ribbon(aes(ymin = lower_CI, # ymax = upper_CI), # alpha = 0.7) + # geom_line(aes(y = rolling_mean), # linewidth = 0.4) + # facet_wrap(vars(StimulusSetNum)) + # xlab("Proportion of Rolling Trials") + # ylab("% Correct") + # ggtitle(phase_name) + # theme( # panel.grid.major = element_blank(), # panel.grid.minor = element_blank(), # panel.background = element_blank(), # panel.border = element_rect(color = "black", fill = NA), # axis.line = element_line(colour = "black") # ) + # labs(color = "Stimulus Condition", # caption = fig_caption # ) + # scale_fill_manual( # values = c("red4", "lightskyblue"), # #values = wes_palette("Cavalcanti1", n = 2), # labels = c("Control", "Experimental") # ) # # {r P034b.PCFvUPCF_combined_by_session_by_stim_rolling_avg_with_mean_sessions, echo=FALSE, warning=FALSE, message=FALSE} # # This graph calculates is the same as above, except it now combines all averages # # together across stimulus sets. # # rolling_window_size <- 250 # #phase_name <- "P034.x (IFv4PN-IF) -" # phase_name <- substitute(paste(bold("P034b.viii (PCFvUPCF)"))) # stimulus_set_vec <- c(15) # fig_caption <- # "Figure 43. Combined learning curves showing change in performance (e.g., accuracy) # over time (e.g., fractions of total sessions) across the two conditions: Control and # Experimental. Accuracy is calculated via rolling averages (n = 250) and compared to # each other via Clopper-Pearson 'exact' method (shading shows 95% CI)." # # combined_data %>% # # Select the relevant columns # select(Event, SampleStimulus, StimulusCondition, TrialNum, Subject, # TrainingPhase, Date, StimulusSetNum) %>% # # Remove specific subject data # # filter(Subject %in% c("Peach"))%>% # # Remove sessions with too few trials # group_by(Subject, Date) %>% # mutate(MaxTrialsCompletedPerSession = max(TrialNum)) %>% # filter(strtoi(MaxTrialsCompletedPerSession) >= 72) %>% # # Filter one StimulusSetNum # filter(StimulusSetNum %in% stimulus_set_vec) %>% # # Select one data point per trial # filter(Event %in% c("correct_choice", # "incorrect_choice")) %>% # # Get session number from date # group_by(Subject, StimulusSetNum) %>% # mutate(SessionNum = dense_rank(Date)) %>% # ungroup() %>% # # Make all trials consecutive... # group_by(Subject, StimulusSetNum, StimulusCondition) %>% # mutate(TrialRank = (SessionNum * 100) + TrialNum, # Assumes fewer than 100 trials per session # TrialRank = dense_rank(TrialRank), # MaxTrial = max(TrialRank), # PropTrial = TrialRank / MaxTrial) %>% # # Convert choice to a binary # mutate(BinaryOutcome = ifelse(Event == "correct_choice", # 1, # 0)) %>% # # Sort by TrialRank within each group (note combination across stimulus sets) # group_by(StimulusCondition) %>% # arrange(PropTrial) %>% # # Calculate rolling mean and confidence intervals using rollapply # mutate( # rolling_mean = rollapply(Event, # rolling_window_size, # FUN = function(x) mean(x == "correct_choice"), # fill = NA), # lower_CI = rollapply(BinaryOutcome, # rolling_window_size, # FUN = function(x) binom.confint(sum(x), # length(x), # method = "exact")$lower, # fill = NA), # upper_CI = rollapply(BinaryOutcome, # rolling_window_size, # FUN = function(x) binom.confint(sum(x), # length(x), # method = "exact")$upper, # fill = NA) # ) %>% # ungroup() %>% # #group_by(StimulusSetNum, StimulusCondition, TrialRank) %>% # # Then plot... # ggplot(aes(x = PropTrial, # fill = StimulusCondition)) + # geom_hline(yintercept = 0.5, # linetype = "dotted") + # geom_hline(yintercept = 0.8, # linetype = "dashed") + # geom_ribbon(aes(ymin = lower_CI, # ymax = upper_CI), # alpha = 0.7) + # geom_line(aes(y = rolling_mean), # linewidth = 0.4) + # #facet_wrap(vars(StimulusSetNum)) + # xlab("Proportion of Rolling Trials") + # ylab("% Correct") + # ggtitle(phase_name) + # theme( # panel.grid.major = element_blank(), # panel.grid.minor = element_blank(), # panel.background = element_blank(), # panel.border = element_rect(color = "black", fill = NA), # axis.line = element_line(colour = "black") # ) + # labs(color = "Stimulus Condition", # caption = fig_caption # ) + # scale_fill_manual( # values = c("red4", "lightskyblue"), # #values = wes_palette("Cavalcanti1", n = 2), # labels = c("Control", "Experimental") # ) #

P034b.ix - Informative feedback vs. signaled feedback (IFvSF)

Combined graphics