Emotional Impact on Memory Part 2

Import

Raw CSV files with all IAPS database and images to be used in each task imported into an object.

raw_df <- read_csv("data/ret_task.csv"
                   , col_types = cols(CR = col_factor(levels = c("same",  "different"))
                   , Emotion = col_factor(levels = c("negative", "neutral"))
                  , Sex = col_factor(levels = c("male", "female"))))

raw_df$CorrectAnswer <- recode(raw_df$CorrectAnswer, a = "l", l = "a")
raw_df$Stimulus1.RESP <- recode(raw_df$Stimulus1.RESP, a = "l", l = "a")

# import tables 

RET_SEEN <- read_csv("data/RET_SEEN.csv")
RET_UNSEEN_NEW <- read_csv("data/RET_UNSEEN_NEW.csv")
RET_PS_a <- read_csv("data/RET_PS_a.csv")

Data Setup

• 75 Negative Images

• 75 Neutral Images

General d-prime score: p(hits|75) and then p(FA|75)

raw_df <- raw_df %>% 
  select_all() %>% 
  mutate(
    Pattern_Sep = case_when(
      CorrectAnswer == Stimulus1.RESP & CorrectAnswer == "a"  ~ "Hit", 
      # Condition checks to match correct answer to 
      CorrectAnswer == Stimulus1.RESP & CorrectAnswer == "l" ~ "Hit",  
      # the participants response. Labelled as "hits"
      CorrectAnswer != Stimulus1.RESP & CorrectAnswer == "l" ~ "Miss", 
      # and "miss" for easy identifying. 
      CorrectAnswer != Stimulus1.RESP & CorrectAnswer == "a" ~ "Miss",
      TRUE  ~ "")) %>% 
  mutate(
    Score = case_when(
      Pattern_Sep == "Hit" ~ 1, # A column of hits and misses coded 1 for hit and 0 for miss
      Pattern_Sep == "Miss" ~ 0
    )
  )  %>% 
  mutate(
    Total_Hits = factor(case_when( # total counts for hits and misses
      Score == 1 ~ 1,
      Score == 0 ~ 0
    )),
    Total_Miss = factor(case_when(
      Score == 0 ~ 1,
      Score == 1 ~ 0
    ))
  )  %>% 
  mutate(Hit_similar = factor(ifelse(CorrectAnswer %in% c("a") &   
                                       # These columns count the appropriate hits and misses
                                Stimulus1.RESP == "a", 1, 0)),      
         # for each emotional condition. 
         Negative_Hit = factor(ifelse(Emotion %in% c("negative") &
                            Pattern_Sep == "Hit", 1, 0)),
         Negative_Miss = factor(ifelse(Emotion %in% c("negative") &
                              Pattern_Sep == "Miss", 1, 0)),
         Neutral_Hit = factor(ifelse(Emotion %in% c("neutral") &
                             Pattern_Sep == "Hit", 1, 0)),
         Neutral_Miss = factor(ifelse(Emotion %in% c("neutral") &
                                 Pattern_Sep == "Miss", 1, 0)))
 
raw_df$Picture <-  str_remove(raw_df$Picture, ".jpg") #remove the jpg extention


# check the column picture number and compare to the originally coded
# tasks use to setup the experiment. 
raw_df <- raw_df %>% 
  mutate(
    coding = case_when(
      Picture %in% RET_PS_a$V1 ~ "SIMILAR", 
      Picture %in% RET_UNSEEN_NEW$nr ~ "NEW", 
      Picture %in% RET_SEEN$nr ~ "OLD",
      TRUE ~ ""))

# Added pattern separation counts similar to Stark(2013)
raw_df <- raw_df %>% 
  mutate(pshits = ifelse(coding %in% c("SIMILAR") & Stimulus1.RESP == "a", 1, 0),
         psmiss = ifelse(coding %in% c("SIMILAR") & Stimulus1.RESP == "l", 1, 0),
         pscr = ifelse(coding %in% c("NEW") & Stimulus1.RESP == "l", 1, 0),
         psfa = ifelse(coding %in% c("NEW") & Stimulus1.RESP == "a", 1, 0))

Grouping Variables and Joining To Long Format:

Temporary tables are then created per subject based on hits and misses.

a <- raw_df %>% group_by(Subject, Neutral_Hit) %>% 
  tally() %>% 
  filter(Neutral_Hit == 1) %>% 
  select(n) %>% 
  rename(Neutral_hits = n) 

