Tendency to laugh is a stable trait: Findings from a round-robin conversation study
Adrienne Wood, Emma Templeton, Jessica Morrel, Frederick Schubert, & Thalia Wheatley
1/20/2022
Analyses accompanying the paper, “Tendency to laugh is a stable trait: Findings from a round-robin conversation study”
Data overview
Codebook
codebook <-read_excel("codebook.xlsx")
DT::datatable(codebook)Descriptive statistics
For conversation-level variables
dAll <-read.csv("complete_round_robin_data.csv")
dAll <-unique(dAll)
conversationVars <-c("convo_flow","convo_enjoy","friends","know_now","common","similar","fun","comfortable")
dfSummary(dAll[,c("LaughCount",conversationVars)], plain.ascii = FALSE, style = "grid",
graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp",round.digits=3)Data Frame Summary
dAll
Dimensions: 644 x 9
Duplicates: 0
| No | Variable | Stats / Values | Freqs (% of Valid) | Graph | Missing |
|---|---|---|---|---|---|
| 1 | LaughCount [integer] |
Mean (sd) : 8.88 (7.525) min < med < max: 0 < 7 < 45 IQR (CV) : 10 (0.847) |
36 distinct values |  |
0 (0.0%) |
| 2 | convo_flow [integer] |
Mean (sd) : 73.255 (21.232) min < med < max: 0 < 76 < 100 IQR (CV) : 30 (0.29) |
84 distinct values |  |
0 (0.0%) |
| 3 | convo_enjoy [integer] |
Mean (sd) : 72.55 (20.945) min < med < max: 0 < 74.5 < 100 IQR (CV) : 28 (0.289) |
87 distinct values |  |
0 (0.0%) |
| 4 | friends [integer] |
Mean (sd) : 66.806 (24.128) min < med < max: 0 < 69 < 100 IQR (CV) : 31.25 (0.361) |
93 distinct values |  |
0 (0.0%) |
| 5 | know_now [integer] |
Mean (sd) : 42.416 (20.62) min < med < max: 0 < 41.5 < 100 IQR (CV) : 32 (0.486) |
92 distinct values |  |
0 (0.0%) |
| 6 | common [integer] |
Mean (sd) : 53.183 (22.065) min < med < max: 0 < 57 < 100 IQR (CV) : 31 (0.415) |
93 distinct values |  |
0 (0.0%) |
| 7 | similar [integer] |
Mean (sd) : 53.118 (21.646) min < med < max: 0 < 56 < 100 IQR (CV) : 29.25 (0.408) |
90 distinct values |  |
0 (0.0%) |
| 8 | fun [integer] |
Mean (sd) : 68.205 (20.863) min < med < max: 0 < 69 < 100 IQR (CV) : 25 (0.306) |
88 distinct values |  |
0 (0.0%) |
| 9 | comfortable [integer] |
Mean (sd) : 68.268 (20.609) min < med < max: 0 < 69 < 100 IQR (CV) : 25 (0.302) |
84 distinct values |  |
110 (17.1%) |
For person-level variables
personalityVars <-c("BFAS_NWscore","BFAS_NVscore","BFAS_ACscore", "BFAS_APscore","BFAS_CIscore","BFAS_COscore","BFAS_EEscore","BFAS_EAscore","BFAS_OIscore","BFAS_OOscore","IRI_PTscore",
"IRI_FSscore", "IRI_ECscore", "IRI_PDscore", "LONELY_",
"NTB_", "REJECTION_", "SSES_Pscore", "SSES_Sscore",
"SSES_Ascore", "STAI_")
dPersAgg <-dAll[!duplicated(dAll$subID),personalityVars]
dfSummary(dPersAgg, plain.ascii = FALSE, style = "grid",
graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp",round.digits=3)Data Frame Summary
dPersAgg
Dimensions: 66 x 21
Duplicates: 7
| No | Variable | Stats / Values | Freqs (% of Valid) | Graph | Missing |
|---|---|---|---|---|---|
| 1 | BFAS_NWscore [numeric] |
Mean (sd) : 3.111 (0.687) min < med < max: 2 < 3 < 4.7 IQR (CV) : 0.7 (0.221) |
25 distinct values |  |
7 (10.6%) |
| 2 | BFAS_NVscore [numeric] |
Mean (sd) : 2.714 (0.768) min < med < max: 0.95 < 2.7 < 4.8 IQR (CV) : 0.8 (0.283) |
31 distinct values |  |
7 (10.6%) |
| 3 | BFAS_ACscore [numeric] |
Mean (sd) : 4.013 (0.642) min < med < max: 2.2 < 4.1 < 5 IQR (CV) : 0.85 (0.16) |
25 distinct values |  |
7 (10.6%) |
| 4 | BFAS_APscore [numeric] |
Mean (sd) : 3.62 (0.53) min < med < max: 2.4 < 3.6 < 4.8 IQR (CV) : 0.675 (0.146) |
24 distinct values |  |
7 (10.6%) |
| 5 | BFAS_CIscore [numeric] |
Mean (sd) : 3.254 (0.605) min < med < max: 1.9 < 3.3 < 4.4 IQR (CV) : 0.9 (0.186) |
26 distinct values |  |
7 (10.6%) |
| 6 | BFAS_COscore [numeric] |
Mean (sd) : 3.545 (0.615) min < med < max: 2.3 < 3.6 < 4.7 IQR (CV) : 0.725 (0.173) |
23 distinct values |  |
7 (10.6%) |
| 7 | BFAS_EEscore [numeric] |
Mean (sd) : 3.726 (0.757) min < med < max: 1.8 < 3.9 < 5 IQR (CV) : 1.1 (0.203) |
26 distinct values |  |
7 (10.6%) |
| 8 | BFAS_EAscore [numeric] |
Mean (sd) : 3.493 (0.695) min < med < max: 1.8 < 3.5 < 5 IQR (CV) : 0.9 (0.199) |
29 distinct values |  |
7 (10.6%) |
| 9 | BFAS_OIscore [numeric] |
Mean (sd) : 3.715 (0.598) min < med < max: 2.4 < 3.7 < 4.9 IQR (CV) : 0.825 (0.161) |
27 distinct values |  |
7 (10.6%) |
| 10 | BFAS_OOscore [numeric] |
Mean (sd) : 3.586 (0.695) min < med < max: 2 < 3.65 < 4.9 IQR (CV) : 0.9 (0.194) |
26 distinct values |  |
7 (10.6%) |
| 11 | IRI_PTscore [numeric] |
Mean (sd) : 2.787 (0.42) min < med < max: 1.714 < 2.714 < 4.429 IQR (CV) : 0.429 (0.151) |
14 distinct values |  |
9 (13.6%) |
| 12 | IRI_FSscore [numeric] |
Mean (sd) : 2.887 (0.491) min < med < max: 1.714 < 3 < 4 IQR (CV) : 0.571 (0.17) |
15 distinct values |  |
9 (13.6%) |
| 13 | IRI_ECscore [numeric] |
Mean (sd) : 2.907 (0.346) min < med < max: 2.143 < 2.857 < 4 IQR (CV) : 0.429 (0.119) |
12 distinct values |  |
9 (13.6%) |
| 14 | IRI_PDscore [numeric] |
Mean (sd) : 3.213 (0.419) min < med < max: 2.429 < 3.286 < 4.143 IQR (CV) : 0.429 (0.13) |
13 distinct values |  |
9 (13.6%) |
| 15 | LONELY_ [numeric] |
Mean (sd) : 2.237 (0.615) min < med < max: 1.25 < 2.15 < 3.9 IQR (CV) : 0.95 (0.275) |
29 distinct values |  |
19 (28.8%) |
| 16 | NTB_ [numeric] |
Mean (sd) : 3.714 (0.623) min < med < max: 2.5 < 3.7 < 5 IQR (CV) : 0.8 (0.168) |
22 distinct values |  |
9 (13.6%) |
| 17 | REJECTION_ [numeric] |
Mean (sd) : 4.274 (0.878) min < med < max: 2.857 < 4.286 < 5.857 IQR (CV) : 1.464 (0.205) |
32 distinct values |  |
19 (28.8%) |
| 18 | SSES_Pscore [numeric] |
Mean (sd) : 3.641 (0.733) min < med < max: 1.571 < 3.714 < 5 IQR (CV) : 0.714 (0.201) |
20 distinct values |  |
17 (25.8%) |
| 19 | SSES_Sscore [numeric] |
Mean (sd) : 3.236 (0.801) min < med < max: 1.429 < 3.429 < 4.857 IQR (CV) : 1 (0.248) |
22 distinct values |  |
17 (25.8%) |
| 20 | SSES_Ascore [numeric] |
Mean (sd) : 3.306 (0.711) min < med < max: 1.5 < 3.333 < 4.667 IQR (CV) : 0.833 (0.215) |
17 distinct values |  |
17 (25.8%) |
| 21 | STAI_ [numeric] |
Mean (sd) : 2.18 (0.549) min < med < max: 1.4 < 2.05 < 3.6 IQR (CV) : 0.45 (0.252) |
27 distinct values |  |
17 (25.8%) |
Demographics breakdown
dDems <-dAll[!duplicated(dAll$subID),]
dDems$sex <-tolower(dDems$sex)
kable(table(dDems$sex),col.names=c("Gender","Number of students"))| Gender | Number of students |
|---|---|
| female | 33 |
| male | 33 |
kable(table(dDems$race),col.names=c("Race","Number of students"))| Race | Number of students |
|---|---|
| Asian/Asian-American | 14 |
| Biracial/Multi-racial | 3 |
| Latino(a)/Hispanic | 3 |
| Native American | 1 |
| White/Caucasian | 39 |
kable(table(dDems$age),col.names=c("Age","Number of students"))| Age | Number of students |
|---|---|
| 17 | 1 |
| 18 | 17 |
| 19 | 19 |
| 20 | 8 |
| 21 | 4 |
| 25 | 1 |
kable(table(dDems$nativeEnglish),col.names=c("Native English speaker","Number of students"))| Native English speaker | Number of students |
|---|---|
| No | 5 |
| Yes | 45 |
Data preprocessing
Reduce the 8 conversation self-report items to two factors
Exploratory factor analysis code adapted from here.
Correlations between all variables in dataset
corrTable <-function(df,caption){
dCor <-data.frame(round(cor(df,use="pairwise.complete.obs"),2))
diag(dCor) <-NA
brks <-seq(-1,1,.1)
clrsneg <- rev(round(seq(255, 40, length.out = length(brks)/2), 0) %>%
{paste0("rgb(255,", ., ",", ., ")")})
clrspos <- round(seq(255, 40, length.out = length(brks)/2), 0) %>%
{paste0("rgb(",.,",255,",.,")")}
clrs <-c(clrsneg,clrspos)
DT::datatable(dCor,caption=caption) %>% formatStyle(names(dCor),backgroundColor = styleInterval(brks, clrs))
}
corrTable(dAll[,c("LaughCount",conversationVars,personalityVars)],"All variables in dataset")Correlations between conversation rating variables of interest
corrTable(dAll[,conversationVars],"Conversation rating variables")Correlations between personality measures
corrTable(dAll[,personalityVars],"Correlations between personality measures")Round robin calculations
From Bonito & Kenny, 2010:
- “The actor effect is the extent to which a given member thinks about or behaves toward other members of the group in similar ways, whereas the partner effect is the degree to which a given member is thought of similarly or elicits similar behaviors from others.”
- The dyadic-level component is called the relationship effect, which refers to the unique perceptions or behaviors pairs of members within the collective elicit from each other.
- See TripleR documentation for more information.
- A great explanation of all SRM variables can be found in the appendix of this paper: Kluger, A. N., Malloy, T. E., Pery, S., Itzchakov, G., Castro, D. R., Lipetz, L., … Borut, L. (2020). Dyadic Listening in Teams: Social Relations Model. Applied Psychology. doi:10.1111/apps.12263
- See also: Schonbrodt FD, Schmukle SC, Back MD. Round robin analyses in R: How to use TripleR.
Calculate actor/partner variance for laughter
laughRR <-RR(LaughCount~subID*partnerID|round_robin_num,data=dAll,na.rm=T)
DT::datatable(laughRR$varComp)dcsv <-laughRR$varComp
dcsv[,c(2:7)] <-round(dcsv[,c(2:7)],3)
write.csv(dcsv,"laughterRRoutput.csv",row.names=F)
plot(laughRR)
Calculate actor/partner variance for enjoyment
enjRR <-RR(enjoymentFactor~subID*partnerID|round_robin_num,data=dAll,na.rm=T)
DT::datatable(enjRR$varComp)dcsv <-enjRR$varComp
dcsv[,c(2:7)] <-round(dcsv[,c(2:7)],3)
write.csv(dcsv,"enjoyRRoutput.csv",row.names=F)
plot(enjRR)
Calculate actor/partner variance for similarity
simRR <-RR(similarityFactor~subID*partnerID|round_robin_num,data=dAll,na.rm=T)
DT::datatable(simRR$varComp)dcsv <-simRR$varComp
dcsv[,c(2:7)] <-round(dcsv[,c(2:7)],3)
write.csv(dcsv,"similarityRRoutput.csv",row.names=F)
plot(simRR)
Round-robin bivariate relationships between laughter and enjoyment and similarity
See page 251 here. These are capturing the different within-person, across-dyad relationships between enjoyment/similarity and amount of laughter.
Enjoyment and laughter
enjoyRR <-RR(LaughCount+enjoymentFactor~subID*partnerID|round_robin_num,data=dAll,na.rm=T)
DT::datatable(enjoyRR$bivariate)dcsv <-enjoyRR$bivariate
dcsv[,c(2:7)] <-round(dcsv[,c(2:7)],3)
write.csv(dcsv,"enjoyRRoutput.csv",row.names=F)Similarity and laughter
similarityRR <-RR(LaughCount+similarityFactor~subID*partnerID|round_robin_num,data=dAll,na.rm=T)
DT::datatable(similarityRR$bivariate)dcsv <-similarityRR$bivariate
dcsv[,c(2:7)] <-round(dcsv[,c(2:7)],3)
write.csv(dcsv,"similarityRRoutput.csv",row.names=F)Partner variable calculation
Create variables that represents how much your PARTNER laughed, enjoyed, and felt similar to you
dPL <-dAll[,c("subID","partnerID","LaughCount","similarityFactor","enjoymentFactor")]
dPL <-varRename(dPL,c("subID","partnerID"),c("sub","partner"))
#switch partner and subject
dPL <-varRename(dPL,c("sub","partner","LaughCount","similarityFactor","enjoymentFactor"),c("partnerID","subID","partnerLaughCount","partnersimilarityFactor","partnerenjoymentFactor"))
dAll <-join(dAll,dPL,by=c("subID","partnerID"),type="left")
dAll$sex <-ifelse(dAll$sex=="Male","male",dAll$sex)Aggregate data by participant
Aggregate conversation variables by participant. Get mean and standard deviation scores across conversations for each participant. These will be for the personality analyses later.
dM <-aggregate(dAll,by=list(dAll$subID,dAll$sex),FUN="mean",na.rm=T)
dM$Group.1<-NULL
dM$sex <-dM$Group.2
dSD <-aggregate(dAll[,c("subID","sex","LaughCount","partnerLaughCount", "length_partner","partnersimilarityFactor","partnerenjoymentFactor","enjoymentFactor", "similarityFactor")],by=list(dAll[,c("subID","LaughCount", "partnerLaughCount", "length_partner","partnersimilarityFactor","partnerenjoymentFactor","enjoymentFactor", "similarityFactor")]$subID),FUN="sd",na.rm=T)
colnames(dSD) <-paste(colnames(dSD),"SD",sep="_")
dAgg <-cbind(dM,dSD)
dAgg$subID_SD<-NULLMake lists of our variables
personalityVars <-c("BFAS_NWscore", "BFAS_NVscore", "BFAS_ACscore", "BFAS_APscore", "BFAS_CIscore", "BFAS_COscore", "BFAS_EEscore", "BFAS_EAscore", "BFAS_OIscore", "BFAS_OOscore", "IRI_PTscore", "IRI_FSscore", "IRI_ECscore", "IRI_PDscore", "LONELY_", "NTB_", "REJECTION_", "SSES_Pscore", "SSES_Sscore", "SSES_Ascore", "STAI_")
convoVars <-c("enjoymentFactor","similarityFactor","convo_flow", "convo_enjoy", "friends", "speak", "knew_before", "knew_before_text", "know_now", "common", "similar", "attractive", "attracted_to", "extraverted", "fun", "disclosed", "comfortable", "extraverted_self", "fun_self", "disclosed_self", "comfortable_self", "length_self", "length_partner","partnersimilarityFactor","partnerenjoymentFactor")
laughVars <-c("LaughCount", "partnerLaughCount")
laugh_SDVars<-c("LaughCount_SD", "partnerLaughCount_SD")
convo_SDVars <-c("enjoymentFactor_SD","similarityFactor_SD","convo_flow", "convo_enjoy", "friends", "speak", "knew_before", "knew_before_text", "know_now", "common", "similar", "attractive", "attracted_to", "extraverted", "fun", "disclosed", "comfortable", "extraverted_self", "fun_self", "disclosed_self", "comfortable_self", "length_self", "length_partner_SD","partnersimilarityFactor_SD","partnerenjoymentFactor_SD")Look at correlations between trait variables
Laughter variables
- LaughCount is the participant’s average amount of laughter across conversations
- LaughCount_SD is the variability in the participant’s conversations’ laughter, with higher values indicating more variability from one conversation to the next.
corData <-as.matrix(dAgg[,c(laughVars,laugh_SDVars,convoVars,convo_SDVars,personalityVars)])
aggCors <-cor(corData,use="pairwise.complete.obs")
corrTable(aggCors, "Person-level correlations")Between-subject models predicting laughter from personality
First we need to impute the missing personality data. We’ll use the existing personality and conversation rating data, but not the behavioral measure since those are what we’ll be predicting in our models.
# how much personality data is missing?
(sum(is.na(dAgg[,c(personalityVars)]))/prod(dim(dAgg[,c(personalityVars)])))*100[1] 15.94517
imp <-mice(dAgg[,c(personalityVars,convoVars,convo_SDVars)],seed=14)iter imp variable 1 1 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore* IRI_FSscore IRI_ECscore IRI_PDscore* LONELY_* NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 1 2 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 1 3 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore* BFAS_COscore* BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore* IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore* STAI_ comfortable* extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 1 4 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 1 5 BFAS_NWscore BFAS_NVscore BFAS_ACscore* BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore* SSES_Ascore STAI_ comfortable* extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 2 1 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore* BFAS_EEscore BFAS_EAscore* BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 2 2 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore* BFAS_OIscore* BFAS_OOscore IRI_PTscore IRI_FSscore* IRI_ECscore IRI_PDscore LONELY_ NTB_* REJECTION_* SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable* extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 2 3 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner* length_partner_SD 2 4 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore* LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 2 5 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore* BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore* IRI_ECscore* IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore* SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 3 1 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner* length_partner_SD 3 2 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner length_partner_SD 3 3 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore* BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore* LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 3 4 BFAS_NWscore BFAS_NVscore BFAS_ACscore* BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore* STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 3 5 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self* length_self* length_partner* length_partner_SD 4 1 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner length_partner_SD 4 2 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore* IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 4 3 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self* fun_self disclosed_self length_self* length_partner* length_partner_SD 4 4 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore* BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore* IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner* length_partner_SD 4 5 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore* BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_* SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self* length_self* length_partner* length_partner_SD 5 1 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self* disclosed_self length_self* length_partner* length_partner_SD 5 2 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 5 3 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_* NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_* comfortable extraverted_self fun_self disclosed_self length_self* length_partner* length_partner_SD 5 4 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner length_partner_SD 5 5 BFAS_NWscore BFAS_NVscore BFAS_ACscore BFAS_APscore BFAS_CIscore BFAS_COscore BFAS_EEscore BFAS_EAscore BFAS_OIscore BFAS_OOscore IRI_PTscore IRI_FSscore IRI_ECscore IRI_PDscore LONELY_ NTB_ REJECTION_ SSES_Pscore SSES_Sscore SSES_Ascore STAI_ comfortable extraverted_self fun_self disclosed_self length_self length_partner* length_partner_SD*
dImp <-mice::cbind(imp,dAgg[,c("subID","LaughCount","partnerLaughCount","sex")])Predict laughter output from personality
Average laugh count is skewed with a floor at 0 so we’ll use a Gamma distribution with a log link.
modLaugh<-with(dImp, glm(LaughCount~sex+BFAS_NWscore+BFAS_NVscore+BFAS_ACscore+BFAS_APscore+BFAS_CIscore+BFAS_COscore+BFAS_EEscore+BFAS_EAscore+BFAS_OIscore+BFAS_OOscore+IRI_PTscore+IRI_FSscore+IRI_ECscore+IRI_PDscore+LONELY_+NTB_+REJECTION_+STAI_+SSES_Pscore+SSES_Sscore+SSES_Ascore,family=Gamma(link="log")))
modLaughSummary <-data.frame(pool(modLaugh)$pooled)Predict average partner laughter from personality
Average partner laugh count is normally distributed so we’ll use a general linear model.
modLaughPartner<- with(dImp, lm(partnerLaughCount~sex+BFAS_NWscore+BFAS_NVscore+BFAS_ACscore+BFAS_APscore+BFAS_CIscore+BFAS_COscore+BFAS_EEscore+BFAS_EAscore+BFAS_OIscore+BFAS_OOscore+IRI_PTscore+IRI_FSscore+IRI_ECscore+IRI_PDscore+LONELY_+NTB_+REJECTION_+STAI_+SSES_Pscore+SSES_Sscore+SSES_Ascore))
modLaughPartnerSummary <-data.frame(pool(modLaughPartner)$pooled)Combine two personality models’ outputs for table
# calculate and adjust p values for multiple comparisons
modLaughSummary$p <-pt(q=modLaughSummary$t, df=43,lower.tail=F)
modLaughPartnerSummary$p <-pt(q=modLaughPartnerSummary$t, df=43,lower.tail=F)
modLaughSummary$p.adjust <-p.adjust(modLaughSummary$p,method="bonferroni")
modLaughPartnerSummary$p.adjust <-p.adjust(modLaughPartnerSummary$p,method="bonferroni")
# round numbers
modLaughSummary<-modLaughSummary %>%
mutate_if(is.numeric, round,3)
modLaughPartnerSummary<-modLaughPartnerSummary %>%
mutate_if(is.numeric, round,3)
modLaughSummary$Outcome <- "Participant Laughter"
modLaughPartnerSummary$Outcome <-"Partner Laughter"
#combine two models' outputs for table
modLaughSummary<-modLaughSummary %>%
mutate_if(is.numeric, round,3)
modLaughPartnerSummary<-modLaughPartnerSummary %>%
mutate_if(is.numeric, round,3)
modLaughSummary$Outcome <- "Participant Laughter"
modLaughPartnerSummary$Outcome <-"Partner Laughter"
modLaughSummaryBoth <-rbind(modLaughSummary,modLaughPartnerSummary)
modLaughSummaryBoth <-modLaughSummaryBoth[,c(14,1:13)]
write_csv(modLaughSummaryBoth,"personalityModelsCombined.csv")
DT::datatable(modLaughSummaryBoth)Were these models underpowered?
Calculate the minimum detectable effect size for a single variable with 80% power and alpha = .05.
pwr.f2.test(u=1, v=43,sig.level=.05,power=.80) Multiple regression power calculation
u = 1
v = 43
f2 = 0.1825491
sig.level = 0.05
power = 0.8Graphs
Spaghetti plots for enjoyment and similarity
laughEnjoy <-ggplot(data=dAll,aes(x=LaughCount,y=enjoymentFactor,color=as.factor(subID)))+
geom_smooth(method="lm",se=FALSE,size=.3)+
geom_smooth(data=dAgg,method="lm",color="black",size=1)+theme(legend.position="none")+xlab(label="Laughs Produced")+ylab(label="Enjoyment")+ylim(-1.5,1.5)
laughEnjoy
laughPartnerEnjoy <-ggplot(data=dAll,aes(x=partnerLaughCount,y=enjoymentFactor,color=as.factor(subID)))+
geom_smooth(method="lm",se=FALSE,size=.3)+
geom_smooth(data=dAgg,method="lm",color="black",size=1)+theme(legend.position="none")+xlab(label="Laughs Elicited")+ylab(label="Enjoyment")+ylim(-1.5,1.5)
laughPartnerEnjoy
laughSimilar <-ggplot(data=dAll,aes(x=LaughCount,y=similarityFactor,color=as.factor(subID)))+
geom_smooth(method="lm",se=FALSE,size=.3)+
geom_smooth(data=dAgg,method="lm",color="black",size=1)+theme(legend.position="none")+xlab(label="Laughs Produced")+ylab(label="Perceived Similarity")+ylim(-1.5,1.5)
laughSimilar
laughPartnerSimilar <-ggplot(data=dAll,aes(x=partnerLaughCount,y=similarityFactor,color=as.factor(subID)))+
geom_smooth(method="lm",se=FALSE,size=.3)+
geom_smooth(data=dAgg,method="lm",color="black",size=1)+theme(legend.position="none")+xlab(label="Laughs Elicited")+ylab(label="Perceived Similarity")+ylim(-1.5,1.5)
laughPartnerSimilar
allplots <-ggarrange(laughEnjoy,laughPartnerEnjoy,laughSimilar,laughPartnerSimilar,labels="AUTO")
ggsave("spaghetti_plots.png",allplots)Plot fitted versus observed laughter variables from personality models
Let’s see how well personality variables predict laughter
modLaugh<-glm.mids(LaughCount~BFAS_NWscore+BFAS_NVscore+BFAS_ACscore+BFAS_APscore+BFAS_CIscore+BFAS_COscore+BFAS_EEscore+BFAS_EAscore+BFAS_OIscore+BFAS_OOscore+IRI_PTscore+IRI_FSscore+IRI_ECscore+IRI_PDscore+LONELY_+NTB_+REJECTION_+STAI_+SSES_Pscore+SSES_Sscore+SSES_Ascore,data=dImp,family=Gamma(link="log"))
# calculate variance explained by personality variables
modLaughAnalyses <-modLaugh$analyses
# Since we have a GLM, it's a little tricky. We can calculate by what percent the null model's deviance (error) is reduced by all our variables. Basically a partial eta squared. We'll do it for all 5 of the imputed datasets.
dev1 <-(modLaughAnalyses[[1]]$null.deviance-modLaughAnalyses[[1]]$deviance)/modLaughAnalyses[[1]]$null.deviance
dev2 <-(modLaughAnalyses[[2]]$null.deviance-modLaughAnalyses[[2]]$deviance)/modLaughAnalyses[[2]]$null.deviance
dev3 <-(modLaughAnalyses[[3]]$null.deviance-modLaughAnalyses[[3]]$deviance)/modLaughAnalyses[[3]]$null.deviance
dev4 <-(modLaughAnalyses[[4]]$null.deviance-modLaughAnalyses[[4]]$deviance)/modLaughAnalyses[[4]]$null.deviance
dev5 <-(modLaughAnalyses[[5]]$null.deviance-modLaughAnalyses[[5]]$deviance)/modLaughAnalyses[[5]]$null.deviance
# Average portion of deviance explained:
meanDev <- mean(dev1,dev2,dev3,dev4,dev5)
# Minimum:
minDev <-min(dev1,dev2,dev3,dev4,dev5)
# Maximum:
maxDev <-max(dev1,dev2,dev3,dev4,dev5)
print(paste("Average portion of deviance in laughs produced explained by personality traits: M=",as.character(round(meanDev,3)), ", min=", as.character(round(minDev,3)), ", max=", as.character(round(maxDev,3))))[1] “Average portion of deviance in laughs produced explained by personality traits: M= 0.188 , min= 0.16 , max= 0.336”
modLaughPartner<-lm.mids(partnerLaughCount~BFAS_NWscore+BFAS_NVscore+BFAS_ACscore+BFAS_APscore+BFAS_CIscore+BFAS_COscore+BFAS_EEscore+BFAS_EAscore+BFAS_OIscore+BFAS_OOscore+IRI_PTscore+IRI_FSscore+IRI_ECscore+IRI_PDscore+LONELY_+NTB_+REJECTION_+STAI_+SSES_Pscore+SSES_Sscore+SSES_Ascore,data=dImp)
print("Pooled r^2 for the 5 imputed models predicting average laughs elicited from all personality variables:")[1] “Pooled r^2 for the 5 imputed models predicting average laughs elicited from all personality variables:”
print(pool.r.squared(modLaughPartner)) est lo 95 hi 95 fmiR^2 0.3439863 0.102689 0.587966 0.5235208
Graph laughter networks
RReffects <-laughRR$effects
RReffects <-RReffects[RReffects$group.id==1,]
maxActor <-RReffects[RReffects$LaughCount.a==max(RReffects$LaughCount.a),"id"]
minActor <-RReffects[RReffects$LaughCount.a==min(RReffects$LaughCount.a),"id"]
maxPartner <-RReffects[RReffects$LaughCount.p==max(RReffects$LaughCount.p),"id"]
minPartner <-RReffects[RReffects$LaughCount.p==min(RReffects$LaughCount.p),"id"]
colrs <-RColorBrewer::brewer.pal(name="Set3",n=11)
# we'll just make a visualization of Group 1 but to do them all, uncomment the two commented lines below then comment out "group <-1".
#for(group in unique(dAll$round_robin_num)){
group <- 1
LaughCountDF <-dAll[dAll$round_robin_num==group,c("subID","partnerID","LaughCount")]
names(LaughCountDF) <-c("Ego","Alter","weight")
net <-graph_from_data_frame(LaughCountDF,directed=T)
V(net)$color <- colrs
edge.start <- ends(net, es=E(net), names=F)[,1]
edge.col <- V(net)$color[edge.start]
lay <-create_layout(net,layout="linear",circular=TRUE)
ggraph(lay) +
geom_edge_fan(alpha = .4,
aes(width = weight,color=as.factor(edge.col),show.legend=F)) +
geom_node_point(aes(color=color),size=8,show.legend=F)+
#geom_node_text(aes(label = c("max. partner effect","","","min. partner effect","","","","","max. actor effect","min. actor effect","")), size =4,repel=T)+
theme_graph()+theme(legend.position = "none")
ggsave(paste("LaughCount_graph_",group,".png",sep=""),plot=last_plot(),bg="White",width=6,height=6,units="in")
#}
1
1
1
