CERT behavioral analysis
Nikki Puccetti
7/20/2023
###Load libraries
###Load data
###Create wideform summary dfs
Descriptive Tables:
Emotion Ratings
summary_allobs_emo <- describeBy(emo_resp ~ PicValence + Procedure, data=cert_mna, mat=T)
#print(summary_allobs)
htmlTable::htmlTable(format(summary_allobs_emo,
digits = 2)) | item | group1 | group2 | vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| emo_resp1 | 1 | neg | reg | 1 | 2178 | 3.1 | 1.19 | 3 | 3.2 | 1.5 | 1 | 5 | 4 | -0.024 | -0.92 | 0.026 |
| emo_resp2 | 2 | neut | reg | 1 | 2153 | 1.3 | 0.58 | 1 | 1.1 | 0.0 | 1 | 5 | 4 | 2.537 | 7.38 | 0.013 |
| emo_resp3 | 3 | neg | watch | 1 | 2183 | 3.7 | 1.15 | 4 | 3.8 | 1.5 | 1 | 5 | 4 | -0.562 | -0.59 | 0.025 |
| emo_resp4 | 4 | neut | watch | 1 | 2163 | 1.3 | 0.65 | 1 | 1.1 | 0.0 | 1 | 5 | 4 | 2.606 | 7.52 | 0.014 |
Thinking Change Ratings
summary_allobs_er <- describeBy(er_resp ~ PicValence + Procedure, data=cert_mna, mat=T)
#print(summary_allobs)
htmlTable::htmlTable(format(summary_allobs_er,
digits = 2)) | item | group1 | group2 | vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| er_resp1 | 1 | neg | reg | 1 | 2180 | 3.1 | 1.15 | 3 | 3.1 | 1.5 | 1 | 5 | 4 | -0.091 | -0.80 | 0.025 |
| er_resp2 | 2 | neut | reg | 1 | 2168 | 2.7 | 1.13 | 3 | 2.7 | 1.5 | 1 | 5 | 4 | 0.159 | -0.73 | 0.024 |
| er_resp3 | 3 | neg | watch | 1 | 2151 | 1.7 | 1.07 | 1 | 1.5 | 0.0 | 1 | 5 | 4 | 1.489 | 1.44 | 0.023 |
| er_resp4 | 4 | neut | watch | 1 | 2144 | 1.3 | 0.74 | 1 | 1.1 | 0.0 | 1 | 5 | 4 | 2.719 | 7.88 | 0.016 |
Visualizations:
On average, the group found negative images more negative
and they changed their thinking more during the reappraise trials
sumdf_l$Valence <- factor(sumdf_l$Valence,
levels=c("neg","neut"),
labels=c("Negative","Neutral"))
sumdf_l$Condition <- factor(sumdf_l$Condition,
levels=c("reg","watch"),
labels=c("Regulate","Watch"))
sumdf_l$Rating_Type <- factor(sumdf_l$Rating_Type,
levels=c("emo_resp","er_resp"),
labels=c("Emotion","Thinking Change"))
ggplot(data = sumdf_l, aes(x = Condition, y = Rating, color = Valence)) +
geom_boxplot(aes(fill=Valence), alpha = .5) +
facet_wrap(~Rating_Type) +
labs(y = "Rating", x = "Condition") +
ggtitle("Ratings across Valence and Conditions") +
theme_minimal() 
emosum <- ggplot(data = sumdf, aes(x = Procedure, y = emo_resp, color = PicValence)) +
geom_boxplot(aes(fill=PicValence), alpha = .5) +
labs(y = "Emotion Rating", x = "Condition") +
ggtitle("Ratings across Valence and Conditions") +
theme(legend.position = "none")
regsum <- ggplot(data = sumdf, aes(x = Procedure, y = er_resp, color = PicValence)) +
geom_boxplot(aes(fill=PicValence), alpha = .5) +
labs(y = "Regulation Rating", x = "Condition") +
ggtitle(" ")
#grid.arrange(emosum,regsum,nrow=1)Distribution of Emotion Ratings on Negative trials:
Purple = regulate
Blue = watch
Green = difference between reg and watch
sumdf_emo$cond22<- paste(sumdf_emo$PicValence,sumdf_emo$Procedure,sep="_")
sumdf_reg$cond22<- paste(sumdf_reg$PicValence,sumdf_reg$Procedure,sep="_")
sumdf_emo <- sumdf_emo[,-c(2,3)]
sumdf_reg<- sumdf_reg[,-c(2,3)]
sumdf_emo_w<-spread(sumdf_emo, key=cond22, value=emo_resp)
sumdf_reg_w<-spread(sumdf_reg, key=cond22, value=er_resp)
sumdf_emo_w$diff <- sumdf_emo_w$neg_watch - sumdf_emo_w$neg_reg
sumdf_reg_w$diff <- sumdf_reg_w$neg_watch - sumdf_reg_w$neg_reg
negemodens<-ggplot(data = sumdf_emo_w) +
geom_density(aes(x=neg_reg), alpha = .4, fill = "plum4")+
geom_density(aes(x=neg_watch), alpha = .4, fill = "cadetblue4") +
geom_density(aes(x=diff), alpha = .4, fill = "palegreen4")
negemodens + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
Distribution of Thinking Change Ratings on Negative trials:
negemoregdens<-ggplot(data = sumdf_reg_w) +
geom_density(aes(x=neg_reg), alpha = .4, fill = "plum1")+
geom_density(aes(x=neg_watch), alpha = .4, fill = "cadetblue1") +
geom_density(aes(x=diff), alpha = .4, fill = "palegreen1")
negemoregdens + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
#Decompose within and between person effects for model
cert_mna$emo_win <- calc.mcent(emo_resp, subject, data=cert_mna)
cert_mna$emo_bw <- calc.mean(emo_resp, subject, data=cert_mna, expand=TRUE)
cert_mna$reg_win <- calc.mcent(er_resp, subject, data=cert_mna)
cert_mna$reg_bw <- calc.mean(er_resp, subject, data=cert_mna, expand=TRUE)Individuals also rate the negative images more negative during Watch compared to Regulate
cert_mna_neg <- subset(cert_mna, cert_mna$PicValence=="neg")
sumdf_neg <- subset(sumdf, sumdf$PicValence=="neg")
# win <- ggplot(data = cert_mna_neg, aes(x = Procedure, y= emo_win)) +
# geom_smooth(aes(group = subject, color = subject), alpha = .4, size = .5, method = "lm", se = F) +
# geom_smooth(aes(group = 1), color = "black",size=1.5, method = "lm", se = F) +
# scale_color_gradient(low = "indianred4", high = "indianred2") +
# ylim(1,3.25) +
# ylab("Within-person Centered Emotion Ratings") +
# xlab("Condition") +
# theme_minimal()
#
# win <- win + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
# panel.background = element_blank(), axis.line = element_line(colour = "black"))
bw <- ggplot(data = sumdf_neg, aes(x = Procedure, y= emo_resp, group=subject,color=subject)) +
geom_line(alpha = .5, size = .5) +
geom_smooth(aes(group = 1), color = "black",size=1.5, method = "lm", se = F) +
scale_color_gradient(low = "deeppink4", high = "deeppink2") +
#scale_fill_gradient(low = "indianred4", high = "indianred2")
xlab("Condition") +
ylab("Person-mean Emotion Ratings on Negative Trials")
bw <- bw + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
bw2 <- ggplot(data = sumdf_neg, aes(x = Procedure, y= er_resp, group=subject,color=subject)) +
geom_line(alpha = .5, size = .5) +
geom_smooth(aes(group = 1), color = "black",size=1.5, method = "lm", se = F) +
scale_color_gradient(low = "darkblue", high = "skyblue3") +
#scale_fill_gradient(low = "indianred4", high = "indianred2")
xlab("Condition") +
ylab("Person-mean Thinking Change Ratings on Negative Trials")
bw2 <- bw2 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
bw
Individuals also more thinking change during Regulate compared to Watch
bw2
Confirm visual effects with HLM
longest_emo <- subset(longest,longest$Rating_Type=="emo_resp")
longest_reg <- subset(longest,longest$Rating_Type=="er_resp")
longest_emo$emo_win <- calc.mcent(Rating, Subject, data=longest_emo)
longest_emo$emo_bw <- calc.mean(Rating, Subject, data=longest_emo, expand=TRUE)
longest_reg$reg_win <- calc.mcent(Rating, Subject, data=longest_reg)
longest_reg$reg_bw <- calc.mean(Rating, Subject, data=longest_reg, expand=TRUE)
model1 <- lmer(Rating ~ Valence*Condition + (1|Subject), data=longest_emo)
#summary(model1)
#htmlTable::htmlTable(format(model1, digits = 2))
#sjPlot::tab_model(model1, p.val = "kr", show.df = TRUE)
gtsummary::tbl_regression(model1)| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| Valence | |||
| neg | — | — | |
| neut | -1.9 | -1.9, -1.8 | <0.001 |
| Condition | |||
| reg | — | — | |
| watch | 0.56 | 0.51, 0.61 | <0.001 |
| Valence * Condition | |||
| neut * watch | -0.54 | -0.61, -0.47 | <0.001 |
| 1 CI = Confidence Interval | |||