b <- raw_df %>% group_by(Subject, Neutral_Miss) %>% 
  tally() %>% 
  filter(Neutral_Miss == 1) %>% 
  select(n) %>% 
  rename(Neutral_miss = n) 

c <- raw_df %>% group_by(Subject, Negative_Hit) %>% 
  tally() %>% 
  filter(Negative_Hit == 1) %>% 
  select(n) %>% 
  rename(Negative_hits = n) 

d <- raw_df %>% group_by(Subject, Negative_Miss) %>% 
  tally() %>% 
  filter(Negative_Miss == 1) %>% 
  select(n) %>% 
  rename(Negative_miss = n) 

e <- full_join(a, b)

f <- full_join(c, d)

g <- full_join(e, f)


h <- raw_df %>% 
  group_by(Subject) %>% 
  filter(Total_Hits == 1) %>% 
  tally() %>% 
  rename("Total_hits" = n)

i <- raw_df %>% 
  group_by(Subject) %>% 
  filter(Total_Miss == 1) %>% 
  tally() %>% 
  rename("Total_miss" = n)

j <- full_join(h, i)
k <- full_join(g, j)

l <- raw_df %>% 
  select(Subject, Sex, Stimulus1.RT) %>% 
  group_by(Subject, Sex) %>% 
  summarise(MeanRT = mean(Stimulus1.RT), )

Ret_task_a <- full_join(l, k)


m <- raw_df %>% 
  select(Subject, Sex, Emotion, Stimulus1.RT) %>% 
  filter(Emotion == "negative") %>% 
  group_by(Subject, Sex) %>% 
  summarise(Neg_RT = mean(Stimulus1.RT))

n <- raw_df %>% 
  select(Subject, Sex, Emotion, Stimulus1.RT) %>% 
  filter(Emotion == "neutral") %>% 
  group_by(Subject, Sex) %>% 
  summarise(Neut_RT = mean(Stimulus1.RT))

# ---
d1 <- raw_df %>% 
  group_by(Subject) %>% 
  filter(Emotion == "negative" & Hit_similar == "1") %>%
  tally() %>%
  rename("Neg_Sim_Hit" = n)

d2 <- raw_df %>% 
  group_by(Subject) %>% 
  filter(Emotion == "neutral" & Hit_similar == "1") %>%
  tally() %>%
  rename("Neut_Sim_Hit" = n)

Ret_task_c <- full_join(d1, d2)

# ---

Ret_task_b <- full_join(m, n)  

Ret_task_d <- full_join(Ret_task_b, Ret_task_c)

Ret_task_df_temp <- full_join(Ret_task_a, Ret_task_d) # temp join of data tables

pattern_sep_scores <- raw_df %>% 
  group_by(Subject, Sex) %>% 
  summarise(n_hits = sum(pshits)
            , n_miss = sum(psmiss)
            , n_cr = sum(pscr)
            , n_fa = sum(psfa)) %>% 
  mutate(n_hits = replace(n_hits, which(is.na(n_hits)), 0)) %>% 
  mutate(n_miss = replace(n_miss, which(is.na(n_miss)), 0)) %>% 
  mutate(n_cr = replace(n_cr, which(is.na(n_cr)), 0)) %>% 
  mutate(n_fa = replace(n_fa, which(is.na(n_fa)), 0))

 
 
pattern_sep_scores <- pattern_sep_scores  %>% 
  mutate(Perc_correct = (n_hits + n_cr)/(n_hits + n_miss + n_fa +n_cr)
         , Dprime = (n_hits/(n_hits + n_miss)-(n_fa/(n_fa + n_cr))))

Ret_task_df_join <-  full_join(Ret_task_df_temp, pattern_sep_scores)


Ret_display <- flextable(Ret_task_df_join)
Ret_display <- bold(Ret_display, part = "header")
Ret_display %>% 
  autofit() %>% 
  empty_blanks() %>% 
  theme_zebra()

Validation Task Data

Validation database imported into an object

val_task <- read_csv(file = "data/val_task.csv")

A table is created by grouping by each subject and then a new variable is computed for each emotion score dimension. There is also response times for each image but wont be using those for this analysis.

val_df <- val_task %>% 
  group_by(Subject) %>% 
  summarise(Arousal = mean(arousal.RESP), Valence = mean(valence.RESP), Dominance = mean(dominance.RESP))

