# import libraries for meta-analysis
library(metaSEM)
library(mvmeta)
library(metafor)
library(tidyverse)
library(psych) # to convert z to r using fisherz2r(meta_df$b[1])
library(bslib)
library(pander)
my_theme <- theme_bw() + theme(legend.position="top",
strip.background = element_rect(fill="#FFFFFF"),
strip.text = element_text(size=12),
axis.text = element_text(size=12),
axis.title.x = element_text(size=14, vjust=-0.2),
axis.title.y = element_text(size=14, vjust=0.8),
legend.text = element_text(size=12),
title = element_text(size=18, vjust=1),
panel.grid = element_blank())This code is an accompaniment to the following paper:
Yeo, G. C., & Ong, D. C. (to appear). Associations Between Cognitive Appraisals and Emotions: A Meta-Analytic Review. Psychological Bulletin.
The GitHub repository can be found at: https://github.com/desmond-ong/appraisal-meta-analysis
and a link to the R Shiny application is: https://desmond-ong.shinyapps.io/meta-analysis-code/
This file contains code to reproduce the tables and figures in the paper.
## -- This chunk reads in the data and defines the emotions/appraisals -- ##
data <- read.csv('meta-analysis_data.csv',header=T) %>%
filter(included=="yes") %>%
droplevels() %>%
mutate(Appraisal_Raw = Appraisal)
### --- Cleaning emotions and appraisals ---- ####
# 47 appraisals, 63 emotions
LIST_OF_EMOTIONS_Short = c("anger", "anxiety", "boredom", "enjoyment", "fear",
"guilt", "joy", "pride", "sadness", "shame")
LIST_OF_EMOTIONS_Long = c(
"admiration", "affection", "amusement", "apathy", "awe",
"bitter", "challenge", "comfortable", "compassion", "confident",
"confusion", "contempt", "contentment", "curious", "disappointment",
"disgust", "distrust", "embarrassment", "empathy", "enthusiasm",
"envy", "excitement", "frustration", "gladness", "gratitude",
"homesickness", "hope", "inspiration", "interest", "irritation",
"jealousy", "loneliness", "longing", "love", "nostalgia",
"pity", "playfulness", "pleasure", "psyched-up", "regret",
"relief", "resignation", "schadenfreude", "self-anger", "self-pity",
"serenity", "surprise", "sympathy", "tenderness", "threat-awe", "unfriendly",
"unlucky", "worry")
#
# "despair" in this study. Renamed as "hope". Effect sizes have been reversed coded.
# "relaxation" in study. Renamed to "serenity"
# "dejection" in this study. Renamed to "sadness"
# "humiliation" in the study. Renamed to "shame"
# "hopelessness" in study. Renamed as "hope". Effect sizes have been reversed coded
# "positive surprise" in study. Renamed to "surprise"
# "satisfaction" in study. Renamed to "contentment".
# "liking" in study. Renamed as "affection"
# "hopeful" in study. Renamed to "hope"
# "nervous" in study. Renamed to "anxiety"
# "resentful" in study. Renamed to "bitter"
# "annoy" in this study. Renamed to "irritation"
# "tranquility" in study. Renamed to "serenity"
#
# emotion measured as fearful/worry/anxiety, and we separate into fear, worry, and anxiety.
# emotion measured as hope/confidence, and we separate into hope and confident
#
# "familiarity" in study. Reversed coded to "novelty".
# "immorality" in study. Reverse coded to merge with normative significance (external)
# "unexpectedness" in study. Re-coded to "expectedness"
# "irrelevance" in study. Reverse-coded to "goal relevance"
# some studies measured multiple appraisals within the same "cluster" (that we define).
# for these, we picked the most relevant one and excluded the rest.
LIST_OF_APPRAISALS = c(
'pleasantness', 'threat', 'loss', 'harm', 'severity', "easing of threat",
'goal conduciveness', 'goal relevance', 'value', 'difficulty',
'perceived obstacle', 'attainability', 'desire for object',
'accountability-circumstances', 'accountability-other',
'accountability-self', 'intentionality',
'control-circumstances', "control-other", "control-self",
'emotion-focused coping potential', 'problem-focused coping potential',
'effortful success', "modifiability",
'novelty', 'expectedness', "remarkable", 'uniqueness',
'future expectancy', 'attentional activity', 'certainty',
'future predictability', 'effort', 'stability',
'fairness', 'normative significance (external)', 'normative significance (internal)',
'concern for others', 'closeness', "evil character", "liking",
'challenge', 'globality', "reality",
"self-esteem decreased", 'temporal distance', 'vastness')
LIST_OF_APPRAISALS_alphabetical = LIST_OF_APPRAISALS[str_order(LIST_OF_APPRAISALS)]
# The following lines "groups" appraisals with different terminologies
# into the appraisal "clusters" we have defined in the paper, i.e.,
# LIST_OF_APPRAISALS just above.
data <- data %>%
mutate(Appraisal = fct_collapse(Appraisal,
'accountability-circumstances' = c("agency-circumstances",
'circumstances-attribution',
'situational-agency',
"situation-attribution"),
'accountability-other' = c('agency-other', 'external agency',
'other-accountability',
'other-attribution', 'other-blame',
'other-caused',
'other-responsibility'),
'accountability-self' = c("agency-self", 'internal agency',
"internal attribution", "internal locus",
'self-accountability', 'self-attribution',
'self-blame', 'self-caused',
'self-responsibility'),
'attainability' = c('attainability', "possibility"),
'attentional activity' = c('attention', 'attentional activity',
'consideration', 'urgency', 'safety (reversed)'),
'certainty' = c('certainty', 'clarity', 'understandability'),
'challenge' = c('challenge'),
'closeness' = c('closeness'),
'concern for others' = c('other-concern', 'other-involved'),
'control-circumstances' = c("circumstances-control", 'situational-control'),
"control-other" = c( "control-other", 'external control'),
"control-self" = c('control-self', 'personal control', 'power', 'helplessness (reversed)'),
'desire for object' = c('desirability'),
'difficulty' = c('difficulty', 'situational demand', 'skill demand'),
"easing of threat" = c("easing of threat"),
'effort' = c('effort'),
'effortful success' = c('effortful optimism', "potential for success"),
'emotion-focused coping potential' = c('emotion-focused coping potential'),
"evil character" = c('evil character'),
'expectedness' = c('expectation', 'expectedness'),
'fairness' = c("deservingness", "fairness" ,'injustice (reversed)',
"justice", 'legitimacy', 'unfairness (reversed)'),
'future expectancy' = c("future expectancy",
"future expectations", "positive future expectancy",
"negative future expectancy",
"outcome expectancy", "optimism", "expected success", "negative likelihood (reversed)"),
'globality' = c('globality'),
'goal conduciveness' = c('benefit',
'goal conduciveness',
'goal congruence',
'goal hindrance (reversed)', 'motivational congruence',
"motivational consistency",
'situational state', 'hindrance (reversed)'),
'goal relevance' = c('centrality', 'goal relevance',
'importance',
'motivational relevance', "self-concern"),
'harm' = c('harm'),
'intentionality' = c('other-intentionality', 'intentionality'),
"liking" = c("liking"),
'loss' = c('loss', 'reversibility (reversed)'),
"modifiability" = c("modifiability"),
'normative significance (external)' =
c('external self-compatibility', 'fail to live up to external standards (reversed)',
'norm compatibility', 'norm violation (reversed)',
"compatibility with external standards norms"),
'normative significance (internal)' =
c("compatibility with individual norms",
"compatibility with internal standards",
"internal self-compatibility", "moral congruence", "self-consistency",
"immorality (reversed)"),
'novelty' = c('novelty', "familiarity (reversed)"),
'perceived obstacle' = c('obstacle','problems'),
'pleasantness' = c('intrinsic pleasantness', 'pleasantness', 'valence'),
'future predictability' = c('predictability', "outcome probability"),
'problem-focused coping potential' = c('competence', 'coping potential',
'problem-focused coping potential',
'self-efficacy'),
"reality" = c("reality"),
"remarkable" = c('remarkable', 'exceed expectation'),
"self-esteem decreased" = c("self-esteem decreased"),
'severity' = c("impact", "severity"),
'stability' = c('stability'),
'temporal distance' = c('temporal distance'),
'threat' = c('threat', 'danger', 'risk', "susceptibility", 'vulnerability'),
'uniqueness' = c('uniqueness', 'pattern/unique'),
'value' = c('attainment value', 'intrinsic value', 'outcome value','value'),
'vastness' = c('vastness')
)) %>% mutate(Appraisal = fct_relevel(Appraisal, LIST_OF_APPRAISALS),
Emotion = factor(Emotion),
Appraisal_alphabetical_order = fct_relevel(Appraisal, LIST_OF_APPRAISALS_alphabetical))
## The rows with the following emotions are not included in meta-analysis
## (reasons are given in the remarks column)
## These emotions are already tagged with "no" in the `included` column
## and so are already excluded by the above data read-in.
# LIST_OF_EMOTIONS_NOTUSED = c("depression", "stress", "beloved", "embrace",
# "grief", "hate", "hostility", "melancholy", "rage")
## similarly the following appraisals are not included.
# LIST_OF_APPRAISALS_NOTUSED =
# c("ability", # consists of multiple appraisals, stable and uncontrollable
# "causal locus", # this study also measured 'other-accountability', which is
# # more relevant
# "coping ability", # this study measured on a nominal scale;
# # each level had a different anchor point
# "external causation", # one study measured on nominal scale
# # another study included 'other person' and 'external'
# # and one study used factor scores
# "external locus", # for this study, unclear whether 'other person' or 'external'
# "extrinsic value", # this study had both 'intrinsic' and 'extrinsic'
# # we chose to use intrinsic
# "locus of causality", # unclear whether 'other person' or 'external'
# "obstacle/effort", # consists of multiple appraisals
# 'other-significance', # excluded because this study also has 'other-concern'
# "uncontrollable", # unclear in the study's definition.
# "valued achievement", # multiple appraisals: "accountability-self",
# # and "goal conduciveness"
# "other-caused failure", "other-caused success",
# "self-caused failure", "self-caused success")## --- This chunk contains helper-functions to compute the meta-analysis,
## publication bias analyses, and other functions for creating the tables.
## -- ##
# P-curve analysis
# The following are the auxiliary and main functions used to run
# the p-curve analysis. I adapted the code from the original authors -
# http://p-curve.com/app4/pcurve_app4.06.r
# Function 1 - functions that find non-centrality parameter for f,chi
# distributions that gives some level of power
# F-test
# Note: starting with app 4.0, t() are converted to F() and Z to chisq() to
# avoid unnecessary repetition of code
# So we only need code to find ncp for F() and chisq()
getncp.f = function(df1,df2, power) {
error = function(ncp_est, power, x, df1,df2)
pf(x, df1 = df1, df2=df2, ncp = ncp_est) - (1-power)
xc=qf(p=.95, df1=df1,df2=df2)
return(uniroot(error, c(0, 1000), x = xc, df1 = df1,df2=df2, power=power)$root)
}
# chisq-test
getncp.c =function(df, power) {
xc=qchisq(p=.95, df=df)
error = function(ncp_est, power, x, df)
pchisq(x, df = df, ncp = ncp_est) - (1-power)
return(uniroot(error, c(0, 1000), x = xc, df = df, power=power)$root)
}
# Combine both in single function
getncp = function(family,df1,df2,power) {
if (family=="f") ncp=getncp.f(df1=df1,df2=df2,power=power)
if (family=="c") ncp=getncp.c(df=df1,power=power)
return(ncp)
}
# Function 3 - pbound: bound p-values and pp-values by precision of
# measurement to avoid errors
pbound=function(p) pmin(pmax(p,2.2e-16),1-2.2e-16)
# Function 4 - prop33(pc) - Computes % of p-values that are expected to be
# smaller than pc, for the tests submitted to
# p-curve, if power is 33%
prop33=function(pc, family1, p, r_df, ncp33)
{
#pc: critical p-value
#Overview:
#Creates a vector of the same length as the number of tests
# submitted to p-curve, significant and not,
# and computes the proportion of p-values expected to be smaller than
# {pc} given the d.f.
# and outputs the entire vector, with NA values where needed
# F-tests (& thus t-tests)
prop=ifelse(family1=="f" & p<.05,
1-pf(qf(1-pc,df1=1, df2=r_df),df1=1, df2=r_df, ncp=ncp33),NA)
# Chi2 (& thus Normal)
prop=ifelse(family1=="c" & p<.05,
1-pchisq(qchisq(1-pc,df=df1), df=df1, ncp=ncp33),prop)
# output it
prop
}
# Function 5 Stouffer test for a vector of pp-values
stouffer=function(pp) sum(qnorm(pp),na.rm=TRUE)/sqrt(sum(!is.na(pp)))
# main p-curve function. This function takes in a dataframe
# (that has already been subsetted by the appraisal and emotion)
# and computes the necessary p-curve statistics
p_curve = function(df) {
r_values <- df$r
r_df = df$N - 2
# Create family to turn t-->F
family1 = rep("f",dim(df)[1])
#For correlation, first turn value (r) to t, then square t.
# (using t=r/sqrt(1-r**2)/DF)
value= (r_values/(sqrt((1-r_values**2)/r_df)))**2
# Compute p-values
p = 1-pf(value,df1=1,df2=r_df)
p=pbound(p)
# Count studies
ksig= sum(p<.05,na.rm=TRUE) #significant studies
khalf=sum(p<.025,na.rm=TRUE) #half p-curve studies
# COMPUTE PP-values
#2.1 Right Skew, Full p-curve
ppr=as.numeric(ifelse(p<.05,20*p,NA))
#If p<.05, ppr is 1/alpha*p-value, so 20*pvalue, otherwise missing.
ppr=pbound(ppr) #apply pbound function to avoid 0
#2.2 Right Skew, half p-curve
ppr.half=as.numeric(ifelse(p<.025,40*p,NA))
#If p<.05, ppr is 40*pvalue, otherwise missing.
ppr.half=pbound(ppr.half)
#2.3 Power of 33%
#2.3.1 NCP for f,c distributions
# NCP33 (noncentrality parameter giving each test
# in p-curve 33% power given the d.f. of the test)
ncp33=mapply(getncp,df1=1,df2=r_df,power=1/3,family=family1)
#See function 1 above
#2.3.2 Full-p-curve
#Using the ncp33 compute pp33
pp33=ifelse(family1=="f" & p<.05,3*(pf(value, df1=1, df2=r_df, ncp=ncp33)-2/3),NA)
pp33=pbound(pp33)
#2.3.3 HALF-p-curve
#Share of p-values expected to be p<.025 if 33% power
# (using Function 4 from above, prop33() )
prop25=3*prop33(.025, family1 = family1, p = p, r_df = r_df, ncp33 = ncp33 )
prop25.sig=prop25[p<.05]
#Compute pp-values for the half
pp33.half=ifelse(family1=="f" & p<.025, (1/prop25)*(
pf(value,df1=1,df2=r_df,ncp=ncp33)-(1-prop25)),NA)
pp33.half=pbound(pp33.half)
#########################################################################
# INFERENCE - STOUFFER & BINOMIAL
###########################################################################
# Convert pp-values to Z scores, using Stouffer function above
Zppr = stouffer(ppr) #right skew -
# this is a Z value from Stouffer's test
Zpp33= stouffer(pp33) #33% - idem
Zppr.half= stouffer(ppr.half) #right skew, half p-curve - idem
Zpp33.half=stouffer(pp33.half) #33% skew, half p-curve - idem
# Overall p-values from Stouffer test
p.Zppr =pnorm(Zppr)
p.Zpp33=pnorm(Zpp33)
p.Zppr.half =pnorm(Zppr.half)
p.Zpp33.half=pnorm(Zpp33.half)
return(c(Zppr, p.Zppr, Zpp33, p.Zpp33, Zppr.half, p.Zppr.half))
}
### the following functions help to provide the interpretation
### of significant appraisal-emotion relationships
# These mappings just make the interpretation sound more grammatical.
emotion_strings = data.frame(
emotion = c(LIST_OF_EMOTIONS_Short, LIST_OF_EMOTIONS_Long),
string = c(LIST_OF_EMOTIONS_Short,
c("admiration", "affection", "amusement", "apathy", "awe",
"bitter", "challenge", "comfortable", "compassion", "confidence",
"confusion", "contempt", "contentment", "curiosity", "disappointment",
"disgust",
"distrust", "embarrassment", "empathy", "enthusiasm", "envy",
"excitement", "frustration", "gladness", "gratitude", "homesickness",
"hope", "inspiration", "interest", "irritation", "jealousy",
"feelings of loneliness",
"feelings of longing",
"love", "nostalgia", "pity", "playfulness",
"pleasure", "psyched-up", "regret", "relief", "resignation",
"feelings of schadenfreude",
"self-anger", "self-pity", "serenity", "surprise",
"sympathy", "tenderness",
"feelings of awe (in response to something threatening or fearful)",
"feelings of unfriendliness",
"feelings of unluckiness", "worry"))
)
appraisal_strings = data.frame(
appraisal = LIST_OF_APPRAISALS,
string = c(
'perceived pleasantness of the situation',
'perceived imminent threat in the situation',
'perception that something irretrievable has been lost',
'perceived harm',
"perceived severity of the consequences of the situation to one's well-being",
"perception that a threat or harm has been removed from the situation",
"consistency of the situation with one's goals",
"perceived relevance of the situation to one's goals",
"perceived value of the situation to one's goals and desires",
'perceived difficulty',
'perception that an obstacle hampers the attainment of a desired goal',
'perception that one could obtain what one desires',
'desire for something another person has',
'attribution of the cause of the situation to impersonal circumstances',
'perceived responsibility for the cause of the situation attributed to other people/objects',
'perceived personal responsibility of the cause of the situation',
'perceived intentionality of the cause of the event either by oneself or others',
'perception that impersonal circumstances have control over the situation',
"perception that other people/objects have control over the situation",
"perceived control over the situation",
'ability to emotionally cope and adapt to the situation',
'perceived ability to cope and adapt to the situation',
'perception that effort could make the situation better',
"perception that the situation could be modified",
'perceived novelty in the situation',
'expectation of the occurrence of the situation',
"feeling that it was remarkable to have gotten this outcome",
'perception of how unique the situation was',
'expectation that the situation will get better',
'perceived need to take time/effort to attend to the situation further',
'understanding of the situation',
'ability to predict what is going to occur in the future',
'need to exert effort to deal with the situation',
'perception that the situation is stable and permanent',
'perceived fairness of the situation',
'consistency of the situation with external and social norms',
"consistency of the situation with one's ideals",
"concern for others' well-being in the situation",
'perception of closeness of the relationship to another person',
"perception of others as dispositionally evil",
"liking for another person",
'perception of a future gain after overcoming an obstacle in the situation',
"perception that the event is relevant to all aspect of one's life",
"perception that is situation is real and had already occurred",
"perception that one's self-esteem has decreased",
'perceived temporal distance to a remembered past situation',
"perception that something is much grander than oneself"
)
)
# function that returns a grammatical string for the table
return_interpretation = function(this_appraisal, this_emotion, r) {
# Example interpretation:
# The greater the
# perceived responsibility for the cause of the
# situation attributed to other people/objects
# , the
# greater
# the
# anger
appraisal_string = appraisal_strings[
appraisal_strings$appraisal==this_appraisal, "string"]
emotion_string = emotion_strings[
emotion_strings$emotion==this_emotion, "string"]
if(r>0) {comparator = "greater"} else {comparator = "less"}
interpretation_string = paste(
"The greater the ",
appraisal_string,
", the ", comparator, " the ",
emotion_string, ".", sep=""
)
return(interpretation_string)
}# This function is a helper function to construct Results Tables
# (Meta-analysis for a given Emotion and Appraisal)
# It takes in the data frame and produces the necessary statistics
# as a row of a data frame.
meta_analysis_for_table = function(df, this_emotion,
num_digits=4,
pubBias = TRUE,
interpretation=TRUE) {
meta_df = rma(z,v,data=df, method = 'ML')
if(meta_df$pval<0.001) {
pstring = "***"
} else if(meta_df$pval<0.01) {
pstring = "**"
} else if(meta_df$pval<0.05) {
pstring = "*"
} else { pstring = "" }
table_df = data.frame(
Emotion = this_emotion,
Appraisal = df$Appraisal[1],
k = nrow(df),
# apply fisherz2r()
r = paste(format(fisherz2r(meta_df$b[1]), digits=num_digits),
pstring, sep = ""))
if(nrow(df)>1) {
if(meta_df$QEp<0.001) {
Q_pstring = "***"
} else if(meta_df$QEp<0.01) {
Q_pstring = "**"
} else if(meta_df$QEp<0.05) {
Q_pstring = "*"
} else { Q_pstring = "" }
table_df = table_df %>% mutate(
# 95% CI; apply fisherz2r()
ci = paste(format(fisherz2r(meta_df$ci.lb), digits=num_digits),
format(fisherz2r(meta_df$ci.ub), digits=num_digits), sep=", "),
# Q statistic, (Q df), Q_pstring
Q = paste(format(meta_df$QE, digits=num_digits), " (",
format(nrow(df) - 1, digits=num_digits), ")", Q_pstring, sep=""),
# sqrt(tau^2)
#tau2 = format(meta_df$tau2, digits=num_digits),
tau = format(sqrt(meta_df$tau2), digits=num_digits),
# I2
I2 = format(meta_df$I2, digits=num_digits))
} else {
table_df = table_df %>% mutate(ci = NA, Q = NA, tau = NA, I2 = NA)
}
# the publication bias analyses only done if 10 or more studies.
if(pubBias & nrow(df)>10) {
reg_test = regtest(meta_df, model='rma')
# fsn_orwin = fsn(yi=z, vi=v, data=df, type='Orwin', target=0.05)
# p_curve_results = p_curve(df)
# ## p-curve significance
# ## z_half
# if(p_curve_results[6]<0.001) { pstring1 = "***"
# } else if(p_curve_results[6]<0.01) { pstring1 = "**"
# } else if(p_curve_results[6]<0.05) { pstring1 = "*"
# } else { pstring1 = "" }
#
# ## z_full
# if(p_curve_results[2]<0.001) { pstring2 = "***"
# } else if(p_curve_results[2]<0.01) { pstring2 = "**"
# } else if(p_curve_results[2]<0.05) { pstring2 = "*"
# } else { pstring2 = "" }
#
# ## z_flat
# if(p_curve_results[4]<0.001) { pstring3 = "***"
# } else if(p_curve_results[4]<0.01) { pstring3 = "**"
# } else if(p_curve_results[4]<0.05) { pstring3 = "*"
# } else { pstring3 = "" }
table_df <- table_df %>% mutate(
# Egger regression p value
p_egger = format(reg_test$pval, digits=num_digits) #,
## fail-safe N
#FSN = format(fsn_orwin$fsnum, digits=num_digits),
## z_half
#z_half = paste(format(p_curve_results[5], digits=num_digits),
# pstring1, sep = ""),
## z_full
#z_full = paste(format(p_curve_results[1], digits=num_digits),
# pstring2, sep = ""),
## z_flat
#z_flat = paste(format(p_curve_results[3], digits=num_digits),
# pstring3, sep = ""),
)
} else if (pubBias) { # 9 or fewer studies but still want to print pubBias
table_df <- table_df %>% mutate(
p_egger = NA #, FSN = NA, z_half = NA, z_full = NA, z_flat = NA
)
}
if(interpretation) {
if(meta_df$pval<0.05) {
table_df <- table_df %>% mutate(interpretation =
return_interpretation(df$Appraisal[1], this_emotion, fisherz2r(meta_df$b[1]))
)
} else {
table_df <- table_df %>% mutate(interpretation = NA)
}
}
return(table_df)
}# This chunk calculates some descriptives: total number of studies, etc
num_total_effect_sizes = nrow(data)
num_total_studies = length(unique(data$Study.ID))
# this following line does some regex manipulation
# to collapse different samples within the same article
unique_articles = data %>%
group_by(Study.ID) %>%
filter(row_number()==1) %>%
ungroup() %>%
select(Study.ID, Study, Year, Dissertation) %>%
mutate(Article = str_replace_all(Study,
c("(main study)" = "",
"[Ss]tudy [1-9][a-z]*" = "",
"experiment [1-9]" = "",
", in-group condition" = "",
", out-group condition" = "",
"Hangzhou sample" = "", "Yangshuo sample" = "",
"study1: second grade sample" = "", "study1: third grade sample" = "",
"study2" = "",
"US sample" = "", "Korean sample" = "", "Japanese sample" = "",
"husband sample" = "", "wife sample" = "",
"female sample" = "", "male sample" = "", "women" = "", "men" = "",
"phase 1" = "", "; accounting" = "", "; aerospace" = "",
"- climate change sample" = "",
"- climate influenza sample" = "",
"adult sample" = "", "child sample" = "",
"Grade [1-9] sample" = "", "Great Lakes study" = "",
"Watershed study: flood risk path" = "",
"Watershed study: environmetal health of river path" = "",
"[.]1a" = "", "[.]1b" = "", "[.]2" = "",
"[()]" = "", ":"="", ";"="", ","=""
)),
Article = str_trim(Article),
Article = paste(Article, Year)
)
data_unique_articles <- unique_articles %>% group_by(Article) %>%
filter(row_number()==1) %>%
select(Article, Year, Dissertation) %>%
mutate(Year = as.numeric(str_replace_all(Year, c("a" = "", "b" = "")))) %>% ungroup()
data_articles_insufficient_statistics <- readxl::read_excel("prisma_all_articles.xlsx", sheet="insufficient statistics") %>% mutate(type = "insufficient statistics") %>% rename(Year = year)
data_articles_both = bind_rows(
(data_unique_articles %>% mutate(type = "included") %>% select(Year, type)),
(data_articles_insufficient_statistics %>% select(Year, type))
) %>% mutate(type = factor(type, levels=c("insufficient statistics", "included")))
num_total_articles = nrow(data_unique_articles)
# table(data_unique_articles$Dissertation)
#num_total_articles = length(unique(unique_articles$Article))
#num_total_emotion_appraisal_relationships = nrow(data %>% group_by(Emotion, Appraisal) %>% summarize(num = n()))
num_total_emotion_appraisal_relationships = (data %>% group_by(Emotion, Appraisal) %>% summarize(num = n()) %>% ungroup() %>% summarize(count = n()))$count
num_total_emotions = length(levels(data$Emotion))
num_total_appraisals = length(levels(data$Appraisal))| Category | Count |
|---|---|
| Total number of effect sizes | 2634 |
| Total number of emotion-appraisal relationships | 853 |
| Total number of studies | 309 |
| Total number of articles | 251 |
| Total number of emotions | 63 |
| Total number of appraisals | 47 |
# data <- read.csv('meta-analysis_data.csv',header=T) %>%
# filter(included=="yes") %>%
# droplevels() %>%
# mutate(Appraisal_Raw = Appraisal)
data_singlestudy = data %>% group_by(Study.ID) %>% filter(row_number()==1) %>%
mutate(sample_raw = sample,
context_raw = context,
inferredLanguage = recode(country,
"USA" = "English",
"USA/Canada" = "English",
"UK" = "English",
"Australia" = "English",
"Canada" = "English",
"Online, mostly USA/UK sample" = "English",
"Undisclosed (likely UK or Australia)" = "English",
"Undisclosed (MTurk)" = "English",
"Undisclosed (Reddit)" = "English",
"Singapore" = "English",
"Trinidad and Tobago" = "English",
"China" = "Chinese",
"Hong Kong" = "Chinese"),
sample = recode(sample,
"community-AMT" = "crowdsource",
"community-Mturk" = "crowdsource",
"community-WisoPanel" = "crowdsource",
"community-crowdsource" = "crowdsource",
"community-crowdsource (Credamo)" = "crowdsource",
"community-crowdsource (prolific)" = "crowdsource",
"student-athletes" = "student",
"student-managers" = "student",
"community-athletes" = "community",
"community-clerks" = "community",
"community-dancers" = "community",
"community-employees" = "community",
"community-faculty" = "community",
"community-nurse" = "community",
"community-nurses" = "community",
"community-reddit" = "community",
"community-teachers" = "community",
"community-tourist" = "community",
"community-university workers" = "community",
"community-work" = "community"),
context = recode(context,
'academic-bullying' = 'education',
'academic-classroom management' = 'education',
'academic-classroom management / corporate' = 'education',
'academic-education' = 'education',
'academic-exams' = 'education',
'academic-finance' = 'education',
'academic-lesson' = 'education',
'academic-lessons' = 'education',
'academic-test' = 'education',
'Health' = 'health',
'health-injury' = 'health',
'health-pandemic' = 'health',
'health-pregnancy' = 'health',
'corporate' = 'work',
'corporate-employment' = 'work',
'corporate-fraud' = 'work',
'corporate-nursing setting' = 'work',
'corporate-social relationships' = 'work',
'corporate-tax evasion' = 'work',
'performance-dance' = 'work',
'social relationshio' = 'social relationships',
'social relationship-sexual aggression' = 'social relationships',
'social relationships- stigma' = 'social relationships',
'Social relationships-breakup' = 'social relationships',
'social relationships-conflict' = 'social relationships',
'social relationships-divorce' = 'social relationships',
'social relationships-envy' = 'social relationships',
'social relationships-health context' = 'social relationships',
'social relationships-health, taking care of partner' = 'social relationships',
'social relationships-interparental conflict' = 'social relationships',
'social relationships-negotiation' = 'social relationships',
'social relationships-partners' = 'social relationships',
'social relationships-romantic' = 'social relationships',
'social relationships-child-parent' = 'social relationships',
'death of loved one-grief' = 'social relationships',
'childhood experience' = 'social relationships',
'childhood experiences' = 'social relationships',
'event-food and wine' = 'consumption',
'art-images' = 'art',
'art-poems' = 'art',
'disaster-flood' = 'environment',
'environment and ecology' = 'environment',
'environment-climate change' = 'environment',
'environment/ecology' = 'environment',
'environment/ecology-animals' = 'environment',
'contamination-using toilet' = 'environment',
'do a task and obtain hints from the experimenter' = 'lab tasks',
'opinion-expression task' = 'lab tasks',
'partner task' = 'lab tasks',
'social relationships- competitive task and public speaking' = 'lab tasks',
'social relationships- lab task' = 'lab tasks',
'stressor task' = 'lab tasks',
'stressor task-speech presentation' = 'lab tasks',
'task' = 'lab tasks',
'task and feedback' = 'lab tasks',
'task in front of audience' = 'lab tasks',
'watching film' = 'lab tasks',
'play activity-alone' = 'lab tasks',
'human computer interaction' = 'human-computer interaction',
'disaster-terrorism' = 'politics',
'immigration' = 'politics',
'immigration-general' = 'politics',
'intergroup perception' = 'politics',
'politics-intergroup perception' = 'politics',
'politics-intergroup violece' = 'politics',
'politics-terrorism' = 'politics',
'legal-court case' = 'legal',
'crime' = 'legal',
'violence' = 'legal',
'trauma experience' = 'legal',
'media-news' = 'media',
'sports-competition' = 'sports'
)
)
print("Country")## [1] "Country"
table(data_singlestudy$country)##
## Australia Austria
## 12 1
## Canada China
## 20 15
## Croatia Finland
## 4 1
## France Germany
## 1 21
## Germany, Austria, Switzerland Germany, Spain, Netherlands, UK
## 1 1
## Hong Kong Iran
## 1 1
## Israel Italy
## 5 5
## Japan Korea
## 2 3
## Many countries Online, mostly USA/UK sample
## 3 1
## Pakistan Portugal
## 3 3
## Singapore South Africa
## 4 1
## Spain Switzerland
## 4 2
## The Netherlands Trinidad and Tobago
## 8 1
## UK Undisclosed (likely UK or Australia)
## 30 2
## Undisclosed (MTurk) Undisclosed (Reddit)
## 2 1
## Undisclosed country in East Asia USA
## 1 147
## USA/Canada
## 2
#table(data_singlestudy$region)
print("Inferred language -- mainly English or non-English")## [1] "Inferred language -- mainly English or non-English"
table(data_singlestudy$inferredLanguage)##
## Austria Chinese
## 1 16
## Croatia English
## 4 222
## Finland France
## 1 1
## Germany Germany, Austria, Switzerland
## 21 1
## Germany, Spain, Netherlands, UK Iran
## 1 1
## Israel Italy
## 5 5
## Japan Korea
## 2 3
## Many countries Pakistan
## 3 3
## Portugal South Africa
## 3 1
## Spain Switzerland
## 4 2
## The Netherlands Undisclosed country in East Asia
## 8 1
print("Participant sample type")## [1] "Participant sample type"
table(data_singlestudy$sample)##
## community crowdsource student
## 95 29 185
print("Experiment Context")## [1] "Experiment Context"
table(data_singlestudy$context)##
## art consumption
## 6 12
## education environment
## 64 9
## general health
## 39 32
## human-computer interaction lab tasks
## 7 14
## legal media
## 4 3
## politics religion
## 11 1
## social relationships sports
## 51 14
## tourism work
## 5 37
print("Experimental Study? (No == Correlational Study)")## [1] "Experimental Study? (No == Correlational Study)"
table(data_singlestudy$exp)##
## no yes
## 276 33
print("Dissertation Study? (No == Journal Study)")## [1] "Dissertation Study? (No == Journal Study)"
table(data_singlestudy$Dissertation)##
## no yes
## 228 81
print("Summary of sample size")## [1] "Summary of sample size"
summary(data_singlestudy$N)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 22 103 205 1973 348 280805
# table(data_unique_articles$Dissertation) ## 59 dissertations, 192 articles
data_unique_articles %>% ggplot(aes(x=Year)) +
geom_histogram(data = data_articles_both, stat = "count", fill="grey80") +
geom_histogram(stat="count", fill="grey30") +
# stat_count(binwidth = 1,
# geom = 'text',
# color = 'white',
# aes(label = ..count..),
# position = position_stack(vjust = 0.5)) +
stat_count(geom = "text",
aes(label = ..count..),
position=position_stack(vjust=0.5), colour="white", size = 3) +
scale_x_continuous(breaks = c(1975, 1980, 1985, 1987, 1990, 1995, 2000, 2005, 2010, 2015, 2020, 2023)) +
ylab("Number of Articles") + theme_bw() + theme(panel.grid.minor.x = element_blank())# 8.5 by 4
# data_unique_articles %>% ggplot(aes(x=Year)) +
# geom_histogram(stat = "count") +
# stat_count(binwidth = 1,
# geom = 'text',
# color = 'white',
# aes(label = ..count..),
# position = position_stack(vjust = 0.5)) +
# scale_x_continuous(breaks = c(1987, 1990, 1995, 2000, 2005, 2010, 2015, 2020, 2023)) +
# ylab("Number of Articles") + theme_bw()
# # 8 by 3
# year_counts = bind_rows(
# data_unique_articles %>% group_by(Year) %>% summarize(count=n()),
# data.frame(Year = c(1989, 1990, 1991, 1992), count=0)) %>% # adding years with 0
# arrange(Year) %>% mutate(
# rolling_avg_2 = (count + lag(count)) / 2,
# rolling_avg_3 = (count + lag(count) + lag(count, n=2)) / 3
# )
#
# year_counts %>% ggplot(aes(x=Year)) +
# geom_line(aes(y=count), color="black") +
# geom_line(aes(y=rolling_avg_2), color="red") +
# geom_line(aes(y=rolling_avg_3), color="green")These next chunks are to create the static tables and figures for the
paper. Several of the next chunks that write to file are current set to
eval=F (i.e., these chunks don’t run).
## Set `eval=T` to run this chunk.
## This chunk is to create the static Results Tables in the paper
## This is written to file, not output.
## This next set of code writes the whole Results Table to a .csv file
# this is for the "commonly studied emotions (min k > 10)"
full_table = data.frame()
for(this_emotion in LIST_OF_EMOTIONS_Short) {
this_table = data.frame()
for(this_appraisal in LIST_OF_APPRAISALS) {
df = data %>% filter(Emotion == this_emotion,
Appraisal == this_appraisal)
if(nrow(df)>=1) {
this_table = bind_rows(this_table,
meta_analysis_for_table(df, this_emotion,
pubBias=TRUE,
interpretation=TRUE))
}
}
this_table <- this_table %>% arrange(Emotion, desc(k), Appraisal)
full_table = bind_rows(full_table, this_table, data.frame(NA))
}
# adding spaces just just to make the table look nicer
full_table <- full_table %>%
mutate(blank1=NA, .after = k) %>%
mutate(blank2=NA, .after = I2)
write.csv(full_table, "table-meta-analysis-results-common-emotions-raw.csv", row.names=F, na="")
## And this is for all other emotions (in appendix)
# Note variable names are re-used
full_table = data.frame()
for(this_emotion in LIST_OF_EMOTIONS_Long) {
this_table = data.frame()
for(this_appraisal in LIST_OF_APPRAISALS) {
df = data %>% filter(Emotion == this_emotion,
Appraisal == this_appraisal)
if(nrow(df)>=1) {
this_table = bind_rows(this_table,
meta_analysis_for_table(df, this_emotion,
pubBias=FALSE,
interpretation=TRUE))
}
}
this_table <- this_table %>% arrange(Emotion, desc(k), Appraisal)
full_table = bind_rows(full_table, this_table, data.frame(NA))
}
# adding spaces just just to make the table look nicer
full_table <- full_table %>% mutate(blank1=NA, .after = k)
write.csv(full_table, "table-meta-analysis-results-all-other-emotions-raw.csv", row.names=F, na="")table_common = read.csv('table-meta-analysis-results-common-emotions-raw.csv', header=T) %>%
select(-blank1, -blank2, -`NA.`) %>%
filter(Appraisal != "") %>%
mutate(Emotion = factor(Emotion),
r_significant = factor( grepl("[*]", r)*1.0 ,
levels=c(1,0), labels=c("Yes", "No")),
r = as.numeric(str_replace_all(r, c("[*]" = ""))))
set.seed(42)
table_common %>% ggplot() +
# geom_rect(xmin = -1.0, xmax = -0.25, ymin=0, ymax = 12,
# alpha=0.2, fill="#EEEEEE") +
geom_rect(xmin = 0.25, xmax = 1.00, ymin=0, ymax = 12,
alpha=0.2, fill="#EEEEEE") +
geom_point(aes(y=Emotion, x=abs(r), size=k, color=k, shape=r_significant), alpha=0.8,
position=position_jitter(height=0.25)) +
#geom_point(aes(y=Emotion, x=abs(r), size=k, shape=r_significant), alpha=0.5,
# position=position_jitter(height=0.25)) +
#scale_x_continuous(breaks=c(-0.5, -0.25, 0, 0.25, 0.5)) +
scale_x_continuous(breaks=c(0, 0.25, 0.5)) +
scale_y_discrete(limits = rev(levels(table_common$Emotion))) +
scale_shape_manual(values = c(16, 1), name="Significant") +
scale_size_continuous(name="Number of effect sizes", breaks = c(1,10,20,30,40)) +
# scale_color_distiller(name="Number of effect sizes", palette = "YlOrBr",
# direction = 1,
# aesthetics = c("colour", "fill"),
# limits=c(-20, 50),
# breaks=c(10,20,30,40)) +
scale_color_viridis_c(begin = 0, end = 1,
direction = -1, na.value = "#f9f9f9",
#option = "plasma",
breaks = c(1,10,20,30,40),
name = "Number of effect sizes") +
guides(shape = guide_legend(nrow = 2, byrow = T),
size = guide_legend(nrow = 5, byrow = T),
color = guide_legend(nrow = 5, byrow = T)) +
xlab("Absolute value of the effect size (correlation coefficient |r|)") +
my_theme + theme(legend.position = "right",
legend.title = element_text(size=12),
legend.text = element_text(size=10))# 7 x 4## Set `eval=T` to run this chunk.
heatmap_df = data %>%
#group_by(Emotion, Appraisal) %>%
group_by(Emotion, Appraisal, .drop = FALSE) %>% ## this line is to calculate k=0's
summarize(k = n()) %>% ungroup() %>%
arrange(desc(k), Emotion, Appraisal) %>%
mutate(k = na_if(k, 0))
# manually sorting
emotion_order <- c("anger",
"sadness",
"fear",
"joy",
"hope",
"pride",
"shame",
"embarrassment",
"anxiety",
"worry",
"guilt",
"gratitude",
"relief",
"regret",
"disappointment",
"contentment",
"resignation",
"love",
"affection",
"surprise",
"excitement",
"enthusiasm",
"amusement",
"serenity",
"awe",
"threat-awe",
"confident",
"challenge",
"interest",
"curious",
"boredom",
"frustration",
"confusion",
"irritation",
"self-anger",
"bitter",
"disgust",
"contempt",
"self-pity",
"pity",
"compassion",
"sympathy",
"empathy",
"apathy",
"schadenfreude",
"distrust",
"jealousy",
"envy",
"admiration",
"loneliness",
"homesickness",
"longing",
"nostalgia",
"tenderness",
"pleasure",
"enjoyment",
"gladness",
"comfortable",
"psyched-up",
"playfulness",
"inspiration",
"unfriendly",
"unlucky"
)
appraisal_order <- c("pleasantness",
"loss",
"harm",
"severity",
"threat",
"easing of threat",
"goal conduciveness",
"goal relevance",
"value",
"difficulty",
"perceived obstacle",
"attainability",
"desire for object",
"liking",
"closeness",
"evil character",
"concern for others",
"accountability-other",
"accountability-self",
"accountability-circumstances",
"intentionality",
"control-other",
"control-self",
"control-circumstances",
"problem-focused coping potential",
"emotion-focused coping potential",
"effortful success",
"modifiability",
"novelty",
"expectedness",
"remarkable",
"uniqueness",
"future expectancy",
"attentional activity",
"certainty",
"future predictability",
"effort",
"stability",
"fairness",
"normative significance (external)",
"normative significance (internal)",
"challenge",
"globality",
"reality",
"self-esteem decreased",
"temporal distance",
"vastness"
)
heatmap_df %>%
ggplot(aes(x = factor(Emotion, level = emotion_order),
y = factor(Appraisal, level = rev(appraisal_order)),
fill= k)) +
geom_tile() +
#scale_fill_gradient(low = "red", high = "blue") +
# scale_fill_gradientn (
# colours = colorRampPalette(c("grey100", "blue"))(20),
# values = c(1,2,3,4,5,6,7,8,9,10,11,12,13,15,29,25,30,35,40,50)/50) +
#scale_fill_gradientn (colours = colorRampPalette(c("grey", "blue"))(20)) +
#scale_fill_gradientn (colours = colorRampPalette(c("grey90", "grey10"))(20)) +
# scale_fill_distiller(name="Number of effect sizes",
# #palette = "Oranges",
# palette = "YlOrBr",
# direction = 1,
# na.value = "#f9f9f9",
# limits=c(-10, 50),
# breaks=c(1, 10,20,30,40,50)#,
# #guide = guide_colorbar(draw.llim = FALSE)
# ) +
scale_fill_viridis_c(begin = 0, end = 1,
direction = -1, na.value = "#f9f9f9",
#option = "plasma",
breaks = c(1,10,20,30,40),
name = "Number of effect sizes") +
xlab("Emotions") + ylab("Appraisals") +
scale_x_discrete(position = "top") +
theme_bw() + my_theme +
theme(legend.position="bottom",
#axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=0))# 12 by 9d2 <- read.csv("predicted_relationships.csv") %>%
rename(appraisal = Appraisal, emotion=Emotion) %>%
mutate(
appraisal = tolower(as.character(appraisal)),
prediction = factor(prediction, levels=c(
"Predicted & Supported", "Predicted & Not Significant",
"Predicted & Opposite", "No prediction & Significant",
"No prediction & Not Significant"
)),
appraisal = recode(appraisal, "predictability" = "future predictability")
)
for(thisline in c(1:nrow(d2))) {
this_appraisal = d2$appraisal[thisline]
if(this_appraisal=="predictability") {this_appraisal="future predictability"}
temp_df = data %>% filter(Emotion == d2$emotion[thisline],
Appraisal == this_appraisal)
meta_df = rma(z,v,data=temp_df, method = 'ML')
d2$r_precise[thisline] = fisherz2r(meta_df$b[1])
}
d2 = d2 %>% mutate(
r_abs = abs(r_precise),
z = fisherz(r_abs)
)
descriptivesTable2 = d2 %>% group_by(prediction) %>%
summarize(count = n(), r_mean = mean(r_abs), r_sd = sd(r_abs)) %>%
ungroup() %>% mutate(r_se = r_sd/sqrt(count))
pander(descriptivesTable2)| prediction | count | r_mean | r_sd | r_se |
|---|---|---|---|---|
| Predicted & Supported | 180 | 0.329 | 0.1367 | 0.01019 |
| Predicted & Not Significant | 57 | 0.09567 | 0.08019 | 0.01062 |
| Predicted & Opposite | 3 | 0.2441 | 0.08542 | 0.04932 |
| No prediction & Significant | 328 | 0.2717 | 0.1296 | 0.007153 |
| No prediction & Not Significant | 285 | 0.08268 | 0.07895 | 0.004677 |
## Testing if effect sizes in 'Predicted and Supported' are higher than in 'No Prediction and Significant': (note that we convert the pearson `r`'s to `z`'s and do a two-sample t-test.)
# Testing for a difference between these two:
d2 %>%
filter(prediction %in% c("Predicted & Supported",
"No prediction & Significant")) %>%
t.test(z ~ prediction, data=.)##
## Welch Two Sample t-test
##
## data: z by prediction
## t = 4.4792, df = 335.96, p-value = 1.028e-05
## alternative hypothesis: true difference in means between group Predicted & Supported and group No prediction & Significant is not equal to 0
## 95 percent confidence interval:
## 0.03701071 0.09497132
## sample estimates:
## mean in group Predicted & Supported
## 0.3511533
## mean in group No prediction & Significant
## 0.2851623
# d2 %>% ggplot(aes(x=r_abs, fill=prediction)) +
# geom_density(alpha=.3) + xlab("(Absolute) Effect Size") +
# ylab("Density") + my_theme +
# guides(fill=guide_legend(nrow=2,byrow=TRUE))full_table = data.frame()
for(this_emotion in c(LIST_OF_EMOTIONS_Short, LIST_OF_EMOTIONS_Long)) {
this_table = data.frame()
for(this_appraisal in LIST_OF_APPRAISALS) {
df = data %>% filter(Emotion == this_emotion,
Appraisal_alphabetical_order == this_appraisal)
if(nrow(df)>=1) {
this_table = bind_rows(this_table,
meta_analysis_for_table(df, this_emotion,
pubBias=FALSE,
interpretation=FALSE))
}
}
this_table <- this_table %>% arrange(Emotion, desc(k), Appraisal)
full_table = bind_rows(full_table, this_table)
}
full_table <- full_table %>% mutate(
significant = grepl("[*]", r),
r_bare = abs(as.numeric(gsub("[*]", "", r)))
) %>% select(-ci, -Q, -tau, -I2) %>%
mutate(Appraisal = fct_relevel(Appraisal, LIST_OF_APPRAISALS_alphabetical)) %>%
arrange(Emotion, desc(k), Appraisal)
table_profile_intermediate = full_table %>% filter(significant) %>%
mutate(large = (r_bare > .25)) %>%
group_by(Emotion, large) %>% arrange(Appraisal) %>% summarize(
list_appraisals = paste0(Appraisal, collapse=", ")
) %>% arrange(Emotion, desc(large))
table_profile = full_join(
table_profile_intermediate %>% filter(large) %>% select(-large) %>% rename(Large = list_appraisals),
table_profile_intermediate %>% filter(!large) %>% select(-large) %>% rename(Small = list_appraisals),
id=Emotion
) %>% arrange(Emotion)
pander(table_profile, split.table = Inf)| Emotion | Large | Small |
|---|---|---|
| admiration | liking, pleasantness | closeness, desire for object, fairness |
| affection | accountability-self, fairness, goal conduciveness, goal relevance, harm, normative significance (internal), pleasantness, threat | accountability-other, control-self, future predictability |
| amusement | pleasantness | attentional activity, certainty |
| anger | accountability-other, easing of threat, effortful success, fairness, goal conduciveness, goal relevance, harm, loss, modifiability, normative significance (external), perceived obstacle, pleasantness, severity, threat, value | control-self, difficulty, effort, evil character, future predictability, normative significance (internal), problem-focused coping potential |
| anxiety | certainty, concern for others, control-self, difficulty, emotion-focused coping potential, future predictability, goal conduciveness, harm, intentionality, loss, novelty, pleasantness, problem-focused coping potential, severity, threat | accountability-circumstances, accountability-self, control-other, easing of threat, effort, future expectancy, goal relevance, stability, value |
| apathy | accountability-other, attentional activity | effort, pleasantness |
| awe | pleasantness, remarkable, vastness | loss, temporal distance, uniqueness |
| bitter | loss, pleasantness | accountability-other, temporal distance |
| boredom | attentional activity, control-self, expectedness, goal conduciveness, goal relevance, pleasantness, value | accountability-other, accountability-self, challenge, concern for others, threat |
| challenge | effort, fairness, goal relevance | accountability-circumstances, attentional activity, problem-focused coping potential |
| comfortable | pleasantness | NA |
| compassion | normative significance (internal) | goal relevance |
| confident | certainty, goal conduciveness, normative significance (external), pleasantness | challenge |
| confusion | accountability-self, control-self | NA |
| contempt | challenge, harm, loss, pleasantness, threat | accountability-other |
| contentment | accountability-self, control-self, loss | attentional activity, certainty, effort, future predictability, normative significance (internal), perceived obstacle, temporal distance, uniqueness, value |
| curious | control-self, goal relevance | NA |
| disappointment | goal conduciveness, loss, pleasantness | NA |
| disgust | accountability-other, challenge, goal relevance, harm, normative significance (external), threat | attentional activity, control-other, expectedness, fairness, goal conduciveness, normative significance (internal), pleasantness, uniqueness |
| distrust | harm, pleasantness, threat | NA |
| embarrassment | accountability-self, pleasantness, threat | accountability-other, loss, uniqueness |
| empathy | concern for others, control-other | loss, pleasantness, temporal distance |
| enjoyment | control-self, future expectancy, goal conduciveness, goal relevance, problem-focused coping potential, value | expectedness |
| enthusiasm | pleasantness | loss, temporal distance, uniqueness |
| envy | control-self | attainability, closeness, desire for object |
| excitement | challenge, control-self, novelty, value | problem-focused coping potential, threat |
| fear | certainty, control-self, difficulty, emotion-focused coping potential, goal relevance, harm, loss, normative significance (external), novelty, perceived obstacle, pleasantness, severity, threat | accountability-circumstances, accountability-self, attentional activity, concern for others, control-circumstances, easing of threat, effort, fairness, future predictability, problem-focused coping potential, stability, temporal distance |
| frustration | accountability-self, challenge, fairness, goal conduciveness, harm, problem-focused coping potential, threat | future predictability, goal relevance |
| gladness | future expectancy, goal conduciveness, goal relevance | NA |
| gratitude | accountability-other, fairness, future expectancy, goal conduciveness, value | accountability-self, certainty, emotion-focused coping potential, goal relevance, loss, problem-focused coping potential, remarkable, temporal distance, uniqueness |
| guilt | accountability-self, certainty, concern for others, easing of threat, effort, goal conduciveness, harm, loss, perceived obstacle | accountability-circumstances, challenge, control-circumstances, effortful success, emotion-focused coping potential, expectedness, fairness, globality, novelty, stability, threat |
| homesickness | loss | pleasantness |
| hope | certainty, challenge, control-self, easing of threat, effortful success, fairness, future expectancy, goal conduciveness, intentionality, loss, novelty, pleasantness, problem-focused coping potential, value | emotion-focused coping potential, expectedness, future predictability, globality, goal relevance, normative significance (internal), temporal distance |
| inspiration | goal conduciveness | NA |
| interest | attentional activity, certainty, challenge, concern for others, control-self, goal conduciveness, goal relevance, harm, pleasantness, problem-focused coping potential | future predictability, normative significance (internal) |
| irritation | control-self, pleasantness | NA |
| jealousy | fairness, future predictability, perceived obstacle, pleasantness | attentional activity, control-self, effort, goal relevance |
| joy | certainty, control-self, easing of threat, effortful success, emotion-focused coping potential, fairness, goal conduciveness, intentionality, loss, normative significance (external), normative significance (internal), perceived obstacle, pleasantness, problem-focused coping potential, remarkable, value | accountability-self, challenge, concern for others, effort, future expectancy, future predictability, globality, harm, stability, temporal distance, threat, uniqueness |
| loneliness | loss | pleasantness |
| longing | loss, pleasantness | temporal distance, uniqueness |
| love | certainty, effortful success, fairness, future expectancy, goal conduciveness, goal relevance, normative significance (internal), novelty, pleasantness, problem-focused coping potential | accountability-other, attentional activity, concern for others, control-self, normative significance (external), temporal distance, uniqueness |
| nostalgia | pleasantness | loss, temporal distance, uniqueness |
| pity | accountability-other, pleasantness | threat |
| playfulness | certainty | NA |
| pleasure | control-self | NA |
| pride | accountability-self, control-self, easing of threat, effortful success, emotion-focused coping potential, goal conduciveness, novelty, problem-focused coping potential, value | attentional activity, certainty, challenge, effort, future expectancy, future predictability, globality, goal relevance, pleasantness, temporal distance, uniqueness |
| psyched-up | pleasantness, threat | NA |
| regret | accountability-self, effort, loss, normative significance (internal), pleasantness | accountability-circumstances |
| relief | easing of threat, effortful success, emotion-focused coping potential, future expectancy, goal conduciveness, intentionality, loss, threat | accountability-self, certainty, control-self, future predictability, globality, normative significance (internal), novelty, pleasantness, temporal distance, uniqueness, value |
| resignation | NA | control-circumstances, effort, future predictability, perceived obstacle |
| sadness | certainty, control-circumstances, control-self, difficulty, easing of threat, emotion-focused coping potential, fairness, future predictability, goal conduciveness, goal relevance, harm, intentionality, loss, normative significance (external), novelty, perceived obstacle, pleasantness, reality, threat | accountability-circumstances, accountability-other, accountability-self, attentional activity, effort, effortful success, normative significance (internal) |
| schadenfreude | NA | accountability-other, fairness, normative significance (internal) |
| self-anger | accountability-other, accountability-self | NA |
| self-pity | loss | pleasantness |
| serenity | challenge, control-self, future expectancy, goal relevance, harm, loss, pleasantness, threat, value | accountability-self, certainty, concern for others, effort, future predictability, goal conduciveness, normative significance (internal), perceived obstacle |
| shame | accountability-self, challenge, control-self, difficulty, future expectancy, harm, intentionality, problem-focused coping potential, threat | fairness, goal conduciveness, loss, pleasantness, value |
| surprise | attentional activity, certainty, expectedness, future predictability, goal conduciveness, goal relevance, normative significance (internal), novelty | accountability-other, challenge, concern for others, normative significance (external) |
| sympathy | concern for others, loss, pleasantness | control-self, expectedness, fairness, goal conduciveness, threat |
| tenderness | pleasantness | temporal distance, uniqueness |
| threat-awe | certainty, control-circumstances, control-other, control-self, pleasantness, threat | NA |
| unfriendly | NA | accountability-other |
| unlucky | accountability-circumstances | NA |
| worry | difficulty, goal conduciveness, goal relevance, problem-focused coping potential, threat | challenge, emotion-focused coping potential, fairness |
#### Moderator Analyses
## Set `eval=T` to run this chunk.
## This is written to file, not output.
# This function is a helper function to construct the table for the moderator analyses.
meta_analysis_for_table_moderator = function(df, this_emotion, num_digits=4) {
# only do for appraisal-emotion relationships that have at least 1 exp and 1 control condition
if (dim(df[df$exp == 'yes',])[1] >0 & dim(df[df$exp == 'no',])[1] >0){
meta_df = mvmeta(z~exp, S = v, data = df, method = "ml")
df$exp_num <- ifelse(df$exp == 'yes',1,0)
meta_df_sem = rma(yi = z, vi = v, mods = exp_num, data = df, method = 'ML') # using the metaSEM to get I2
df_cor = df[df$exp == 'no',]
if (dim(df_cor)[1] > 1){
meta_df1 = mvmeta(z, S = v, data = df_cor, method = "ml")
summary_meta_df1 <- summary(meta_df1)
r_cor = round(summary_meta_df1$coefficients["(Intercept)", "Estimate"], 2)
} else {
r_cor = round(df_cor$z,2)
}
summary_meta_df <- summary(meta_df)
summary_meta_df_sem<- summary(meta_df_sem)
if(summary_meta_df$qstat$pvalue<0.001) {
Q_pstring = "***"
} else if(summary_meta_df$qstat$pvalue<0.01) {
Q_pstring = "**"
} else if(summary_meta_df$qstat$pvalue<0.05) {
Q_pstring = "*"
} else { Q_pstring = "" }
r_p = summary_meta_df$coefficients["(Intercept)", "Pr(>|z|)"]
if(r_p < 0.001) {
r_pstring = "***"
} else if(r_p < 0.01) {
r_pstring = "**"
} else if(r_p < 0.05) {
r_pstring = "*"
} else { r_pstring = "" }
moderator_p = summary_meta_df$coefficients["expyes", "Pr(>|z|)"]
if(moderator_p < 0.001) {
pstring = "***"
} else if(moderator_p < 0.01) {
pstring = "**"
} else if(moderator_p < 0.05) {
pstring = "*"
} else { pstring = "" }
n_exp <- dim(df[df$exp == 'yes',])[1]
n_co <- dim(df[df$exp == 'no',])[1]
table_df = data.frame(
Emotion = this_emotion,
Appraisal = df$Appraisal[1],
Q = paste(round(summary_meta_df$qstat$Q, 2), " (",
format(summary_meta_df$qstat$df, digits=num_digits), ")", Q_pstring, sep=""),
#k = paste(nrow(df), " (c=",n_co,", e=",n_exp,")"),
k_cor = n_co,
k_exp = n_exp,
r_cor = paste(r_cor, r_pstring, sep=""),
b = round(summary_meta_df$coefficients["expyes", "Estimate"],2),
z = paste(round(summary_meta_df$coefficients["expyes", "z"], 2), pstring, sep=""),
i_sqaured = round(summary_meta_df_sem$R2,1))
return(table_df)
}
}
# This next chunk actually produces the table for the moderator analysis
full_table = data.frame()
for(this_emotion in sort(c(LIST_OF_EMOTIONS_Short, LIST_OF_EMOTIONS_Long))) {
this_table = data.frame()
for(this_appraisal in LIST_OF_APPRAISALS) {
df = data %>% filter(Emotion == this_emotion,
Appraisal == this_appraisal)
if (dim(df[df$exp == 'yes',])[1] >0 & dim(df[df$exp == 'no',])[1] >0 & dim(df)[1] >2) {
this_table = bind_rows(this_table,
meta_analysis_for_table_moderator(df, this_emotion))
}
}
#this_table <- this_table %>% arrange(Emotion, desc(k), Appraisal)
full_table = bind_rows(full_table, this_table)
}
write.csv(full_table, "table-raw-moderator2.csv", row.names=F, na="")
full_table_significant_moderator = full_table %>% filter(str_detect(z, fixed("*"))) %>% mutate(
r_sign = as.numeric(str_replace_all(r_cor, fixed("*"), "")),
z_sign = as.numeric(str_replace_all(z, fixed("*"), "")),
same_sign = ((r_sign*z_sign)>0)
)
full_table_significant_moderator_same_pattern = full_table_significant_moderator %>% filter(same_sign)
# number relationships tested: nrow(full_table) = 73
# number relationships significant: nrow(full_table_significant_moderator) = 21
# of these, same sign are: nrow(full_table_significant_moderator_same_pattern) = 9
# that means 12 are different sign.## this chunk is used to write the prediction tables
library(stringr)
df <- read.csv('prediction_data.csv', header=T) # prediction file
df_reference <- read.csv('reference_prediction.csv', header=T)
#string_test <- df$Predicted[2]
#hi1 <- string_test %>% str_match_all("[0-9]+") %>% sapply(toString)
#hi2 <- as.numeric(unlist(strsplit(hi1, split=", ")))
#grepl("\\d", string_test)
df_reference_total <- data.frame()
for (i in 1:dim(df)[1]){
string <- df$Predicted[i]
if (grepl("\\d", string)){
string1 <- string %>% str_match_all("[0-9]+") %>% sapply(toString)
string2 <- as.numeric(unlist(strsplit(string1, split=", ")))
reference_lists <- c()
for (num in string2){
row_reference <- df_reference[df_reference$num == num,]
reference_lists <- c(reference_lists,row_reference$reference)
}
df_reference_row <- data.frame(
appraisal = df$Appraisal[i],
emotion = df$Emotion[i],
reference = paste(reference_lists, collapse = "; ")
)
df_reference_total <- rbind(df_reference_total, df_reference_row)
}
}
write.csv(df_reference_total,"prediction_results.csv", row.names=F, na="")