Full join of both tasks to one dataframe in wide format

val_df$Subject <- as.factor(val_df$Subject)

Ret_task_df_join$Subject <- as.factor(Ret_task_df_join$Subject)

group_39_wide <- full_join(Ret_task_df_join, val_df) # Final data table with all computed results

# Display complete dataframe of the variables of interest for analysis 
group_39_wide %>% 
  select(Subject, Sex, Neg_Sim_Hit, Neut_Sim_Hit, Arousal, Valence, Dominance) %>% 
flextable() %>% 
  bold(part = "header")%>% 
  autofit() %>% 
  empty_blanks() %>% 
  theme_zebra()

Descriptives

my_fun <- function(x, num_var){
  num_var <- enquo(num_var)

  x %>%
    summarize(avg = mean(!!num_var), n = n(), 
              sd = sd(!!num_var), se = sd/sqrt(n))
}

mean_response_time <- group_39_wide %>%
  group_by(Sex) %>%
  my_fun(MeanRT)

neg_similar_hits <- group_39_wide %>%
  group_by(Sex) %>%
  na.omit() %>% 
  my_fun(Neg_Sim_Hit)

flextable(mean_response_time)%>% 
  add_header_lines(values = c("Mean Response Times to Stimuli")) %>% 
  autofit() %>% 
  empty_blanks() %>% 
  theme_zebra()

flextable(neg_similar_hits) %>% 
  add_header_lines(values = c("Mean Hits of Pattern Separation Scores")) %>% 
  autofit() %>% 
  empty_blanks() %>% 
  theme_zebra()

Emotion Scores

library(hrbrthemes)
# Gather variables and change to wide format
ret_long <- group_39_wide %>% 
  gather(key, value, Valence, Arousal, Dominance) %>%
  select(Subject, key, value, Sex) %>% 
  rename("Emotion" = key) %>% 
  arrange(desc(Subject))

ggplot(data = ret_long) +
  aes(x = value) +
  geom_histogram(bins = 30, fill = "#1f78b4") +
  labs(title = "Distribution of Emotion Response Scores",
    x = "Mean Scores",
    y = "Ratings",
    subtitle = "IAPS Scores") +
  theme_ft_rc() +
  facet_wrap(vars(Emotion))

Emotion Ratings from Negative Stimuli

# Negative Emotion Scores
val_task %>% 
  filter(condition == "negative") %>% 
  na.omit() %>% 
  group_by(Subject, Sex) %>% 
  summarise(Arousal = mean(arousal.RESP)
            , Dominance = mean(dominance.RESP)
            , Valence = mean(valence.RESP)) %>% 
  gather(key, value, Arousal, Dominance, Valence) %>% 
  rename("Emotion" = key) %>% 
  ggplot(aes(x = value)) +
  geom_histogram(bins = 20, fill = "#1f78b4") +
  labs(title = "Emotion Scores from Negative Stimuli",
       y = "Response",
    subtitle = "Arousal, Dominance and Valence") +
  theme_ft_rc() +
  facet_wrap(vars(Emotion))

As expected, negative stimuli have a higher arousal rating and lower valence rating.

Emotion Ratings from Neutral Stimuli

# Neutral Emotion Scores
val_task %>% 
  filter(condition == "neutral") %>% 
  na.omit() %>% 
  group_by(Subject, Sex) %>% 
  summarise(Arousal = mean(arousal.RESP)
            , Dominance = mean(dominance.RESP)
            , Valence = mean(valence.RESP)) %>% 
  gather(key, value, Arousal, Dominance, Valence) %>% 
  rename("Emotion" = key) %>% 
  ggplot(aes(x = value)) +
  geom_histogram(bins = 20, fill = "#1f78b4") +
  labs(title = "Emotion Scores from the Neutral Condition",
    subtitle = "Arousal, Dominance and Valence") +
  theme_ft_rc() +
  facet_wrap(vars(Emotion))

This is what we would expect. Neutral stimuli should have low arousal ratings and higher valence ratings.

Histogram of Total Negative and Neutral Condition hits

group_39_wide %>% 
  gather(key, value, Neutral_hits, Negative_hits) %>% # change to long format
  select(Subject, Sex, key, value) %>%
  na.omit() %>% 
  ggplot(aes(x = value)) +
  geom_histogram(bins = 22, fill = "#1f78b4") +
  theme_ft_rc() +
  facet_wrap(vars(key)) +
  geom_vline(aes(xintercept = mean(value)), linetype = "dashed") 

Negative Similar Hits (Male vs Females)

This is our overall indicator of if there is evidence of pattern separation performance. The ability to detect a image that was seen in the encoding task and recall if it they had seen it previously.

group_39_wide %>% 
  select(Sex, Neg_Sim_Hit, Subject) %>%
  na.omit() %>% 
  ggplot(aes(x = Neg_Sim_Hit)) +
  geom_histogram(bins = 22, fill = "#1f78b4") +
  labs(title = "Negative Similar Hits",
    subtitle = "Male and Females") +
  theme_ft_rc() +
  facet_wrap(vars(Sex)) +
  geom_vline(data = na.omit(group_39_wide), aes(xintercept = mean(Neg_Sim_Hit)), linetype = "dashed")

Neutral Simiar Hits (Male vs Females)

group_39_wide %>% 
  select(Sex, Neut_Sim_Hit, Subject) %>%
  na.omit() %>% 
  ggplot(aes(x = Neut_Sim_Hit)) +
  geom_histogram(bins = 22, fill = "#1f78b4") +
  labs(title = "Neutral Similar Hits",
       subtitle = "Male and Females") +
  theme_ft_rc() +
  facet_wrap(vars(Sex)) +
  geom_vline(data = na.omit(group_39_wide), aes(xintercept = mean(Neut_Sim_Hit)), linetype = "dashed")

Validated vs Fake Comparisons

We need to check if the altered images were eliciting a similar emotional response as to the original IAPS validated images. There should be no difference between dimensions specifically, arousal and valence. If there is a difference then we dont know if we are actually eliciting the same response from participants as we want to.

I had already processed this file previous created a file with two groups. Group “a” is the original IAPS images with the means and sds taken from the manual. Group “b” is the altered images used in the retrieval task.

IAPS_Fake_df <- read_csv("data/validation_task_df.csv", # import data
    col_types = cols(Group = col_factor(levels = c("b", 
        "a")), aromn = col_number(), dommn = col_number(), 
        valmn = col_number()), na = "0")


# Change to long format

IAPS_Fake_df <- IAPS_Fake_df %>% 
  gather(key, value, aromn, valmn, dommn) %>% 
  rename("Emotion" = key)

IAPS_Fake_df$Emotion <- as.factor(IAPS_Fake_df$Emotion)
IAPS_Fake_df$Group <- as.factor(IAPS_Fake_df$Group)


IAPS_Fake_df %>% 
  na.omit() %>% 
  ggplot() +
  aes(x = Emotion, y = value, fill = Group, colour = Group) +
  geom_boxplot() +
  scale_fill_hue() +
  scale_color_hue() +
  labs(x = "Emotion"
       , y = "Mean Arousal Score"
       , title = "Validated vs Fake Comparison"
       , subtitle = "Original IAPS Images with Altered Images") +
  theme_ft_rc() +
  theme(legend.position = "none") +
  facet_wrap(vars(Group))

Boxplot seems to indicate we are getting pretty similar responses to the IAPS images.

library(ggpubr)

comparison <- compare_means(value ~ Emotion, group.by = "Group",  data = IAPS_Fake_df)

comparison

## # A tibble: 6 x 9
##   Group .y.   group1 group2        p   p.adj p.format p.signif method  
##   <fct> <chr> <chr>  <chr>     <dbl>   <dbl> <chr>    <chr>    <chr>   
## 1 b     value aromn  dommn  0.109    0.33    0.10930  ns       Wilcoxon
## 2 b     value aromn  valmn  0.150    0.33    0.15010  ns       Wilcoxon
## 3 b     value dommn  valmn  0.00362  0.014   0.00362  **       Wilcoxon
## 4 a     value aromn  dommn  0.992    0.99    0.99175  ns       Wilcoxon
## 5 a     value aromn  valmn  0.000505 0.0025  0.00051  ***      Wilcoxon
## 6 a     value dommn  valmn  0.000203 0.00120 0.00020  ***      Wilcoxon

Data Analysis

1. Participants will show increased pattern separation scores on high arousal trials versus low-arousal trials.

2. We expect an interaction effect between sex and emotion, females will have a higher pattern separation score than males for negative stimuli only.

• Will need to pivot the dataframe from wide into long format
• Change the Subject and Condition variables to factors
• Run a mixed model

z <- group_39_wide %>% 
  select(Subject, Sex, Neg_Sim_Hit, Neut_Sim_Hit) %>% 
  gather(key = "Condition", value = "Score", Neg_Sim_Hit, Neut_Sim_Hit) 

# Change to factors 
z$Subject <- as.factor(z$Subject)
z$Condition <- as.factor(z$Condition)

# Run the mixed model and store in object
model <- aov(Score ~ Condition*Sex + Error(Subject/Condition), data = z)

# Summary statistics
summary(model)

## 
## Error: Subject
##           Df Sum Sq Mean Sq F value Pr(>F)
## Sex        1   14.6   14.58   0.359  0.551
## Residuals 54 2191.7   40.59               
## 
## Error: Subject:Condition
##               Df Sum Sq Mean Sq F value Pr(>F)  
## Condition      1   41.3   41.29   6.735 0.0121 *
## Condition:Sex  1    1.7    1.71   0.280 0.5991  
## Residuals     54  331.0    6.13                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# summary function does not immediately display the means for each condition, it does create a data structure that represents 
# this information. And, the means can be found using model.tables

print(model.tables(model,"means"),digits=6)

## Tables of means
## Grand mean
##        
## 18.125 
## 
##  Condition 
##     Neg_Sim_Hit Neut_Sim_Hit
##         18.7321      17.5179
## rep     56.0000      56.0000
## 
##  Sex 
##      male  female
##     18.75 17.9167
## rep 28.00 84.0000
## 
##  Condition:Sex 
##               Sex
## Condition      male    female 
##   Neg_Sim_Hit  19.1429 18.5952
##   rep          14.0000 42.0000
##   Neut_Sim_Hit 18.3571 17.2381
##   rep          14.0000 42.0000

model_means <- aggregate(Score ~ Condition*Sex, data = z, mean) #Subset the means from the model 

# Plot the means from the aggregated object
model_means %>% 
  ggplot(aes(x = Condition, y = Score, group = Sex, color = Sex, shape = Sex)) +
  geom_line(size=1) +
  geom_point(size=3) +
  labs(x = "Emotion Condition"
       , y = "Pattern Separation Score (Sim)"
       , title = "Pattern Separation Scores"
       , subtitle = "Males vs Females") +
  theme_ft_rc()

flextable(model_means)

Comparison with AFEX package

As there are only 2 within conditions for each factor sphericity is assumed

library(afex)

aov_car(formula = Score ~ Condition * Sex + Error(Subject/Condition)
        , check_contrasts = afex_options("check_contrasts")
        , anova_table = list("ges")
        ,data = z) %>% 
  summary()

## 
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
## 
##                Sum Sq num Df Error SS den Df  F value  Pr(>F)    
## (Intercept)   28233.3      1   2191.7     54 695.6350 < 2e-16 ***
## Sex              14.6      1   2191.7     54   0.3593 0.55139    
## Condition        24.1      1    331.0     54   3.9329 0.05245 .  
## Sex:Condition     1.7      1    331.0     54   0.2797 0.59908    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

group_39_wide %>% 
  gather(value = Score, key = Emotion, Arousal, Valence, Dominance) %>% 
  select(Subject, Sex, Emotion, Score) %>% 
  aov_car(formula = Score ~ Emotion * Sex + Error(Subject/Emotion)) %>% 
  summary()

## 
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
## 
##              Sum Sq num Df Error SS den Df   F value    Pr(>F)    
## (Intercept) 2820.11      1   24.695     53 6052.4267 < 2.2e-16 ***
## Sex            0.14      1   24.695     53    0.3005    0.5859    
## Emotion       35.42      2  108.037    106   17.3748 2.975e-07 ***
## Sex:Emotion    0.05      2  108.037    106    0.0255    0.9748    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Mauchly Tests for Sphericity
## 
##             Test statistic    p-value
## Emotion            0.53501 8.6586e-08
## Sex:Emotion        0.53501 8.6586e-08
## 
## 
## Greenhouse-Geisser and Huynh-Feldt Corrections
##  for Departure from Sphericity
## 
##             GG eps Pr(>F[GG])    
## Emotion     0.6826  1.285e-05 ***
## Sex:Emotion 0.6826     0.9312    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##                HF eps   Pr(>F[HF])
## Emotion     0.6944999 1.114802e-05
## Sex:Emotion 0.6944999 9.337959e-01