Coping for climate resilience
Detailed results
Wullenkord, M.C., Rikner Martinsson, A. & Ojala, M.
2026-07-25
1 Preparations
1.1 Loading basic packages
library(psych)
library(MASS)
library(rcompanion)##
## Attaching package: 'rcompanion'## The following object is masked from 'package:psych':
##
## philibrary(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:psych':
##
## logit1.2 Reading in data
library(haven)
data <- read_sav("773.sav")1.3 Overview over variables
- IV’s:
- Climate emotions:
- Anxiety: data$anx
- Sadness: data$sad
- Anger: data$ang
- Indifference: data$indif
- DV’s:
- Pro-environmental behavior - Influencing others’ PEB: data$peb.others
- Pro-environmental behavior - Own PEB: data$peb.own
- Pro-environmental behavior - Future PEB: data$futpeb
- Climate anxiety-related impairment - Cognitive-emotions impairment: data$cas.ce
- Climate anxiety-related impairment - Functional impairment: data$cas.f
- Moderators:
- Empathy - perspective taking: data$emp.pt
- Empathy - empathic concern: data$emp.ec
- Emotion-focused coping - emotional integration: emoreg.ier
- Emotion-focused coping - emotional suppression: emoreg.ed
- Nature connectedness: data$natcon
- Socio-demographics
- Gender: data$gender
- Age: data$age
- Study program: data$pro
1.4 Renaming variables
# Climate emotions
data$anx <- data$VAR15
data$sad <- data$VAR12
data$ang <- data$VAR10
data$indif <- data$VAR13
# Pro-environmental behavior
## Influencing others' PEB
data$peb.1 <- data$VAR21_1
data$peb.7 <- data$VAR21_7
data$peb.8 <- data$VAR21_8
data$peb.9 <- data$VAR21_9
data$peb.10 <- data$VAR21_10
## Own PEB
data$peb.2 <- data$VAR21_2
data$peb.3 <- data$VAR21_3
data$peb.4 <- data$VAR21_4
data$peb.5 <- data$VAR21_5
data$peb.6 <- data$VAR21_6
data$peb.11 <- data$VAR21_11
data$peb.12 <- data$VAR21_12
data$peb.13 <- data$VAR21_13
## Future PEB
data$futpeb.1 <- data$VAR22_1
data$futpeb.2 <- data$VAR22_2
data$futpeb.3 <- data$VAR22_3
data$futpeb.4 <- data$VAR22_4
# Climate anxiety-related impairment
## Cognitive-emotional impairment
data$cas.01 <- data$VAR51_1
data$cas.02 <- data$VAR51_2
data$cas.03 <- data$VAR51_3
data$cas.04 <- data$VAR51_4
data$cas.05 <- data$VAR51_5
data$cas.06 <- data$VAR51_6
data$cas.07 <- data$VAR51_7
data$cas.08 <- data$VAR51_8
## Functional impairment
data$cas.09 <- data$VAR51_9
data$cas.10 <- data$VAR51_10
data$cas.11 <- data$VAR51_11
data$cas.12 <- data$VAR51_12
data$cas.13 <- data$VAR51_13
# Empathy
## Empathic concern
data$emp.ec.1 <- data$VAR42_1
data$emp.ec.2 <- data$VAR42_2
data$emp.ec.3 <- data$VAR42_4
data$emp.ec.4 <- data$VAR42_5
## Perspective taking
data$emp.pt.1 <- data$VAR42_3
data$emp.pt.2 <- data$VAR42_6
data$emp.pt.3 <- data$VAR42_7
data$emp.pt.4 <- data$VAR42_8
# Emotion-focused coping
## Emotional integration
data$emoreg.ier.1 <- data$VAR48_4
data$emoreg.ier.2 <- data$VAR48_7
data$emoreg.ier.3 <- data$VAR48_8
## emotional suppression
data$emoreg.ed.1 <- data$VAR48_3
data$emoreg.ed.2 <- data$VAR48_9
data$emoreg.ed.3 <- data$VAR48_10
# Nature connectedness
data$natcon.1 <- data$VAR44_1
data$natcon.2 <- data$VAR44_2
data$natcon.3 <- data$VAR44_3
data$natcon.4 <- data$VAR44_4
data$natcon.5 <- data$VAR44_5
data$natcon.6 <- data$VAR44_6
# Socio-demographics
data$gender <- data$VAR04
data$age <- data$VAR031.5 Define missings
# Climate emotions
is.na(data$anx) <- which(data$anx== 999)
is.na(data$sad) <- which(data$sad== 999)
is.na(data$ang) <- which(data$ang== 999)
is.na(data$indif) <- which(data$indif== 999)
# Pro-environmental behavior
## Influencing others' and own PEB
is.na(data$peb.1) <- which(data$peb.1== 999)
is.na(data$peb.2) <- which(data$peb.2== 999)
is.na(data$peb.3) <- which(data$peb.3== 999)
is.na(data$peb.4) <- which(data$peb.4== 999)
is.na(data$peb.5) <- which(data$peb.5== 999)
is.na(data$peb.6) <- which(data$peb.6== 999)
is.na(data$peb.7) <- which(data$peb.7== 999)
is.na(data$peb.8) <- which(data$peb.8== 999)
is.na(data$peb.9) <- which(data$peb.9== 999)
is.na(data$peb.10) <- which(data$peb.10== 999)
is.na(data$peb.11) <- which(data$peb.11== 999)
is.na(data$peb.12) <- which(data$peb.12== 999)
is.na(data$peb.13) <- which(data$peb.13== 999)
## Future PEB
is.na(data$futpeb.1) <- which(data$futpeb.1== 999)
is.na(data$futpeb.2) <- which(data$futpeb.2== 999)
is.na(data$futpeb.3) <- which(data$futpeb.3== 999)
is.na(data$futpeb.4) <- which(data$futpeb.4== 999)
# Climate anxiety-related impairment
## Cognitive-emotional impairment
is.na(data$cas.01) <- which(data$cas.01== 999)
is.na(data$cas.02) <- which(data$cas.02== 999)
is.na(data$cas.03) <- which(data$cas.03== 999)
is.na(data$cas.04) <- which(data$cas.04== 999)
is.na(data$cas.05) <- which(data$cas.05== 999)
is.na(data$cas.06) <- which(data$cas.06== 999)
is.na(data$cas.07) <- which(data$cas.07== 999)
is.na(data$cas.08) <- which(data$cas.08== 999)
## Functional impairment
is.na(data$cas.09) <- which(data$cas.09== 999)
is.na(data$cas.10) <- which(data$cas.10== 999)
is.na(data$cas.11) <- which(data$cas.11== 999)
is.na(data$cas.12) <- which(data$cas.12== 999)
is.na(data$cas.13) <- which(data$cas.13== 999)
# Empathy
## Empathic concern
is.na(data$emp.ec.1) <- which(data$emp.ec.1== 999)
is.na(data$emp.ec.2) <- which(data$emp.ec.2== 999)
is.na(data$emp.ec.3) <- which(data$emp.ec.3== 999)
is.na(data$emp.ec.4) <- which(data$emp.ec.4== 999)
## Perspective taking
is.na(data$emp.pt.1) <- which(data$emp.pt.1== 999)
is.na(data$emp.pt.2) <- which(data$emp.pt.2== 999)
is.na(data$emp.pt.3) <- which(data$emp.pt.3== 999)
is.na(data$emp.pt.4) <- which(data$emp.pt.4== 999)
# Emotion-focused coping
## Emotional integration
is.na(data$emoreg.ier.1) <- which(data$emoreg.ier.1== 999)
is.na(data$emoreg.ier.2) <- which(data$emoreg.ier.2== 999)
is.na(data$emoreg.ier.3) <- which(data$emoreg.ier.3== 999)
## Emotional suppression
is.na(data$emoreg.ed.1) <- which(data$emoreg.ed.1== 999)
is.na(data$emoreg.ed.2) <- which(data$emoreg.ed.2== 999)
is.na(data$emoreg.ed.3) <- which(data$emoreg.ed.3== 999)
# Nature connectedness
is.na(data$natcon.1) <- which(data$natcon.1== 999)
is.na(data$natcon.2) <- which(data$natcon.2== 999)
is.na(data$natcon.3) <- which(data$natcon.3== 999)
is.na(data$natcon.4) <- which(data$natcon.4== 999)
is.na(data$natcon.5) <- which(data$natcon.5== 999)
is.na(data$natcon.6) <- which(data$natcon.6== 999)
# Socio-demographics
is.na(data$gender) <- which(data$gender== 999)
is.na(data$age) <- which(data$age== 999)
is.na(data$pro) <- which(data$pro== 999) 2 Calculating variables
2.1 Climate emotions
data$emo <- rowMeans (data [c("anx", "sad", "ang")])2.2 PEB
# PEB
data$peb <- rowMeans (data [c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.11", "peb.12", "peb.13")])
# Influencing others' PEB
data$peb.others <- rowMeans (data [c("peb.1",
"peb.7", "peb.8", "peb.9", "peb.10")])
# Own PEB
data$peb.own <- rowMeans (data [c("peb.2", "peb.3", "peb.4", "peb.5",
"peb.6",
"peb.12", "peb.13")])
# Future PEB
data$futpeb <- rowMeans (data [c("futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")])2.2.1 EFA PEB + Future PEB
2.2.1.1 Correlations
between items to inspect for high item-inter-correlations
corr.test (data [,c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.11", "peb.12", "peb.13",
"futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")],
method = "spearman")## Call:corr.test(x = data[, c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
## "peb.6", "peb.7", "peb.8", "peb.9", "peb.10", "peb.11", "peb.12",
## "peb.13", "futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")],
## method = "spearman")
## Correlation matrix
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.11
## peb.1 1.00 0.40 0.25 0.35 0.32 0.20 0.75 0.58 0.41 0.56 0.67
## peb.2 0.40 1.00 0.28 0.44 0.44 0.27 0.41 0.42 0.29 0.37 0.48
## peb.3 0.25 0.28 1.00 0.39 0.33 0.45 0.28 0.20 0.17 0.18 0.26
## peb.4 0.35 0.44 0.39 1.00 0.38 0.36 0.41 0.35 0.23 0.30 0.40
## peb.5 0.32 0.44 0.33 0.38 1.00 0.33 0.31 0.32 0.22 0.24 0.39
## peb.6 0.20 0.27 0.45 0.36 0.33 1.00 0.27 0.24 0.15 0.20 0.25
## peb.7 0.75 0.41 0.28 0.41 0.31 0.27 1.00 0.71 0.49 0.65 0.60
## peb.8 0.58 0.42 0.20 0.35 0.32 0.24 0.71 1.00 0.54 0.70 0.53
## peb.9 0.41 0.29 0.17 0.23 0.22 0.15 0.49 0.54 1.00 0.53 0.36
## peb.10 0.56 0.37 0.18 0.30 0.24 0.20 0.65 0.70 0.53 1.00 0.52
## peb.11 0.67 0.48 0.26 0.40 0.39 0.25 0.60 0.53 0.36 0.52 1.00
## peb.12 0.43 0.43 0.23 0.43 0.41 0.25 0.48 0.42 0.26 0.40 0.51
## peb.13 0.33 0.36 0.38 0.48 0.30 0.33 0.34 0.29 0.21 0.26 0.42
## futpeb.1 0.45 0.35 0.29 0.38 0.32 0.26 0.50 0.46 0.22 0.49 0.46
## futpeb.2 0.42 0.32 0.20 0.29 0.26 0.22 0.42 0.44 0.34 0.49 0.41
## futpeb.3 0.42 0.32 0.17 0.30 0.29 0.18 0.45 0.45 0.34 0.48 0.44
## futpeb.4 0.45 0.31 0.14 0.29 0.27 0.21 0.49 0.52 0.44 0.53 0.44
## peb.12 peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 0.43 0.33 0.45 0.42 0.42 0.45
## peb.2 0.43 0.36 0.35 0.32 0.32 0.31
## peb.3 0.23 0.38 0.29 0.20 0.17 0.14
## peb.4 0.43 0.48 0.38 0.29 0.30 0.29
## peb.5 0.41 0.30 0.32 0.26 0.29 0.27
## peb.6 0.25 0.33 0.26 0.22 0.18 0.21
## peb.7 0.48 0.34 0.50 0.42 0.45 0.49
## peb.8 0.42 0.29 0.46 0.44 0.45 0.52
## peb.9 0.26 0.21 0.22 0.34 0.34 0.44
## peb.10 0.40 0.26 0.49 0.49 0.48 0.53
## peb.11 0.51 0.42 0.46 0.41 0.44 0.44
## peb.12 1.00 0.41 0.44 0.34 0.38 0.34
## peb.13 0.41 1.00 0.33 0.22 0.25 0.22
## futpeb.1 0.44 0.33 1.00 0.50 0.53 0.46
## futpeb.2 0.34 0.22 0.50 1.00 0.67 0.63
## futpeb.3 0.38 0.25 0.53 0.67 1.00 0.72
## futpeb.4 0.34 0.22 0.46 0.63 0.72 1.00
## Sample Size
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.11
## peb.1 771 768 770 768 766 769 769 768 771 764 770
## peb.2 768 770 769 767 765 768 768 766 769 764 769
## peb.3 770 769 772 769 767 770 769 768 771 765 771
## peb.4 768 767 769 770 766 769 768 767 769 764 769
## peb.5 766 765 767 766 768 767 766 765 767 763 767
## peb.6 769 768 770 769 767 771 769 768 770 765 770
## peb.7 769 768 769 768 766 769 770 768 770 764 769
## peb.8 768 766 768 767 765 768 768 769 769 763 768
## peb.9 771 769 771 769 767 770 770 769 772 765 771
## peb.10 764 764 765 764 763 765 764 763 765 766 765
## peb.11 770 769 771 769 767 770 769 768 771 765 772
## peb.12 761 760 762 761 759 762 761 760 762 757 762
## peb.13 768 767 769 767 765 768 767 766 769 763 769
## futpeb.1 768 767 769 767 765 768 767 766 769 763 769
## futpeb.2 765 764 766 765 762 765 764 763 766 760 766
## futpeb.3 768 767 769 767 765 768 767 766 769 763 769
## futpeb.4 767 766 768 766 764 767 766 765 768 762 768
## peb.12 peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 761 768 768 765 768 767
## peb.2 760 767 767 764 767 766
## peb.3 762 769 769 766 769 768
## peb.4 761 767 767 765 767 766
## peb.5 759 765 765 762 765 764
## peb.6 762 768 768 765 768 767
## peb.7 761 767 767 764 767 766
## peb.8 760 766 766 763 766 765
## peb.9 762 769 769 766 769 768
## peb.10 757 763 763 760 763 762
## peb.11 762 769 769 766 769 768
## peb.12 763 760 760 757 760 759
## peb.13 760 770 767 764 767 766
## futpeb.1 760 767 770 765 768 768
## futpeb.2 757 764 765 767 766 765
## futpeb.3 760 767 768 766 770 768
## futpeb.4 759 766 768 765 768 769
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.11
## peb.1 0 0 0 0 0 0 0 0 0 0 0
## peb.2 0 0 0 0 0 0 0 0 0 0 0
## peb.3 0 0 0 0 0 0 0 0 0 0 0
## peb.4 0 0 0 0 0 0 0 0 0 0 0
## peb.5 0 0 0 0 0 0 0 0 0 0 0
## peb.6 0 0 0 0 0 0 0 0 0 0 0
## peb.7 0 0 0 0 0 0 0 0 0 0 0
## peb.8 0 0 0 0 0 0 0 0 0 0 0
## peb.9 0 0 0 0 0 0 0 0 0 0 0
## peb.10 0 0 0 0 0 0 0 0 0 0 0
## peb.11 0 0 0 0 0 0 0 0 0 0 0
## peb.12 0 0 0 0 0 0 0 0 0 0 0
## peb.13 0 0 0 0 0 0 0 0 0 0 0
## futpeb.1 0 0 0 0 0 0 0 0 0 0 0
## futpeb.2 0 0 0 0 0 0 0 0 0 0 0
## futpeb.3 0 0 0 0 0 0 0 0 0 0 0
## futpeb.4 0 0 0 0 0 0 0 0 0 0 0
## peb.12 peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 0 0 0 0 0 0
## peb.2 0 0 0 0 0 0
## peb.3 0 0 0 0 0 0
## peb.4 0 0 0 0 0 0
## peb.5 0 0 0 0 0 0
## peb.6 0 0 0 0 0 0
## peb.7 0 0 0 0 0 0
## peb.8 0 0 0 0 0 0
## peb.9 0 0 0 0 0 0
## peb.10 0 0 0 0 0 0
## peb.11 0 0 0 0 0 0
## peb.12 0 0 0 0 0 0
## peb.13 0 0 0 0 0 0
## futpeb.1 0 0 0 0 0 0
## futpeb.2 0 0 0 0 0 0
## futpeb.3 0 0 0 0 0 0
## futpeb.4 0 0 0 0 0 0
##
## To see confidence intervals of the correlations, print with the short=FALSE option-> looks okay
Subset with PEB-items
subset.peb <- data[c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.11", "peb.12", "peb.13",
"futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")]
View(subset.peb)2.2.1.2 Kaiser-Maier-Olkin coefficient
KMO(subset.peb)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = subset.peb)
## Overall MSA = 0.92
## MSA for each item =
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8
## 0.89 0.95 0.87 0.94 0.93 0.89 0.90 0.92
## peb.9 peb.10 peb.11 peb.12 peb.13 futpeb.1 futpeb.2 futpeb.3
## 0.93 0.93 0.94 0.95 0.93 0.95 0.93 0.90
## futpeb.4
## 0.91options(max.print=1000000)-> KMO=.92
2.2.1.3 Extracting factors and parallel analysis
Scree Plot
VSS.scree (subset.peb)
Parallel analysis (Horn)
parallel.peb <- fa.parallel (subset.peb, fm="pa", fa = "fa")
## Parallel analysis suggests that the number of factors = 4 and the number of components = NAEigenvalues of factors
parallel.peb$fa.values## [1] 6.71387491 1.14307085 0.57546396 0.27251030 0.11245968 0.06814878
## [7] -0.03713274 -0.07927356 -0.10271730 -0.18432030 -0.19555318 -0.21040395
## [13] -0.21114583 -0.23795639 -0.26796624 -0.29596455 -0.348784132.2.1.4 Factor analysis with fixed number of factors = 4
as suggested by parallel analysis
fa.pa.promax.peb <- fa(subset.peb, 4, fm = "pa", rotate = "Promax") ## Loading required namespace: GPArotationprint (fa.pa.promax.peb, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.peb, nfactors = 4, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item PA4 PA2 PA3 PA1 h2 u2 com
## peb.8 8 0.83 0.74 0.26 1.0
## peb.7 7 0.73 0.36 0.76 0.24 1.5
## peb.10 10 0.70 0.67 0.33 1.1
## peb.9 9 0.63 0.41 0.59 1.3
## futpeb.3 16 0.95 0.78 0.22 1.0
## futpeb.2 15 0.78 0.62 0.38 1.0
## futpeb.4 17 0.76 0.69 0.31 1.1
## futpeb.1 14 0.40 0.47 0.53 2.0
## peb.3 3 0.80 0.48 0.52 1.1
## peb.6 6 0.76 0.42 0.58 1.2
## peb.4 4 0.54 0.48 0.52 1.3
## peb.13 13 0.47 0.31 0.43 0.57 1.8
## peb.5 5 0.45 0.37 0.63 1.3
## peb.2 2 0.31 0.38 0.62 2.3
## peb.11 11 0.64 0.63 0.37 1.4
## peb.1 1 0.49 0.58 0.64 0.36 2.2
## peb.12 12 0.47 0.43 0.57 1.3
##
## PA4 PA2 PA3 PA1
## SS loadings 2.89 2.36 2.17 1.99
## Proportion Var 0.17 0.14 0.13 0.12
## Cumulative Var 0.17 0.31 0.44 0.55
## Proportion Explained 0.31 0.25 0.23 0.21
## Cumulative Proportion 0.31 0.56 0.79 1.00
##
## With factor correlations of
## PA4 PA2 PA3 PA1
## PA4 1.00 0.67 0.47 0.51
## PA2 0.67 1.00 0.49 0.55
## PA3 0.47 0.49 1.00 0.66
## PA1 0.51 0.55 0.66 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 4 factors are sufficient.
##
## df null model = 136 with the objective function = 8.74 with Chi Square = 6691.36
## df of the model are 74 and the objective function was 0.41
##
## The root mean square of the residuals (RMSR) is 0.02
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic n.obs is 766 with the empirical chi square 62.94 with prob < 0.82
## The total n.obs was 773 with Likelihood Chi Square = 313.42 with prob < 3.2e-31
##
## Tucker Lewis Index of factoring reliability = 0.933
## RMSEA index = 0.065 and the 90 % confidence intervals are 0.057 0.072
## BIC = -178.7
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA4 PA2 PA3 PA1
## Correlation of (regression) scores with factors 0.78 0.86 0.79 0.68
## Multiple R square of scores with factors 0.61 0.74 0.62 0.46
## Minimum correlation of possible factor scores 0.23 0.48 0.24 -0.08-> quite a few cross-loading items
2.2.1.5 Visualizing results
fa.diagram(fa.pa.promax.peb, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.peb, simple=FALSE, cut=.4, digits=2)
2.2.1.6 Factor analysis with fixed number of factors = 3
as suggested by scree plot and Eigenvalues
fa.pa.promax.peb <- fa(subset.peb, 3, fm = "pa", rotate = "Promax")
print (fa.pa.promax.peb, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.peb, nfactors = 3, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item PA3 PA1 PA2 h2 u2 com
## peb.7 7 0.95 0.78 0.22 1.0
## peb.8 8 0.86 0.69 0.31 1.0
## peb.10 10 0.77 0.66 0.34 1.2
## peb.1 1 0.76 0.59 0.41 1.0
## peb.9 9 0.55 0.32 0.68 1.0
## peb.11 11 0.53 0.55 0.45 1.5
## peb.3 3 0.76 0.42 0.58 1.1
## peb.4 4 0.69 0.49 0.51 1.0
## peb.13 13 0.67 0.43 0.57 1.0
## peb.6 6 0.63 0.32 0.68 1.1
## peb.5 5 0.58 0.37 0.63 1.0
## peb.2 2 0.47 0.38 0.62 1.4
## peb.12 12 0.41 0.39 0.61 1.6
## futpeb.3 16 0.95 0.76 0.24 1.0
## futpeb.2 15 0.81 0.62 0.38 1.0
## futpeb.4 17 0.79 0.69 0.31 1.1
## futpeb.1 14 0.39 0.46 0.54 2.0
##
## PA3 PA1 PA2
## SS loadings 3.67 2.83 2.42
## Proportion Var 0.22 0.17 0.14
## Cumulative Var 0.22 0.38 0.52
## Proportion Explained 0.41 0.32 0.27
## Cumulative Proportion 0.41 0.73 1.00
##
## With factor correlations of
## PA3 PA1 PA2
## PA3 1.00 0.64 0.72
## PA1 0.64 1.00 0.54
## PA2 0.72 0.54 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 136 with the objective function = 8.74 with Chi Square = 6691.36
## df of the model are 88 and the objective function was 0.65
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.04
##
## The harmonic n.obs is 766 with the empirical chi square 121.38 with prob < 0.011
## The total n.obs was 773 with Likelihood Chi Square = 497.4 with prob < 2e-58
##
## Tucker Lewis Index of factoring reliability = 0.903
## RMSEA index = 0.078 and the 90 % confidence intervals are 0.071 0.084
## BIC = -87.83
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## PA3 PA1 PA2
## Correlation of (regression) scores with factors 0.84 0.82 0.87
## Multiple R square of scores with factors 0.70 0.67 0.75
## Minimum correlation of possible factor scores 0.40 0.34 0.51-> 3 factors: Influencing other people’s PEB, Own PEB, Future PEB
2.2.1.7 Visualizing results
fa.diagram(fa.pa.promax.peb, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.peb, simple=FALSE, cut=.4, digits=2)2.2.2 EFA PEB + Future PEB without item 11
because item 11 does not make conceptual sense in the factor Influencing others’ PEB #### Correlations between items to inspect for high item-inter-correlations
corr.test (data [,c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.12", "peb.13",
"futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")],
method = "spearman")## Call:corr.test(x = data[, c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
## "peb.6", "peb.7", "peb.8", "peb.9", "peb.10", "peb.12", "peb.13",
## "futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")], method = "spearman")
## Correlation matrix
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.12
## peb.1 1.00 0.40 0.25 0.35 0.32 0.20 0.75 0.58 0.41 0.56 0.43
## peb.2 0.40 1.00 0.28 0.44 0.44 0.27 0.41 0.42 0.29 0.37 0.43
## peb.3 0.25 0.28 1.00 0.39 0.33 0.45 0.28 0.20 0.17 0.18 0.23
## peb.4 0.35 0.44 0.39 1.00 0.38 0.36 0.41 0.35 0.23 0.30 0.43
## peb.5 0.32 0.44 0.33 0.38 1.00 0.33 0.31 0.32 0.22 0.24 0.41
## peb.6 0.20 0.27 0.45 0.36 0.33 1.00 0.27 0.24 0.15 0.20 0.25
## peb.7 0.75 0.41 0.28 0.41 0.31 0.27 1.00 0.71 0.49 0.65 0.48
## peb.8 0.58 0.42 0.20 0.35 0.32 0.24 0.71 1.00 0.54 0.70 0.42
## peb.9 0.41 0.29 0.17 0.23 0.22 0.15 0.49 0.54 1.00 0.53 0.26
## peb.10 0.56 0.37 0.18 0.30 0.24 0.20 0.65 0.70 0.53 1.00 0.40
## peb.12 0.43 0.43 0.23 0.43 0.41 0.25 0.48 0.42 0.26 0.40 1.00
## peb.13 0.33 0.36 0.38 0.48 0.30 0.33 0.34 0.29 0.21 0.26 0.41
## futpeb.1 0.45 0.35 0.29 0.38 0.32 0.26 0.50 0.46 0.22 0.49 0.44
## futpeb.2 0.42 0.32 0.20 0.29 0.26 0.22 0.42 0.44 0.34 0.49 0.34
## futpeb.3 0.42 0.32 0.17 0.30 0.29 0.18 0.45 0.45 0.34 0.48 0.38
## futpeb.4 0.45 0.31 0.14 0.29 0.27 0.21 0.49 0.52 0.44 0.53 0.34
## peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 0.33 0.45 0.42 0.42 0.45
## peb.2 0.36 0.35 0.32 0.32 0.31
## peb.3 0.38 0.29 0.20 0.17 0.14
## peb.4 0.48 0.38 0.29 0.30 0.29
## peb.5 0.30 0.32 0.26 0.29 0.27
## peb.6 0.33 0.26 0.22 0.18 0.21
## peb.7 0.34 0.50 0.42 0.45 0.49
## peb.8 0.29 0.46 0.44 0.45 0.52
## peb.9 0.21 0.22 0.34 0.34 0.44
## peb.10 0.26 0.49 0.49 0.48 0.53
## peb.12 0.41 0.44 0.34 0.38 0.34
## peb.13 1.00 0.33 0.22 0.25 0.22
## futpeb.1 0.33 1.00 0.50 0.53 0.46
## futpeb.2 0.22 0.50 1.00 0.67 0.63
## futpeb.3 0.25 0.53 0.67 1.00 0.72
## futpeb.4 0.22 0.46 0.63 0.72 1.00
## Sample Size
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.12
## peb.1 771 768 770 768 766 769 769 768 771 764 761
## peb.2 768 770 769 767 765 768 768 766 769 764 760
## peb.3 770 769 772 769 767 770 769 768 771 765 762
## peb.4 768 767 769 770 766 769 768 767 769 764 761
## peb.5 766 765 767 766 768 767 766 765 767 763 759
## peb.6 769 768 770 769 767 771 769 768 770 765 762
## peb.7 769 768 769 768 766 769 770 768 770 764 761
## peb.8 768 766 768 767 765 768 768 769 769 763 760
## peb.9 771 769 771 769 767 770 770 769 772 765 762
## peb.10 764 764 765 764 763 765 764 763 765 766 757
## peb.12 761 760 762 761 759 762 761 760 762 757 763
## peb.13 768 767 769 767 765 768 767 766 769 763 760
## futpeb.1 768 767 769 767 765 768 767 766 769 763 760
## futpeb.2 765 764 766 765 762 765 764 763 766 760 757
## futpeb.3 768 767 769 767 765 768 767 766 769 763 760
## futpeb.4 767 766 768 766 764 767 766 765 768 762 759
## peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 768 768 765 768 767
## peb.2 767 767 764 767 766
## peb.3 769 769 766 769 768
## peb.4 767 767 765 767 766
## peb.5 765 765 762 765 764
## peb.6 768 768 765 768 767
## peb.7 767 767 764 767 766
## peb.8 766 766 763 766 765
## peb.9 769 769 766 769 768
## peb.10 763 763 760 763 762
## peb.12 760 760 757 760 759
## peb.13 770 767 764 767 766
## futpeb.1 767 770 765 768 768
## futpeb.2 764 765 767 766 765
## futpeb.3 767 768 766 770 768
## futpeb.4 766 768 765 768 769
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8 peb.9 peb.10 peb.12
## peb.1 0 0 0 0 0 0 0 0 0 0 0
## peb.2 0 0 0 0 0 0 0 0 0 0 0
## peb.3 0 0 0 0 0 0 0 0 0 0 0
## peb.4 0 0 0 0 0 0 0 0 0 0 0
## peb.5 0 0 0 0 0 0 0 0 0 0 0
## peb.6 0 0 0 0 0 0 0 0 0 0 0
## peb.7 0 0 0 0 0 0 0 0 0 0 0
## peb.8 0 0 0 0 0 0 0 0 0 0 0
## peb.9 0 0 0 0 0 0 0 0 0 0 0
## peb.10 0 0 0 0 0 0 0 0 0 0 0
## peb.12 0 0 0 0 0 0 0 0 0 0 0
## peb.13 0 0 0 0 0 0 0 0 0 0 0
## futpeb.1 0 0 0 0 0 0 0 0 0 0 0
## futpeb.2 0 0 0 0 0 0 0 0 0 0 0
## futpeb.3 0 0 0 0 0 0 0 0 0 0 0
## futpeb.4 0 0 0 0 0 0 0 0 0 0 0
## peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## peb.1 0 0 0 0 0
## peb.2 0 0 0 0 0
## peb.3 0 0 0 0 0
## peb.4 0 0 0 0 0
## peb.5 0 0 0 0 0
## peb.6 0 0 0 0 0
## peb.7 0 0 0 0 0
## peb.8 0 0 0 0 0
## peb.9 0 0 0 0 0
## peb.10 0 0 0 0 0
## peb.12 0 0 0 0 0
## peb.13 0 0 0 0 0
## futpeb.1 0 0 0 0 0
## futpeb.2 0 0 0 0 0
## futpeb.3 0 0 0 0 0
## futpeb.4 0 0 0 0 0
##
## To see confidence intervals of the correlations, print with the short=FALSE option-> looks okay
Subset with PEB-items
subset.peb <- data[c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.12", "peb.13",
"futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")]
View(subset.peb)2.2.2.1 Kaiser-Maier-Olkin coefficient
KMO(subset.peb)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = subset.peb)
## Overall MSA = 0.92
## MSA for each item =
## peb.1 peb.2 peb.3 peb.4 peb.5 peb.6 peb.7 peb.8
## 0.90 0.95 0.87 0.94 0.93 0.88 0.88 0.92
## peb.9 peb.10 peb.12 peb.13 futpeb.1 futpeb.2 futpeb.3 futpeb.4
## 0.93 0.93 0.95 0.92 0.94 0.93 0.89 0.91options(max.print=1000000)-> KMO=.92
2.2.2.2 Extracting factors and parallel analysis
Scree Plot
VSS.scree (subset.peb)
Parallel analysis (Horn)
parallel.peb <- fa.parallel (subset.peb, fm="pa", fa = "fa")
## Parallel analysis suggests that the number of factors = 4 and the number of components = NAEigenvalues of factors
parallel.peb$fa.values## [1] 6.18042913 1.14161797 0.55862611 0.19946655 0.10600463 0.02902519
## [7] -0.04035576 -0.10405639 -0.16464850 -0.18680617 -0.20476080 -0.21095493
## [13] -0.21791945 -0.26945045 -0.28876867 -0.346489782.2.2.3 Factor analysis with fixed number of factors = 4
as suggested by parallel analysis
fa.pa.promax.peb <- fa(subset.peb, 4, fm = "pa", rotate = "Promax")
print (fa.pa.promax.peb, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.peb, nfactors = 4, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item PA2 PA4 PA1 PA3 h2 u2 com
## peb.8 8 0.87 0.74 0.26 1.0
## peb.7 7 0.85 0.77 0.23 1.2
## peb.10 10 0.75 0.67 0.33 1.1
## peb.9 9 0.63 0.40 0.60 1.4
## peb.1 1 0.60 0.30 0.55 0.45 1.6
## futpeb.3 15 0.92 0.78 0.22 1.1
## futpeb.2 14 0.78 0.62 0.38 1.0
## futpeb.4 16 0.77 0.70 0.30 1.1
## futpeb.1 13 0.37 0.36 0.48 0.52 2.0
## peb.3 3 0.78 0.52 0.48 1.0
## peb.6 6 0.75 0.44 0.56 1.1
## peb.4 4 0.39 0.37 0.49 0.51 2.0
## peb.5 5 0.35 0.36 0.64 2.0
## peb.12 11 0.63 0.48 0.52 1.1
## peb.13 12 0.34 0.41 0.43 0.57 2.0
## peb.2 2 0.36 0.38 0.62 2.0
##
## PA2 PA4 PA1 PA3
## SS loadings 3.07 2.32 1.75 1.66
## Proportion Var 0.19 0.14 0.11 0.10
## Cumulative Var 0.19 0.34 0.45 0.55
## Proportion Explained 0.35 0.26 0.20 0.19
## Cumulative Proportion 0.35 0.61 0.81 1.00
##
## With factor correlations of
## PA2 PA4 PA1 PA3
## PA2 1.00 0.69 0.50 0.57
## PA4 0.69 1.00 0.43 0.51
## PA1 0.50 0.43 1.00 0.67
## PA3 0.57 0.51 0.67 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 4 factors are sufficient.
##
## df null model = 120 with the objective function = 7.91 with Chi Square = 6056.33
## df of the model are 62 and the objective function was 0.37
##
## The root mean square of the residuals (RMSR) is 0.02
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic n.obs is 766 with the empirical chi square 53.67 with prob < 0.77
## The total n.obs was 773 with Likelihood Chi Square = 284.09 with prob < 3.6e-30
##
## Tucker Lewis Index of factoring reliability = 0.927
## RMSEA index = 0.068 and the 90 % confidence intervals are 0.06 0.076
## BIC = -128.23
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA2 PA4 PA1 PA3
## Correlation of (regression) scores with factors 0.80 0.85 0.76 0.65
## Multiple R square of scores with factors 0.64 0.72 0.57 0.43
## Minimum correlation of possible factor scores 0.29 0.43 0.15 -0.15-> quite a few cross-loading items
2.2.2.4 Visualizing results
fa.diagram(fa.pa.promax.peb, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.peb, simple=FALSE, cut=.4, digits=2)2.2.2.5 Factor analysis with fixed number of factors = 3
as suggested by scree plot and Eigenvalues
fa.pa.promax.peb <- fa(subset.peb, 3, fm = "pa", rotate = "Promax")
print (fa.pa.promax.peb, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.peb, nfactors = 3, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item PA1 PA2 PA3 h2 u2 com
## peb.7 7 0.93 0.78 0.22 1.0
## peb.8 8 0.90 0.72 0.28 1.0
## peb.10 10 0.79 0.67 0.33 1.1
## peb.1 1 0.67 0.54 0.46 1.0
## peb.9 9 0.58 0.34 0.66 1.0
## peb.3 3 0.76 0.43 0.57 1.1
## peb.4 4 0.69 0.49 0.51 1.0
## peb.13 12 0.67 0.43 0.57 1.0
## peb.6 6 0.62 0.33 0.67 1.0
## peb.5 5 0.57 0.37 0.63 1.0
## peb.2 2 0.47 0.37 0.63 1.3
## peb.12 11 0.41 0.38 0.62 1.5
## futpeb.3 15 0.97 0.77 0.23 1.0
## futpeb.2 14 0.80 0.62 0.38 1.0
## futpeb.4 16 0.78 0.68 0.32 1.1
## futpeb.1 13 0.40 0.46 0.54 1.9
##
## PA1 PA2 PA3
## SS loadings 3.26 2.72 2.40
## Proportion Var 0.20 0.17 0.15
## Cumulative Var 0.20 0.37 0.52
## Proportion Explained 0.39 0.32 0.29
## Cumulative Proportion 0.39 0.71 1.00
##
## With factor correlations of
## PA1 PA2 PA3
## PA1 1.00 0.61 0.72
## PA2 0.61 1.00 0.54
## PA3 0.72 0.54 1.00
##
## Mean item complexity = 1.1
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 120 with the objective function = 7.91 with Chi Square = 6056.33
## df of the model are 75 and the objective function was 0.51
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.04
##
## The harmonic n.obs is 766 with the empirical chi square 93.8 with prob < 0.07
## The total n.obs was 773 with Likelihood Chi Square = 391.94 with prob < 2e-44
##
## Tucker Lewis Index of factoring reliability = 0.914
## RMSEA index = 0.074 and the 90 % confidence intervals are 0.067 0.081
## BIC = -106.83
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## PA1 PA2 PA3
## Correlation of (regression) scores with factors 0.84 0.82 0.89
## Multiple R square of scores with factors 0.70 0.68 0.79
## Minimum correlation of possible factor scores 0.40 0.35 0.59-> 3 factors: Influencing other people’s PEB, Own PEB, Future PEB
2.2.2.6 Visualizing results
fa.diagram(fa.pa.promax.peb, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.peb, simple=FALSE, cut=.4, digits=2)2.3 Climate anxiety-related impairment
# Climate anxiety-related impairment
data$cas <- rowMeans (data [c("cas.01", "cas.02", "cas.03", "cas.04",
"cas.05", "cas.06", "cas.07", "cas.08",
"cas.09", "cas.10", "cas.11", "cas.12", "cas.13")])
# Cognitive-emotional impairment
data$cas.ce <- rowMeans (data [c("cas.01", "cas.02", "cas.03", "cas.04",
"cas.05", "cas.06", "cas.07", "cas.08")])
# Functional impairment
data$cas.f <- rowMeans (data [c("cas.09", "cas.10", "cas.11", "cas.12", "cas.13")]) 2.3.1 CFA
Increases the number of rows that can be printed
options(max.print = 10000000)2.3.1.1 Normality
Load package
library(MVN)## Registered S3 method overwritten by 'lme4':
## method from
## na.action.merMod car##
## Attaching package: 'MVN'## The following object is masked from 'package:psych':
##
## mardiaCreate data frame with all CAS items
data.cas.items = data.frame(data$cas.01, data$cas.02, data$cas.03, data$cas.04, data$cas.05,
data$cas.06, data$cas.07, data$cas.08, data$cas.09, data$cas.10,
data$cas.11, data$cas.12, data$cas.13)Check for overall multivariate normality (Doornik-Hansen’s test)
result <- mvn(data = data.cas.items)## Warning in mvn(data = data.cas.items): Missing values detected in 32 rows.
## These rows will be removed.result$multivariateNormality## NULL2.3.1.2 CFA - 1 factor solution
Load package
library(lavaan)## This is lavaan 0.6-21
## lavaan is FREE software! Please report any bugs.##
## Attaching package: 'lavaan'## The following object is masked from 'package:psych':
##
## cor2covCFA
CFA.1 <- ' cas.1 =~ cas.01 + cas.02 + cas.03 + cas.04 + cas.05 + cas.06 + cas.07 + cas.08 + cas.09 + cas.10 + cas.11 + cas.12 + cas.13'
fit.1 <- cfa(CFA.1, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.1, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 42 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 26
##
## Used Total
## Number of observations 741 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 669.060 190.591
## Degrees of freedom 65 65
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 3.510
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 6511.635 1291.127
## Degrees of freedom 78 78
## P-value 0.000 0.000
## Scaling correction factor 5.043
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.906 0.896
## Tucker-Lewis Index (TLI) 0.887 0.876
##
## Robust Comparative Fit Index (CFI) 0.928
## Robust Tucker-Lewis Index (TLI) 0.914
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -5455.205 -5455.205
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 10962.409 10962.409
## Bayesian (BIC) 11082.217 11082.217
## Sample-size adjusted Bayesian (SABIC) 10999.658 10999.658
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.112 0.051
## 90 Percent confidence interval - lower 0.104 0.047
## 90 Percent confidence interval - upper 0.120 0.056
## P-value H_0: RMSEA <= 0.050 0.000 0.341
## P-value H_0: RMSEA >= 0.080 1.000 0.000
##
## Robust RMSEA 0.096
## 90 Percent confidence interval - lower 0.080
## 90 Percent confidence interval - upper 0.112
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 0.951
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.047 0.047
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## cas.1 =~
## cas.01 0.422 0.033 12.969 0.000 0.422 0.609
## cas.02 0.476 0.033 14.445 0.000 0.476 0.696
## cas.03 0.398 0.036 11.063 0.000 0.398 0.725
## cas.04 0.461 0.037 12.477 0.000 0.461 0.794
## cas.05 0.440 0.035 12.486 0.000 0.440 0.797
## cas.06 0.429 0.034 12.458 0.000 0.429 0.764
## cas.07 0.382 0.039 9.742 0.000 0.382 0.718
## cas.08 0.443 0.033 13.425 0.000 0.443 0.733
## cas.09 0.444 0.031 14.190 0.000 0.444 0.813
## cas.10 0.444 0.033 13.554 0.000 0.444 0.668
## cas.11 0.425 0.037 11.629 0.000 0.425 0.818
## cas.12 0.437 0.034 12.955 0.000 0.437 0.814
## cas.13 0.365 0.038 9.564 0.000 0.365 0.703
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .cas.01 0.303 0.034 8.797 0.000 0.303 0.630
## .cas.02 0.241 0.028 8.483 0.000 0.241 0.515
## .cas.03 0.143 0.016 9.128 0.000 0.143 0.474
## .cas.04 0.125 0.026 4.789 0.000 0.125 0.370
## .cas.05 0.111 0.015 7.321 0.000 0.111 0.364
## .cas.06 0.131 0.025 5.185 0.000 0.131 0.416
## .cas.07 0.137 0.029 4.672 0.000 0.137 0.485
## .cas.08 0.169 0.021 8.011 0.000 0.169 0.462
## .cas.09 0.101 0.015 6.887 0.000 0.101 0.339
## .cas.10 0.245 0.037 6.614 0.000 0.245 0.554
## .cas.11 0.089 0.016 5.712 0.000 0.089 0.330
## .cas.12 0.097 0.022 4.515 0.000 0.097 0.337
## .cas.13 0.136 0.023 6.019 0.000 0.136 0.506
## cas.1 1.000 1.000 1.000
##
## R-Square:
## Estimate
## cas.01 0.370
## cas.02 0.485
## cas.03 0.526
## cas.04 0.630
## cas.05 0.636
## cas.06 0.584
## cas.07 0.515
## cas.08 0.538
## cas.09 0.661
## cas.10 0.446
## cas.11 0.670
## cas.12 0.663
## cas.13 0.494parameterEstimates(fit.1, standardized=TRUE) ## lhs op rhs est se z pvalue ci.lower ci.upper std.lv std.all
## 1 cas.1 =~ cas.01 0.422 0.033 12.969 0 0.358 0.486 0.422 0.609
## 2 cas.1 =~ cas.02 0.476 0.033 14.445 0 0.412 0.541 0.476 0.696
## 3 cas.1 =~ cas.03 0.398 0.036 11.063 0 0.327 0.468 0.398 0.725
## 4 cas.1 =~ cas.04 0.461 0.037 12.477 0 0.389 0.533 0.461 0.794
## 5 cas.1 =~ cas.05 0.440 0.035 12.486 0 0.371 0.509 0.440 0.797
## 6 cas.1 =~ cas.06 0.429 0.034 12.458 0 0.362 0.497 0.429 0.764
## 7 cas.1 =~ cas.07 0.382 0.039 9.742 0 0.305 0.459 0.382 0.718
## 8 cas.1 =~ cas.08 0.443 0.033 13.425 0 0.379 0.508 0.443 0.733
## 9 cas.1 =~ cas.09 0.444 0.031 14.190 0 0.383 0.505 0.444 0.813
## 10 cas.1 =~ cas.10 0.444 0.033 13.554 0 0.380 0.508 0.444 0.668
## 11 cas.1 =~ cas.11 0.425 0.037 11.629 0 0.353 0.497 0.425 0.818
## 12 cas.1 =~ cas.12 0.437 0.034 12.955 0 0.371 0.503 0.437 0.814
## 13 cas.1 =~ cas.13 0.365 0.038 9.564 0 0.290 0.439 0.365 0.703
## 14 cas.01 ~~ cas.01 0.303 0.034 8.797 0 0.235 0.371 0.303 0.630
## 15 cas.02 ~~ cas.02 0.241 0.028 8.483 0 0.185 0.297 0.241 0.515
## 16 cas.03 ~~ cas.03 0.143 0.016 9.128 0 0.112 0.173 0.143 0.474
## 17 cas.04 ~~ cas.04 0.125 0.026 4.789 0 0.074 0.176 0.125 0.370
## 18 cas.05 ~~ cas.05 0.111 0.015 7.321 0 0.081 0.141 0.111 0.364
## 19 cas.06 ~~ cas.06 0.131 0.025 5.185 0 0.082 0.181 0.131 0.416
## 20 cas.07 ~~ cas.07 0.137 0.029 4.672 0 0.080 0.195 0.137 0.485
## 21 cas.08 ~~ cas.08 0.169 0.021 8.011 0 0.127 0.210 0.169 0.462
## 22 cas.09 ~~ cas.09 0.101 0.015 6.887 0 0.072 0.130 0.101 0.339
## 23 cas.10 ~~ cas.10 0.245 0.037 6.614 0 0.172 0.317 0.245 0.554
## 24 cas.11 ~~ cas.11 0.089 0.016 5.712 0 0.059 0.120 0.089 0.330
## 25 cas.12 ~~ cas.12 0.097 0.022 4.515 0 0.055 0.140 0.097 0.337
## 26 cas.13 ~~ cas.13 0.136 0.023 6.019 0 0.092 0.180 0.136 0.506
## 27 cas.1 ~~ cas.1 1.000 0.000 NA NA 1.000 1.000 1.000 1.000Factor loadings
library(dplyr) ##
## Attaching package: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following object is masked from 'package:MASS':
##
## select## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.1, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| cas.1 | cas.01 | 0.422 | 0.033 | 12.969 | 0 | 0.609 |
| cas.1 | cas.02 | 0.476 | 0.033 | 14.445 | 0 | 0.696 |
| cas.1 | cas.03 | 0.398 | 0.036 | 11.063 | 0 | 0.725 |
| cas.1 | cas.04 | 0.461 | 0.037 | 12.477 | 0 | 0.794 |
| cas.1 | cas.05 | 0.440 | 0.035 | 12.486 | 0 | 0.797 |
| cas.1 | cas.06 | 0.429 | 0.034 | 12.458 | 0 | 0.764 |
| cas.1 | cas.07 | 0.382 | 0.039 | 9.742 | 0 | 0.718 |
| cas.1 | cas.08 | 0.443 | 0.033 | 13.425 | 0 | 0.733 |
| cas.1 | cas.09 | 0.444 | 0.031 | 14.190 | 0 | 0.813 |
| cas.1 | cas.10 | 0.444 | 0.033 | 13.554 | 0 | 0.668 |
| cas.1 | cas.11 | 0.425 | 0.037 | 11.629 | 0 | 0.818 |
| cas.1 | cas.12 | 0.437 | 0.034 | 12.955 | 0 | 0.814 |
| cas.1 | cas.13 | 0.365 | 0.038 | 9.564 | 0 | 0.703 |
Modification indices
mod_ind <- modificationindices(fit.1)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 28 cas.01 ~~ cas.02 181.838 0.141 0.141 0.520 0.520
## 103 cas.11 ~~ cas.12 149.031 0.048 0.048 0.520 0.520
## 79 cas.06 ~~ cas.08 53.924 0.044 0.044 0.294 0.294
## 40 cas.02 ~~ cas.03 48.325 0.051 0.051 0.273 0.273
## 44 cas.02 ~~ cas.07 41.076 -0.046 -0.046 -0.251 -0.251
## 59 cas.03 ~~ cas.12 27.103 -0.025 -0.025 -0.213 -0.213
## 93 cas.08 ~~ cas.11 20.810 -0.023 -0.023 -0.187 -0.187
## 96 cas.09 ~~ cas.10 19.538 0.028 0.028 0.178 0.178
## 85 cas.07 ~~ cas.08 17.481 0.025 0.025 0.165 0.165
## 33 cas.01 ~~ cas.07 15.702 -0.031 -0.031 -0.153 -0.153subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 28 cas.01 ~~ cas.02 181.838 0.141 0.141 0.520 0.520
## 103 cas.11 ~~ cas.12 149.031 0.048 0.048 0.520 0.520
## 79 cas.06 ~~ cas.08 53.924 0.044 0.044 0.294 0.294
## 40 cas.02 ~~ cas.03 48.325 0.051 0.051 0.273 0.273
## 44 cas.02 ~~ cas.07 41.076 -0.046 -0.046 -0.251 -0.251
## 59 cas.03 ~~ cas.12 27.103 -0.025 -0.025 -0.213 -0.213
## 93 cas.08 ~~ cas.11 20.810 -0.023 -0.023 -0.187 -0.187
## 96 cas.09 ~~ cas.10 19.538 0.028 0.028 0.178 0.178
## 85 cas.07 ~~ cas.08 17.481 0.025 0.025 0.165 0.165
## 33 cas.01 ~~ cas.07 15.702 -0.031 -0.031 -0.153 -0.153
## 102 cas.10 ~~ cas.13 14.545 0.027 0.027 0.148 0.148
## 67 cas.04 ~~ cas.11 13.770 -0.016 -0.016 -0.156 -0.156
## 100 cas.10 ~~ cas.11 12.289 -0.021 -0.021 -0.142 -0.142
## 57 cas.03 ~~ cas.10 8.216 -0.021 -0.021 -0.112 -0.112
## 80 cas.06 ~~ cas.09 8.114 -0.014 -0.014 -0.118 -0.118
## 61 cas.04 ~~ cas.05 7.914 0.014 0.014 0.117 0.117
## 39 cas.01 ~~ cas.13 7.870 -0.022 -0.022 -0.108 -0.108
## 41 cas.02 ~~ cas.04 7.443 0.019 0.019 0.110 0.110
## 90 cas.07 ~~ cas.13 7.254 0.014 0.014 0.106 0.106
## 37 cas.01 ~~ cas.11 7.019 -0.017 -0.017 -0.106 -0.106
## 48 cas.02 ~~ cas.11 6.366 -0.015 -0.015 -0.103 -0.103
## 76 cas.05 ~~ cas.12 6.344 -0.011 -0.011 -0.106 -0.106
## 104 cas.11 ~~ cas.13 6.328 0.011 0.011 0.102 0.102
## 50 cas.02 ~~ cas.13 5.812 -0.017 -0.017 -0.094 -0.094
## 68 cas.04 ~~ cas.12 5.810 -0.011 -0.011 -0.101 -0.101
## 49 cas.02 ~~ cas.12 5.190 -0.014 -0.014 -0.092 -0.092
## 43 cas.02 ~~ cas.06 5.031 -0.016 -0.016 -0.089 -0.089Variance-Covariance-Matrix
inspect(fit.1, "sampstat")$cov ## cas.01 cas.02 cas.03 cas.04 cas.05 cas.06 cas.07 cas.08 cas.09 cas.10
## cas.01 0.481
## cas.02 0.329 0.468
## cas.03 0.175 0.234 0.301
## cas.04 0.198 0.235 0.192 0.337
## cas.05 0.173 0.200 0.177 0.214 0.305
## cas.06 0.173 0.191 0.175 0.197 0.192 0.315
## cas.07 0.133 0.142 0.151 0.178 0.174 0.173 0.283
## cas.08 0.178 0.201 0.175 0.207 0.201 0.227 0.191 0.365
## cas.09 0.189 0.210 0.184 0.204 0.194 0.180 0.163 0.187 0.298
## cas.10 0.198 0.221 0.158 0.193 0.208 0.186 0.159 0.197 0.220 0.442
## cas.11 0.165 0.190 0.164 0.183 0.185 0.177 0.163 0.170 0.194 0.171
## cas.12 0.184 0.197 0.154 0.193 0.184 0.183 0.169 0.187 0.195 0.188
## cas.13 0.134 0.159 0.135 0.171 0.153 0.157 0.152 0.155 0.160 0.186
## cas.11 cas.12 cas.13
## cas.01
## cas.02
## cas.03
## cas.04
## cas.05
## cas.06
## cas.07
## cas.08
## cas.09
## cas.10
## cas.11 0.270
## cas.12 0.222 0.288
## cas.13 0.164 0.161 0.269fitted(fit.1)$cov ## cas.01 cas.02 cas.03 cas.04 cas.05 cas.06 cas.07 cas.08 cas.09 cas.10
## cas.01 0.481
## cas.02 0.201 0.468
## cas.03 0.168 0.189 0.301
## cas.04 0.195 0.220 0.183 0.337
## cas.05 0.186 0.210 0.175 0.203 0.305
## cas.06 0.181 0.204 0.171 0.198 0.189 0.315
## cas.07 0.161 0.182 0.152 0.176 0.168 0.164 0.283
## cas.08 0.187 0.211 0.176 0.204 0.195 0.190 0.169 0.365
## cas.09 0.187 0.211 0.177 0.205 0.195 0.191 0.170 0.197 0.298
## cas.10 0.188 0.212 0.177 0.205 0.195 0.191 0.170 0.197 0.197 0.442
## cas.11 0.179 0.202 0.169 0.196 0.187 0.182 0.162 0.188 0.189 0.189
## cas.12 0.185 0.208 0.174 0.201 0.192 0.188 0.167 0.194 0.194 0.194
## cas.13 0.154 0.174 0.145 0.168 0.160 0.157 0.139 0.162 0.162 0.162
## cas.11 cas.12 cas.13
## cas.01
## cas.02
## cas.03
## cas.04
## cas.05
## cas.06
## cas.07
## cas.08
## cas.09
## cas.10
## cas.11 0.270
## cas.12 0.186 0.288
## cas.13 0.155 0.159 0.269Standardized residuals
cov_table <- resid(fit.1, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | cas.01 | cas.02 | cas.03 | cas.04 | cas.05 | cas.06 | cas.07 | cas.08 | cas.09 | cas.10 | cas.11 | cas.12 | cas.13 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| cas.01 | |||||||||||||
| cas.02 | 5.52 | ||||||||||||
| cas.03 | 0.56 | 3.62 | |||||||||||
| cas.04 | 0.32 | 1.57 | 1.02 | ||||||||||
| cas.05 | -1.35 | -0.98 | 0.20 | 1.49 | |||||||||
| cas.06 | -0.98 | -1.64 | 0.50 | -0.16 | 0.42 | ||||||||
| cas.07 | -2.95 | -3.75 | -0.08 | 0.28 | 0.77 | 1.25 | |||||||
| cas.08 | -0.86 | -0.97 | -0.16 | 0.30 | 0.80 | 2.76 | 1.87 | ||||||
| cas.09 | 0.15 | -0.14 | 0.85 | -0.07 | -0.14 | -1.74 | -1.05 | -1.36 | |||||
| cas.10 | 0.79 | 0.64 | -1.65 | -1.14 | 0.98 | -0.43 | -0.98 | -0.02 | 1.83 | ||||
| cas.11 | -1.98 | -1.43 | -0.66 | -2.01 | -0.28 | -0.95 | 0.13 | -2.46 | 0.86 | -2.01 | |||
| cas.12 | -0.07 | -1.17 | -3.03 | -1.29 | -1.16 | -0.67 | 0.34 | -0.96 | 0.15 | -0.66 | 3.82 | ||
| cas.13 | -1.79 | -1.18 | -1.14 | 0.35 | -1.03 | 0.00 | 1.40 | -0.83 | -0.19 | 1.41 | 1.14 | 0.2 |
2.3.1.3 CFA - 2 factor solution
CFA.2 <- ' cas.ce.f =~ cas.01 + cas.02 + cas.03 + cas.04 + cas.05 + cas.06 + cas.07 + cas.08
cas.f.f =~ cas.09 + cas.10 + cas.11 + cas.12 + cas.13'
fit.2 <- cfa(CFA.2, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.2, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 52 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 27
##
## Used Total
## Number of observations 741 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 575.807 164.615
## Degrees of freedom 64 64
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 3.498
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 6511.635 1291.127
## Degrees of freedom 78 78
## P-value 0.000 0.000
## Scaling correction factor 5.043
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.920 0.917
## Tucker-Lewis Index (TLI) 0.903 0.899
##
## Robust Comparative Fit Index (CFI) 0.942
## Robust Tucker-Lewis Index (TLI) 0.930
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -5408.578 -5408.578
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 10871.157 10871.157
## Bayesian (BIC) 10995.573 10995.573
## Sample-size adjusted Bayesian (SABIC) 10909.838 10909.838
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.104 0.046
## 90 Percent confidence interval - lower 0.096 0.041
## 90 Percent confidence interval - upper 0.112 0.051
## P-value H_0: RMSEA <= 0.050 0.000 0.917
## P-value H_0: RMSEA >= 0.080 1.000 0.000
##
## Robust RMSEA 0.086
## 90 Percent confidence interval - lower 0.070
## 90 Percent confidence interval - upper 0.102
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 0.745
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.044 0.044
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## cas.ce.f =~
## cas.01 0.428 0.032 13.337 0.000 0.428 0.616
## cas.02 0.484 0.033 14.440 0.000 0.484 0.707
## cas.03 0.406 0.036 11.300 0.000 0.406 0.739
## cas.04 0.468 0.037 12.752 0.000 0.468 0.806
## cas.05 0.444 0.035 12.609 0.000 0.444 0.804
## cas.06 0.436 0.034 12.693 0.000 0.436 0.776
## cas.07 0.383 0.040 9.667 0.000 0.383 0.720
## cas.08 0.453 0.033 13.570 0.000 0.453 0.749
## cas.f.f =~
## cas.09 0.448 0.032 14.160 0.000 0.448 0.821
## cas.10 0.445 0.033 13.594 0.000 0.445 0.669
## cas.11 0.443 0.037 12.052 0.000 0.443 0.853
## cas.12 0.455 0.034 13.501 0.000 0.455 0.847
## cas.13 0.370 0.039 9.595 0.000 0.370 0.713
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## cas.ce.f ~~
## cas.f.f 0.930 0.021 45.254 0.000 0.930 0.930
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .cas.01 0.298 0.034 8.791 0.000 0.298 0.620
## .cas.02 0.234 0.028 8.309 0.000 0.234 0.500
## .cas.03 0.137 0.015 9.088 0.000 0.137 0.454
## .cas.04 0.118 0.026 4.600 0.000 0.118 0.350
## .cas.05 0.108 0.016 6.752 0.000 0.108 0.354
## .cas.06 0.126 0.025 5.126 0.000 0.126 0.398
## .cas.07 0.137 0.029 4.676 0.000 0.137 0.482
## .cas.08 0.160 0.021 7.774 0.000 0.160 0.439
## .cas.09 0.097 0.016 6.250 0.000 0.097 0.325
## .cas.10 0.244 0.038 6.417 0.000 0.244 0.553
## .cas.11 0.073 0.015 4.857 0.000 0.073 0.272
## .cas.12 0.082 0.019 4.256 0.000 0.082 0.283
## .cas.13 0.132 0.023 5.732 0.000 0.132 0.491
## cas.ce.f 1.000 1.000 1.000
## cas.f.f 1.000 1.000 1.000
##
## R-Square:
## Estimate
## cas.01 0.380
## cas.02 0.500
## cas.03 0.546
## cas.04 0.650
## cas.05 0.646
## cas.06 0.602
## cas.07 0.518
## cas.08 0.561
## cas.09 0.675
## cas.10 0.447
## cas.11 0.728
## cas.12 0.717
## cas.13 0.509parameterEstimates(fit.2, standardized=TRUE) ## lhs op rhs est se z pvalue ci.lower ci.upper std.lv
## 1 cas.ce.f =~ cas.01 0.428 0.032 13.337 0 0.365 0.490 0.428
## 2 cas.ce.f =~ cas.02 0.484 0.033 14.440 0 0.418 0.549 0.484
## 3 cas.ce.f =~ cas.03 0.406 0.036 11.300 0 0.335 0.476 0.406
## 4 cas.ce.f =~ cas.04 0.468 0.037 12.752 0 0.396 0.540 0.468
## 5 cas.ce.f =~ cas.05 0.444 0.035 12.609 0 0.375 0.513 0.444
## 6 cas.ce.f =~ cas.06 0.436 0.034 12.693 0 0.368 0.503 0.436
## 7 cas.ce.f =~ cas.07 0.383 0.040 9.667 0 0.305 0.461 0.383
## 8 cas.ce.f =~ cas.08 0.453 0.033 13.570 0 0.387 0.518 0.453
## 9 cas.f.f =~ cas.09 0.448 0.032 14.160 0 0.386 0.511 0.448
## 10 cas.f.f =~ cas.10 0.445 0.033 13.594 0 0.381 0.509 0.445
## 11 cas.f.f =~ cas.11 0.443 0.037 12.052 0 0.371 0.515 0.443
## 12 cas.f.f =~ cas.12 0.455 0.034 13.501 0 0.389 0.521 0.455
## 13 cas.f.f =~ cas.13 0.370 0.039 9.595 0 0.294 0.445 0.370
## 14 cas.01 ~~ cas.01 0.298 0.034 8.791 0 0.232 0.365 0.298
## 15 cas.02 ~~ cas.02 0.234 0.028 8.309 0 0.179 0.289 0.234
## 16 cas.03 ~~ cas.03 0.137 0.015 9.088 0 0.107 0.166 0.137
## 17 cas.04 ~~ cas.04 0.118 0.026 4.600 0 0.068 0.168 0.118
## 18 cas.05 ~~ cas.05 0.108 0.016 6.752 0 0.076 0.139 0.108
## 19 cas.06 ~~ cas.06 0.126 0.025 5.126 0 0.078 0.174 0.126
## 20 cas.07 ~~ cas.07 0.137 0.029 4.676 0 0.079 0.194 0.137
## 21 cas.08 ~~ cas.08 0.160 0.021 7.774 0 0.120 0.201 0.160
## 22 cas.09 ~~ cas.09 0.097 0.016 6.250 0 0.067 0.127 0.097
## 23 cas.10 ~~ cas.10 0.244 0.038 6.417 0 0.170 0.319 0.244
## 24 cas.11 ~~ cas.11 0.073 0.015 4.857 0 0.044 0.103 0.073
## 25 cas.12 ~~ cas.12 0.082 0.019 4.256 0 0.044 0.119 0.082
## 26 cas.13 ~~ cas.13 0.132 0.023 5.732 0 0.087 0.177 0.132
## 27 cas.ce.f ~~ cas.ce.f 1.000 0.000 NA NA 1.000 1.000 1.000
## 28 cas.f.f ~~ cas.f.f 1.000 0.000 NA NA 1.000 1.000 1.000
## 29 cas.ce.f ~~ cas.f.f 0.930 0.021 45.254 0 0.890 0.970 0.930
## std.all
## 1 0.616
## 2 0.707
## 3 0.739
## 4 0.806
## 5 0.804
## 6 0.776
## 7 0.720
## 8 0.749
## 9 0.821
## 10 0.669
## 11 0.853
## 12 0.847
## 13 0.713
## 14 0.620
## 15 0.500
## 16 0.454
## 17 0.350
## 18 0.354
## 19 0.398
## 20 0.482
## 21 0.439
## 22 0.325
## 23 0.553
## 24 0.272
## 25 0.283
## 26 0.491
## 27 1.000
## 28 1.000
## 29 0.930Factor loadings
library(dplyr)
library(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.2, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| cas.ce.f | cas.01 | 0.428 | 0.032 | 13.337 | 0 | 0.616 |
| cas.ce.f | cas.02 | 0.484 | 0.033 | 14.440 | 0 | 0.707 |
| cas.ce.f | cas.03 | 0.406 | 0.036 | 11.300 | 0 | 0.739 |
| cas.ce.f | cas.04 | 0.468 | 0.037 | 12.752 | 0 | 0.806 |
| cas.ce.f | cas.05 | 0.444 | 0.035 | 12.609 | 0 | 0.804 |
| cas.ce.f | cas.06 | 0.436 | 0.034 | 12.693 | 0 | 0.776 |
| cas.ce.f | cas.07 | 0.383 | 0.040 | 9.667 | 0 | 0.720 |
| cas.ce.f | cas.08 | 0.453 | 0.033 | 13.570 | 0 | 0.749 |
| cas.f.f | cas.09 | 0.448 | 0.032 | 14.160 | 0 | 0.821 |
| cas.f.f | cas.10 | 0.445 | 0.033 | 13.594 | 0 | 0.669 |
| cas.f.f | cas.11 | 0.443 | 0.037 | 12.052 | 0 | 0.853 |
| cas.f.f | cas.12 | 0.455 | 0.034 | 13.501 | 0 | 0.847 |
| cas.f.f | cas.13 | 0.370 | 0.039 | 9.595 | 0 | 0.713 |
Modification indices
mod_ind <- modificationindices(fit.2)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 43 cas.01 ~~ cas.02 179.882 0.139 0.139 0.526 0.526
## 118 cas.11 ~~ cas.12 105.133 0.042 0.042 0.540 0.540
## 59 cas.02 ~~ cas.07 52.578 -0.052 -0.052 -0.291 -0.291
## 94 cas.06 ~~ cas.08 42.222 0.038 0.038 0.271 0.271
## 55 cas.02 ~~ cas.03 39.697 0.046 0.046 0.255 0.255
## 115 cas.10 ~~ cas.11 38.927 -0.037 -0.037 -0.275 -0.275
## 48 cas.01 ~~ cas.07 19.686 -0.035 -0.035 -0.175 -0.175
## 111 cas.09 ~~ cas.10 18.466 0.028 0.028 0.183 0.183
## 74 cas.03 ~~ cas.12 16.546 -0.018 -0.018 -0.174 -0.174
## 30 cas.ce.f =~ cas.09 14.971 0.239 0.239 0.437 0.437subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 43 cas.01 ~~ cas.02 179.882 0.139 0.139 0.526 0.526
## 118 cas.11 ~~ cas.12 105.133 0.042 0.042 0.540 0.540
## 59 cas.02 ~~ cas.07 52.578 -0.052 -0.052 -0.291 -0.291
## 94 cas.06 ~~ cas.08 42.222 0.038 0.038 0.271 0.271
## 55 cas.02 ~~ cas.03 39.697 0.046 0.046 0.255 0.255
## 115 cas.10 ~~ cas.11 38.927 -0.037 -0.037 -0.275 -0.275
## 48 cas.01 ~~ cas.07 19.686 -0.035 -0.035 -0.175 -0.175
## 111 cas.09 ~~ cas.10 18.466 0.028 0.028 0.183 0.183
## 74 cas.03 ~~ cas.12 16.546 -0.018 -0.018 -0.174 -0.174
## 30 cas.ce.f =~ cas.09 14.971 0.239 0.239 0.437 0.437
## 32 cas.ce.f =~ cas.11 14.252 -0.220 -0.220 -0.424 -0.424
## 100 cas.07 ~~ cas.08 12.884 0.022 0.022 0.146 0.146
## 113 cas.09 ~~ cas.12 12.861 -0.016 -0.016 -0.177 -0.177
## 71 cas.03 ~~ cas.09 12.699 0.017 0.017 0.150 0.150
## 117 cas.10 ~~ cas.13 12.659 0.026 0.026 0.142 0.142
## 58 cas.02 ~~ cas.06 12.458 -0.025 -0.025 -0.145 -0.145
## 105 cas.07 ~~ cas.13 11.432 0.018 0.018 0.135 0.135
## 89 cas.05 ~~ cas.10 10.337 0.021 0.021 0.131 0.131
## 116 cas.10 ~~ cas.12 10.110 -0.020 -0.020 -0.139 -0.139
## 108 cas.08 ~~ cas.11 9.683 -0.015 -0.015 -0.135 -0.135
## 41 cas.f.f =~ cas.07 8.948 0.188 0.188 0.354 0.354
## 57 cas.02 ~~ cas.05 8.500 -0.019 -0.019 -0.122 -0.122
## 33 cas.ce.f =~ cas.12 8.424 -0.175 -0.175 -0.326 -0.326
## 46 cas.01 ~~ cas.05 8.391 -0.021 -0.021 -0.118 -0.118
## 60 cas.02 ~~ cas.08 7.738 -0.022 -0.022 -0.113 -0.113
## 31 cas.ce.f =~ cas.10 7.362 0.227 0.227 0.342 0.342
## 120 cas.12 ~~ cas.13 5.433 -0.011 -0.011 -0.104 -0.104
## 42 cas.f.f =~ cas.08 5.310 -0.160 -0.160 -0.265 -0.265Variance-Covariance-Matrix
inspect(fit.2, "sampstat")$cov ## cas.01 cas.02 cas.03 cas.04 cas.05 cas.06 cas.07 cas.08 cas.09 cas.10
## cas.01 0.481
## cas.02 0.329 0.468
## cas.03 0.175 0.234 0.301
## cas.04 0.198 0.235 0.192 0.337
## cas.05 0.173 0.200 0.177 0.214 0.305
## cas.06 0.173 0.191 0.175 0.197 0.192 0.315
## cas.07 0.133 0.142 0.151 0.178 0.174 0.173 0.283
## cas.08 0.178 0.201 0.175 0.207 0.201 0.227 0.191 0.365
## cas.09 0.189 0.210 0.184 0.204 0.194 0.180 0.163 0.187 0.298
## cas.10 0.198 0.221 0.158 0.193 0.208 0.186 0.159 0.197 0.220 0.442
## cas.11 0.165 0.190 0.164 0.183 0.185 0.177 0.163 0.170 0.194 0.171
## cas.12 0.184 0.197 0.154 0.193 0.184 0.183 0.169 0.187 0.195 0.188
## cas.13 0.134 0.159 0.135 0.171 0.153 0.157 0.152 0.155 0.160 0.186
## cas.11 cas.12 cas.13
## cas.01
## cas.02
## cas.03
## cas.04
## cas.05
## cas.06
## cas.07
## cas.08
## cas.09
## cas.10
## cas.11 0.270
## cas.12 0.222 0.288
## cas.13 0.164 0.161 0.269fitted(fit.2)$cov ## cas.01 cas.02 cas.03 cas.04 cas.05 cas.06 cas.07 cas.08 cas.09 cas.10
## cas.01 0.481
## cas.02 0.207 0.468
## cas.03 0.173 0.196 0.301
## cas.04 0.200 0.226 0.190 0.337
## cas.05 0.190 0.215 0.180 0.208 0.305
## cas.06 0.186 0.211 0.177 0.204 0.193 0.315
## cas.07 0.164 0.185 0.155 0.179 0.170 0.167 0.283
## cas.08 0.194 0.219 0.184 0.212 0.201 0.197 0.173 0.365
## cas.09 0.178 0.202 0.169 0.195 0.185 0.182 0.160 0.189 0.298
## cas.10 0.177 0.200 0.168 0.194 0.184 0.180 0.158 0.187 0.199 0.442
## cas.11 0.176 0.199 0.167 0.193 0.183 0.180 0.158 0.187 0.199 0.197
## cas.12 0.181 0.205 0.172 0.198 0.188 0.184 0.162 0.191 0.204 0.202
## cas.13 0.147 0.166 0.140 0.161 0.153 0.150 0.132 0.156 0.166 0.165
## cas.11 cas.12 cas.13
## cas.01
## cas.02
## cas.03
## cas.04
## cas.05
## cas.06
## cas.07
## cas.08
## cas.09
## cas.10
## cas.11 0.270
## cas.12 0.201 0.288
## cas.13 0.164 0.168 0.269Standardized residuals
cov_table <- resid(fit.2, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | cas.01 | cas.02 | cas.03 | cas.04 | cas.05 | cas.06 | cas.07 | cas.08 | cas.09 | cas.10 | cas.11 | cas.12 | cas.13 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| cas.01 | |||||||||||||
| cas.02 | 5.55 | ||||||||||||
| cas.03 | 0.11 | 3.34 | |||||||||||
| cas.04 | -0.17 | 0.90 | 0.32 | ||||||||||
| cas.05 | -1.80 | -1.65 | -0.42 | 0.98 | |||||||||
| cas.06 | -1.56 | -2.49 | -0.27 | -1.15 | -0.21 | ||||||||
| cas.07 | -3.33 | -4.17 | -0.55 | -0.12 | 0.57 | 0.94 | |||||||
| cas.08 | -1.56 | -1.83 | -1.14 | -0.67 | 0.05 | 2.44 | 1.64 | ||||||
| cas.09 | 0.97 | 0.87 | 1.66 | 1.23 | 0.86 | -0.26 | 0.45 | -0.21 | |||||
| cas.10 | 1.49 | 1.29 | -0.83 | -0.06 | 1.73 | 0.54 | 0.04 | 0.86 | 1.71 | ||||
| cas.11 | -1.36 | -1.02 | -0.36 | -1.38 | 0.28 | -0.44 | 0.71 | -2.03 | -1.00 | -3.46 | |||
| cas.12 | 0.32 | -0.78 | -2.59 | -0.70 | -0.47 | -0.11 | 0.97 | -0.59 | -1.77 | -1.96 | 3.10 | ||
| cas.13 | -1.10 | -0.59 | -0.48 | 0.99 | 0.00 | 0.72 | 2.09 | -0.12 | -0.70 | 1.25 | 0.03 | -1.14 |
2.3.1.3.1 Plot CFA - 2 factor solution
Load package
library(semPlot)semPaths(fit.2, rotation = 2, nodeLabels=1:13)
Create the vector for the node labels
nodeLabels <- c("1", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "11", "12", "13",
"cognitive-emotional impairment",
"functional impairment"
)Create a character vector for the order of latent variables
latents <- c("cas.ce.f", "cas.f.f")Plot
semPaths(fit.2,
style = "lisrel",
whatLabels = "std.all",
nCharNodes = 0,
rotation = 2,
layout = "tree3",
curvePivot = TRUE,
curvePivotShape = 2.1,
edge.label.cex = .5,
cardinal = TRUE,
sizeMan = 5,
sizeMan2 = 2,
sizeLat =10,
sizeLat2 = 10,
nodeLabels = nodeLabels,
latents = latents
)
2.3.1.4 Comparing CFAs
2.3.1.4.1 1 factor vs. 2 factor
lavTestLRT(fit.1, fit.2)##
## Scaled Chi-Squared Difference Test (method = "satorra.bentler.2001")
##
## lavaan->lavTestLRT():
## lavaan NOTE: The "Chisq" column contains standard test statistics, not the
## robust test that should be reported per model. A robust difference test is
## a function of two standard (not robust) statistics.
##
## Df AIC BIC Chisq Chisq diff RMSEA Df diff Pr(>Chisq)
## fit.2 64 10871 10996 575.81
## fit.1 65 10962 11082 669.06 21.62 0.34645 1 3.323e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> 2-factor solution fits better
2.3.2 Diverging stacked barchart of answers
Load relevant packages
library(HH)## Loading required package: lattice## Loading required package: grid## Loading required package: latticeExtra## Loading required package: multcomp## Loading required package: mvtnorm## Loading required package: survival##
## Attaching package: 'survival'## The following object is masked from 'package:MVN':
##
## royston## Loading required package: TH.data##
## Attaching package: 'TH.data'## The following object is masked from 'package:MASS':
##
## geyser## Loading required package: gridExtra##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combine##
## Attaching package: 'HH'## The following objects are masked from 'package:car':
##
## logit, vif## The following object is masked from 'package:psych':
##
## logit## The following object is masked from 'package:base':
##
## is.Rlibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.1 ✔ readr 2.2.0
## ✔ ggplot2 4.0.3 ✔ stringr 1.6.0
## ✔ lubridate 1.9.5 ✔ tibble 3.3.1
## ✔ purrr 1.2.2## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::%+%() masks psych::%+%()
## ✖ ggplot2::alpha() masks psych::alpha()
## ✖ gridExtra::combine() masks dplyr::combine()
## ✖ dplyr::filter() masks stats::filter()
## ✖ lubridate::interval() masks HH::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ ggplot2::layer() masks latticeExtra::layer()
## ✖ dplyr::recode() masks car::recode()
## ✖ dplyr::select() masks MASS::select()
## ✖ purrr::some() masks car::some()
## ✖ purrr::transpose() masks HH::transpose()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsCreate data frame with all CAS items
df = data.frame(data$cas.01, data$cas.02, data$cas.03, data$cas.04, data$cas.05,
data$cas.06, data$cas.07, data$cas.08, data$cas.09, data$cas.10,
data$cas.11, data$cas.12, data$cas.13)Convert to long format
survey <- gather(df, measure, response, c(1:13))## Warning: attributes are not identical across measure variables; they will be
## droppedConvert to factors
survey$measure <- as.factor(survey$measure)
survey$response <- as.factor(survey$response)Create contingency table
survey_df <- table(survey$measure, survey$response) %>% as.data.frame.matrix()Rename rows and columns
colnames(survey_df) <- c("never","seldomly","sometimes","often","almost always")
rownames(survey_df)<-c("1: Thinking about climate change makes it difficult for me to concentrate.",
"2: Thinking about climate change makes it difficult for me to sleep.",
"3: I have nightmares about climate change",
"4: I find myself crying because of climate change.",
"5: I think, “why can’t I handle climate change better?”.",
"6: I go away by myself and think about why I feel this way about climate change.",
"7: I write down my thoughts about climate change and analyze them.",
"8: I think, “why do I react to climate change this way?”.",
"9: My concerns about climate change make it hard for me to have fun with my family or friends.",
"10: I have problems balancing my concerns about sustainability with the needs of my family.",
"11: My concerns about climate change interfere with my ability to get work or school assignments done.",
"12: My concerns about climate change undermine my ability to work to my potential.",
"13: My friends say I think about climate change too much.")
survey_df <- tibble::rownames_to_column(survey_df, var="Measure") Plotting the graph
likert(Measure ~ ., data=survey_df,
ylab=NULL,
scales = list(y = list(cex = 1.2)),
auto.key=list(cex = 1.2,just = 0.95),
ReferenceZero=4, as.percent=TRUE,
main = list(" ",x=unit(.55, "npc")),
xlim=c(-100, -80, -60, -40, -20, 0, 20, 40),
strip=FALSE,
par.strip.text=list(cex=.7))
Detach packages
detach("package:HH", unload=TRUE)
detach("package:tidyverse", unload=TRUE)2.4 Empathy
# Empathic concern
data$emp.ec.2.i <- car::recode (data$emp.ec.2, '1=5; 2=4; 4=2; 5=1')
data$emp.ec.3.i <- car::recode (data$emp.ec.3, '1=5; 2=4; 4=2; 5=1')
data$emp.ec.4.i <- car::recode (data$emp.ec.4, '1=5; 2=4; 4=2; 5=1')
data$emp.ec <- rowMeans (data [c("emp.ec.1", "emp.ec.2.i", "emp.ec.3.i", "emp.ec.4.i")])
# Perspective taking
data$emp.pt <- rowMeans (data [c("emp.pt.1", "emp.pt.2", "emp.pt.3", "emp.pt.4")]) 2.4.1 CFA
Increases the number of rows that can be printed
options(max.print = 10000000)2.4.1.1 Normality
Load package
library(MVN)Create data frame with all empathy items
data.emp.items = data.frame(data$emp.ec.1, data$emp.ec.2.i, data$emp.ec.3.i, data$emp.ec.4.i,
data$emp.pt.1, data$emp.pt.2, data$emp.pt.3, data$emp.pt.4)Check for overall multivariate normality (Doornik-Hansen’s test)
result <- mvn(data = data.emp.items)## Warning in mvn(data = data.emp.items): Missing values detected in 45 rows.
## These rows will be removed.result$multivariateNormality## NULL2.4.1.2 CFA - 1 factor solution
Load package
library(lavaan)CFA
CFA.1 <- ' emp =~ emp.ec.1 + emp.ec.2.i + emp.ec.3.i + emp.ec.4.i +
emp.pt.1 + emp.pt.2 + emp.pt.3 + emp.pt.4 '
fit.1 <- cfa(CFA.1, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.1, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 16 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 16
##
## Used Total
## Number of observations 728 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 400.363 309.544
## Degrees of freedom 20 20
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 1.293
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 1364.491 1018.598
## Degrees of freedom 28 28
## P-value 0.000 0.000
## Scaling correction factor 1.340
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.715 0.708
## Tucker-Lewis Index (TLI) 0.602 0.591
##
## Robust Comparative Fit Index (CFI) 0.718
## Robust Tucker-Lewis Index (TLI) 0.605
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -8008.250 -8008.250
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 16048.501 16048.501
## Bayesian (BIC) 16121.945 16121.945
## Sample-size adjusted Bayesian (SABIC) 16071.140 16071.140
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.162 0.141
## 90 Percent confidence interval - lower 0.148 0.129
## 90 Percent confidence interval - upper 0.176 0.153
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 1.000 1.000
##
## Robust RMSEA 0.160
## 90 Percent confidence interval - lower 0.145
## 90 Percent confidence interval - upper 0.176
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.100 0.100
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emp =~
## emp.ec.1 0.511 0.049 10.472 0.000 0.511 0.464
## emp.ec.2.i 0.409 0.049 8.278 0.000 0.409 0.367
## emp.ec.3.i 0.500 0.045 10.996 0.000 0.500 0.477
## emp.ec.4.i 0.457 0.045 10.203 0.000 0.457 0.466
## emp.pt.1 0.588 0.038 15.426 0.000 0.588 0.640
## emp.pt.2 0.421 0.041 10.238 0.000 0.421 0.471
## emp.pt.3 0.762 0.040 19.302 0.000 0.762 0.647
## emp.pt.4 0.767 0.041 18.702 0.000 0.767 0.687
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .emp.ec.1 0.951 0.064 14.813 0.000 0.951 0.785
## .emp.ec.2.i 1.078 0.065 16.476 0.000 1.078 0.866
## .emp.ec.3.i 0.847 0.051 16.567 0.000 0.847 0.772
## .emp.ec.4.i 0.752 0.055 13.572 0.000 0.752 0.783
## .emp.pt.1 0.498 0.043 11.705 0.000 0.498 0.590
## .emp.pt.2 0.623 0.044 14.294 0.000 0.623 0.778
## .emp.pt.3 0.807 0.052 15.457 0.000 0.807 0.581
## .emp.pt.4 0.658 0.052 12.769 0.000 0.658 0.528
## emp 1.000 1.000 1.000
##
## R-Square:
## Estimate
## emp.ec.1 0.215
## emp.ec.2.i 0.134
## emp.ec.3.i 0.228
## emp.ec.4.i 0.217
## emp.pt.1 0.410
## emp.pt.2 0.222
## emp.pt.3 0.419
## emp.pt.4 0.472parameterEstimates(fit.1, standardized=TRUE) ## lhs op rhs est se z pvalue ci.lower ci.upper std.lv
## 1 emp =~ emp.ec.1 0.511 0.049 10.472 0 0.415 0.606 0.511
## 2 emp =~ emp.ec.2.i 0.409 0.049 8.278 0 0.312 0.506 0.409
## 3 emp =~ emp.ec.3.i 0.500 0.045 10.996 0 0.411 0.589 0.500
## 4 emp =~ emp.ec.4.i 0.457 0.045 10.203 0 0.369 0.545 0.457
## 5 emp =~ emp.pt.1 0.588 0.038 15.426 0 0.514 0.663 0.588
## 6 emp =~ emp.pt.2 0.421 0.041 10.238 0 0.341 0.502 0.421
## 7 emp =~ emp.pt.3 0.762 0.040 19.302 0 0.685 0.840 0.762
## 8 emp =~ emp.pt.4 0.767 0.041 18.702 0 0.687 0.847 0.767
## 9 emp.ec.1 ~~ emp.ec.1 0.951 0.064 14.813 0 0.825 1.077 0.951
## 10 emp.ec.2.i ~~ emp.ec.2.i 1.078 0.065 16.476 0 0.950 1.206 1.078
## 11 emp.ec.3.i ~~ emp.ec.3.i 0.847 0.051 16.567 0 0.747 0.947 0.847
## 12 emp.ec.4.i ~~ emp.ec.4.i 0.752 0.055 13.572 0 0.644 0.861 0.752
## 13 emp.pt.1 ~~ emp.pt.1 0.498 0.043 11.705 0 0.415 0.582 0.498
## 14 emp.pt.2 ~~ emp.pt.2 0.623 0.044 14.294 0 0.538 0.709 0.623
## 15 emp.pt.3 ~~ emp.pt.3 0.807 0.052 15.457 0 0.705 0.909 0.807
## 16 emp.pt.4 ~~ emp.pt.4 0.658 0.052 12.769 0 0.557 0.759 0.658
## 17 emp ~~ emp 1.000 0.000 NA NA 1.000 1.000 1.000
## std.all
## 1 0.464
## 2 0.367
## 3 0.477
## 4 0.466
## 5 0.640
## 6 0.471
## 7 0.647
## 8 0.687
## 9 0.785
## 10 0.866
## 11 0.772
## 12 0.783
## 13 0.590
## 14 0.778
## 15 0.581
## 16 0.528
## 17 1.000Factor loadings
library(dplyr)
library(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.1, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| emp | emp.ec.1 | 0.511 | 0.049 | 10.472 | 0 | 0.464 |
| emp | emp.ec.2.i | 0.409 | 0.049 | 8.278 | 0 | 0.367 |
| emp | emp.ec.3.i | 0.500 | 0.045 | 10.996 | 0 | 0.477 |
| emp | emp.ec.4.i | 0.457 | 0.045 | 10.203 | 0 | 0.466 |
| emp | emp.pt.1 | 0.588 | 0.038 | 15.426 | 0 | 0.640 |
| emp | emp.pt.2 | 0.421 | 0.041 | 10.238 | 0 | 0.471 |
| emp | emp.pt.3 | 0.762 | 0.040 | 19.302 | 0 | 0.647 |
| emp | emp.pt.4 | 0.767 | 0.041 | 18.702 | 0 | 0.687 |
Modification indices
mod_ind <- modificationindices(fit.1)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 45 emp.pt.3 ~~ emp.pt.4 182.115 0.545 0.545 0.749 0.749
## 31 emp.ec.3.i ~~ emp.ec.4.i 114.609 0.349 0.349 0.437 0.437
## 25 emp.ec.2.i ~~ emp.ec.3.i 58.221 0.290 0.290 0.304 0.304
## 38 emp.ec.4.i ~~ emp.pt.3 57.176 -0.264 -0.264 -0.339 -0.339
## 26 emp.ec.2.i ~~ emp.ec.4.i 52.007 0.258 0.258 0.286 0.286
## 34 emp.ec.3.i ~~ emp.pt.3 32.900 -0.214 -0.214 -0.259 -0.259
## 29 emp.ec.2.i ~~ emp.pt.3 28.063 -0.214 -0.214 -0.229 -0.229
## 39 emp.ec.4.i ~~ emp.pt.4 24.212 -0.162 -0.162 -0.230 -0.230
## 20 emp.ec.1 ~~ emp.ec.4.i 24.193 0.169 0.169 0.200 0.200
## 35 emp.ec.3.i ~~ emp.pt.4 22.369 -0.166 -0.166 -0.223 -0.223subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 45 emp.pt.3 ~~ emp.pt.4 182.115 0.545 0.545 0.749 0.749
## 31 emp.ec.3.i ~~ emp.ec.4.i 114.609 0.349 0.349 0.437 0.437
## 25 emp.ec.2.i ~~ emp.ec.3.i 58.221 0.290 0.290 0.304 0.304
## 38 emp.ec.4.i ~~ emp.pt.3 57.176 -0.264 -0.264 -0.339 -0.339
## 26 emp.ec.2.i ~~ emp.ec.4.i 52.007 0.258 0.258 0.286 0.286
## 34 emp.ec.3.i ~~ emp.pt.3 32.900 -0.214 -0.214 -0.259 -0.259
## 29 emp.ec.2.i ~~ emp.pt.3 28.063 -0.214 -0.214 -0.229 -0.229
## 39 emp.ec.4.i ~~ emp.pt.4 24.212 -0.162 -0.162 -0.230 -0.230
## 20 emp.ec.1 ~~ emp.ec.4.i 24.193 0.169 0.169 0.200 0.200
## 35 emp.ec.3.i ~~ emp.pt.4 22.369 -0.166 -0.166 -0.223 -0.223
## 37 emp.ec.4.i ~~ emp.pt.2 19.729 -0.124 -0.124 -0.181 -0.181
## 24 emp.ec.1 ~~ emp.pt.4 17.519 -0.155 -0.155 -0.196 -0.196
## 19 emp.ec.1 ~~ emp.ec.3.i 16.240 0.148 0.148 0.164 0.164
## 23 emp.ec.1 ~~ emp.pt.3 14.763 -0.151 -0.151 -0.172 -0.172
## 33 emp.ec.3.i ~~ emp.pt.2 13.950 -0.111 -0.111 -0.153 -0.153
## 40 emp.pt.1 ~~ emp.pt.2 12.691 0.089 0.089 0.159 0.159
## 43 emp.pt.2 ~~ emp.pt.3 10.291 0.102 0.102 0.144 0.144
## 28 emp.ec.2.i ~~ emp.pt.2 9.125 -0.098 -0.098 -0.120 -0.120
## 42 emp.pt.1 ~~ emp.pt.4 5.674 -0.075 -0.075 -0.131 -0.131
## 30 emp.ec.2.i ~~ emp.pt.4 5.597 -0.089 -0.089 -0.106 -0.106Variance-Covariance-Matrix
inspect(fit.1, "sampstat")$cov ## emp.c.1 em..2. em..3. em..4. emp.p.1 emp..2 emp..3 emp..4
## emp.ec.1 1.212
## emp.ec.2.i 0.250 1.245
## emp.ec.3.i 0.377 0.456 1.097
## emp.ec.4.i 0.374 0.412 0.516 0.961
## emp.pt.1 0.336 0.216 0.280 0.292 0.845
## emp.pt.2 0.209 0.087 0.119 0.090 0.309 0.801
## emp.pt.3 0.286 0.155 0.237 0.168 0.431 0.391 1.388
## emp.pt.4 0.294 0.253 0.281 0.249 0.417 0.335 0.828 1.246fitted(fit.1)$cov ## emp.c.1 em..2. em..3. em..4. emp.p.1 emp..2 emp..3 emp..4
## emp.ec.1 1.212
## emp.ec.2.i 0.209 1.245
## emp.ec.3.i 0.255 0.205 1.097
## emp.ec.4.i 0.233 0.187 0.228 0.961
## emp.pt.1 0.301 0.241 0.294 0.269 0.845
## emp.pt.2 0.215 0.172 0.211 0.192 0.248 0.801
## emp.pt.3 0.389 0.312 0.381 0.348 0.449 0.321 1.388
## emp.pt.4 0.392 0.314 0.384 0.350 0.451 0.323 0.585 1.246Standardized residuals
cov_table <- resid(fit.1, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | emp.ec.1 | emp.ec.2.i | emp.ec.3.i | emp.ec.4.i | emp.pt.1 | emp.pt.2 | emp.pt.3 | emp.pt.4 | |
|---|---|---|---|---|---|---|---|---|
| emp.ec.1 | ||||||||
| emp.ec.2.i | 0.99 | |||||||
| emp.ec.3.i | 3.38 | 6.04 | ||||||
| emp.ec.4.i | 3.92 | 5.27 | 8.04 | |||||
| emp.pt.1 | 1.45 | -1.03 | -0.70 | 1.15 | ||||
| emp.pt.2 | -0.20 | -2.47 | -3.37 | -4.22 | 3.30 | |||
| emp.pt.3 | -3.67 | -5.38 | -5.66 | -7.82 | -0.90 | 2.81 | ||
| emp.pt.4 | -4.30 | -2.28 | -4.71 | -5.16 | -2.38 | 0.56 | 9.08 |
2.4.1.3 CFA - 2 factor solution
CFA.2 <- ' emp.ec.lat =~ emp.ec.1 + emp.ec.2.i + emp.ec.3.i + emp.ec.4.i
emp.pt.lat =~ emp.pt.1 + emp.pt.2 + emp.pt.3 + emp.pt.4 '
fit.2 <- cfa(CFA.2, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.2, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 15 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 17
##
## Used Total
## Number of observations 728 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 116.666 93.876
## Degrees of freedom 19 19
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 1.243
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 1364.491 1018.598
## Degrees of freedom 28 28
## P-value 0.000 0.000
## Scaling correction factor 1.340
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.927 0.924
## Tucker-Lewis Index (TLI) 0.892 0.889
##
## Robust Comparative Fit Index (CFI) 0.930
## Robust Tucker-Lewis Index (TLI) 0.897
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -7866.402 -7866.402
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 15766.804 15766.804
## Bayesian (BIC) 15844.839 15844.839
## Sample-size adjusted Bayesian (SABIC) 15790.859 15790.859
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.084 0.074
## 90 Percent confidence interval - lower 0.070 0.061
## 90 Percent confidence interval - upper 0.099 0.087
## P-value H_0: RMSEA <= 0.050 0.000 0.002
## P-value H_0: RMSEA >= 0.080 0.691 0.226
##
## Robust RMSEA 0.082
## 90 Percent confidence interval - lower 0.066
## 90 Percent confidence interval - upper 0.099
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.600
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.062 0.062
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emp.ec.lat =~
## emp.ec.1 0.534 0.048 11.065 0.000 0.534 0.485
## emp.ec.2.i 0.585 0.050 11.671 0.000 0.585 0.524
## emp.ec.3.i 0.745 0.041 18.138 0.000 0.745 0.711
## emp.ec.4.i 0.687 0.042 16.433 0.000 0.687 0.701
## emp.pt.lat =~
## emp.pt.1 0.521 0.039 13.326 0.000 0.521 0.567
## emp.pt.2 0.430 0.042 10.302 0.000 0.430 0.480
## emp.pt.3 0.902 0.038 23.858 0.000 0.902 0.765
## emp.pt.4 0.874 0.041 21.269 0.000 0.874 0.783
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emp.ec.lat ~~
## emp.pt.lat 0.454 0.049 9.186 0.000 0.454 0.454
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .emp.ec.1 0.927 0.065 14.329 0.000 0.927 0.765
## .emp.ec.2.i 0.903 0.072 12.545 0.000 0.903 0.725
## .emp.ec.3.i 0.542 0.052 10.482 0.000 0.542 0.494
## .emp.ec.4.i 0.488 0.054 9.119 0.000 0.488 0.508
## .emp.pt.1 0.573 0.043 13.219 0.000 0.573 0.678
## .emp.pt.2 0.616 0.043 14.167 0.000 0.616 0.769
## .emp.pt.3 0.575 0.054 10.635 0.000 0.575 0.414
## .emp.pt.4 0.482 0.056 8.614 0.000 0.482 0.386
## emp.ec.lat 1.000 1.000 1.000
## emp.pt.lat 1.000 1.000 1.000
##
## R-Square:
## Estimate
## emp.ec.1 0.235
## emp.ec.2.i 0.275
## emp.ec.3.i 0.506
## emp.ec.4.i 0.492
## emp.pt.1 0.322
## emp.pt.2 0.231
## emp.pt.3 0.586
## emp.pt.4 0.614parameterEstimates(fit.2, standardized=TRUE)## lhs op rhs est se z pvalue ci.lower ci.upper std.lv
## 1 emp.ec.lat =~ emp.ec.1 0.534 0.048 11.065 0 0.439 0.629 0.534
## 2 emp.ec.lat =~ emp.ec.2.i 0.585 0.050 11.671 0 0.487 0.683 0.585
## 3 emp.ec.lat =~ emp.ec.3.i 0.745 0.041 18.138 0 0.665 0.826 0.745
## 4 emp.ec.lat =~ emp.ec.4.i 0.687 0.042 16.433 0 0.605 0.769 0.687
## 5 emp.pt.lat =~ emp.pt.1 0.521 0.039 13.326 0 0.445 0.598 0.521
## 6 emp.pt.lat =~ emp.pt.2 0.430 0.042 10.302 0 0.348 0.512 0.430
## 7 emp.pt.lat =~ emp.pt.3 0.902 0.038 23.858 0 0.828 0.976 0.902
## 8 emp.pt.lat =~ emp.pt.4 0.874 0.041 21.269 0 0.794 0.955 0.874
## 9 emp.ec.1 ~~ emp.ec.1 0.927 0.065 14.329 0 0.800 1.054 0.927
## 10 emp.ec.2.i ~~ emp.ec.2.i 0.903 0.072 12.545 0 0.762 1.044 0.903
## 11 emp.ec.3.i ~~ emp.ec.3.i 0.542 0.052 10.482 0 0.441 0.644 0.542
## 12 emp.ec.4.i ~~ emp.ec.4.i 0.488 0.054 9.119 0 0.384 0.593 0.488
## 13 emp.pt.1 ~~ emp.pt.1 0.573 0.043 13.219 0 0.488 0.658 0.573
## 14 emp.pt.2 ~~ emp.pt.2 0.616 0.043 14.167 0 0.531 0.701 0.616
## 15 emp.pt.3 ~~ emp.pt.3 0.575 0.054 10.635 0 0.469 0.682 0.575
## 16 emp.pt.4 ~~ emp.pt.4 0.482 0.056 8.614 0 0.372 0.591 0.482
## 17 emp.ec.lat ~~ emp.ec.lat 1.000 0.000 NA NA 1.000 1.000 1.000
## 18 emp.pt.lat ~~ emp.pt.lat 1.000 0.000 NA NA 1.000 1.000 1.000
## 19 emp.ec.lat ~~ emp.pt.lat 0.454 0.049 9.186 0 0.357 0.551 0.454
## std.all
## 1 0.485
## 2 0.524
## 3 0.711
## 4 0.701
## 5 0.567
## 6 0.480
## 7 0.765
## 8 0.783
## 9 0.765
## 10 0.725
## 11 0.494
## 12 0.508
## 13 0.678
## 14 0.769
## 15 0.414
## 16 0.386
## 17 1.000
## 18 1.000
## 19 0.454Factor loadings
library(dplyr)
library(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.2, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| emp.ec.lat | emp.ec.1 | 0.534 | 0.048 | 11.065 | 0 | 0.485 |
| emp.ec.lat | emp.ec.2.i | 0.585 | 0.050 | 11.671 | 0 | 0.524 |
| emp.ec.lat | emp.ec.3.i | 0.745 | 0.041 | 18.138 | 0 | 0.711 |
| emp.ec.lat | emp.ec.4.i | 0.687 | 0.042 | 16.433 | 0 | 0.701 |
| emp.pt.lat | emp.pt.1 | 0.521 | 0.039 | 13.326 | 0 | 0.567 |
| emp.pt.lat | emp.pt.2 | 0.430 | 0.042 | 10.302 | 0 | 0.480 |
| emp.pt.lat | emp.pt.3 | 0.902 | 0.038 | 23.858 | 0 | 0.765 |
| emp.pt.lat | emp.pt.4 | 0.874 | 0.041 | 21.269 | 0 | 0.783 |
Modification indices
mod_ind <- modificationindices(fit.2)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 55 emp.pt.3 ~~ emp.pt.4 51.630 0.492 0.492 0.934 0.934
## 20 emp.ec.lat =~ emp.pt.1 45.619 0.285 0.285 0.311 0.311
## 22 emp.ec.lat =~ emp.pt.3 20.947 -0.242 -0.242 -0.205 -0.205
## 50 emp.pt.1 ~~ emp.pt.2 19.264 0.110 0.110 0.185 0.185
## 24 emp.pt.lat =~ emp.ec.1 17.539 0.216 0.216 0.197 0.197
## 52 emp.pt.1 ~~ emp.pt.4 13.451 -0.132 -0.132 -0.252 -0.252
## 31 emp.ec.1 ~~ emp.pt.1 13.081 0.107 0.107 0.147 0.147
## 46 emp.ec.4.i ~~ emp.pt.1 12.705 0.085 0.085 0.162 0.162
## 51 emp.pt.1 ~~ emp.pt.3 10.357 -0.120 -0.120 -0.209 -0.209
## 54 emp.pt.2 ~~ emp.pt.4 10.165 -0.102 -0.102 -0.187 -0.187subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 55 emp.pt.3 ~~ emp.pt.4 51.630 0.492 0.492 0.934 0.934
## 20 emp.ec.lat =~ emp.pt.1 45.619 0.285 0.285 0.311 0.311
## 22 emp.ec.lat =~ emp.pt.3 20.947 -0.242 -0.242 -0.205 -0.205
## 50 emp.pt.1 ~~ emp.pt.2 19.264 0.110 0.110 0.185 0.185
## 24 emp.pt.lat =~ emp.ec.1 17.539 0.216 0.216 0.197 0.197
## 52 emp.pt.1 ~~ emp.pt.4 13.451 -0.132 -0.132 -0.252 -0.252
## 31 emp.ec.1 ~~ emp.pt.1 13.081 0.107 0.107 0.147 0.147
## 46 emp.ec.4.i ~~ emp.pt.1 12.705 0.085 0.085 0.162 0.162
## 51 emp.pt.1 ~~ emp.pt.3 10.357 -0.120 -0.120 -0.209 -0.209
## 54 emp.pt.2 ~~ emp.pt.4 10.165 -0.102 -0.102 -0.187 -0.187
## 48 emp.ec.4.i ~~ emp.pt.3 9.170 -0.083 -0.083 -0.157 -0.157
## 32 emp.ec.1 ~~ emp.pt.2 6.812 0.079 0.079 0.104 0.104Variance-Covariance-Matrix
inspect(fit.2, "sampstat")$cov ## emp.c.1 em..2. em..3. em..4. emp.p.1 emp..2 emp..3 emp..4
## emp.ec.1 1.212
## emp.ec.2.i 0.250 1.245
## emp.ec.3.i 0.377 0.456 1.097
## emp.ec.4.i 0.374 0.412 0.516 0.961
## emp.pt.1 0.336 0.216 0.280 0.292 0.845
## emp.pt.2 0.209 0.087 0.119 0.090 0.309 0.801
## emp.pt.3 0.286 0.155 0.237 0.168 0.431 0.391 1.388
## emp.pt.4 0.294 0.253 0.281 0.249 0.417 0.335 0.828 1.246fitted(fit.2)$cov ## emp.c.1 em..2. em..3. em..4. emp.p.1 emp..2 emp..3 emp..4
## emp.ec.1 1.212
## emp.ec.2.i 0.313 1.245
## emp.ec.3.i 0.398 0.436 1.097
## emp.ec.4.i 0.367 0.402 0.512 0.961
## emp.pt.1 0.126 0.138 0.176 0.163 0.845
## emp.pt.2 0.104 0.114 0.145 0.134 0.224 0.801
## emp.pt.3 0.219 0.240 0.305 0.281 0.470 0.388 1.388
## emp.pt.4 0.212 0.232 0.296 0.273 0.456 0.376 0.788 1.246Standardized residuals
cov_table <- resid(fit.2, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | emp.ec.1 | emp.ec.2.i | emp.ec.3.i | emp.ec.4.i | emp.pt.1 | emp.pt.2 | emp.pt.3 | emp.pt.4 | |
|---|---|---|---|---|---|---|---|---|
| emp.ec.1 | ||||||||
| emp.ec.2.i | -1.82 | |||||||
| emp.ec.3.i | -1.06 | 0.97 | ||||||
| emp.ec.4.i | 0.33 | 0.46 | 0.48 | |||||
| emp.pt.1 | 5.64 | 2.34 | 3.48 | 4.44 | ||||
| emp.pt.2 | 2.69 | -0.69 | -0.84 | -1.56 | 3.91 | |||
| emp.pt.3 | 1.50 | -2.08 | -2.29 | -4.11 | -3.11 | 0.2 | ||
| emp.pt.4 | 2.02 | 0.53 | -0.56 | -0.97 | -4.10 | -3.0 | 5.41 |
2.4.1.3.1 Plot CFA - 2 factor solution
Load package
library(semPlot)semPaths(fit.2, rotation = 2, nodeLabels=1:8)
Create the vector for the node labels
nodeLabels <- c("1", "2", "3", "4",
"5", "6", "7", "8",
"empathic concern",
"perspective taking"
)Create a character vector for the order of latent variables
latents <- c("emp.ec.lat", "emp.pt.lat")Plot
semPaths(fit.2,
style = "lisrel",
whatLabels = "std.all",
nCharNodes = 0,
rotation = 2,
layout = "tree3",
curvePivot = TRUE,
curvePivotShape = 2.1,
edge.label.cex = .5,
cardinal = TRUE,
sizeMan = 5,
sizeMan2 = 2,
sizeLat =10,
sizeLat2 = 10,
nodeLabels = nodeLabels,
latents = latents
)
2.4.1.4 Comparing CFAs
2.4.1.4.1 1 factor vs. 2 factor
lavTestLRT(fit.1, fit.2)##
## Scaled Chi-Squared Difference Test (method = "satorra.bentler.2001")
##
## lavaan->lavTestLRT():
## lavaan NOTE: The "Chisq" column contains standard test statistics, not the
## robust test that should be reported per model. A robust difference test is
## a function of two standard (not robust) statistics.
##
## Df AIC BIC Chisq Chisq diff RMSEA Df diff Pr(>Chisq)
## fit.2 19 15767 15845 116.67
## fit.1 20 16048 16122 400.36 125.78 0.62177 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> 2-factor solution fits better
2.5 Emotion-focused coping
# Emotional suppression
data$emoreg.ed <- rowMeans (data [c("emoreg.ed.1", "emoreg.ed.2", "emoreg.ed.3")])
# Emotional integration
data$emoreg.ier <- rowMeans (data [c("emoreg.ier.1", "emoreg.ier.2", "emoreg.ier.3")]) 2.5.1 CFA
Increases the number of rows that can be printed
options(max.print = 10000000)2.5.1.1 Normality
Load package
library(MVN)Create data frame with all emotion-focused coping items
data.emoreg.items = data.frame(data$emoreg.ed.1, data$emoreg.ed.2, data$emoreg.ed.3,
data$emoreg.ier.1, data$emoreg.ier.2, data$emoreg.ier.3)Check for overall multivariate normality (Doornik-Hansen’s test)
result <- mvn(data = data.emoreg.items)## Warning in mvn(data = data.emoreg.items): Missing values detected in 37 rows.
## These rows will be removed.result$multivariateNormality## NULL2.5.1.2 CFA - 1 factor solution
Load package
library(lavaan)CFA
CFA.1 <- ' emoreg =~ emoreg.ed.1 + emoreg.ed.2 + emoreg.ed.3 +
emoreg.ier.1 + emoreg.ier.2 + emoreg.ier.3 '
fit.1 <- cfa(CFA.1, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.1, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 18 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 12
##
## Used Total
## Number of observations 736 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 693.451 567.978
## Degrees of freedom 9 9
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 1.221
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 1486.692 1198.532
## Degrees of freedom 15 15
## P-value 0.000 0.000
## Scaling correction factor 1.240
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.535 0.528
## Tucker-Lewis Index (TLI) 0.225 0.213
##
## Robust Comparative Fit Index (CFI) 0.535
## Robust Tucker-Lewis Index (TLI) 0.225
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -8235.217 -8235.217
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 16494.435 16494.435
## Bayesian (BIC) 16549.650 16549.650
## Sample-size adjusted Bayesian (SABIC) 16511.545 16511.545
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.321 0.290
## 90 Percent confidence interval - lower 0.301 0.272
## 90 Percent confidence interval - upper 0.342 0.309
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 1.000 1.000
##
## Robust RMSEA 0.321
## 90 Percent confidence interval - lower 0.299
## 90 Percent confidence interval - upper 0.344
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.201 0.201
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emoreg =~
## emoreg.ed.1 1.156 0.068 17.020 0.000 1.156 0.631
## emoreg.ed.2 1.495 0.059 25.467 0.000 1.495 0.853
## emoreg.ed.3 1.389 0.059 23.361 0.000 1.389 0.813
## emoreg.ier.1 0.267 0.071 3.746 0.000 0.267 0.165
## emoreg.ier.2 0.082 0.076 1.077 0.281 0.082 0.049
## emoreg.ier.3 0.028 0.078 0.353 0.724 0.028 0.016
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .emoreg.ed.1 2.014 0.153 13.134 0.000 2.014 0.601
## .emoreg.ed.2 0.836 0.136 6.166 0.000 0.836 0.272
## .emoreg.ed.3 0.993 0.129 7.689 0.000 0.993 0.340
## .emoreg.ier.1 2.536 0.107 23.688 0.000 2.536 0.973
## .emoreg.ier.2 2.754 0.114 24.245 0.000 2.754 0.998
## .emoreg.ier.3 2.860 0.123 23.344 0.000 2.860 1.000
## emoreg 1.000 1.000 1.000
##
## R-Square:
## Estimate
## emoreg.ed.1 0.399
## emoreg.ed.2 0.728
## emoreg.ed.3 0.660
## emoreg.ier.1 0.027
## emoreg.ier.2 0.002
## emoreg.ier.3 0.000parameterEstimates(fit.1, standardized=TRUE) ## lhs op rhs est se z pvalue ci.lower ci.upper
## 1 emoreg =~ emoreg.ed.1 1.156 0.068 17.020 0.000 1.023 1.289
## 2 emoreg =~ emoreg.ed.2 1.495 0.059 25.467 0.000 1.380 1.610
## 3 emoreg =~ emoreg.ed.3 1.389 0.059 23.361 0.000 1.273 1.506
## 4 emoreg =~ emoreg.ier.1 0.267 0.071 3.746 0.000 0.127 0.407
## 5 emoreg =~ emoreg.ier.2 0.082 0.076 1.077 0.281 -0.067 0.231
## 6 emoreg =~ emoreg.ier.3 0.028 0.078 0.353 0.724 -0.126 0.181
## 7 emoreg.ed.1 ~~ emoreg.ed.1 2.014 0.153 13.134 0.000 1.714 2.315
## 8 emoreg.ed.2 ~~ emoreg.ed.2 0.836 0.136 6.166 0.000 0.570 1.101
## 9 emoreg.ed.3 ~~ emoreg.ed.3 0.993 0.129 7.689 0.000 0.740 1.246
## 10 emoreg.ier.1 ~~ emoreg.ier.1 2.536 0.107 23.688 0.000 2.327 2.746
## 11 emoreg.ier.2 ~~ emoreg.ier.2 2.754 0.114 24.245 0.000 2.532 2.977
## 12 emoreg.ier.3 ~~ emoreg.ier.3 2.860 0.123 23.344 0.000 2.620 3.101
## 13 emoreg ~~ emoreg 1.000 0.000 NA NA 1.000 1.000
## std.lv std.all
## 1 1.156 0.631
## 2 1.495 0.853
## 3 1.389 0.813
## 4 0.267 0.165
## 5 0.082 0.049
## 6 0.028 0.016
## 7 2.014 0.601
## 8 0.836 0.272
## 9 0.993 0.340
## 10 2.536 0.973
## 11 2.754 0.998
## 12 2.860 1.000
## 13 1.000 1.000Factor loadings
library(dplyr)
library(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.1, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| emoreg | emoreg.ed.1 | 1.156 | 0.068 | 17.020 | 0.000 | 0.631 |
| emoreg | emoreg.ed.2 | 1.495 | 0.059 | 25.467 | 0.000 | 0.853 |
| emoreg | emoreg.ed.3 | 1.389 | 0.059 | 23.361 | 0.000 | 0.813 |
| emoreg | emoreg.ier.1 | 0.267 | 0.071 | 3.746 | 0.000 | 0.165 |
| emoreg | emoreg.ier.2 | 0.082 | 0.076 | 1.077 | 0.281 | 0.049 |
| emoreg | emoreg.ier.3 | 0.028 | 0.078 | 0.353 | 0.724 | 0.016 |
Modification indices
mod_ind <- modificationindices(fit.1)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 28 emoreg.ier.2 ~~ emoreg.ier.3 349.249 1.934 1.934 0.689 0.689
## 26 emoreg.ier.1 ~~ emoreg.ier.2 149.206 1.193 1.193 0.452 0.452
## 27 emoreg.ier.1 ~~ emoreg.ier.3 123.197 1.105 1.105 0.410 0.410
## 19 emoreg.ed.2 ~~ emoreg.ed.3 12.774 2.055 2.055 2.256 2.256
## 16 emoreg.ed.1 ~~ emoreg.ier.1 12.093 0.311 0.311 0.138 0.138
## 23 emoreg.ed.3 ~~ emoreg.ier.1 8.085 -0.213 -0.213 -0.134 -0.134
## 14 emoreg.ed.1 ~~ emoreg.ed.2 7.721 -0.928 -0.928 -0.715 -0.715
## 17 emoreg.ed.1 ~~ emoreg.ier.2 6.057 -0.228 -0.228 -0.097 -0.097
## 25 emoreg.ed.3 ~~ emoreg.ier.3 4.886 -0.172 -0.172 -0.102 -0.102
## 24 emoreg.ed.3 ~~ emoreg.ier.2 4.581 -0.164 -0.164 -0.099 -0.099subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 28 emoreg.ier.2 ~~ emoreg.ier.3 349.249 1.934 1.934 0.689 0.689
## 26 emoreg.ier.1 ~~ emoreg.ier.2 149.206 1.193 1.193 0.452 0.452
## 27 emoreg.ier.1 ~~ emoreg.ier.3 123.197 1.105 1.105 0.410 0.410
## 19 emoreg.ed.2 ~~ emoreg.ed.3 12.774 2.055 2.055 2.256 2.256
## 16 emoreg.ed.1 ~~ emoreg.ier.1 12.093 0.311 0.311 0.138 0.138
## 23 emoreg.ed.3 ~~ emoreg.ier.1 8.085 -0.213 -0.213 -0.134 -0.134
## 14 emoreg.ed.1 ~~ emoreg.ed.2 7.721 -0.928 -0.928 -0.715 -0.715
## 17 emoreg.ed.1 ~~ emoreg.ier.2 6.057 -0.228 -0.228 -0.097 -0.097Variance-Covariance-Matrix
inspect(fit.1, "sampstat")$cov ## emrg.d.1 emrg.d.2 emrg.d.3 emrg.r.1 emrg.r.2 emrg.r.3
## emoreg.ed.1 3.350
## emoreg.ed.2 1.709 3.071
## emoreg.ed.3 1.615 2.084 2.923
## emoreg.ier.1 0.578 0.389 0.241 2.608
## emoreg.ier.2 -0.105 0.187 0.010 1.208 2.761
## emoreg.ier.3 -0.100 0.072 -0.071 1.106 1.935 2.861fitted(fit.1)$cov ## emrg.d.1 emrg.d.2 emrg.d.3 emrg.r.1 emrg.r.2 emrg.r.3
## emoreg.ed.1 3.350
## emoreg.ed.2 1.728 3.071
## emoreg.ed.3 1.606 2.077 2.923
## emoreg.ier.1 0.309 0.399 0.371 2.608
## emoreg.ier.2 0.095 0.122 0.114 0.022 2.761
## emoreg.ier.3 0.032 0.041 0.038 0.007 0.002 2.861Standardized residuals
cov_table <- resid(fit.1, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | emoreg.ed.1 | emoreg.ed.2 | emoreg.ed.3 | emoreg.ier.1 | emoreg.ier.2 | emoreg.ier.3 | |
|---|---|---|---|---|---|---|
| emoreg.ed.1 | ||||||
| emoreg.ed.2 | -2.24 | |||||
| emoreg.ed.3 | 0.82 | 2.70 | ||||
| emoreg.ier.1 | 3.05 | -0.27 | -2.78 | |||
| emoreg.ier.2 | -2.23 | 1.52 | -1.94 | 11.13 | ||
| emoreg.ier.3 | -1.48 | 0.69 | -1.96 | 10.03 | 16.08 |
2.5.1.3 CFA - 2 factor solution
CFA.2 <- ' emoreg.ed.lat =~ emoreg.ed.1 + emoreg.ed.2 + emoreg.ed.3
emoreg.ier.lat =~ emoreg.ier.1 + emoreg.ier.2 + emoreg.ier.3 '
fit.2 <- cfa(CFA.2, std.lv=TRUE, data=data, estimator = "MLM")
summary(fit.2, fit.measures=TRUE, standardized=TRUE, rsquare=TRUE)## lavaan 0.6-21 ended normally after 24 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 13
##
## Used Total
## Number of observations 736 773
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 54.012 45.119
## Degrees of freedom 8 8
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 1.197
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 1486.692 1198.532
## Degrees of freedom 15 15
## P-value 0.000 0.000
## Scaling correction factor 1.240
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.969 0.969
## Tucker-Lewis Index (TLI) 0.941 0.941
##
## Robust Comparative Fit Index (CFI) 0.970
## Robust Tucker-Lewis Index (TLI) 0.943
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -7915.498 -7915.498
## Loglikelihood unrestricted model (H1) NA NA
##
## Akaike (AIC) 15856.995 15856.995
## Bayesian (BIC) 15916.811 15916.811
## Sample-size adjusted Bayesian (SABIC) 15875.532 15875.532
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.088 0.079
## 90 Percent confidence interval - lower 0.067 0.060
## 90 Percent confidence interval - upper 0.111 0.101
## P-value H_0: RMSEA <= 0.050 0.002 0.008
## P-value H_0: RMSEA >= 0.080 0.754 0.508
##
## Robust RMSEA 0.087
## 90 Percent confidence interval - lower 0.063
## 90 Percent confidence interval - upper 0.112
## P-value H_0: Robust RMSEA <= 0.050 0.006
## P-value H_0: Robust RMSEA >= 0.080 0.704
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.055 0.055
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emoreg.ed.lat =~
## emoreg.ed.1 1.150 0.068 16.840 0.000 1.150 0.628
## emoreg.ed.2 1.489 0.060 24.993 0.000 1.489 0.850
## emoreg.ed.3 1.400 0.059 23.621 0.000 1.400 0.819
## emoreg.ier.lat =~
## emoreg.ier.1 0.833 0.063 13.265 0.000 0.833 0.516
## emoreg.ier.2 1.454 0.068 21.364 0.000 1.454 0.875
## emoreg.ier.3 1.330 0.074 18.004 0.000 1.330 0.786
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## emoreg.ed.lat ~~
## emoreg.ier.lat 0.043 0.050 0.849 0.396 0.043 0.043
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .emoreg.ed.1 2.028 0.154 13.179 0.000 2.028 0.605
## .emoreg.ed.2 0.854 0.138 6.181 0.000 0.854 0.278
## .emoreg.ed.3 0.962 0.129 7.464 0.000 0.962 0.329
## .emoreg.ier.1 1.914 0.108 17.804 0.000 1.914 0.734
## .emoreg.ier.2 0.646 0.161 4.012 0.000 0.646 0.234
## .emoreg.ier.3 1.092 0.178 6.135 0.000 1.092 0.382
## emoreg.ed.lat 1.000 1.000 1.000
## emoreg.ier.lat 1.000 1.000 1.000
##
## R-Square:
## Estimate
## emoreg.ed.1 0.395
## emoreg.ed.2 0.722
## emoreg.ed.3 0.671
## emoreg.ier.1 0.266
## emoreg.ier.2 0.766
## emoreg.ier.3 0.618parameterEstimates(fit.2, standardized=TRUE) ## lhs op rhs est se z pvalue ci.lower ci.upper
## 1 emoreg.ed.lat =~ emoreg.ed.1 1.150 0.068 16.840 0.000 1.016 1.284
## 2 emoreg.ed.lat =~ emoreg.ed.2 1.489 0.060 24.993 0.000 1.372 1.605
## 3 emoreg.ed.lat =~ emoreg.ed.3 1.400 0.059 23.621 0.000 1.284 1.517
## 4 emoreg.ier.lat =~ emoreg.ier.1 0.833 0.063 13.265 0.000 0.710 0.956
## 5 emoreg.ier.lat =~ emoreg.ier.2 1.454 0.068 21.364 0.000 1.321 1.588
## 6 emoreg.ier.lat =~ emoreg.ier.3 1.330 0.074 18.004 0.000 1.185 1.475
## 7 emoreg.ed.1 ~~ emoreg.ed.1 2.028 0.154 13.179 0.000 1.727 2.330
## 8 emoreg.ed.2 ~~ emoreg.ed.2 0.854 0.138 6.181 0.000 0.583 1.125
## 9 emoreg.ed.3 ~~ emoreg.ed.3 0.962 0.129 7.464 0.000 0.710 1.215
## 10 emoreg.ier.1 ~~ emoreg.ier.1 1.914 0.108 17.804 0.000 1.703 2.125
## 11 emoreg.ier.2 ~~ emoreg.ier.2 0.646 0.161 4.012 0.000 0.330 0.962
## 12 emoreg.ier.3 ~~ emoreg.ier.3 1.092 0.178 6.135 0.000 0.743 1.441
## 13 emoreg.ed.lat ~~ emoreg.ed.lat 1.000 0.000 NA NA 1.000 1.000
## 14 emoreg.ier.lat ~~ emoreg.ier.lat 1.000 0.000 NA NA 1.000 1.000
## 15 emoreg.ed.lat ~~ emoreg.ier.lat 0.043 0.050 0.849 0.396 -0.056 0.141
## std.lv std.all
## 1 1.150 0.628
## 2 1.489 0.850
## 3 1.400 0.819
## 4 0.833 0.516
## 5 1.454 0.875
## 6 1.330 0.786
## 7 2.028 0.605
## 8 0.854 0.278
## 9 0.962 0.329
## 10 1.914 0.734
## 11 0.646 0.234
## 12 1.092 0.382
## 13 1.000 1.000
## 14 1.000 1.000
## 15 0.043 0.043Factor loadings
library(dplyr)
library(tidyr)
library(knitr)
options(knitr.kable.NA = '')
parameterEstimates(fit.2, standardized=TRUE) %>%
filter(op == "=~") %>%
select('Latent Factor'=lhs, Indicator=rhs, B=est, SE=se, Z=z, 'p-value'= pvalue, Beta=std.all) %>%
kable(digits = 3, format="pandoc", caption="Factor Loadings")| Latent Factor | Indicator | B | SE | Z | p-value | Beta |
|---|---|---|---|---|---|---|
| emoreg.ed.lat | emoreg.ed.1 | 1.150 | 0.068 | 16.840 | 0 | 0.628 |
| emoreg.ed.lat | emoreg.ed.2 | 1.489 | 0.060 | 24.993 | 0 | 0.850 |
| emoreg.ed.lat | emoreg.ed.3 | 1.400 | 0.059 | 23.621 | 0 | 0.819 |
| emoreg.ier.lat | emoreg.ier.1 | 0.833 | 0.063 | 13.265 | 0 | 0.516 |
| emoreg.ier.lat | emoreg.ier.2 | 1.454 | 0.068 | 21.364 | 0 | 0.875 |
| emoreg.ier.lat | emoreg.ier.3 | 1.330 | 0.074 | 18.004 | 0 | 0.786 |
Modification indices
mod_ind <- modificationindices(fit.2)
head(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], 10) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 24 emoreg.ed.1 ~~ emoreg.ier.1 31.125 0.441 0.441 0.224 0.224
## 16 emoreg.ed.lat =~ emoreg.ier.1 17.022 0.238 0.238 0.147 0.147
## 36 emoreg.ier.2 ~~ emoreg.ier.3 17.016 12.953 12.953 15.417 15.417
## 25 emoreg.ed.1 ~~ emoreg.ier.2 9.196 -0.196 -0.196 -0.171 -0.171
## 23 emoreg.ed.1 ~~ emoreg.ed.3 6.174 3.288 3.288 2.353 2.353
## 20 emoreg.ier.lat =~ emoreg.ed.2 6.173 0.130 0.130 0.074 0.074
## 34 emoreg.ier.1 ~~ emoreg.ier.2 3.272 -1.956 -1.956 -1.759 -1.759
## 18 emoreg.ed.lat =~ emoreg.ier.3 3.271 -0.092 -0.092 -0.054 -0.054
## 29 emoreg.ed.2 ~~ emoreg.ier.2 3.226 0.094 0.094 0.127 0.127
## 21 emoreg.ier.lat =~ emoreg.ed.3 2.816 -0.085 -0.085 -0.050 -0.050subset(mod_ind[order(mod_ind$mi, decreasing=TRUE), ], mi > 5) ## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 24 emoreg.ed.1 ~~ emoreg.ier.1 31.125 0.441 0.441 0.224 0.224
## 16 emoreg.ed.lat =~ emoreg.ier.1 17.022 0.238 0.238 0.147 0.147
## 36 emoreg.ier.2 ~~ emoreg.ier.3 17.016 12.953 12.953 15.417 15.417
## 25 emoreg.ed.1 ~~ emoreg.ier.2 9.196 -0.196 -0.196 -0.171 -0.171
## 23 emoreg.ed.1 ~~ emoreg.ed.3 6.174 3.288 3.288 2.353 2.353
## 20 emoreg.ier.lat =~ emoreg.ed.2 6.173 0.130 0.130 0.074 0.074Variance-Covariance-Matrix
inspect(fit.2, "sampstat")$cov ## emrg.d.1 emrg.d.2 emrg.d.3 emrg.r.1 emrg.r.2 emrg.r.3
## emoreg.ed.1 3.350
## emoreg.ed.2 1.709 3.071
## emoreg.ed.3 1.615 2.084 2.923
## emoreg.ier.1 0.578 0.389 0.241 2.608
## emoreg.ier.2 -0.105 0.187 0.010 1.208 2.761
## emoreg.ier.3 -0.100 0.072 -0.071 1.106 1.935 2.861fitted(fit.2)$cov ## emrg.d.1 emrg.d.2 emrg.d.3 emrg.r.1 emrg.r.2 emrg.r.3
## emoreg.ed.1 3.350
## emoreg.ed.2 1.712 3.071
## emoreg.ed.3 1.610 2.085 2.923
## emoreg.ier.1 0.041 0.053 0.050 2.608
## emoreg.ier.2 0.071 0.092 0.087 1.211 2.761
## emoreg.ier.3 0.065 0.084 0.079 1.108 1.934 2.861Standardized residuals
cov_table <- resid(fit.2, type="standardized")$cov
cov_table[upper.tri(cov_table)] <- NA
diag(cov_table) <- NA
kable(cov_table, digits=2) | emoreg.ed.1 | emoreg.ed.2 | emoreg.ed.3 | emoreg.ier.1 | emoreg.ier.2 | emoreg.ier.3 | |
|---|---|---|---|---|---|---|
| emoreg.ed.1 | ||||||
| emoreg.ed.2 | -1.49 | |||||
| emoreg.ed.3 | 2.27 | -1.17 | ||||
| emoreg.ier.1 | 4.78 | 3.47 | 1.98 | |||
| emoreg.ier.2 | -1.89 | 1.74 | -1.26 | -1.60 | ||
| emoreg.ier.3 | -1.68 | -0.16 | -1.94 | -0.39 | 3.71 |
2.5.1.3.1 Plot CFA - 2 factor solution
Load package
library(semPlot)semPaths(fit.2, rotation = 2, nodeLabels=1:6)
Create the vector for the node labels
nodeLabels <- c("1", "2", "3",
"4", "5", "6",
"emotional suppression",
"emotional integration"
)Create a character vector for the order of latent variables
latents <- c("emoreg.ed.lat", "emoreg.ier.lat")Plot
semPaths(fit.2,
style = "lisrel",
whatLabels = "std.all",
nCharNodes = 0,
rotation = 2,
layout = "tree3",
curvePivot = TRUE,
curvePivotShape = 2.1,
edge.label.cex = .5,
cardinal = TRUE,
sizeMan = 5,
sizeMan2 = 2,
sizeLat =10,
sizeLat2 = 10,
nodeLabels = nodeLabels,
latents = latents
)
2.5.1.4 Comparing CFAs
2.5.1.4.1 1 factor vs. 2 factor
lavTestLRT(fit.1, fit.2)##
## Scaled Chi-Squared Difference Test (method = "satorra.bentler.2001")
##
## lavaan->lavTestLRT():
## lavaan NOTE: The "Chisq" column contains standard test statistics, not the
## robust test that should be reported per model. A robust difference test is
## a function of two standard (not robust) statistics.
##
## Df AIC BIC Chisq Chisq diff RMSEA Df diff Pr(>Chisq)
## fit.2 8 15857 15917 54.012
## fit.1 9 16494 16550 693.451 453.05 0.93107 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> 2-factor solution fits better
2.6 Nature connectedness
data$natcon <- rowMeans (data [c("natcon.1", "natcon.2", "natcon.3", "natcon.4", "natcon.5",
"natcon.6")])2.6.1 EFA
2.6.1.1 Correlations
between items to inspect for high item-inter-correlations
corr.test (data [,c("natcon.1", "natcon.2", "natcon.3", "natcon.4", "natcon.5",
"natcon.6")],
method = "spearman")## Call:corr.test(x = data[, c("natcon.1", "natcon.2", "natcon.3", "natcon.4",
## "natcon.5", "natcon.6")], method = "spearman")
## Correlation matrix
## natcon.1 natcon.2 natcon.3 natcon.4 natcon.5 natcon.6
## natcon.1 1.00 0.54 0.71 0.65 0.70 0.55
## natcon.2 0.54 1.00 0.60 0.53 0.53 0.48
## natcon.3 0.71 0.60 1.00 0.81 0.83 0.63
## natcon.4 0.65 0.53 0.81 1.00 0.85 0.72
## natcon.5 0.70 0.53 0.83 0.85 1.00 0.70
## natcon.6 0.55 0.48 0.63 0.72 0.70 1.00
## Sample Size
## natcon.1 natcon.2 natcon.3 natcon.4 natcon.5 natcon.6
## natcon.1 770 765 766 766 767 769
## natcon.2 765 768 764 765 765 767
## natcon.3 766 764 769 765 766 768
## natcon.4 766 765 765 769 766 768
## natcon.5 767 765 766 766 770 769
## natcon.6 769 767 768 768 769 772
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## natcon.1 natcon.2 natcon.3 natcon.4 natcon.5 natcon.6
## natcon.1 0 0 0 0 0 0
## natcon.2 0 0 0 0 0 0
## natcon.3 0 0 0 0 0 0
## natcon.4 0 0 0 0 0 0
## natcon.5 0 0 0 0 0 0
## natcon.6 0 0 0 0 0 0
##
## To see confidence intervals of the correlations, print with the short=FALSE option-> looks good
Subset with PEB-items
subset.natcon <- data[c("natcon.1", "natcon.2", "natcon.3", "natcon.4", "natcon.5",
"natcon.6")]
View(subset.natcon)2.6.1.2 Kaiser-Maier-Olkin coefficient
KMO(subset.natcon)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = subset.natcon)
## Overall MSA = 0.9
## MSA for each item =
## natcon.1 natcon.2 natcon.3 natcon.4 natcon.5 natcon.6
## 0.94 0.93 0.88 0.88 0.87 0.92options(max.print=1000000)-> KMO=.90
2.6.1.3 Extracting factors and parallel analysis
Scree Plot
VSS.scree (subset.natcon)
Parallel analysis (Horn)
parallel.natcon <- fa.parallel (subset.natcon, fm="pa", fa = "fa")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAEigenvalues of factors
parallel.natcon$fa.values## [1] 3.98986929 0.15768094 0.02033085 -0.01748942 -0.06696270 -0.093871812.6.1.4 Factor analysis with fixed number of factors = 2
as suggested by parallel analysis
fa.pa.promax.natcon <- fa(subset.natcon, 2, fm = "pa", rotate = "Promax")
print (fa.pa.promax.natcon, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.natcon, nfactors = 2, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item PA1 PA2 h2 u2 com
## natcon.4 4 0.88 0.88 0.12 1.0
## natcon.6 6 0.72 0.58 0.42 1.0
## natcon.5 5 0.70 0.85 0.15 1.3
## natcon.1 1 0.70 0.64 0.36 1.1
## natcon.2 2 0.63 0.46 0.54 1.0
## natcon.3 3 0.33 0.63 0.83 0.17 1.5
##
## PA1 PA2
## SS loadings 2.40 1.84
## Proportion Var 0.40 0.31
## Cumulative Var 0.40 0.71
## Proportion Explained 0.57 0.43
## Cumulative Proportion 0.57 1.00
##
## With factor correlations of
## PA1 PA2
## PA1 1.00 0.79
## PA2 0.79 1.00
##
## Mean item complexity = 1.1
## Test of the hypothesis that 2 factors are sufficient.
##
## df null model = 15 with the objective function = 4.63 with Chi Square = 3563.5
## df of the model are 4 and the objective function was 0.05
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic n.obs is 767 with the empirical chi square 2.52 with prob < 0.64
## The total n.obs was 773 with Likelihood Chi Square = 36.7 with prob < 2.1e-07
##
## Tucker Lewis Index of factoring reliability = 0.965
## RMSEA index = 0.103 and the 90 % confidence intervals are 0.074 0.135
## BIC = 10.1
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA1 PA2
## Correlation of (regression) scores with factors 0.74 0.70
## Multiple R square of scores with factors 0.55 0.49
## Minimum correlation of possible factor scores 0.10 -0.02-> one cross-loading item
2.6.1.5 Visualizing results
fa.diagram(fa.pa.promax.natcon, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.natcon, simple=FALSE, cut=.4, digits=2)2.6.1.6 Factor analysis with fixed number of factors = 1
as suggested by scree plot and Eigenvalues
fa.pa.promax.natcon <- fa(subset.natcon, 1, fm = "pa", rotate = "Promax")
print (fa.pa.promax.natcon, digits = 2, cut = .3, sort = TRUE) ## Factor Analysis using method = pa
## Call: fa(r = subset.natcon, nfactors = 1, rotate = "Promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## V PA1 h2 u2 com
## natcon.5 5 0.92 0.84 0.16 1
## natcon.4 4 0.90 0.81 0.19 1
## natcon.3 3 0.90 0.81 0.19 1
## natcon.1 1 0.76 0.57 0.43 1
## natcon.6 6 0.74 0.54 0.46 1
## natcon.2 2 0.64 0.41 0.59 1
##
## PA1
## SS loadings 3.99
## Proportion Var 0.66
##
## Mean item complexity = 1
## Test of the hypothesis that 1 factor is sufficient.
##
## df null model = 15 with the objective function = 4.63 with Chi Square = 3563.5
## df of the model are 9 and the objective function was 0.17
##
## The root mean square of the residuals (RMSR) is 0.04
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic n.obs is 767 with the empirical chi square 14.9 with prob < 0.094
## The total n.obs was 773 with Likelihood Chi Square = 132.77 with prob < 3.2e-24
##
## Tucker Lewis Index of factoring reliability = 0.942
## RMSEA index = 0.133 and the 90 % confidence intervals are 0.114 0.154
## BIC = 72.91
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA1
## Correlation of (regression) scores with factors 0.97
## Multiple R square of scores with factors 0.94
## Minimum correlation of possible factor scores 0.892.6.1.7 Visualizing results
fa.diagram(fa.pa.promax.natcon, simple=TRUE, cut=.4, digits=2)
fa.diagram(fa.pa.promax.natcon, simple=FALSE, cut=.4, digits=2)2.7 Socio-demographics
2.7.1 Gender
# Dummy-code gender (0 = male, 1 = non-male)
data$gender.d <- car::recode (data$gender, '3=1; 2=0')2.7.2 Study program
original coding in accordance with national high school programs: Higher education preparatory programs: 1 - Ekonomi (Economics) 2 - Estetik (Aesthetics) 3 - Humanities 4 - Naturvetenskap (Natural Science) 5 - Samhällsvetenskap (Social Science) 6 - Teknik (Technology)
vocational programs: 7 – Barn och fritid (Children and Leisure) 8 – Bygg och anläggning (Construction and Civil Engineering) 9 – El och energi (Electrical and Energy) 10 – Fordon och transport (Vehicle and Transport) 11 – Försäljning och service (Sales and Service) 12 – Hantverk (Craft) 13 – Frisör och stylist (Hairdresser and Stylist) 14 – Hotell och turism (Hotel and Tourism) 15 – Industriteknik (Industrial Technology) 16 – Naturbruk (Agriculture and Nature Management) 17 – Restaurang och livsmedel (Restaurant and Food) 18 – VVS och fastighet (HVAC and Property Maintenance) 19 – Vård och omsorg (Health and Social Care)
New coding to describe participants: 1 - Higher education preparatory programs 2 - Occupational programs
data$pro.uni <- car::recode (data$pro, '1=1; 2=1; 3=1; 4=1; 5=1; 6=1;
7=2; 8=2; 9=2; 10=2; 11=2; 12=2; 13=2; 14=2; 15=2; 16=2;
17=2; 18=2; 19=2')3 Descriptives and distributions
3.1 Overall scores
subset <- subset (data, select = c(anx,
sad,
ang,
indif,
emo,
peb,
peb.others,
peb.own,
futpeb,
cas.ce,
cas.f,
emp.pt,
emp.ec,
emoreg.ier,
emoreg.ed,
natcon,
age))
describe (subset)## vars n mean sd median trimmed mad min max range skew
## anx 1 770 2.38 1.26 2.00 2.26 1.48 1 6.00 5.00 0.58
## sad 2 773 2.76 1.37 3.00 2.67 1.48 1 6.00 5.00 0.42
## ang 3 771 2.80 1.38 3.00 2.70 1.48 1 6.00 5.00 0.44
## indif 4 773 2.91 1.34 3.00 2.83 1.48 1 6.00 5.00 0.40
## emo 5 768 2.65 1.18 2.67 2.58 1.48 1 6.00 5.00 0.38
## peb 6 740 2.67 0.78 2.62 2.66 0.80 1 4.85 3.85 0.04
## peb.others 7 761 1.84 0.84 1.60 1.72 0.89 1 5.00 4.00 1.03
## peb.own 8 749 3.29 0.90 3.43 3.35 0.85 1 5.00 4.00 -0.57
## futpeb 9 763 2.35 0.89 2.25 2.30 0.74 1 5.00 4.00 0.51
## cas.ce 10 751 1.26 0.46 1.00 1.14 0.00 1 3.38 2.38 2.36
## cas.f 11 761 1.21 0.47 1.00 1.08 0.00 1 4.00 3.00 2.71
## emp.pt 12 740 3.49 0.78 3.50 3.52 0.74 1 5.00 4.00 -0.36
## emp.ec 13 739 3.65 0.76 3.75 3.67 0.74 1 5.00 4.00 -0.41
## emoreg.ier 14 747 4.13 1.36 4.33 4.16 1.48 1 7.00 6.00 -0.19
## emoreg.ed 15 749 4.42 1.49 4.33 4.44 1.48 1 7.00 6.00 -0.16
## natcon 16 754 4.76 1.32 4.83 4.82 1.24 1 7.00 6.00 -0.36
## age 17 773 16.27 0.48 16.00 16.20 0.00 15 18.00 3.00 1.18
## kurtosis se
## anx -0.53 0.05
## sad -0.69 0.05
## ang -0.57 0.05
## indif -0.47 0.05
## emo -0.62 0.04
## peb -0.24 0.03
## peb.others 0.59 0.03
## peb.own -0.08 0.03
## futpeb -0.14 0.03
## cas.ce 5.49 0.02
## cas.f 7.40 0.02
## emp.pt 0.09 0.03
## emp.ec 0.19 0.03
## emoreg.ier -0.44 0.05
## emoreg.ed -0.68 0.05
## natcon -0.32 0.05
## age 0.53 0.023.2 Climate emotions
subset.climemo.descr <- subset (data, select = c(anx, sad, ang, indif, emo))
describe (subset.climemo.descr)## vars n mean sd median trimmed mad min max range skew kurtosis se
## anx 1 770 2.38 1.26 2.00 2.26 1.48 1 6 5 0.58 -0.53 0.05
## sad 2 773 2.76 1.37 3.00 2.67 1.48 1 6 5 0.42 -0.69 0.05
## ang 3 771 2.80 1.38 3.00 2.70 1.48 1 6 5 0.44 -0.57 0.05
## indif 4 773 2.91 1.34 3.00 2.83 1.48 1 6 5 0.40 -0.47 0.05
## emo 5 768 2.65 1.18 2.67 2.58 1.48 1 6 5 0.38 -0.62 0.043.2.1 Distribution Climate anxiety
par(mfrow = c(1, 2))
plotNormalHistogram(data$anx)
qqnorm(data$anx,
ylab="Sample Quantiles for anx")
qqline(data$anx,
col="red")
describe(data$anx)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 770 2.38 1.26 2 2.38 1.48 1 6 5 0.58 -0.53 0.05shapiro.test (data$anx)##
## Shapiro-Wilk normality test
##
## data: data$anx
## W = 0.87609, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.2.2 Distribution Climate sadness
par(mfrow = c(1, 2))
plotNormalHistogram(data$sad)
qqnorm(data$sad,
ylab="Sample Quantiles for sad")
qqline(data$sad,
col="red")
describe(data$sad)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 773 2.76 1.37 3 2.76 1.48 1 6 5 0.42 -0.69 0.05shapiro.test (data$sad)##
## Shapiro-Wilk normality test
##
## data: data$sad
## W = 0.91117, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.2.3 Distribution Climate anger
par(mfrow = c(1, 2))
plotNormalHistogram(data$ang)
qqnorm(data$ang,
ylab="Sample Quantiles for ang")
qqline(data$ang,
col="red")
describe(data$ang)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 771 2.8 1.38 3 2.8 1.48 1 6 5 0.44 -0.57 0.05shapiro.test (data$ang)##
## Shapiro-Wilk normality test
##
## data: data$ang
## W = 0.91338, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.2.4 Distribution Climate indifference
par(mfrow = c(1, 2))
plotNormalHistogram(data$indif)
qqnorm(data$indif,
ylab="Sample Quantiles for indif")
qqline(data$indif,
col="red")
describe(data$indif)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 773 2.91 1.34 3 2.91 1.48 1 6 5 0.4 -0.47 0.05shapiro.test (data$indif)##
## Shapiro-Wilk normality test
##
## data: data$indif
## W = 0.92259, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.2.5 Distribution Climate emotions
par(mfrow = c(1, 2))
plotNormalHistogram(data$emo)
qqnorm(data$emo,
ylab="Sample Quantiles for emo")
qqline(data$emo,
col="red")
describe(data$emo)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 768 2.65 1.18 2.67 2.58 1.48 1 6 5 0.38 -0.62 0.04shapiro.test (data$emo)##
## Shapiro-Wilk normality test
##
## data: data$emo
## W = 0.95503, p-value = 1.425e-14par(mfrow = c(1, 1)) 3.3 PEB
subset.peb.descr <- subset (data, select = c(peb, peb.others, peb.own, futpeb))
describe (subset.peb.descr)## vars n mean sd median trimmed mad min max range skew kurtosis
## peb 1 740 2.67 0.78 2.62 2.66 0.80 1 4.85 3.85 0.04 -0.24
## peb.others 2 761 1.84 0.84 1.60 1.72 0.89 1 5.00 4.00 1.03 0.59
## peb.own 3 749 3.29 0.90 3.43 3.35 0.85 1 5.00 4.00 -0.57 -0.08
## futpeb 4 763 2.35 0.89 2.25 2.30 0.74 1 5.00 4.00 0.51 -0.14
## se
## peb 0.03
## peb.others 0.03
## peb.own 0.03
## futpeb 0.033.3.1 Distribution PEB
par(mfrow = c(1, 2))
plotNormalHistogram(data$peb)
qqnorm(data$peb,
ylab="Sample Quantiles for peb")
qqline(data$peb,
col="red")
describe(data$peb)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 740 2.67 0.78 2.62 2.66 0.8 1 4.85 3.85 0.04 -0.24 0.03shapiro.test (data$peb)##
## Shapiro-Wilk normality test
##
## data: data$peb
## W = 0.99263, p-value = 0.001009par(mfrow = c(1, 1)) 3.3.2 Distribution Influencing others’ PEB
par(mfrow = c(1, 2))
plotNormalHistogram(data$peb.others)
qqnorm(data$peb.others,
ylab="Sample Quantiles for peb.others")
qqline(data$peb.others,
col="red")
describe(data$peb.others)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 761 1.84 0.84 1.6 1.72 0.89 1 5 4 1.03 0.59 0.03shapiro.test (data$peb.others)##
## Shapiro-Wilk normality test
##
## data: data$peb.others
## W = 0.87772, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.3.3 Distribution Own PEB
par(mfrow = c(1, 2))
plotNormalHistogram(data$peb.own)
qqnorm(data$peb.own,
ylab="Sample Quantiles for peb.own")
qqline(data$peb.own,
col="red")
describe(data$peb.own)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 749 3.29 0.9 3.43 3.35 0.85 1 5 4 -0.57 -0.08 0.03shapiro.test (data$peb.own)##
## Shapiro-Wilk normality test
##
## data: data$peb.own
## W = 0.96743, p-value = 7.275e-12par(mfrow = c(1, 1)) 3.3.4 Distribution Future PEB
par(mfrow = c(1, 2))
plotNormalHistogram(data$futpeb)
qqnorm(data$futpeb,
ylab="Sample Quantiles for futpeb")
qqline(data$futpeb,
col="red")
describe(data$futpeb)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 763 2.35 0.89 2.25 2.3 0.74 1 5 4 0.51 -0.14 0.03shapiro.test (data$futpeb)##
## Shapiro-Wilk normality test
##
## data: data$futpeb
## W = 0.96363, p-value = 7.807e-13par(mfrow = c(1, 1)) 3.4 Climate anxiety-related impairment
subset.cas.descr <- subset (data, select = c(cas.ce, cas.f))
describe (subset.cas.descr)## vars n mean sd median trimmed mad min max range skew kurtosis se
## cas.ce 1 751 1.26 0.46 1 1.14 0 1 3.38 2.38 2.36 5.49 0.02
## cas.f 2 761 1.21 0.47 1 1.08 0 1 4.00 3.00 2.71 7.40 0.023.4.1 Distribution Cognitive-emotional impairment
par(mfrow = c(1, 2))
plotNormalHistogram(data$cas.ce)
qqnorm(data$cas.ce,
ylab="Sample Quantiles for cas.ce")
qqline(data$cas.ce,
col="red")
describe(data$cas.ce)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 751 1.26 0.46 1 1.14 0 1 3.38 2.38 2.36 5.49 0.02shapiro.test (data$cas.ce)##
## Shapiro-Wilk normality test
##
## data: data$cas.ce
## W = 0.62516, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.4.2 Distribution Functional impairment
par(mfrow = c(1, 2))
plotNormalHistogram(data$cas.f)
qqnorm(data$cas.f,
ylab="Sample Quantiles for cas.f")
qqline(data$cas.f,
col="red")
describe(data$cas.f)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 761 1.21 0.47 1 1.08 0 1 4 3 2.71 7.4 0.02shapiro.test (data$cas.f)##
## Shapiro-Wilk normality test
##
## data: data$cas.f
## W = 0.51895, p-value < 2.2e-16par(mfrow = c(1, 1)) 3.5 Empathy
subset.emp.descr <- subset (data, select = c(emp.pt, emp.ec))
describe (subset.emp.descr)## vars n mean sd median trimmed mad min max range skew kurtosis se
## emp.pt 1 740 3.49 0.78 3.50 3.52 0.74 1 5 4 -0.36 0.09 0.03
## emp.ec 2 739 3.65 0.76 3.75 3.67 0.74 1 5 4 -0.41 0.19 0.033.5.1 Distribution Perspective taking
par(mfrow = c(1, 2))
plotNormalHistogram(data$emp.pt)
qqnorm(data$emp.pt,
ylab="Sample Quantiles for emp.pt")
qqline(data$emp.pt,
col="red")
describe(data$emp.pt)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 740 3.49 0.78 3.5 3.52 0.74 1 5 4 -0.36 0.09 0.03shapiro.test (data$emp.pt)##
## Shapiro-Wilk normality test
##
## data: data$emp.pt
## W = 0.97923, p-value = 9.479e-09par(mfrow = c(1, 1)) 3.5.2 Distribution Empathic concern
par(mfrow = c(1, 2))
plotNormalHistogram(data$emp.ec)
qqnorm(data$emp.ec,
ylab="Sample Quantiles for emp.ec")
qqline(data$emp.ec,
col="red")
describe(data$emp.ec)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 739 3.65 0.76 3.75 3.67 0.74 1 5 4 -0.41 0.19 0.03shapiro.test (data$emp.ec)##
## Shapiro-Wilk normality test
##
## data: data$emp.ec
## W = 0.97378, p-value = 3.051e-10par(mfrow = c(1, 1)) 3.6 Emotion-focused coping
subset.emoreg.descr <- subset (data, select = c(emoreg.ier, emoreg.ed))
describe (subset.emoreg.descr)## vars n mean sd median trimmed mad min max range skew kurtosis
## emoreg.ier 1 747 4.13 1.36 4.33 4.16 1.48 1 7 6 -0.19 -0.44
## emoreg.ed 2 749 4.42 1.49 4.33 4.44 1.48 1 7 6 -0.16 -0.68
## se
## emoreg.ier 0.05
## emoreg.ed 0.053.6.1 Distribution Emotional integration
par(mfrow = c(1, 2))
plotNormalHistogram(data$emoreg.ier)
qqnorm(data$emoreg.ier,
ylab="Sample Quantiles for emoreg.ier")
qqline(data$emoreg.ier,
col="red")
describe(data$emoreg.ier)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 747 4.13 1.36 4.33 4.16 1.48 1 7 6 -0.19 -0.44 0.05shapiro.test (data$emoreg.ier)##
## Shapiro-Wilk normality test
##
## data: data$emoreg.ier
## W = 0.98511, p-value = 6.793e-07par(mfrow = c(1, 1)) 3.6.2 Distribution emotional suppression
par(mfrow = c(1, 2))
plotNormalHistogram(data$emoreg.ed)
qqnorm(data$emoreg.ed,
ylab="Sample Quantiles for emoreg.ed")
qqline(data$emoreg.ed,
col="red")
describe(data$emoreg.ed)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 749 4.42 1.49 4.33 4.44 1.48 1 7 6 -0.16 -0.68 0.05shapiro.test (data$emoreg.ed)##
## Shapiro-Wilk normality test
##
## data: data$emoreg.ed
## W = 0.97711, p-value = 1.938e-09par(mfrow = c(1, 1)) 3.7 Nature connectedness
par(mfrow = c(1, 2))
plotNormalHistogram(data$natcon)
qqnorm(data$natcon,
ylab="Sample Quantiles for natcon")
qqline(data$natcon,
col="red")
describe(data$natcon)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 754 4.76 1.32 4.83 4.82 1.24 1 7 6 -0.36 -0.32 0.05shapiro.test (data$natcon)##
## Shapiro-Wilk normality test
##
## data: data$natcon
## W = 0.97859, p-value = 4.667e-09par(mfrow = c(1, 1)) 3.8 Socio-demographics
describe (data$age)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 773 16.27 0.48 16 16.2 0 15 18 3 1.18 0.53 0.02table (data$gender)##
## 1 2 3
## 428 333 11prop.table (table (data$gender))##
## 1 2 3
## 0.5544041 0.4313472 0.0142487table (data$gender.d)##
## 0 1
## 333 439prop.table (table (data$gender.d))##
## 0 1
## 0.4313472 0.5686528table (data$pro)##
## 1 2 3 4 5 6 7 8 9 10 12 13 14 15 17 18 19
## 69 66 11 141 239 101 11 14 14 17 8 6 16 17 22 6 10prop.table (table (data$pro))##
## 1 2 3 4 5 6 7
## 0.08984375 0.08593750 0.01432292 0.18359375 0.31119792 0.13151042 0.01432292
## 8 9 10 12 13 14 15
## 0.01822917 0.01822917 0.02213542 0.01041667 0.00781250 0.02083333 0.02213542
## 17 18 19
## 0.02864583 0.00781250 0.013020833.8.1 Distribution Age
par(mfrow = c(1, 2)) # Split the plotting panel into a 1 x 2 grid
plotNormalHistogram(data$age)
qqnorm(data$age,
ylab="Sample Quantiles for age")
qqline(data$age,
col="red")
describe(data$age)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 773 16.27 0.48 16 16.2 0 15 18 3 1.18 0.53 0.02shapiro.test (data$age)##
## Shapiro-Wilk normality test
##
## data: data$age
## W = 0.59786, p-value < 2.2e-16par(mfrow = c(1, 1)) # Return plotting panel to 1 section4 Reliability
library(MBESS)##
## Attaching package: 'MBESS'## The following object is masked from 'package:lavaan':
##
## cor2cov## The following object is masked from 'package:psych':
##
## cor2cov4.1 Climate emotions
psych::alpha (data[c("anx", "sad", "ang")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("anx", "sad", "ang")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.86 0.8 0.67 6 0.0089 2.6 1.2 0.67
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.84 0.86 0.87
## Duhachek 0.84 0.86 0.87
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## anx 0.81 0.81 0.68 0.68 4.3 0.014 NA 0.68
## sad 0.78 0.78 0.64 0.64 3.6 0.016 NA 0.64
## ang 0.80 0.81 0.67 0.67 4.1 0.014 NA 0.67
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## anx 770 0.87 0.88 0.77 0.72 2.4 1.3
## sad 773 0.89 0.89 0.81 0.75 2.8 1.4
## ang 771 0.88 0.88 0.78 0.73 2.8 1.4
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## anx 0.33 0.24 0.23 0.15 0.05 0.01 0
## sad 0.21 0.27 0.22 0.19 0.09 0.03 0
## ang 0.21 0.24 0.26 0.17 0.08 0.04 0ci.reliability((data[c("anx", "sad", "ang")]),type='omega') ## $est
## [1] 0.8581211
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.2 PEB
4.2.1 PEB
psych::alpha (data[c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.11", "peb.12", "peb.13")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
## "peb.6", "peb.7", "peb.8", "peb.9", "peb.10", "peb.11", "peb.12",
## "peb.13")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.89 0.89 0.9 0.38 8 0.0061 2.7 0.78 0.37
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.87 0.89 0.9
## Duhachek 0.87 0.89 0.9
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## peb.1 0.87 0.88 0.89 0.37 7.2 0.0067 0.015 0.37
## peb.2 0.88 0.88 0.90 0.38 7.4 0.0066 0.020 0.36
## peb.3 0.88 0.89 0.90 0.40 7.9 0.0062 0.017 0.39
## peb.4 0.88 0.88 0.90 0.38 7.4 0.0066 0.019 0.36
## peb.5 0.88 0.88 0.90 0.39 7.6 0.0064 0.019 0.38
## peb.6 0.88 0.89 0.90 0.40 8.0 0.0061 0.017 0.40
## peb.7 0.87 0.87 0.89 0.36 6.9 0.0069 0.013 0.36
## peb.8 0.87 0.88 0.89 0.37 7.1 0.0066 0.014 0.37
## peb.9 0.88 0.89 0.90 0.39 7.8 0.0063 0.017 0.39
## peb.10 0.88 0.88 0.89 0.38 7.3 0.0066 0.014 0.37
## peb.11 0.87 0.88 0.89 0.37 7.1 0.0068 0.017 0.36
## peb.12 0.88 0.88 0.90 0.38 7.4 0.0065 0.019 0.36
## peb.13 0.88 0.88 0.90 0.39 7.6 0.0065 0.019 0.38
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## peb.1 771 0.71 0.72 0.71 0.64 2.0 1.12
## peb.2 770 0.66 0.65 0.61 0.58 2.7 1.35
## peb.3 772 0.56 0.55 0.50 0.47 4.0 1.21
## peb.4 770 0.68 0.66 0.62 0.60 3.0 1.26
## peb.5 768 0.63 0.61 0.56 0.54 3.5 1.37
## peb.6 771 0.54 0.52 0.47 0.44 3.6 1.31
## peb.7 770 0.77 0.79 0.80 0.72 2.1 1.13
## peb.8 769 0.71 0.74 0.74 0.66 1.7 0.96
## peb.9 772 0.53 0.57 0.52 0.47 1.6 0.91
## peb.10 766 0.67 0.70 0.68 0.60 1.8 0.99
## peb.11 772 0.74 0.75 0.73 0.68 2.4 1.20
## peb.12 763 0.67 0.65 0.61 0.58 2.6 1.43
## peb.13 770 0.64 0.62 0.58 0.55 3.5 1.25
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## peb.1 0.45 0.25 0.20 0.07 0.04 0.00
## peb.2 0.26 0.19 0.25 0.18 0.13 0.00
## peb.3 0.06 0.09 0.13 0.28 0.44 0.00
## peb.4 0.16 0.19 0.28 0.24 0.13 0.00
## peb.5 0.14 0.10 0.18 0.28 0.30 0.01
## peb.6 0.10 0.12 0.20 0.26 0.32 0.00
## peb.7 0.38 0.28 0.20 0.09 0.04 0.00
## peb.8 0.53 0.28 0.13 0.04 0.02 0.01
## peb.9 0.65 0.22 0.09 0.03 0.02 0.00
## peb.10 0.53 0.25 0.15 0.05 0.02 0.01
## peb.11 0.32 0.23 0.27 0.13 0.05 0.00
## peb.12 0.30 0.22 0.19 0.13 0.16 0.01
## peb.13 0.10 0.11 0.22 0.31 0.26 0.00ci.reliability((data[c("peb.1", "peb.2", "peb.3", "peb.4", "peb.5",
"peb.6", "peb.7", "peb.8", "peb.9", "peb.10",
"peb.11", "peb.12", "peb.13")]),type='omega') ## $est
## [1] 0.8764384
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.2.2 Influencing others’ PEB
psych::alpha (data[c("peb.1",
"peb.7", "peb.8", "peb.9", "peb.10")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("peb.1", "peb.7", "peb.8", "peb.9", "peb.10")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.87 0.59 7.1 0.0069 1.8 0.84 0.55
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.86 0.88 0.89
## Duhachek 0.86 0.88 0.89
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## peb.1 0.86 0.86 0.83 0.61 6.2 0.0081 0.0120 0.60
## peb.7 0.82 0.83 0.80 0.54 4.8 0.0105 0.0134 0.54
## peb.8 0.83 0.83 0.82 0.55 5.0 0.0095 0.0181 0.53
## peb.9 0.88 0.89 0.87 0.66 7.8 0.0068 0.0084 0.69
## peb.10 0.84 0.84 0.83 0.57 5.4 0.0089 0.0206 0.55
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## peb.1 771 0.81 0.79 0.73 0.67 2.0 1.12
## peb.7 770 0.90 0.88 0.87 0.82 2.1 1.13
## peb.8 769 0.86 0.87 0.84 0.78 1.7 0.96
## peb.9 772 0.69 0.71 0.59 0.55 1.6 0.91
## peb.10 766 0.84 0.84 0.79 0.74 1.8 0.99
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## peb.1 0.45 0.25 0.20 0.07 0.04 0.00
## peb.7 0.38 0.28 0.20 0.09 0.04 0.00
## peb.8 0.53 0.28 0.13 0.04 0.02 0.01
## peb.9 0.65 0.22 0.09 0.03 0.02 0.00
## peb.10 0.53 0.25 0.15 0.05 0.02 0.01ci.reliability((data[c("peb.1",
"peb.7", "peb.8", "peb.9", "peb.10")]),type='omega')## $est
## [1] 0.8860026
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.2.3 Own PEB
psych::alpha (data[c("peb.2", "peb.3", "peb.4", "peb.5",
"peb.6",
"peb.12", "peb.13")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("peb.2", "peb.3", "peb.4", "peb.5", "peb.6",
## "peb.12", "peb.13")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.81 0.81 0.8 0.38 4.3 0.01 3.3 0.9 0.4
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.79 0.81 0.83
## Duhachek 0.79 0.81 0.83
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## peb.2 0.79 0.79 0.77 0.38 3.7 0.012 0.0052 0.40
## peb.3 0.79 0.79 0.76 0.38 3.7 0.012 0.0043 0.40
## peb.4 0.77 0.77 0.75 0.36 3.4 0.013 0.0051 0.37
## peb.5 0.78 0.79 0.77 0.38 3.7 0.012 0.0064 0.41
## peb.6 0.80 0.80 0.77 0.40 3.9 0.011 0.0036 0.41
## peb.12 0.79 0.79 0.77 0.39 3.9 0.012 0.0040 0.38
## peb.13 0.78 0.78 0.76 0.38 3.6 0.012 0.0055 0.40
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## peb.2 770 0.68 0.68 0.60 0.54 2.7 1.4
## peb.3 772 0.67 0.68 0.61 0.54 4.0 1.2
## peb.4 770 0.74 0.74 0.69 0.62 3.0 1.3
## peb.5 768 0.70 0.69 0.62 0.56 3.5 1.4
## peb.6 771 0.64 0.64 0.56 0.49 3.6 1.3
## peb.12 763 0.67 0.66 0.57 0.51 2.6 1.4
## peb.13 770 0.70 0.71 0.64 0.57 3.5 1.2
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## peb.2 0.26 0.19 0.25 0.18 0.13 0.00
## peb.3 0.06 0.09 0.13 0.28 0.44 0.00
## peb.4 0.16 0.19 0.28 0.24 0.13 0.00
## peb.5 0.14 0.10 0.18 0.28 0.30 0.01
## peb.6 0.10 0.12 0.20 0.26 0.32 0.00
## peb.12 0.30 0.22 0.19 0.13 0.16 0.01
## peb.13 0.10 0.11 0.22 0.31 0.26 0.00ci.reliability((data[c("peb.2", "peb.3", "peb.4", "peb.5",
"peb.6",
"peb.12", "peb.13")]),type='omega')## $est
## [1] 0.8113091
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.2.4 Future PEB
psych::alpha (data[c("futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.85 0.85 0.82 0.59 5.8 0.0091 2.4 0.88 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.83 0.85 0.87
## Duhachek 0.83 0.85 0.87
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## futpeb.1 0.87 0.87 0.81 0.68 6.4 0.0083 0.0015 0.68
## futpeb.2 0.80 0.80 0.75 0.58 4.1 0.0130 0.0173 0.54
## futpeb.3 0.77 0.78 0.71 0.54 3.5 0.0145 0.0089 0.50
## futpeb.4 0.80 0.80 0.74 0.57 4.0 0.0129 0.0090 0.54
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## futpeb.1 770 0.77 0.75 0.61 0.57 3.1 1.2
## futpeb.2 767 0.84 0.85 0.78 0.71 2.2 1.0
## futpeb.3 770 0.88 0.88 0.85 0.77 2.1 1.1
## futpeb.4 769 0.84 0.85 0.80 0.72 2.0 1.0
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## futpeb.1 0.11 0.18 0.39 0.18 0.15 0.00
## futpeb.2 0.29 0.36 0.24 0.07 0.03 0.01
## futpeb.3 0.32 0.36 0.20 0.09 0.03 0.00
## futpeb.4 0.37 0.35 0.19 0.08 0.02 0.01ci.reliability((data[c("futpeb.1", "futpeb.2", "futpeb.3", "futpeb.4")]),type='omega')## Warning: lavaan->lav_data_full():
## some cases are empty and will be ignored: 56.## $est
## [1] 0.8500385
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.4 Empathy
4.4.1 Perspective taking
psych::alpha (data[c("emp.pt.1", "emp.pt.2", "emp.pt.3", "emp.pt.4")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("emp.pt.1", "emp.pt.2", "emp.pt.3", "emp.pt.4")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.74 0.74 0.7 0.42 2.9 0.015 3.5 0.78 0.38
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.71 0.74 0.77
## Duhachek 0.72 0.74 0.77
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## emp.pt.1 0.71 0.71 0.64 0.45 2.4 0.017 2.5e-02 0.37
## emp.pt.2 0.73 0.73 0.66 0.47 2.7 0.016 1.8e-02 0.40
## emp.pt.3 0.64 0.64 0.54 0.37 1.8 0.022 8.7e-04 0.38
## emp.pt.4 0.64 0.65 0.55 0.38 1.8 0.022 6.6e-05 0.38
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## emp.pt.1 750 0.69 0.72 0.56 0.49 3.9 0.93
## emp.pt.2 747 0.67 0.70 0.52 0.45 3.8 0.91
## emp.pt.3 750 0.82 0.79 0.72 0.62 3.0 1.17
## emp.pt.4 751 0.81 0.79 0.71 0.61 3.3 1.11
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## emp.pt.1 0.02 0.07 0.18 0.49 0.25 0.03
## emp.pt.2 0.02 0.06 0.21 0.50 0.20 0.03
## emp.pt.3 0.13 0.21 0.30 0.27 0.09 0.03
## emp.pt.4 0.07 0.17 0.28 0.35 0.13 0.03ci.reliability((data[c("emp.pt.1", "emp.pt.2", "emp.pt.3", "emp.pt.4")]),type='omega') ## Warning: lavaan->lav_data_full():
## some cases are empty and will be ignored: 12 27 38 39 59 60 64 106 129 170
## 171 227 355 393 408 438 549 560 612 728.## $est
## [1] 0.7648369
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.4.2 Empathic concern
psych::alpha (data[c("emp.ec.1", "emp.ec.2.i", "emp.ec.3.i", "emp.ec.4.i")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("emp.ec.1", "emp.ec.2.i", "emp.ec.3.i",
## "emp.ec.4.i")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.68 0.69 0.63 0.35 2.2 0.019 3.6 0.76 0.36
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.64 0.68 0.72
## Duhachek 0.64 0.68 0.72
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## emp.ec.1 0.68 0.68 0.60 0.42 2.2 0.020 0.0046 0.39
## emp.ec.2.i 0.65 0.65 0.57 0.39 1.9 0.022 0.0092 0.35
## emp.ec.3.i 0.56 0.57 0.48 0.31 1.3 0.028 0.0092 0.35
## emp.ec.4.i 0.56 0.56 0.47 0.30 1.3 0.028 0.0093 0.32
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## emp.ec.1 748 0.66 0.65 0.44 0.36 3.4 1.10
## emp.ec.2.i 751 0.69 0.68 0.50 0.41 3.7 1.12
## emp.ec.3.i 749 0.76 0.77 0.66 0.54 3.6 1.05
## emp.ec.4.i 749 0.76 0.77 0.67 0.55 3.9 0.98
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## emp.ec.1 0.08 0.10 0.32 0.34 0.16 0.03
## emp.ec.2.i 0.04 0.15 0.16 0.41 0.25 0.03
## emp.ec.3.i 0.04 0.13 0.26 0.39 0.19 0.03
## emp.ec.4.i 0.02 0.07 0.18 0.41 0.31 0.03ci.reliability((data[c("emp.ec.1", "emp.ec.2.i", "emp.ec.3.i", "emp.ec.4.i")]),type='omega') ## Warning: lavaan->lav_data_full():
## some cases are empty and will be ignored: 12 27 38 39 59 60 64 106 129 170
## 171 227 355 393 408 438 549 560 612 728.## $est
## [1] 0.6882664
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.5 Emotion-focused coping
4.5.1 Emotional integration
psych::alpha (data[c("emoreg.ier.1", "emoreg.ier.2", "emoreg.ier.3")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("emoreg.ier.1", "emoreg.ier.2", "emoreg.ier.3")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.76 0.76 0.71 0.52 3.2 0.015 4.1 1.4 0.45
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.73 0.76 0.79
## Duhachek 0.74 0.76 0.79
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## emoreg.ier.1 0.82 0.82 0.69 0.69 4.5 0.013 NA 0.69
## emoreg.ier.2 0.58 0.58 0.41 0.41 1.4 0.030 NA 0.41
## emoreg.ier.3 0.62 0.62 0.45 0.45 1.7 0.027 NA 0.45
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## emoreg.ier.1 753 0.75 0.75 0.52 0.47 3.6 1.6
## emoreg.ier.2 758 0.87 0.87 0.80 0.69 4.3 1.7
## emoreg.ier.3 758 0.86 0.85 0.76 0.65 4.5 1.7
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## emoreg.ier.1 0.11 0.16 0.17 0.26 0.16 0.10 0.04 0.03
## emoreg.ier.2 0.06 0.10 0.17 0.23 0.20 0.15 0.10 0.02
## emoreg.ier.3 0.07 0.07 0.14 0.20 0.22 0.19 0.12 0.02ci.reliability((data[c("emoreg.ier.1", "emoreg.ier.2", "emoreg.ier.3")]),type='omega') ## Warning: lavaan->lav_data_full():
## some cases are empty and will be ignored: 22 39 64 106 107 171 390 408 577
## 590 668 745.## $est
## [1] 0.7852283
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.5.2 Emotional suppression
psych::alpha (data[c("emoreg.ed.1", "emoreg.ed.2", "emoreg.ed.3")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("emoreg.ed.1", "emoreg.ed.2", "emoreg.ed.3")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.81 0.81 0.75 0.58 4.2 0.012 4.4 1.5 0.53
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.78 0.81 0.83
## Duhachek 0.78 0.81 0.83
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## emoreg.ed.1 0.82 0.82 0.70 0.70 4.7 0.013 NA 0.70
## emoreg.ed.2 0.68 0.68 0.52 0.52 2.1 0.023 NA 0.52
## emoreg.ed.3 0.70 0.70 0.53 0.53 2.3 0.022 NA 0.53
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## emoreg.ed.1 752 0.81 0.80 0.62 0.57 4.2 1.8
## emoreg.ed.2 759 0.87 0.88 0.80 0.71 4.6 1.7
## emoreg.ed.3 760 0.86 0.87 0.79 0.69 4.5 1.7
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## emoreg.ed.1 0.08 0.15 0.15 0.17 0.18 0.16 0.12 0.03
## emoreg.ed.2 0.05 0.11 0.11 0.16 0.20 0.22 0.14 0.02
## emoreg.ed.3 0.04 0.11 0.13 0.19 0.20 0.20 0.14 0.02ci.reliability((data[c("emoreg.ed.1", "emoreg.ed.2", "emoreg.ed.3")]),type='omega') ## Warning: lavaan->lav_data_full():
## some cases are empty and will be ignored: 22 39 64 106 107 171 390 408 577
## 590 668 745.## $est
## [1] 0.8101828
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"4.6 Nature connectedness
psych::alpha (data[c("natcon.1", "natcon.2", "natcon.3", "natcon.4", "natcon.5",
"natcon.6")])##
## Reliability analysis
## Call: psych::alpha(x = data[c("natcon.1", "natcon.2", "natcon.3", "natcon.4",
## "natcon.5", "natcon.6")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.92 0.92 0.92 0.65 11 0.0045 4.7 1.3 0.64
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.91 0.92 0.93
## Duhachek 0.91 0.92 0.93
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## natcon.1 0.91 0.91 0.91 0.67 10.0 0.0050 0.0176 0.66
## natcon.2 0.92 0.92 0.92 0.71 12.1 0.0045 0.0098 0.70
## natcon.3 0.89 0.89 0.88 0.62 8.2 0.0059 0.0136 0.59
## natcon.4 0.89 0.89 0.88 0.62 8.3 0.0062 0.0117 0.61
## natcon.5 0.89 0.89 0.88 0.62 8.1 0.0062 0.0104 0.61
## natcon.6 0.91 0.91 0.91 0.68 10.4 0.0048 0.0140 0.66
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## natcon.1 770 0.81 0.81 0.76 0.72 5.1 1.5
## natcon.2 768 0.71 0.73 0.64 0.61 5.3 1.3
## natcon.3 769 0.90 0.90 0.89 0.85 5.2 1.5
## natcon.4 769 0.91 0.90 0.89 0.86 4.5 1.7
## natcon.5 770 0.91 0.91 0.91 0.87 4.9 1.6
## natcon.6 772 0.81 0.80 0.74 0.71 3.5 1.8
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## natcon.1 0.02 0.05 0.08 0.12 0.25 0.27 0.20 0.00
## natcon.2 0.01 0.02 0.05 0.12 0.29 0.35 0.15 0.01
## natcon.3 0.02 0.04 0.06 0.15 0.26 0.26 0.20 0.01
## natcon.4 0.06 0.09 0.13 0.21 0.21 0.17 0.13 0.01
## natcon.5 0.04 0.07 0.06 0.19 0.25 0.22 0.17 0.00
## natcon.6 0.18 0.17 0.13 0.22 0.15 0.08 0.08 0.00ci.reliability((data[c("natcon.1", "natcon.2", "natcon.3", "natcon.4", "natcon.5",
"natcon.6")]),type='omega') ## $est
## [1] 0.9237241
##
## $se
## [1] NA
##
## $ci.lower
## [1] NA
##
## $ci.upper
## [1] NA
##
## $conf.level
## [1] 0.95
##
## $type
## [1] "omega"
##
## $interval.type
## [1] "none"5 Correlations
corr.test (data [,c("anx", "sad", "ang", "indif", "emo",
"peb", "peb.others", "peb.own", "futpeb",
"cas", "cas.ce", "cas.f",
"emp.pt", "emp.ec",
"emoreg.ier", "emoreg.ed",
"natcon",
"age", "gender.d")],
method = "spearman")## Call:corr.test(x = data[, c("anx", "sad", "ang", "indif", "emo", "peb",
## "peb.others", "peb.own", "futpeb", "cas", "cas.ce", "cas.f",
## "emp.pt", "emp.ec", "emoreg.ier", "emoreg.ed", "natcon",
## "age", "gender.d")], method = "spearman")
## Correlation matrix
## anx sad ang indif emo peb peb.others peb.own futpeb cas
## anx 1.00 0.68 0.64 -0.28 0.86 0.50 0.51 0.39 0.51 0.46
## sad 0.68 1.00 0.70 -0.33 0.90 0.51 0.52 0.40 0.51 0.40
## ang 0.64 0.70 1.00 -0.33 0.89 0.55 0.55 0.44 0.55 0.36
## indif -0.28 -0.33 -0.33 1.00 -0.36 -0.37 -0.38 -0.29 -0.35 -0.23
## emo 0.86 0.90 0.89 -0.36 1.00 0.59 0.59 0.46 0.59 0.45
## peb 0.50 0.51 0.55 -0.37 0.59 1.00 0.84 0.90 0.64 0.41
## peb.others 0.51 0.52 0.55 -0.38 0.59 0.84 1.00 0.56 0.64 0.48
## peb.own 0.39 0.40 0.44 -0.29 0.46 0.90 0.56 1.00 0.51 0.27
## futpeb 0.51 0.51 0.55 -0.35 0.59 0.64 0.64 0.51 1.00 0.44
## cas 0.46 0.40 0.36 -0.23 0.45 0.41 0.48 0.27 0.44 1.00
## cas.ce 0.45 0.40 0.35 -0.23 0.44 0.38 0.46 0.24 0.42 0.96
## cas.f 0.33 0.27 0.28 -0.20 0.33 0.33 0.40 0.20 0.33 0.77
## emp.pt 0.24 0.29 0.27 -0.14 0.31 0.37 0.34 0.34 0.30 0.16
## emp.ec 0.28 0.34 0.31 -0.25 0.35 0.36 0.31 0.33 0.27 0.16
## emoreg.ier 0.15 0.21 0.24 -0.12 0.23 0.31 0.29 0.27 0.24 0.16
## emoreg.ed -0.03 -0.08 -0.05 0.08 -0.06 -0.01 -0.05 0.01 -0.06 -0.06
## natcon 0.32 0.37 0.42 -0.25 0.42 0.50 0.44 0.43 0.40 0.26
## age 0.03 0.03 0.06 -0.05 0.04 0.09 0.11 0.06 0.04 0.00
## gender.d 0.32 0.33 0.28 -0.09 0.35 0.27 0.30 0.21 0.27 0.19
## cas.ce cas.f emp.pt emp.ec emoreg.ier emoreg.ed natcon age
## anx 0.45 0.33 0.24 0.28 0.15 -0.03 0.32 0.03
## sad 0.40 0.27 0.29 0.34 0.21 -0.08 0.37 0.03
## ang 0.35 0.28 0.27 0.31 0.24 -0.05 0.42 0.06
## indif -0.23 -0.20 -0.14 -0.25 -0.12 0.08 -0.25 -0.05
## emo 0.44 0.33 0.31 0.35 0.23 -0.06 0.42 0.04
## peb 0.38 0.33 0.37 0.36 0.31 -0.01 0.50 0.09
## peb.others 0.46 0.40 0.34 0.31 0.29 -0.05 0.44 0.11
## peb.own 0.24 0.20 0.34 0.33 0.27 0.01 0.43 0.06
## futpeb 0.42 0.33 0.30 0.27 0.24 -0.06 0.40 0.04
## cas 0.96 0.77 0.16 0.16 0.16 -0.06 0.26 0.00
## cas.ce 1.00 0.66 0.15 0.17 0.15 -0.05 0.24 0.01
## cas.f 0.66 1.00 0.08 0.09 0.10 -0.07 0.20 0.03
## emp.pt 0.15 0.08 1.00 0.35 0.42 -0.02 0.28 0.01
## emp.ec 0.17 0.09 0.35 1.00 0.19 -0.13 0.20 0.04
## emoreg.ier 0.15 0.10 0.42 0.19 1.00 0.07 0.32 0.03
## emoreg.ed -0.05 -0.07 -0.02 -0.13 0.07 1.00 0.06 -0.02
## natcon 0.24 0.20 0.28 0.20 0.32 0.06 1.00 0.10
## age 0.01 0.03 0.01 0.04 0.03 -0.02 0.10 1.00
## gender.d 0.18 0.13 0.25 0.35 -0.03 -0.14 0.04 0.02
## gender.d
## anx 0.32
## sad 0.33
## ang 0.28
## indif -0.09
## emo 0.35
## peb 0.27
## peb.others 0.30
## peb.own 0.21
## futpeb 0.27
## cas 0.19
## cas.ce 0.18
## cas.f 0.13
## emp.pt 0.25
## emp.ec 0.35
## emoreg.ier -0.03
## emoreg.ed -0.14
## natcon 0.04
## age 0.02
## gender.d 1.00
## Sample Size
## anx sad ang indif emo peb peb.others peb.own futpeb cas cas.ce cas.f
## anx 770 770 768 770 768 737 758 746 760 739 749 758
## sad 770 773 771 773 768 740 761 749 763 741 751 761
## ang 768 771 771 771 768 738 759 747 761 740 750 759
## indif 770 773 771 773 768 740 761 749 763 741 751 761
## emo 768 768 768 768 768 735 756 744 758 738 748 756
## peb 737 740 738 740 735 740 740 740 731 711 720 730
## peb.others 758 761 759 761 756 740 761 741 751 731 740 751
## peb.own 746 749 747 749 744 740 741 749 740 719 729 738
## futpeb 760 763 761 763 758 731 751 740 763 731 741 751
## cas 739 741 740 741 738 711 731 719 731 741 741 741
## cas.ce 749 751 750 751 748 720 740 729 741 741 751 741
## cas.f 758 761 759 761 756 730 751 738 751 741 741 761
## emp.pt 737 740 738 740 735 711 730 719 732 711 719 731
## emp.ec 736 739 737 739 734 709 728 718 731 708 718 728
## emoreg.ier 744 747 745 747 742 717 737 725 738 716 726 736
## emoreg.ed 746 749 747 749 744 718 738 727 740 720 729 739
## natcon 751 754 752 754 749 722 742 731 744 722 732 742
## age 770 773 771 773 768 740 761 749 763 741 751 761
## gender.d 769 772 770 772 767 739 760 748 762 740 750 760
## emp.pt emp.ec emoreg.ier emoreg.ed natcon age gender.d
## anx 737 736 744 746 751 770 769
## sad 740 739 747 749 754 773 772
## ang 738 737 745 747 752 771 770
## indif 740 739 747 749 754 773 772
## emo 735 734 742 744 749 768 767
## peb 711 709 717 718 722 740 739
## peb.others 730 728 737 738 742 761 760
## peb.own 719 718 725 727 731 749 748
## futpeb 732 731 738 740 744 763 762
## cas 711 708 716 720 722 741 740
## cas.ce 719 718 726 729 732 751 750
## cas.f 731 728 736 739 742 761 760
## emp.pt 740 728 721 723 724 740 739
## emp.ec 728 739 720 722 722 739 738
## emoreg.ier 721 720 747 736 728 747 746
## emoreg.ed 723 722 736 749 731 749 748
## natcon 724 722 728 731 754 754 753
## age 740 739 747 749 754 773 772
## gender.d 739 738 746 748 753 772 772
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## anx sad ang indif emo peb peb.others peb.own futpeb cas cas.ce
## anx 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## sad 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## ang 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## indif 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## emo 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## peb 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## peb.others 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## peb.own 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## futpeb 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## cas 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## cas.ce 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## cas.f 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## emp.pt 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## emp.ec 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## emoreg.ier 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## emoreg.ed 0.49 0.03 0.17 0.03 0.13 0.87 0.22 0.72 0.1 0.14 0.17
## natcon 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## age 0.42 0.37 0.10 0.14 0.21 0.01 0.00 0.10 0.3 0.92 0.79
## gender.d 0.00 0.00 0.00 0.01 0.00 0.00 0.00 0.00 0.0 0.00 0.00
## cas.f emp.pt emp.ec emoreg.ier emoreg.ed natcon age gender.d
## anx 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## sad 0.00 0.00 0.00 0.00 0.90 0.00 1.00 0.00
## ang 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## indif 0.00 0.01 0.00 0.04 0.98 0.00 1.00 0.34
## emo 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## peb 0.00 0.00 0.00 0.00 1.00 0.00 0.38 0.00
## peb.others 0.00 0.00 0.00 0.00 1.00 0.00 0.12 0.00
## peb.own 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## futpeb 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## cas 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## cas.ce 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## cas.f 0.00 0.92 0.39 0.25 1.00 0.00 1.00 0.02
## emp.pt 0.03 0.00 0.00 0.00 1.00 0.00 1.00 0.00
## emp.ec 0.01 0.00 0.00 0.00 0.01 0.00 1.00 0.00
## emoreg.ier 0.01 0.00 0.00 0.00 1.00 0.00 1.00 1.00
## emoreg.ed 0.07 0.61 0.00 0.07 0.00 1.00 1.00 0.00
## natcon 0.00 0.00 0.00 0.00 0.13 0.00 0.30 1.00
## age 0.41 0.82 0.23 0.35 0.59 0.01 0.00 1.00
## gender.d 0.00 0.00 0.00 0.39 0.00 0.23 0.67 0.00
##
## To see confidence intervals of the correlations, print with the short=FALSE option#bootstrapped confidence intervals
data.ci <- cor.ci(data [,c("anx", "sad", "ang", "indif", "emo",
"peb", "peb.others", "peb.own", "futpeb",
"cas", "cas.ce", "cas.f",
"emp.pt", "emp.ec",
"emoreg.ier", "emoreg.ed",
"natcon",
"age", "gender.d")],
n.iter = 1000)
ci <- cor.plot.upperLowerCi(data.ci) 
ci ##
## High and low confidence intervals
## anx sad ang indf emo peb pb.t pb.w ftpb cas cs.c
## anx 1.00 0.72 0.69 -0.38 0.89 0.54 0.56 0.43 0.57 0.39 0.41
## sad 0.63 1.00 0.73 -0.43 0.91 0.56 0.57 0.45 0.57 0.34 0.36
## ang 0.59 0.64 1.00 -0.43 0.90 0.60 0.60 0.49 0.60 0.32 0.33
## indif -0.25 -0.29 -0.29 1.00 -0.46 -0.45 -0.45 -0.39 -0.44 -0.27 -0.29
## emo 0.85 0.87 0.87 -0.33 1.00 0.63 0.64 0.51 0.65 0.39 0.41
## peb 0.43 0.44 0.50 -0.32 0.53 1.00 0.85 0.93 0.70 0.36 0.36
## peb.others 0.44 0.46 0.49 -0.32 0.54 0.81 1.00 0.59 0.70 0.48 0.49
## peb.own 0.32 0.33 0.37 -0.25 0.40 0.90 0.50 1.00 0.57 0.22 0.23
## futpeb 0.46 0.46 0.50 -0.30 0.55 0.60 0.61 0.45 1.00 0.40 0.42
## cas 0.24 0.19 0.18 -0.13 0.24 0.19 0.33 0.06 0.24 1.00 0.98
## cas.ce 0.26 0.21 0.18 -0.15 0.25 0.20 0.34 0.07 0.26 0.97 1.00
## cas.f 0.18 0.12 0.13 -0.09 0.17 0.15 0.27 0.03 0.18 0.92 0.79
## emp.pt 0.16 0.22 0.20 -0.08 0.23 0.30 0.24 0.27 0.23 0.00 0.01
## emp.ec 0.20 0.28 0.21 -0.17 0.27 0.27 0.20 0.23 0.20 -0.01 0.01
## emoreg.ier 0.08 0.15 0.17 -0.06 0.17 0.24 0.23 0.19 0.18 0.03 0.04
## emoreg.ed 0.05 0.00 0.03 0.00 0.02 0.08 0.04 -0.06 0.00 -0.01 -0.01
## natcon 0.27 0.33 0.37 -0.16 0.38 0.45 0.38 0.36 0.36 0.08 0.09
## age -0.04 -0.04 0.00 0.02 -0.02 0.01 0.05 -0.03 -0.02 -0.03 -0.03
## gender.d 0.25 0.25 0.19 -0.05 0.27 0.21 0.20 0.15 0.19 0.04 0.05
## cs.f emp.p emp.c emrg.r emrg.d ntcn age gnd.
## anx 0.33 0.30 0.36 0.23 -0.10 0.39 0.11 0.37
## sad 0.28 0.36 0.42 0.29 -0.15 0.45 0.10 0.38
## ang 0.27 0.34 0.37 0.32 -0.13 0.48 0.13 0.32
## indif -0.24 -0.22 -0.33 -0.21 0.15 -0.32 -0.12 -0.19
## emo 0.32 0.37 0.42 0.31 -0.13 0.49 0.12 0.40
## peb 0.31 0.43 0.41 0.38 -0.09 0.56 0.17 0.34
## peb.others 0.42 0.38 0.35 0.36 -0.11 0.50 0.20 0.33
## peb.own 0.18 0.40 0.38 0.34 0.10 0.49 0.12 0.29
## futpeb 0.34 0.37 0.35 0.32 -0.14 0.48 0.13 0.32
## cas 0.95 0.13 0.14 0.16 -0.13 0.22 0.12 0.18
## cas.ce 0.87 0.14 0.16 0.15 -0.13 0.23 0.12 0.19
## cas.f 1.00 0.09 0.10 0.14 -0.11 0.19 0.12 0.16
## emp.pt -0.04 1.00 0.45 0.50 -0.11 0.37 0.08 0.31
## emp.ec -0.05 0.29 1.00 0.28 -0.21 0.28 0.11 0.42
## emoreg.ier 0.00 0.37 0.12 1.00 0.15 0.39 0.11 -0.09
## emoreg.ed 0.01 0.06 -0.06 -0.02 1.00 0.14 -0.09 -0.21
## natcon 0.05 0.22 0.12 0.26 -0.01 1.00 0.16 0.12
## age -0.03 -0.07 -0.03 -0.03 0.05 0.01 1.00 0.09
## gender.d 0.02 0.18 0.29 0.05 -0.06 -0.02 -0.05 1.006 Latent Profile Analysis
6.1 Preparing data frame
Create data frame with case,
pro-environmental behavior and climate anxiety-related impairment,
and climate emotions, empathy, emotion regulation, nature connectedness for auxiliary analyses
data.lpa <- data.frame(data$ID,
data$peb.others, data$peb.own, data$futpeb,
data$cas.ce, data$cas.f,
data$anx, data$sad, data$ang, data$indif, data$emo,
data$emp.pt, data$emp.ec,
data$emoreg.ier, data$emoreg.ed,
data$natcon,
data$age, data$gender.d)Considering only complete cases
data.lpa <- data.lpa[complete.cases(data.lpa), ]
data$ID## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
## [91] 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
## [271] 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
## [289] 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306
## [307] 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
## [325] 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
## [343] 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
## [361] 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
## [379] 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
## [397] 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
## [415] 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432
## [433] 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
## [451] 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
## [469] 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
## [487] 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
## [505] 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
## [523] 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
## [541] 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
## [559] 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
## [577] 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594
## [595] 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612
## [613] 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630
## [631] 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648
## [649] 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666
## [667] 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
## [685] 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702
## [703] 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720
## [721] 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738
## [739] 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756
## [757] 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773
## attr(,"label")
## [1] "ID"
## attr(,"format.spss")
## [1] "F10.0"
## attr(,"display_width")
## [1] 10data.lpa$data.ID## [1] 2 5 6 7 9 10 11 13 14 15 16 17 18 19 20 23 24 25
## [19] 26 28 29 31 33 34 35 36 37 40 42 43 44 45 46 48 49 50
## [37] 51 52 53 54 57 58 61 62 66 68 69 70 71 74 75 76 77 78
## [55] 80 81 84 85 86 87 88 89 90 91 92 93 94 95 96 97 99 100
## [73] 101 102 103 104 105 108 109 110 111 112 113 114 115 116 117 118 120 123
## [91] 124 125 126 127 128 130 131 132 133 136 137 138 140 142 143 145 146 147
## [109] 148 150 151 153 154 155 156 157 158 160 161 163 164 167 168 169 172 174
## [127] 175 176 177 179 180 181 182 183 186 187 188 189 190 191 192 193 195 196
## [145] 197 198 199 200 201 202 203 204 205 206 207 208 209 211 212 213 214 215
## [163] 216 217 218 219 220 221 222 223 224 225 226 228 229 230 231 232 233 234
## [181] 235 236 237 238 240 241 242 245 246 247 249 250 251 252 253 254 255 256
## [199] 257 258 260 261 262 263 264 265 266 267 268 269 270 272 273 274 276 277
## [217] 278 279 280 281 282 283 285 286 289 290 291 292 293 294 295 296 297 298
## [235] 299 300 301 302 303 304 305 306 307 308 310 311 312 313 314 318 319 320
## [253] 321 323 324 325 326 327 328 329 330 331 333 334 336 337 338 339 341 342
## [271] 343 344 345 346 347 348 349 350 351 352 353 357 358 360 364 365 367 368
## [289] 369 370 371 372 373 374 375 376 377 378 380 381 382 385 386 388 389 391
## [307] 392 394 395 396 397 398 399 401 403 404 405 406 409 410 411 412 413 414
## [325] 415 416 418 419 420 421 422 424 426 427 428 429 431 432 433 434 435 436
## [343] 437 439 440 441 442 443 444 446 447 449 450 452 453 454 455 456 457 458
## [361] 459 460 461 463 464 466 467 468 469 470 471 472 473 475 477 478 480 481
## [379] 482 483 484 485 486 487 488 489 490 491 492 494 495 496 497 498 499 501
## [397] 502 503 504 505 506 507 508 510 511 512 513 514 516 518 520 521 522 525
## [415] 527 528 529 530 531 532 533 534 536 538 540 541 542 543 544 545 546 547
## [433] 548 551 552 554 555 557 558 559 561 562 563 564 565 566 567 568 569 570
## [451] 571 572 573 574 575 576 578 580 581 582 583 584 585 586 587 589 592 593
## [469] 594 595 596 599 601 602 603 604 605 606 607 608 609 611 613 614 615 616
## [487] 618 619 620 621 622 623 624 625 626 627 628 629 630 631 633 634 635 636
## [505] 637 638 639 640 641 642 644 645 646 647 648 649 650 651 654 656 657 658
## [523] 659 660 661 662 664 665 666 667 669 670 671 672 673 674 675 676 677 678
## [541] 679 681 682 683 684 685 686 687 688 689 690 691 693 695 696 697 698 699
## [559] 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
## [577] 720 721 722 723 724 725 726 727 729 730 731 732 733 734 735 736 738 739
## [595] 740 741 742 743 744 746 747 748 749 750 751 752 753 754 755 756 757 758
## [613] 759 760 761 762 763 764 765 766 7676.2 Calculating multivariate outliers
reg=lm(data.lpa$data.ID~
data.lpa$data.peb.own + data.lpa$data.peb.others + data.lpa$data.futpeb +
data.lpa$data.cas.ce + data.lpa$data.cas.f +
data.lpa$data.anx + data.lpa$data.sad + data.lpa$data.ang + data.lpa$data.indif +
data.lpa$data.emp.pt + data.lpa$data.emp.ec +
data.lpa$data.emoreg.ier + data.lpa$data.emoreg.ed +
data.lpa$data.natcon +
data.lpa$data.age + data.lpa$data.gender.d,
data=data.lpa)
summary(reg)##
## Call:
## lm(formula = data.lpa$data.ID ~ data.lpa$data.peb.own + data.lpa$data.peb.others +
## data.lpa$data.futpeb + data.lpa$data.cas.ce + data.lpa$data.cas.f +
## data.lpa$data.anx + data.lpa$data.sad + data.lpa$data.ang +
## data.lpa$data.indif + data.lpa$data.emp.pt + data.lpa$data.emp.ec +
## data.lpa$data.emoreg.ier + data.lpa$data.emoreg.ed + data.lpa$data.natcon +
## data.lpa$data.age + data.lpa$data.gender.d, data = data.lpa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -452.21 -96.19 2.55 113.59 429.38
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -363.2885 218.5628 -1.662 0.096998 .
## data.lpa$data.peb.own 154.3089 9.0466 17.057 < 2e-16 ***
## data.lpa$data.peb.others 38.6727 11.3587 3.405 0.000706 ***
## data.lpa$data.futpeb 6.6359 10.2427 0.648 0.517318
## data.lpa$data.cas.ce -23.2445 26.6193 -0.873 0.382890
## data.lpa$data.cas.f 25.9654 24.7151 1.051 0.293866
## data.lpa$data.anx 24.3361 7.0556 3.449 0.000601 ***
## data.lpa$data.sad 2.5135 6.9300 0.363 0.716959
## data.lpa$data.ang -11.8992 6.6718 -1.784 0.075007 .
## data.lpa$data.indif 4.1442 5.1790 0.800 0.423913
## data.lpa$data.emp.pt -13.7516 9.3407 -1.472 0.141483
## data.lpa$data.emp.ec -3.6972 9.3803 -0.394 0.693611
## data.lpa$data.emoreg.ier 0.1539 5.2574 0.029 0.976653
## data.lpa$data.emoreg.ed 3.9420 4.2140 0.935 0.349930
## data.lpa$data.natcon -1.2637 5.7566 -0.220 0.826320
## data.lpa$data.age 9.1801 13.0510 0.703 0.482076
## data.lpa$data.gender.d 17.6161 14.2445 1.237 0.216680
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 151.2 on 604 degrees of freedom
## Multiple R-squared: 0.5465, Adjusted R-squared: 0.5345
## F-statistic: 45.49 on 16 and 604 DF, p-value: < 2.2e-16Inspect leverages to detect multivariate outliers
lev =hat(model.matrix(reg))
plot(lev)
Calculate mahalanobis distance and identify top 5 cases
N= nrow(data.lpa)
mahad=(N-1)*(lev-1 / N)
tail(sort(mahad),5)## [1] 56.00064 60.43698 62.93485 63.34032 65.66993order(mahad,decreasing=T)[c(5,4,3,2,1)]## [1] 621 476 417 265 620Calculate probability that case is outlier
P_mahad = 1 - pchisq(mahad, df=16)Compute outlier variable
data.lpa$outlier <- 0
data.lpa$outlier[P_mahad < .001] <- 1Sort cases to see outliers
order(data.lpa$outlier,decreasing=T)## [1] 58 60 76 265 284 295 417 449 476 477 486 518 582 583 591 607 620 621
## [19] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## [37] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## [55] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## [73] 55 56 57 59 61 62 63 64 65 66 67 68 69 70 71 72 73 74
## [91] 75 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
## [109] 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
## [127] 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
## [145] 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
## [163] 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
## [181] 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
## [199] 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201
## [217] 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
## [235] 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
## [253] 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
## [271] 256 257 258 259 260 261 262 263 264 266 267 268 269 270 271 272 273 274
## [289] 275 276 277 278 279 280 281 282 283 285 286 287 288 289 290 291 292 293
## [307] 294 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
## [325] 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330
## [343] 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348
## [361] 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366
## [379] 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384
## [397] 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402
## [415] 403 404 405 406 407 408 409 410 411 412 413 414 415 416 418 419 420 421
## [433] 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
## [451] 440 441 442 443 444 445 446 447 448 450 451 452 453 454 455 456 457 458
## [469] 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 478
## [487] 479 480 481 482 483 484 485 487 488 489 490 491 492 493 494 495 496 497
## [505] 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
## [523] 516 517 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534
## [541] 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552
## [559] 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570
## [577] 571 572 573 574 575 576 577 578 579 580 581 584 585 586 587 588 589 590
## [595] 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 608 609 610
## [613] 611 612 613 614 615 616 617 618 619Removing multivariate outliers
data.lpa_out <- data.lpa[!(data.lpa$outlier==1),]Create data frame without outliers
data.lpa <- data.frame(data.lpa_out$data.ID,
data.lpa_out$data.peb.own, data.lpa_out$data.peb.others, data.lpa_out$data.futpeb,
data.lpa_out$data.cas.ce, data.lpa_out$data.cas.f,
data.lpa_out$data.anx, data.lpa_out$data.sad, data.lpa_out$data.ang, data.lpa_out$data.indif,
data.lpa_out$data.emo,
data.lpa_out$data.emp.pt, data.lpa_out$data.emp.ec,
data.lpa_out$data.emoreg.ier, data.lpa_out$data.emoreg.ed,
data.lpa_out$data.natcon,
data.lpa_out$data.age, data.lpa_out$data.gender.d)6.3 Multivariate normality
Doornik-Hansen’s test
library(MVN)
result <- MVN::mvn(data = data.lpa[, 2:6])
result$multivariateNormality## NULL6.4 Clustering and dimension reduction
6.4.1 BIC
library(mclust)## Package 'mclust' version 6.1.2
## Type 'citation("mclust")' for citing this R package in publications.##
## Attaching package: 'mclust'## The following object is masked from 'package:purrr':
##
## map## The following object is masked from 'package:mvtnorm':
##
## dmvnorm## The following object is masked from 'package:dplyr':
##
## count## The following object is masked from 'package:MVN':
##
## mvn## The following object is masked from 'package:psych':
##
## simmnames <- c("EEI", "EEE", "VVI", "VVV")
# Fit 1-5 class model
mod <- Mclust(data.lpa[, 2:6], modelNames = mnames)
# Optimal number of classes
mod$G## [1] 9# Optimal model variant
mod$modelName## [1] "EEE"# BIC values
mod$BIC## Bayesian Information Criterion (BIC):
## EEI EEE VVI VVV
## 1 -5700.129 -4243.529 -5700.129 -4243.529
## 2 -4429.960 -3731.970 NA NA
## 3 -4095.481 -3720.172 NA NA
## 4 -3957.669 -3637.455 NA NA
## 5 -3648.375 -3675.414 NA NA
## 6 -3437.894 -3689.967 NA NA
## 7 -3462.393 -3566.194 NA NA
## 8 -3500.786 -3430.331 NA NA
## 9 -3446.062 -3235.541 NA NA
##
## Top 3 models based on the BIC criterion:
## EEE,9 EEE,8 EEI,6
## -3235.541 -3430.331 -3437.8946.4.2 BLRT
mclustBootstrapLRT(data.lpa[, 2:6], modelName = "EEE")## -------------------------------------------------------------
## Bootstrap sequential LRT for the number of mixture components
## -------------------------------------------------------------
## Model = EEE
## Replications = 999
## LRTS bootstrap p-value
## 1 vs 2 549.9700286 0.001
## 2 vs 3 50.2097095 0.001
## 3 vs 4 121.1292050 0.001
## 4 vs 5 0.4523574 0.9406.4.3 Comparing different models
library(tidyLPA)## Loading required package: tidySEM##
## Attaching package: 'tidySEM'## The following object is masked from 'package:MVN':
##
## descriptives## Registered S3 method overwritten by 'tidyLPA':
## method from
## print.LRT tidySEM## You can use the function citation('tidyLPA') to create a citation for the use of {tidyLPA}.
## Mplus is not installed. Use only package = 'mclust' when calling estimate_profiles().##
## Attaching package: 'tidyLPA'## The following objects are masked from 'package:tidySEM':
##
## get_data, get_estimates, get_fit, pomsmod <-
data.lpa[, 2:6] %>%
single_imputation() %>%
scale() %>%
estimate_profiles(1:9) %>%
compare_solutions(statistics = c("AIC", "BIC", "SABIC", "Entropy")) ## Warning:
## One or more analyses resulted in warnings! Examine these analyses carefully: model_1_class_8, model_1_class_9
## Warning:
## One or more analyses resulted in warnings! Examine these analyses carefully: model_1_class_8, model_1_class_9## Warning: The solution with the maximum number of classes under consideration
## was considered to be the best solution according to one or more fit indices.
## Examine your results with care and consider estimating more classes.mod## Compare tidyLPA solutions:
##
## Model Classes AIC BIC SABIC Entropy Warnings
## 1 1 8571.195 8615.214 8583.467 1.0000000
## 1 2 7274.614 7345.045 7294.249 0.9921359
## 1 3 6913.803 7010.645 6940.801 0.8959542
## 1 4 6749.533 6872.787 6783.894 0.8469357
## 1 5 6413.860 6563.525 6455.584 0.8678498
## 1 6 6176.928 6353.004 6226.015 0.8863821
## 1 7 6175.015 6377.503 6231.465 0.8138910
## 1 8 6186.971 6415.871 6250.784 0.7680615 Warning
## 1 9 6193.382 6448.693 6264.558 0.6738085 Warning
##
## Best model according to AIC is Model 1 with 7 classes.
## Best model according to BIC is Model 1 with 6 classes.
## Best model according to SABIC is Model 1 with 6 classes.
## Best model according to Entropy is Model NA with NA classes.
##
## An analytic hierarchy process, based on the fit indices AIC, AWE, BIC, CLC, and KIC (Akogul & Erisoglu, 2017), suggests the best solution is Model 1 with 6 classes.6.4.4 Plot profiles with tidyLPA
6.4.4.1 1 to 9
library(tidyLPA)
mod <- data.lpa[, 2:6] %>%
estimate_profiles(1:9)## Warning:
## One or more analyses resulted in warnings! Examine these analyses carefully: model_1_class_8, model_1_class_9plot_profiles(mod,
ci = 0,
sd = FALSE,
add_line = TRUE,
rawdata = FALSE)
6.4.4.2 3
library(tidyLPA)
mod <- data.lpa[, 2:6] %>%
estimate_profiles(3)
plot_profiles(mod,
ci = 0,
sd = FALSE,
add_line = TRUE,
rawdata = FALSE)
6.4.5 Calculate and save profile membership
library(tidyLPA)
mod <- data.lpa[, 2:6] %>%
estimate_profiles(3)
get_data(mod)## # A tibble: 603 × 11
## model_number classes_number data.lpa_out.data.peb.own data.lpa_out.data.peb…¹
## <dbl> <dbl> <dbl> <dbl>
## 1 1 3 2.29 1
## 2 1 3 1.71 1
## 3 1 3 3.14 1
## 4 1 3 1.71 1.2
## 5 1 3 2.29 1
## 6 1 3 3.43 1.8
## 7 1 3 1.14 1
## 8 1 3 1 1
## 9 1 3 1.86 1
## 10 1 3 2.29 1.2
## # ℹ 593 more rows
## # ℹ abbreviated name: ¹data.lpa_out.data.peb.others
## # ℹ 7 more variables: data.lpa_out.data.futpeb <dbl>,
## # data.lpa_out.data.cas.ce <dbl>, data.lpa_out.data.cas.f <dbl>,
## # CPROB1 <dbl>, CPROB2 <dbl>, CPROB3 <dbl>, Class <dbl>class <- get_data(mod)
data.lpa$class <- class$Class
data.lpa$class <- as.factor(data.lpa$class)6.4.6 Plot 3 profile solution with ggplot2
# Assign names to profile levels
levels(data.lpa$class) <- c("climate-resilient\n(high peb, low impairment)",
"climate-disengaged\n(low peb, low impairment)",
"climate-vulnerable\n(high peb, high impairment)")
# Create a data frame
df <- data.frame(
class=data.lpa$class,
peb.own=data.lpa$data.lpa_out.data.peb.own,
peb.others=data.lpa$data.lpa_out.data.peb.others,
futpeb=data.lpa$data.lpa_out.data.futpeb,
cas.ce=data.lpa$data.lpa_out.data.cas.ce,
cas.f=data.lpa$data.lpa_out.data.cas.f)
# Calculate means by group (profile) for each variable
df.means <- aggregate(. ~ class, df, mean, na.rm = TRUE)
# Melt the data
library(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsmelted_df <- melt(df.means, id.vars = "class")
#Create secondary labels for x-axis
library(grid)
label.1 <- textGrob("Pro-environmental\nbehavior", gp=gpar(fontsize=11))
label.2 <- textGrob("Climate anxiety-\nrelated impairment", gp=gpar(fontsize=11))
#Put the plot together
library(ggplot2)
library(stringr)
p.lpa <- ggplot(melted_df, aes(x = variable, y = value, group=class, color = class)) +
geom_line(lwd=.3,
linetype = "dashed") +
geom_point() +
labs(y = "Means",
x = "",
color = "Profiles") +
scale_x_discrete(
label = c(
"Own",
"Influencing\nothers",
"Future",
"Cognitive-\nemotional",
"Functional")) +
scale_color_manual(
values = c("#D73027", "#FDAE61", "#4575B4"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
geom_vline(xintercept=c(3.5), linetype='dashed', size=0.4) +
theme(plot.margin = unit(c(1,1,3,1), "lines"),
axis.text.x = element_text(angle = 45,
hjust = 0.95,
vjust=1)) +
annotation_custom(label.1,xmin=1,xmax=3,ymin=-0.1,ymax=-0.1) +
annotation_custom(label.2,xmin=4,xmax=5,ymin=-0.1,ymax=-0.1) +
coord_cartesian(clip = "off") ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.print(p.lpa)
# Save the plot as a PNG file
ggsave("Figure 1 - LPA.png", plot = p.lpa, height = 4.7, width = 7, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure 1 - LPA.pdf", plot = p.lpa, height = 4.7, width = 7)6.4.7 Calculate mean scores on each variable for each profile
options(max.print = 10000000)
estimates <- get_estimates(mod)
print(estimates, n = Inf)## # A tibble: 30 × 8
## Category Parameter Estimate se p Class Model Classes
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 Means data.lpa_out.data.p… 3.99 0.0753 0 1 1 3
## 2 Means data.lpa_out.data.p… 2.77 0.150 4.27e- 76 1 1 3
## 3 Means data.lpa_out.data.f… 3.29 0.132 2.50e-138 1 1 3
## 4 Means data.lpa_out.data.c… 1.31 0.110 1.11e- 32 1 1 3
## 5 Means data.lpa_out.data.c… 1.15 0.0939 1.10e- 34 1 1 3
## 6 Variances data.lpa_out.data.p… 0.625 0.0493 7.77e- 37 1 1 3
## 7 Variances data.lpa_out.data.p… 0.325 0.0414 4.05e- 15 1 1 3
## 8 Variances data.lpa_out.data.f… 0.458 0.0450 2.15e- 24 1 1 3
## 9 Variances data.lpa_out.data.c… 0.0460 0.00607 3.45e- 14 1 1 3
## 10 Variances data.lpa_out.data.c… 0.0298 0.00509 4.60e- 9 1 1 3
## 11 Means data.lpa_out.data.p… 3.11 0.0630 0 2 1 3
## 12 Means data.lpa_out.data.p… 1.46 0.0657 4.26e-110 2 1 3
## 13 Means data.lpa_out.data.f… 2.02 0.0632 6.17e-224 2 1 3
## 14 Means data.lpa_out.data.c… 1.07 0.00740 0 2 1 3
## 15 Means data.lpa_out.data.c… 1.03 0.00623 0 2 1 3
## 16 Variances data.lpa_out.data.p… 0.625 0.0493 7.77e- 37 2 1 3
## 17 Variances data.lpa_out.data.p… 0.325 0.0414 4.05e- 15 2 1 3
## 18 Variances data.lpa_out.data.f… 0.458 0.0450 2.15e- 24 2 1 3
## 19 Variances data.lpa_out.data.c… 0.0460 0.00607 3.45e- 14 2 1 3
## 20 Variances data.lpa_out.data.c… 0.0298 0.00509 4.60e- 9 2 1 3
## 21 Means data.lpa_out.data.p… 3.68 0.144 8.15e-145 3 1 3
## 22 Means data.lpa_out.data.p… 2.84 0.130 3.38e-105 3 1 3
## 23 Means data.lpa_out.data.f… 3.14 0.122 1.48e-146 3 1 3
## 24 Means data.lpa_out.data.c… 2.11 0.0953 3.97e-108 3 1 3
## 25 Means data.lpa_out.data.c… 2.15 0.103 3.68e- 96 3 1 3
## 26 Variances data.lpa_out.data.p… 0.625 0.0493 7.77e- 37 3 1 3
## 27 Variances data.lpa_out.data.p… 0.325 0.0414 4.05e- 15 3 1 3
## 28 Variances data.lpa_out.data.f… 0.458 0.0450 2.15e- 24 3 1 3
## 29 Variances data.lpa_out.data.c… 0.0460 0.00607 3.45e- 14 3 1 3
## 30 Variances data.lpa_out.data.c… 0.0298 0.00509 4.60e- 9 3 1 36.4.8 Describe number of people in each profile
table (data.lpa$class)##
## climate-resilient\n(high peb, low impairment)
## 102
## climate-disengaged\n(low peb, low impairment)
## 439
## climate-vulnerable\n(high peb, high impairment)
## 62prop.table (table (data.lpa$class))##
## climate-resilient\n(high peb, low impairment)
## 0.1691542
## climate-disengaged\n(low peb, low impairment)
## 0.7280265
## climate-vulnerable\n(high peb, high impairment)
## 0.10281926.4.9 Assign names to profile levels
levels(data.lpa$class) <- c("climate-resilient\n(high peb, low impairment)",
"climate-disengaged\n(low peb, low impairment)",
"climate-vulnerable\n(high peb, high impairment)")7 Sensititvity analysis
for minimum detectable effect for profile contrasts in multinomial regression
library(pwr)## Warning: package 'pwr' was built under R version 4.6.1d_to_OR <- function(d) c(OR_increase = exp(d), OR_decrease = exp(-d))
mde_odds_ratio <- function(n1, n2, alpha = .05, power = .80, label = "") {
fit <- pwr.t2n.test(n1 = n1, n2 = n2, sig.level = alpha, power = power)
or <- d_to_OR(fit$d)
data.frame(
contrast = label,
n1 = n1, n2 = n2, alpha = alpha, power = power,
d = round(fit$d, 3),
OR_increase = round(or["OR_increase"], 2),
OR_decrease = round(or["OR_decrease"], 2),
row.names = NULL
)
}
n_resilient <- 102
n_disengaged <- 439
n_vulnerable <- 62
results <- rbind(
mde_odds_ratio(n_vulnerable, n_resilient, alpha = .05, label = "Vulnerable vs Resilient"),
mde_odds_ratio(n_vulnerable, n_resilient, alpha = .01, label = "Vulnerable vs Resilient"),
mde_odds_ratio(n_disengaged, n_resilient, alpha = .05, label = "Disengaged vs Resilient"),
mde_odds_ratio(n_disengaged, n_resilient, alpha = .01, label = "Disengaged vs Resilient")
)
print(results)## contrast n1 n2 alpha power d OR_increase OR_decrease
## 1 Vulnerable vs Resilient 62 102 0.05 0.8 0.454 1.57 0.64
## 2 Vulnerable vs Resilient 62 102 0.01 0.8 0.556 1.74 0.57
## 3 Disengaged vs Resilient 439 102 0.05 0.8 0.308 1.36 0.73
## 4 Disengaged vs Resilient 439 102 0.01 0.8 0.377 1.46 0.698 Multinomial regression analysis predicting profile membership
8.1 Preparations
Load relevant packages
library(foreign)
library(nnet)
library(ggplot2)
library(ggeffects)
library(reshape2)Specify baseline outcome class
data.lpa$class.rel <- relevel(data.lpa$class, ref = "climate-resilient\n(high peb, low impairment)")Standardize predictors
data.lpa$data.lpa_out.data.anx.z <- scale(data.lpa$data.lpa_out.data.anx)
data.lpa$data.lpa_out.data.sad.z <- scale(data.lpa$data.lpa_out.data.sad)
data.lpa$data.lpa_out.data.ang.z <- scale(data.lpa$data.lpa_out.data.ang)
data.lpa$data.lpa_out.data.emo.z <- scale(data.lpa$data.lpa_out.data.emo)
data.lpa$data.lpa_out.data.indif.z <- scale(data.lpa$data.lpa_out.data.indif)
data.lpa$data.lpa_out.data.emp.pt.z <- scale(data.lpa$data.lpa_out.data.emp.pt)
data.lpa$data.lpa_out.data.emp.ec.z <- scale(data.lpa$data.lpa_out.data.emp.ec)
data.lpa$data.lpa_out.data.emoreg.ed.z <- scale(data.lpa$data.lpa_out.data.emoreg.ed)
data.lpa$data.lpa_out.data.emoreg.ier.z <- scale(data.lpa$data.lpa_out.data.emoreg.ier)
data.lpa$data.lpa_out.data.natcon.z <- scale(data.lpa$data.lpa_out.data.natcon)8.2 Run intercept only model
OIM <- multinom(class.rel ~ 1, data = data.lpa)## # weights: 6 (2 variable)
## initial value 662.463210
## final value 461.631268
## convergedsummary(OIM)## Call:
## multinom(formula = class.rel ~ 1, data = data.lpa)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 1.4595266
## climate-vulnerable\n(high peb, high impairment) -0.4978384
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1099174
## climate-vulnerable\n(high peb, high impairment) 0.1610371
##
## Residual Deviance: 923.2625
## AIC: 927.26258.3 Step 1: Only climate emotions as predictors
8.3.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
data.lpa_out.data.ang.z + data.lpa_out.data.indif.z, data = data.lpa, model=TRUE)## # weights: 18 (10 variable)
## initial value 662.463210
## iter 10 value 380.241905
## iter 20 value 357.119581
## iter 20 value 357.119581
## iter 20 value 357.119581
## final value 357.119581
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z, data = data.lpa,
## model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 1.8474406
## climate-vulnerable\n(high peb, high impairment) -0.7217028
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) -0.5001217
## climate-vulnerable\n(high peb, high impairment) 0.4434527
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) -0.43057787
## climate-vulnerable\n(high peb, high impairment) -0.03323844
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) -0.56211141
## climate-vulnerable\n(high peb, high impairment) -0.04708577
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.4379795
## climate-vulnerable\n(high peb, high impairment) 0.1807901
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1513522
## climate-vulnerable\n(high peb, high impairment) 0.2462460
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.1697857
## climate-vulnerable\n(high peb, high impairment) 0.2248571
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.1837166
## climate-vulnerable\n(high peb, high impairment) 0.2437899
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.1752685
## climate-vulnerable\n(high peb, high impairment) 0.2265596
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1584499
## climate-vulnerable\n(high peb, high impairment) 0.2096400
##
## Residual Deviance: 714.2392
## AIC: 734.2392Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.5507958 2.14408547
## data.lpa_out.data.anx.z -0.8328956 -0.16734792
## data.lpa_out.data.sad.z -0.7906559 -0.07049986
## data.lpa_out.data.ang.z -0.9056314 -0.21859141
## data.lpa_out.data.indif.z 0.1274233 0.74853566
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.204336190 -0.2390695
## data.lpa_out.data.anx.z 0.002740801 0.8841645
## data.lpa_out.data.sad.z -0.511057896 0.4445810
## data.lpa_out.data.ang.z -0.491134414 0.3969629
## data.lpa_out.data.indif.z -0.230096868 0.59167708.3.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 6.3435632
## climate-vulnerable\n(high peb, high impairment) 0.4859241
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.6064568
## climate-vulnerable\n(high peb, high impairment) 1.5580775
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.6501333
## climate-vulnerable\n(high peb, high impairment) 0.9673079
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.5700043
## climate-vulnerable\n(high peb, high impairment) 0.9540056
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.549573
## climate-vulnerable\n(high peb, high impairment) 1.198164Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 4.7152210 8.5342329
## data.lpa_out.data.anx.z 0.4347885 0.8459053
## data.lpa_out.data.sad.z 0.4535472 0.9319279
## data.lpa_out.data.ang.z 0.4042865 0.8036500
## data.lpa_out.data.indif.z 1.1358978 2.1139023
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.2998910 0.7873602
## data.lpa_out.data.anx.z 1.0027446 2.4209609
## data.lpa_out.data.sad.z 0.5998607 1.5598365
## data.lpa_out.data.ang.z 0.6119318 1.4873007
## data.lpa_out.data.indif.z 0.7944566 1.80701638.3.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 12.20624
## climate-vulnerable\n(high peb, high impairment) -2.93082
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) -2.945606
## climate-vulnerable\n(high peb, high impairment) 1.972153
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) -2.3437063
## climate-vulnerable\n(high peb, high impairment) -0.1363405
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) -3.2071440
## climate-vulnerable\n(high peb, high impairment) -0.2078295
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 2.7641507
## climate-vulnerable\n(high peb, high impairment) 0.8623833p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.000000000
## climate-vulnerable\n(high peb, high impairment) 0.003380685
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.003223225
## climate-vulnerable\n(high peb, high impairment) 0.048592136
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.0190932
## climate-vulnerable\n(high peb, high impairment) 0.8915521
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.001340599
## climate-vulnerable\n(high peb, high impairment) 0.835362098
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.005707117
## climate-vulnerable\n(high peb, high impairment) 0.3884766268.3.4 Calculate Pseudo-R
library(DescTools)##
## Attaching package: 'DescTools'## The following object is masked from 'package:mclust':
##
## BrierScore## The following object is masked from 'package:car':
##
## Recode## The following objects are masked from 'package:psych':
##
## AUC, ICC, SDPseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.2929395 0.3737877 0.2263965 0.20473428.3.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.043215053
## 2 0.043215053
## 3 0.043215053
## 4 0.058057746
## 5 0.031629651
## 6 0.042698190
## 7 0.062129949
## 8 0.023067348
## 9 0.023067348
## 10 0.033951819
## 11 0.033951819
## 12 0.031253134
## 13 0.045767706
## 14 0.016777946
## 15 0.016777946
## 16 0.022794204
## 17 0.022794204
## 18 0.022794204
## 19 0.033542453
## 20 0.012179101
## 21 0.012179101
## 22 0.012179101
## 23 0.012179101
## 24 0.012179101
## 25 0.016580345
## 26 0.016580345
## 27 0.016580345
## 28 0.008827742
## 29 0.008827742
## 30 0.008827742
## climate-disengaged\n(low peb, low impairment)
## 1 0.9456715
## 2 0.9456715
## 3 0.9456715
## 4 0.9273703
## 5 0.9590641
## 6 0.9450405
## 7 0.9206183
## 8 0.9691675
## 9 0.9691675
## 10 0.9549968
## 11 0.9549968
## 12 0.9584787
## 13 0.9396924
## 14 0.9767602
## 15 0.9767602
## 16 0.9686375
## 17 0.9686375
## 18 0.9686375
## 19 0.9542658
## 20 0.9824542
## 21 0.9824542
## 22 0.9824542
## 23 0.9824542
## 24 0.9824542
## 25 0.9762890
## 26 0.9762890
## 27 0.9762890
## 28 0.9867217
## 29 0.9867217
## 30 0.9867217
## climate-vulnerable\n(high peb, high impairment)
## 1 0.011113410
## 2 0.011113410
## 3 0.011113410
## 4 0.014571993
## 5 0.009306286
## 6 0.012261341
## 7 0.017251715
## 8 0.007765142
## 9 0.007765142
## 10 0.011051406
## 11 0.011051406
## 12 0.010268141
## 13 0.014539858
## 14 0.006461901
## 15 0.006461901
## 16 0.008568256
## 17 0.008568256
## 18 0.008568256
## 19 0.012191736
## 20 0.005366689
## 21 0.005366689
## 22 0.005366689
## 23 0.005366689
## 24 0.005366689
## 25 0.007130686
## 26 0.007130686
## 27 0.007130686
## 28 0.004450518
## 29 0.004450518
## 30 0.0044505188.3.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.3.7 Likelihood ratio tests
Examine significance of predictors to the model
8.3.7.1 Climate anxiety
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlrtest(test, "data.lpa_out.data.anx.z")## # weights: 15 (8 variable)
## initial value 662.463210
## iter 10 value 371.266423
## final value 368.952135
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z
## Model 2: class.rel ~ data.lpa_out.data.sad.z + data.lpa_out.data.ang.z +
## data.lpa_out.data.indif.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 10 -357.12
## 2 8 -368.95 -2 23.665 7.264e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.3.7.2 Climate sadness
lrtest(test, "data.lpa_out.data.sad.z")## # weights: 15 (8 variable)
## initial value 662.463210
## iter 10 value 363.154369
## final value 360.410180
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.ang.z +
## data.lpa_out.data.indif.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 10 -357.12
## 2 8 -360.41 -2 6.5812 0.03723 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.3.7.3 Climate anger
lrtest(test, "data.lpa_out.data.ang.z")## # weights: 15 (8 variable)
## initial value 662.463210
## iter 10 value 366.500067
## final value 363.348884
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.indif.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 10 -357.12
## 2 8 -363.35 -2 12.459 0.001971 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.3.7.4 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 15 (8 variable)
## initial value 662.463210
## iter 10 value 372.738303
## final value 361.200776
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 10 -357.12
## 2 8 -361.20 -2 8.1624 0.01689 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.3.8 Visualizing means of auxiliary variables across profiles
# Create a data frame
df <- data.frame(
class=data.lpa$class,
anx=data.lpa$data.lpa_out.data.anx.z,
sad=data.lpa$data.lpa_out.data.sad.z,
ang=data.lpa$data.lpa_out.data.ang.z,
indif=data.lpa$data.lpa_out.data.indif.z
)
# Calculate profile-means
df.means <- aggregate(. ~ class, df, mean, na.rm = TRUE)
df.means## class anx sad
## 1 climate-resilient\n(high peb, low impairment) 0.6916940 0.736761
## 2 climate-disengaged\n(low peb, low impairment) -0.3016603 -0.291139
## 3 climate-vulnerable\n(high peb, high impairment) 0.9980014 0.849361
## ang indif
## 1 0.7482332 -0.5159251
## 2 -0.2913827 0.1845219
## 3 0.8322136 -0.4577540# Melt the data
library(reshape2)
melted_df <- melt(df.means, id.vars = "class")
# Load packages
library(ggplot2)
library(stringr)
#Plot
p.all.z.a <- ggplot(melted_df, aes(x = variable, y = value, group=class, color = class)) +
geom_line(lwd=.3) +
geom_point() +
labs(y = "z-standardized means",
x = "",
color = "Profiles") +
scale_x_discrete(
label = c(
"Climate\nanxiety",
"Climate\nsadness",
"Climate\nanger",
"Climate\nindifference")) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
coord_cartesian(clip = "off")
print(p.all.z.a)
# Save the plot as a PNG file
ggsave("Figure-step1.png", plot = p.all.z.a, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step1.pdf", plot = p.all.z.a, width = 9, height = 5)8.4 Step 2: Climate emotions and resilience factors as predictors
8.4.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
data.lpa_out.data.ang.z + data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 33 (20 variable)
## initial value 662.463210
## iter 10 value 389.464376
## iter 20 value 343.619242
## iter 30 value 342.003077
## final value 342.003071
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z,
## data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 1.9891464
## climate-vulnerable\n(high peb, high impairment) -0.6540582
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) -0.5104562
## climate-vulnerable\n(high peb, high impairment) 0.4682238
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) -0.30013874
## climate-vulnerable\n(high peb, high impairment) 0.09111049
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) -0.41632666
## climate-vulnerable\n(high peb, high impairment) 0.04422486
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.302578939
## climate-vulnerable\n(high peb, high impairment) -0.003548318
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.07087351
## climate-vulnerable\n(high peb, high impairment) -0.34819894
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.2611251
## climate-vulnerable\n(high peb, high impairment) -0.4503436
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.08853793
## climate-vulnerable\n(high peb, high impairment) 0.01634861
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2393481
## climate-vulnerable\n(high peb, high impairment) 0.2473102
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.5084209
## climate-vulnerable\n(high peb, high impairment) -0.3566308
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1654829
## climate-vulnerable\n(high peb, high impairment) 0.2606343
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.1727510
## climate-vulnerable\n(high peb, high impairment) 0.2316666
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.1879846
## climate-vulnerable\n(high peb, high impairment) 0.2516676
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.1784939
## climate-vulnerable\n(high peb, high impairment) 0.2357657
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1651561
## climate-vulnerable\n(high peb, high impairment) 0.2199592
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.161560
## climate-vulnerable\n(high peb, high impairment) 0.197723
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1585208
## climate-vulnerable\n(high peb, high impairment) 0.1994251
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1290560
## climate-vulnerable\n(high peb, high impairment) 0.1635984
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1569267
## climate-vulnerable\n(high peb, high impairment) 0.2071246
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.1723658
## climate-vulnerable\n(high peb, high impairment) 0.2289837
##
## Residual Deviance: 684.0061
## AIC: 724.0061Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.66480598 2.31348685
## data.lpa_out.data.anx.z -0.84904185 -0.17187054
## data.lpa_out.data.sad.z -0.66858185 0.06830436
## data.lpa_out.data.ang.z -0.76616832 -0.06648499
## data.lpa_out.data.indif.z -0.02112108 0.62627896
## data.lpa_out.data.emp.pt.z -0.38752523 0.24577822
## data.lpa_out.data.emp.ec.z -0.57182022 0.04956996
## data.lpa_out.data.emoreg.ed.z -0.16440723 0.34148309
## data.lpa_out.data.emoreg.ier.z -0.54691878 0.06822266
## data.lpa_out.data.natcon.z -0.84625172 -0.17059013
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.16489210 -0.14322439
## data.lpa_out.data.anx.z 0.01416572 0.92228194
## data.lpa_out.data.sad.z -0.40214887 0.58436985
## data.lpa_out.data.ang.z -0.41786738 0.50631710
## data.lpa_out.data.indif.z -0.43466035 0.42756372
## data.lpa_out.data.emp.pt.z -0.73572898 0.03933110
## data.lpa_out.data.emp.ec.z -0.84120960 -0.05947764
## data.lpa_out.data.emoreg.ed.z -0.30429838 0.33699559
## data.lpa_out.data.emoreg.ier.z -0.15864655 0.65326689
## data.lpa_out.data.natcon.z -0.80543062 0.092169108.4.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 7.3092920
## climate-vulnerable\n(high peb, high impairment) 0.5199315
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.6002217
## climate-vulnerable\n(high peb, high impairment) 1.5971549
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.7407154
## climate-vulnerable\n(high peb, high impairment) 1.0953900
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.6594648
## climate-vulnerable\n(high peb, high impairment) 1.0452174
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.353345
## climate-vulnerable\n(high peb, high impairment) 0.996458
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9315797
## climate-vulnerable\n(high peb, high impairment) 0.7059584
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7701845
## climate-vulnerable\n(high peb, high impairment) 0.6374091
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.092576
## climate-vulnerable\n(high peb, high impairment) 1.016483
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7871409
## climate-vulnerable\n(high peb, high impairment) 1.2805763
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.6014446
## climate-vulnerable\n(high peb, high impairment) 0.7000309Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.2846478 10.1096140
## data.lpa_out.data.anx.z 0.4278247 0.8420882
## data.lpa_out.data.sad.z 0.5124348 1.0706911
## data.lpa_out.data.ang.z 0.4647906 0.9356770
## data.lpa_out.data.indif.z 0.9791004 1.8706369
## data.lpa_out.data.emp.pt.z 0.6787345 1.2786160
## data.lpa_out.data.emp.ec.z 0.5644970 1.0508191
## data.lpa_out.data.emoreg.ed.z 0.8483965 1.4070328
## data.lpa_out.data.emoreg.ier.z 0.5787303 1.0706037
## data.lpa_out.data.natcon.z 0.4290200 0.8431671
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.3119563 0.8665596
## data.lpa_out.data.anx.z 1.0142665 2.5150230
## data.lpa_out.data.sad.z 0.6688812 1.7938602
## data.lpa_out.data.ang.z 0.6584495 1.6591694
## data.lpa_out.data.indif.z 0.6474845 1.5335169
## data.lpa_out.data.emp.pt.z 0.4791560 1.0401148
## data.lpa_out.data.emp.ec.z 0.4311886 0.9422566
## data.lpa_out.data.emoreg.ed.z 0.7376407 1.4007329
## data.lpa_out.data.emoreg.ier.z 0.8532979 1.9218089
## data.lpa_out.data.natcon.z 0.4468954 1.09655028.4.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 12.020257
## climate-vulnerable\n(high peb, high impairment) -2.509486
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) -2.954868
## climate-vulnerable\n(high peb, high impairment) 2.021111
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) -1.5966132
## climate-vulnerable\n(high peb, high impairment) 0.3620272
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) -2.3324416
## climate-vulnerable\n(high peb, high impairment) 0.1875797
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.83207844
## climate-vulnerable\n(high peb, high impairment) -0.01613171
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.4386823
## climate-vulnerable\n(high peb, high impairment) -1.7610438
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.647261
## climate-vulnerable\n(high peb, high impairment) -2.258209
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.68604259
## climate-vulnerable\n(high peb, high impairment) 0.09993133
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.525222
## climate-vulnerable\n(high peb, high impairment) 1.194017
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -2.949662
## climate-vulnerable\n(high peb, high impairment) -1.557450p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.00000000
## climate-vulnerable\n(high peb, high impairment) 0.01209069
## data.lpa_out.data.anx.z
## climate-disengaged\n(low peb, low impairment) 0.003128033
## climate-vulnerable\n(high peb, high impairment) 0.043268277
## data.lpa_out.data.sad.z
## climate-disengaged\n(low peb, low impairment) 0.1103520
## climate-vulnerable\n(high peb, high impairment) 0.7173317
## data.lpa_out.data.ang.z
## climate-disengaged\n(low peb, low impairment) 0.01967747
## climate-vulnerable\n(high peb, high impairment) 0.85120611
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.06693974
## climate-vulnerable\n(high peb, high impairment) 0.98712931
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.66089172
## climate-vulnerable\n(high peb, high impairment) 0.07823098
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.09950444
## climate-vulnerable\n(high peb, high impairment) 0.02393260
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.4926863
## climate-vulnerable\n(high peb, high impairment) 0.9203988
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1272038
## climate-vulnerable\n(high peb, high impairment) 0.2324715
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.003181216
## climate-vulnerable\n(high peb, high impairment) 0.1193636268.4.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3275159 0.4179067 0.2591423 0.21581778.4.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.016751248
## 2 0.007507202
## 3 0.042222885
## 4 0.009235563
## 5 0.004783875
## 6 0.053219420
## 7 0.023709809
## 8 0.027591176
## 9 0.022298913
## 10 0.018592225
## 11 0.012155760
## 12 0.047839467
## 13 0.051103613
## 14 0.040888919
## 15 0.009971567
## 16 0.017807299
## 17 0.026440829
## 18 0.041391564
## 19 0.022279263
## 20 0.005932992
## 21 0.009688192
## 22 0.002072900
## 23 0.007232576
## 24 0.004754014
## 25 0.007993702
## 26 0.048640557
## 27 0.033529264
## 28 0.010793167
## 29 0.006779086
## 30 0.008914050
## climate-disengaged\n(low peb, low impairment)
## 1 0.9738483
## 2 0.9768535
## 3 0.9502633
## 4 0.9810551
## 5 0.9902804
## 6 0.9374773
## 7 0.9667492
## 8 0.9609859
## 9 0.9714509
## 10 0.9735111
## 11 0.9836309
## 12 0.9424623
## 13 0.9086065
## 14 0.9453134
## 15 0.9856357
## 16 0.9680555
## 17 0.9639560
## 18 0.9502751
## 19 0.9654080
## 20 0.9882762
## 21 0.9847987
## 22 0.9951206
## 23 0.9890900
## 24 0.9894846
## 25 0.9879349
## 26 0.9436622
## 27 0.9613150
## 28 0.9839863
## 29 0.9891867
## 30 0.9891135
## climate-vulnerable\n(high peb, high impairment)
## 1 0.009400424
## 2 0.015639276
## 3 0.007513795
## 4 0.009709363
## 5 0.004935707
## 6 0.009303251
## 7 0.009541033
## 8 0.011422954
## 9 0.006250229
## 10 0.007896654
## 11 0.004213375
## 12 0.009698196
## 13 0.040289851
## 14 0.013797631
## 15 0.004392714
## 16 0.014137221
## 17 0.009603209
## 18 0.008333367
## 19 0.012312737
## 20 0.005790763
## 21 0.005513109
## 22 0.002806510
## 23 0.003677442
## 24 0.005761344
## 25 0.004071448
## 26 0.007697220
## 27 0.005155735
## 28 0.005220568
## 29 0.004034185
## 30 0.0019724368.4.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.4.7 Likelihood ratio tests
Examine significance of predictors to the model
8.4.7.1 Climate anxiety
library(lmtest)
lrtest(test, "data.lpa_out.data.anx.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 380.758860
## iter 20 value 354.989421
## final value 354.156852
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.sad.z + data.lpa_out.data.ang.z +
## data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -354.16 -2 24.308 5.268e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.4.7.2 Climate sadness
lrtest(test, "data.lpa_out.data.sad.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 366.865551
## iter 20 value 346.950834
## final value 343.979813
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.ang.z +
## data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -343.98 -2 3.9535 0.1385-> not significant predictor
8.4.7.3 Climate anger
lrtest(test, "data.lpa_out.data.ang.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 370.674068
## iter 20 value 346.720018
## final value 345.738841
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -345.74 -2 7.4715 0.02385 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.4.7.4 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 381.182878
## iter 20 value 348.145966
## final value 344.291781
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -344.29 -2 4.5774 0.1014-> not significant predictor
8.4.7.5 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 384.397138
## iter 20 value 345.325560
## final value 343.652479
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -343.65 -2 3.2988 0.1922-> not significant predictor
8.4.7.6 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 381.174146
## iter 20 value 345.775040
## final value 344.783733
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -344.78 -2 5.5613 0.062 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.4.7.7 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 378.261398
## iter 20 value 343.735058
## final value 342.259946
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -342.26 -2 0.5138 0.7735-> not significant predictor
8.4.7.8 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 386.932278
## iter 20 value 347.116672
## final value 345.550027
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -345.55 -2 7.0939 0.02881 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.4.7.9 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 384.387435
## iter 20 value 347.780184
## final value 346.543017
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.anx.z + data.lpa_out.data.sad.z +
## data.lpa_out.data.ang.z + data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 20 -342.00
## 2 18 -346.54 -2 9.0799 0.01067 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.4.8 Visualizing means of auxiliary variables across profiles
# Create a data frame
df <- data.frame(
class=data.lpa$class,
anx=data.lpa$data.lpa_out.data.anx.z,
sad=data.lpa$data.lpa_out.data.sad.z,
ang=data.lpa$data.lpa_out.data.ang.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
# Calculate profile-means
df.means <- aggregate(. ~ class, df, mean, na.rm = TRUE)
df.means## class anx sad
## 1 climate-resilient\n(high peb, low impairment) 0.6916940 0.736761
## 2 climate-disengaged\n(low peb, low impairment) -0.3016603 -0.291139
## 3 climate-vulnerable\n(high peb, high impairment) 0.9980014 0.849361
## ang indif emp.pt emp.ec emoreg.ed emoreg.ier
## 1 0.7482332 -0.5159251 0.41478159 0.5139130 -0.12037584 0.3921437
## 2 -0.2913827 0.1845219 -0.10805289 -0.1457956 0.03776484 -0.1407372
## 3 0.8322136 -0.4577540 0.08270156 0.1868570 -0.06936175 0.3513708
## natcon
## 1 0.6214897
## 2 -0.2088794
## 3 0.4565499# Melt the data
library(reshape2)
melted_df <- melt(df.means, id.vars = "class")
#Create secondary labels for x-axis
library(grid)
label.1 <- textGrob("Climate emotions", gp=gpar(fontsize=11))
label.2 <- textGrob("Resilience factors", gp=gpar(fontsize=11))
# Load packages
library(ggplot2)
library(stringr)
#Plot
p.all.z.b <- ggplot(melted_df, aes(x = variable, y = value, group=class, color = class)) +
geom_line(lwd=.3,
linetype = "dashed") +
geom_point() +
labs(y = "z-standardized means",
x = "",
color = "Profiles") +
scale_x_discrete(
label = c(
"Climate\nanxiety",
"Climate\nsadness",
"Climate\nanger",
"Climate\nindifference",
"Perspective\ntaking",
"Empathic\nconcern",
"Emotional\nsuppression",
"Emotional\nintegration",
"Nature\nconnected-\nness")) +
scale_color_manual(
values = c("#D73027", "#FDAE61", "#4575B4"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
geom_vline(xintercept=c(4.5), linetype='dashed', size=0.4) +
theme(plot.margin = unit(c(1,1,3,1), "lines")) +
annotation_custom(label.1,xmin=1,xmax=4,ymin=-0.8,ymax=-0.8) +
annotation_custom(label.2,xmin=5,xmax=9,ymin=-0.8,ymax=-0.8) +
coord_cartesian(clip = "off")
print(p.all.z.b)
# Save the plot as a PNG file
ggsave("Figure-step2.png", plot = p.all.z.b, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step2.pdf", plot = p.all.z.b, width = 9, height = 5)8.5 Step 3a: Climate emotions, resilience factors, and interactions of climate emotions and perspective taking as predictors
8.5.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emo.z*data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 358.010159
## iter 20 value 344.212740
## final value 342.645103
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z, data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 2.0114421
## climate-vulnerable\n(high peb, high impairment) -0.6762115
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.27956017
## climate-vulnerable\n(high peb, high impairment) 0.04233242
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -1.0977275
## climate-vulnerable\n(high peb, high impairment) 0.5997993
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.02300551
## climate-vulnerable\n(high peb, high impairment) -0.46746072
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.2736936
## climate-vulnerable\n(high peb, high impairment) -0.4358796
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.09387295
## climate-vulnerable\n(high peb, high impairment) 0.02941295
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2310959
## climate-vulnerable\n(high peb, high impairment) 0.2259771
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.5195320
## climate-vulnerable\n(high peb, high impairment) -0.3743898
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.1676334
## climate-vulnerable\n(high peb, high impairment) 0.1165068
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1652518
## climate-vulnerable\n(high peb, high impairment) 0.2611444
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1654189
## climate-vulnerable\n(high peb, high impairment) 0.2164466
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.1756846
## climate-vulnerable\n(high peb, high impairment) 0.2341928
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1805663
## climate-vulnerable\n(high peb, high impairment) 0.2527601
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1597005
## climate-vulnerable\n(high peb, high impairment) 0.1995281
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1300685
## climate-vulnerable\n(high peb, high impairment) 0.1612023
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1567148
## climate-vulnerable\n(high peb, high impairment) 0.2057685
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.1730075
## climate-vulnerable\n(high peb, high impairment) 0.2285834
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1646689
## climate-vulnerable\n(high peb, high impairment) 0.1807640
##
## Residual Deviance: 685.2902
## AIC: 721.2902Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.68755448 2.33532980
## data.lpa_out.data.indif.z -0.04465501 0.60377534
## data.lpa_out.data.emo.z -1.44206298 -0.75339210
## data.lpa_out.data.emp.pt.z -0.37690905 0.33089802
## data.lpa_out.data.emp.ec.z -0.58670075 0.03931355
## data.lpa_out.data.emoreg.ed.z -0.16105664 0.34880254
## data.lpa_out.data.emoreg.ier.z -0.53825118 0.07605944
## data.lpa_out.data.natcon.z -0.85862042 -0.18044349
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z -0.49037855 0.15511179
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.1880451 -0.16437788
## data.lpa_out.data.indif.z -0.3818951 0.46655999
## data.lpa_out.data.emo.z 0.1407898 1.05880889
## data.lpa_out.data.emp.pt.z -0.9628613 0.02793989
## data.lpa_out.data.emp.ec.z -0.8269476 -0.04481162
## data.lpa_out.data.emoreg.ed.z -0.2865377 0.34536364
## data.lpa_out.data.emoreg.ier.z -0.1773218 0.62927601
## data.lpa_out.data.natcon.z -0.8224049 0.07362535
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z -0.2377842 0.470797788.5.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 7.474088
## climate-vulnerable\n(high peb, high impairment) 0.508540
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.322548
## climate-vulnerable\n(high peb, high impairment) 1.043241
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.3336284
## climate-vulnerable\n(high peb, high impairment) 1.8217532
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9772571
## climate-vulnerable\n(high peb, high impairment) 0.6265913
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7605651
## climate-vulnerable\n(high peb, high impairment) 0.6466956
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.09842
## climate-vulnerable\n(high peb, high impairment) 1.02985
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7936634
## climate-vulnerable\n(high peb, high impairment) 1.2535470
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.5947989
## climate-vulnerable\n(high peb, high impairment) 0.6877088
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.8456638
## climate-vulnerable\n(high peb, high impairment) 1.1235652Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.4062435 10.3328672
## data.lpa_out.data.indif.z 0.9563274 1.8290109
## data.lpa_out.data.emo.z 0.2364395 0.4707670
## data.lpa_out.data.emp.pt.z 0.6859785 1.3922178
## data.lpa_out.data.emp.ec.z 0.5561592 1.0400966
## data.lpa_out.data.emoreg.ed.z 0.8512439 1.4173693
## data.lpa_out.data.emoreg.ier.z 0.5837683 1.0790267
## data.lpa_out.data.natcon.z 0.4237463 0.8348999
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z 0.6123945 1.1677885
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.3048166 0.8484214
## data.lpa_out.data.indif.z 0.6825666 1.5944997
## data.lpa_out.data.emo.z 1.1511827 2.8829350
## data.lpa_out.data.emp.pt.z 0.3817989 1.0283339
## data.lpa_out.data.emp.ec.z 0.4373823 0.9561776
## data.lpa_out.data.emoreg.ed.z 0.7508587 1.4125035
## data.lpa_out.data.emoreg.ier.z 0.8375102 1.8762517
## data.lpa_out.data.natcon.z 0.4393737 1.0764035
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z 0.7883728 1.60127118.5.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 12.171980
## climate-vulnerable\n(high peb, high impairment) -2.589416
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.690013
## climate-vulnerable\n(high peb, high impairment) 0.195579
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -6.248286
## climate-vulnerable\n(high peb, high impairment) 2.561134
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.1274075
## climate-vulnerable\n(high peb, high impairment) -1.8494248
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.713793
## climate-vulnerable\n(high peb, high impairment) -2.184552
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.7217193
## climate-vulnerable\n(high peb, high impairment) 0.1824599
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.474627
## climate-vulnerable\n(high peb, high impairment) 1.098210
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -3.002945
## climate-vulnerable\n(high peb, high impairment) -1.637870
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -1.0180025
## climate-vulnerable\n(high peb, high impairment) 0.6445243p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.000000000
## climate-vulnerable\n(high peb, high impairment) 0.009613886
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.09102547
## climate-vulnerable\n(high peb, high impairment) 0.84493967
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 4.149803e-10
## climate-vulnerable\n(high peb, high impairment) 1.043310e-02
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.8986179
## climate-vulnerable\n(high peb, high impairment) 0.0643965
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.08656667
## climate-vulnerable\n(high peb, high impairment) 0.02892172
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.4704671
## climate-vulnerable\n(high peb, high impairment) 0.8552218
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1403128
## climate-vulnerable\n(high peb, high impairment) 0.2721127
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.00267381
## climate-vulnerable\n(high peb, high impairment) 0.10144884
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.3086768
## climate-vulnerable\n(high peb, high impairment) 0.51923558.5.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3260823 0.4160775 0.2577515 0.21875948.5.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.014967060
## 2 0.010891708
## 3 0.032585973
## 4 0.016077293
## 5 0.005134503
## 6 0.058763223
## 7 0.024047932
## 8 0.025543508
## 9 0.019379619
## 10 0.027091320
## 11 0.013285034
## 12 0.042623451
## 13 0.063064792
## 14 0.035505468
## 15 0.011221025
## 16 0.024164999
## 17 0.021722647
## 18 0.027616667
## 19 0.024297365
## 20 0.011293892
## 21 0.014358169
## 22 0.003631341
## 23 0.007594386
## 24 0.007596807
## 25 0.010414446
## 26 0.041953718
## 27 0.035752181
## 28 0.018006260
## 29 0.008590571
## 30 0.008148901
## climate-disengaged\n(low peb, low impairment)
## 1 0.9782914
## 2 0.9576991
## 3 0.9634973
## 4 0.9545997
## 5 0.9894822
## 6 0.9312639
## 7 0.9656882
## 8 0.9657546
## 9 0.9765550
## 10 0.9542958
## 11 0.9810637
## 12 0.9505740
## 13 0.8692859
## 14 0.9553810
## 15 0.9835084
## 16 0.9512385
## 17 0.9722854
## 18 0.9690337
## 19 0.9596634
## 20 0.9674968
## 21 0.9738768
## 22 0.9875238
## 23 0.9885906
## 24 0.9781537
## 25 0.9825285
## 26 0.9529433
## 27 0.9586114
## 28 0.9681873
## 29 0.9851148
## 30 0.9902985
## climate-vulnerable\n(high peb, high impairment)
## 1 0.006741574
## 2 0.031409192
## 3 0.003916690
## 4 0.029323049
## 5 0.005383317
## 6 0.009972855
## 7 0.010263822
## 8 0.008701887
## 9 0.004065361
## 10 0.018612839
## 11 0.005651240
## 12 0.006802503
## 13 0.067649261
## 14 0.009113497
## 15 0.005270529
## 16 0.024596491
## 17 0.005991998
## 18 0.003349638
## 19 0.016039213
## 20 0.021209288
## 21 0.011765055
## 22 0.008844809
## 23 0.003814979
## 24 0.014249489
## 25 0.007057055
## 26 0.005103028
## 27 0.005636372
## 28 0.013806448
## 29 0.006294605
## 30 0.0015525848.5.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.5.7 Likelihood ratio tests
Examine significance of predictors to the model
8.5.7.1 Climate emotions
library(lmtest)
lrtest(test, "data.lpa_out.data.emo.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 404.419769
## iter 20 value 390.994231
## final value 390.891160
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -390.89 -2 96.492 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.5.7.2 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.450663
## iter 20 value 344.598240
## final value 344.392911
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.emo.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -344.39 -2 3.4956 0.1742-> not significant predictor
8.5.7.3 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 353.632746
## iter 20 value 345.513721
## final value 344.833412
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -344.83 -2 4.3766 0.1121-> not significant predictor
8.5.7.4 Climate emotions * Empathy - perspective taking
# Reduced model without interaction
test_no_int <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.649244
## iter 20 value 344.479611
## final value 344.028777
## converged# Likelihood ratio test
lrtest(test, test_no_int)## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -344.03 -2 2.7673 0.2507-> not significant predictor
8.5.7.5 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 357.164270
## iter 20 value 345.802081
## final value 345.342027
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -345.34 -2 5.3938 0.06741 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.5.7.6 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.872209
## iter 20 value 343.351747
## final value 342.915222
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -342.92 -2 0.5402 0.7633-> not significant predictor
8.5.7.7 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 356.249963
## iter 20 value 346.289602
## final value 345.869410
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -345.87 -2 6.4486 0.03978 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.5.7.8 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 355.090935
## iter 20 value 347.453941
## final value 347.364138
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.pt.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -342.65
## 2 16 -347.36 -2 9.4381 0.008924 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.5.8 Visualizing interactions
# Simplified variable names
df <- data.frame(
class.rel=data.lpa$class.rel,
emo=data.lpa$data.lpa_out.data.emo.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
test <- multinom(class.rel ~ indif + emo*emp.pt + emp.ec +
emoreg.ier + emoreg.ed + natcon,
data = df, model = TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 358.010159
## iter 20 value 344.212740
## final value 342.645103
## converged# Predicted probabilities for interaction
preds <- ggpredict(test,
terms = c("emo [-2:2 by=.5]", "emp.pt [-1,1]"))
df_preds <- as.data.frame(preds)
# Relabeling legend
df_preds$group <- factor(df_preds$group,
levels = c(-1, 1),
labels = c("-1 SD", "+1 SD"))
# Plotting with ggplot
step3.int.pt <- ggplot(df_preds, aes(x = x, y = predicted,
group = group, color = group)) +
geom_line(lwd =.3) +
geom_point() +
facet_wrap(~ response.level) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = NULL) +
theme(
plot.title.position = "plot",
plot.title = element_text(hjust = 0, size = 14)
) +
scale_color_manual(values = c("#fed789", "#476F84"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
coord_cartesian(clip = "off")
print(step3.int.pt)
# Plotting with plot function
step3.int.pt.simp <- plot(preds) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = "Perspective taking (z-standardized)")## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.print(step3.int.pt.simp)## Ignoring unknown labels:
## • linetype : "emp.pt"
## • shape : "emp.pt"
# Save the plot as a PNG file
ggsave("Figure-step3.int.pt.png", plot = step3.int.pt, width = 9, height = 5, dpi = 300)
ggsave("Figure-step3.int.pt.simp.png", plot = step3.int.pt, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step3.int.pt.pdf", plot = step3.int.pt, width = 9, height = 5)
ggsave("Figure-step3.int.pt.simp.pdf", plot = step3.int.pt, width = 9, height = 5)8.6 Step 3b: Climate emotions, resilience factors, and interactions of climate emotions and empathic concern as predictors
8.6.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emo.z*data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 353.905712
## iter 20 value 340.485443
## final value 339.681681
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z,
## data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 2.0399885
## climate-vulnerable\n(high peb, high impairment) -0.7467523
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.28145663
## climate-vulnerable\n(high peb, high impairment) 0.07891352
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.07255442
## climate-vulnerable\n(high peb, high impairment) -0.29163851
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -1.1421995
## climate-vulnerable\n(high peb, high impairment) 0.5763843
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.3244370
## climate-vulnerable\n(high peb, high impairment) -0.7857971
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.08943659
## climate-vulnerable\n(high peb, high impairment) 0.02667071
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2486517
## climate-vulnerable\n(high peb, high impairment) 0.1705371
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.5109482
## climate-vulnerable\n(high peb, high impairment) -0.3693300
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.05183047
## climate-vulnerable\n(high peb, high impairment) 0.38191422
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1702067
## climate-vulnerable\n(high peb, high impairment) 0.2720279
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1667709
## climate-vulnerable\n(high peb, high impairment) 0.2155493
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1616405
## climate-vulnerable\n(high peb, high impairment) 0.1974179
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.1830502
## climate-vulnerable\n(high peb, high impairment) 0.2448527
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1849922
## climate-vulnerable\n(high peb, high impairment) 0.2473899
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1298719
## climate-vulnerable\n(high peb, high impairment) 0.1610910
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1575112
## climate-vulnerable\n(high peb, high impairment) 0.2042890
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.1731516
## climate-vulnerable\n(high peb, high impairment) 0.2278840
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1709026
## climate-vulnerable\n(high peb, high impairment) 0.1735837
##
## Residual Deviance: 679.3634
## AIC: 715.3634Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.70638954 2.37358744
## data.lpa_out.data.indif.z -0.04540839 0.60832166
## data.lpa_out.data.emp.pt.z -0.38936397 0.24425513
## data.lpa_out.data.emo.z -1.50097131 -0.78342771
## data.lpa_out.data.emp.ec.z -0.68701513 0.03814110
## data.lpa_out.data.emoreg.ed.z -0.16510758 0.34398075
## data.lpa_out.data.emoreg.ier.z -0.55736802 0.06006469
## data.lpa_out.data.natcon.z -0.85031907 -0.17157731
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z -0.38679336 0.28313243
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.27991714 -0.21358748
## data.lpa_out.data.indif.z -0.34355534 0.50138238
## data.lpa_out.data.emp.pt.z -0.67857043 0.09529342
## data.lpa_out.data.emo.z 0.09648184 1.05628673
## data.lpa_out.data.emp.ec.z -1.27067247 -0.30092180
## data.lpa_out.data.emoreg.ed.z -0.28906177 0.34240318
## data.lpa_out.data.emoreg.ier.z -0.22986202 0.57093614
## data.lpa_out.data.natcon.z -0.81597446 0.07731439
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z 0.04169637 0.722132088.6.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 7.6905207
## climate-vulnerable\n(high peb, high impairment) 0.4739031
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.325059
## climate-vulnerable\n(high peb, high impairment) 1.082111
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9300151
## climate-vulnerable\n(high peb, high impairment) 0.7470385
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.3191163
## climate-vulnerable\n(high peb, high impairment) 1.7795923
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7229342
## climate-vulnerable\n(high peb, high impairment) 0.4557563
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.093558
## climate-vulnerable\n(high peb, high impairment) 1.027030
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7798516
## climate-vulnerable\n(high peb, high impairment) 1.1859416
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.5999265
## climate-vulnerable\n(high peb, high impairment) 0.6911973
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.9494898
## climate-vulnerable\n(high peb, high impairment) 1.4650864Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.5090354 10.7358374
## data.lpa_out.data.indif.z 0.9556071 1.8373451
## data.lpa_out.data.emp.pt.z 0.6774876 1.2766700
## data.lpa_out.data.emo.z 0.2229135 0.4568374
## data.lpa_out.data.emp.ec.z 0.5030754 1.0388778
## data.lpa_out.data.emoreg.ed.z 0.8478025 1.4105515
## data.lpa_out.data.emoreg.ier.z 0.5727145 1.0619052
## data.lpa_out.data.natcon.z 0.4272786 0.8423351
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z 0.6792314 1.3272809
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.2780603 0.8076815
## data.lpa_out.data.indif.z 0.7092442 1.6510020
## data.lpa_out.data.emp.pt.z 0.5073418 1.0999816
## data.lpa_out.data.emo.z 1.1012896 2.8756730
## data.lpa_out.data.emp.ec.z 0.2806428 0.7401356
## data.lpa_out.data.emoreg.ed.z 0.7489659 1.4083280
## data.lpa_out.data.emoreg.ier.z 0.7946432 1.7699232
## data.lpa_out.data.natcon.z 0.4422082 1.0803817
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z 1.0425779 2.05881818.6.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 11.985361
## climate-vulnerable\n(high peb, high impairment) -2.745132
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.6876840
## climate-vulnerable\n(high peb, high impairment) 0.3661043
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.4488629
## climate-vulnerable\n(high peb, high impairment) -1.4772650
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -6.239816
## climate-vulnerable\n(high peb, high impairment) 2.354004
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.753787
## climate-vulnerable\n(high peb, high impairment) -3.176351
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.6886526
## climate-vulnerable\n(high peb, high impairment) 0.1655630
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.5786281
## climate-vulnerable\n(high peb, high impairment) 0.8347834
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -2.950872
## climate-vulnerable\n(high peb, high impairment) -1.620693
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.3032749
## climate-vulnerable\n(high peb, high impairment) 2.2001729p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.000000000
## climate-vulnerable\n(high peb, high impairment) 0.006048664
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.09147191
## climate-vulnerable\n(high peb, high impairment) 0.71428727
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.6535306
## climate-vulnerable\n(high peb, high impairment) 0.1396046
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 4.380869e-10
## climate-vulnerable\n(high peb, high impairment) 1.857239e-02
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.079466970
## climate-vulnerable\n(high peb, high impairment) 0.001491406
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.4910419
## climate-vulnerable\n(high peb, high impairment) 0.8685008
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1144214
## climate-vulnerable\n(high peb, high impairment) 0.4038397
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.003168781
## climate-vulnerable\n(high peb, high impairment) 0.105083456
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.76168035
## climate-vulnerable\n(high peb, high impairment) 0.027794638.6.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3326738 0.4244881 0.2641710 0.22517888.6.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.014001186
## 2 0.006160098
## 3 0.035322044
## 4 0.008286486
## 5 0.003994997
## 6 0.049766035
## 7 0.022315394
## 8 0.023917021
## 9 0.019189925
## 10 0.016077850
## 11 0.010619373
## 12 0.045689995
## 13 0.050189989
## 14 0.036628192
## 15 0.008649811
## 16 0.016052704
## 17 0.025907459
## 18 0.041223816
## 19 0.021608548
## 20 0.005213032
## 21 0.008560331
## 22 0.001800102
## 23 0.006378683
## 24 0.004084448
## 25 0.007711910
## 26 0.048743300
## 27 0.033231783
## 28 0.009685722
## 29 0.006094929
## 30 0.007975393
## climate-disengaged\n(low peb, low impairment)
## 1 0.9788258
## 2 0.9589979
## 3 0.9628556
## 4 0.9831580
## 5 0.9856608
## 6 0.9430694
## 7 0.9666431
## 8 0.9528689
## 9 0.9668713
## 10 0.9760927
## 11 0.9877676
## 12 0.9440746
## 13 0.9105754
## 14 0.9474537
## 15 0.9808264
## 16 0.9188417
## 17 0.9659686
## 18 0.9554268
## 19 0.9596992
## 20 0.9893727
## 21 0.9842275
## 22 0.9885883
## 23 0.9808425
## 24 0.9521050
## 25 0.9872273
## 26 0.9470349
## 27 0.9645061
## 28 0.9831133
## 29 0.9860526
## 30 0.9887841
## climate-vulnerable\n(high peb, high impairment)
## 1 0.007173043
## 2 0.034841961
## 3 0.001822387
## 4 0.008555488
## 5 0.010344235
## 6 0.007164544
## 7 0.011041515
## 8 0.023214108
## 9 0.013938805
## 10 0.007829451
## 11 0.001613061
## 12 0.010235378
## 13 0.039234599
## 14 0.015918078
## 15 0.010523821
## 16 0.065105576
## 17 0.008123915
## 18 0.003349351
## 19 0.018692258
## 20 0.005414279
## 21 0.007212120
## 22 0.009611602
## 23 0.012778799
## 24 0.043810598
## 25 0.005060832
## 26 0.004221804
## 27 0.002262135
## 28 0.007200965
## 29 0.007852515
## 30 0.0032405228.6.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.6.7 Likelihood ratio tests
Examine significance of predictors to the model
8.6.7.1 Climate emotions
library(lmtest)
lrtest(test, "data.lpa_out.data.emo.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 402.086601
## iter 20 value 388.145870
## final value 387.414455
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -387.41 -2 95.466 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.6.7.2 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 350.016628
## iter 20 value 341.627030
## final value 341.310055
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.emp.pt.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -341.31 -2 3.2567 0.1962-> not significant predictor
8.6.7.3 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 351.670054
## iter 20 value 342.125617
## final value 340.813760
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -340.81 -2 2.2642 0.3224-> not significant predictor
8.6.7.4 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.451791
## iter 20 value 345.111060
## final value 344.859923
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -344.86 -2 10.357 0.005638 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.6.7.5 Climate emotions * Empathy - empathic concern
# Reduced model without interaction
test_no_int <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.649244
## iter 20 value 344.479611
## final value 344.028777
## converged# Likelihood ratio test
lrtest(test, test_no_int)## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -344.03 -2 8.6942 0.01294 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.6.7.6 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 353.758734
## iter 20 value 340.193896
## final value 339.928552
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -339.93 -2 0.4937 0.7812-> not significant predictor
8.6.7.7 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.882612
## iter 20 value 342.913744
## final value 342.633653
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -342.63 -2 5.9039 0.05224 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.6.7.8 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.147709
## iter 20 value 344.837018
## final value 344.242639
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z:data.lpa_out.data.emp.ec.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -339.68
## 2 16 -344.24 -2 9.1219 0.01045 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.6.8 Visualizing interactions
# Simplified variable names
df <- data.frame(
class.rel=data.lpa$class.rel,
emo=data.lpa$data.lpa_out.data.emo.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
test <- multinom(class.rel ~ indif + emp.pt + emo*emp.ec +
emoreg.ier + emoreg.ed + natcon,
data = df, model = TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 353.905712
## iter 20 value 340.485443
## final value 339.681681
## converged# Predicted probabilities for interaction
preds <- ggpredict(test,
terms = c("emo [-2:2 by=.5]", "emp.ec [-1,1]"))
df_preds <- as.data.frame(preds)
# Relabeling legend
df_preds$group <- factor(df_preds$group,
levels = c(-1, 1),
labels = c("-1 SD", "+1 SD"))
# Plotting with ggplot
step3.int.ec <- ggplot(df_preds, aes(x = x, y = predicted,
group = group, color = group)) +
geom_line(lwd =.3) +
geom_point() +
facet_wrap(~ response.level) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = NULL) +
theme(
plot.title.position = "plot",
plot.title = element_text(hjust = 0, size = 14)
) +
scale_color_manual(values = c("#fed789", "#476F84"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
coord_cartesian(clip = "off")
print(step3.int.ec)
# Plotting with plot function
step3.int.ec.simp <- plot(preds) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = "Empathic concern (z-standardized)")## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.print(step3.int.ec.simp)## Ignoring unknown labels:
## • linetype : "emp.ec"
## • shape : "emp.ec"
# Save the plot as a PNG file
ggsave("Figure-step3.int.ec.png", plot = step3.int.ec, width = 9, height = 5, dpi = 300)
ggsave("Figure-step3.int.ec.simp.png", plot = step3.int.ec, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step3.int.ec.pdf", plot = step3.int.ec, width = 9, height = 5)
ggsave("Figure-step3.int.ec.simp.pdf", plot = step3.int.ec, width = 9, height = 5)8.7 Step 3c: Climate emotions, resilience factors, and interactions of climate emotions and emotional suppression as predictors
8.7.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z*data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 358.480230
## iter 20 value 344.504790
## final value 343.301648
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z,
## data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 2.0006544
## climate-vulnerable\n(high peb, high impairment) -0.6339798
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.30039252
## climate-vulnerable\n(high peb, high impairment) 0.02735045
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.0766157
## climate-vulnerable\n(high peb, high impairment) -0.3592860
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.2657508
## climate-vulnerable\n(high peb, high impairment) -0.4511413
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -1.0901544
## climate-vulnerable\n(high peb, high impairment) 0.5830399
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) -0.01661084
## climate-vulnerable\n(high peb, high impairment) -0.14920901
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2321592
## climate-vulnerable\n(high peb, high impairment) 0.2470129
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.4950646
## climate-vulnerable\n(high peb, high impairment) -0.3736265
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1578093
## climate-vulnerable\n(high peb, high impairment) 0.1762562
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1661908
## climate-vulnerable\n(high peb, high impairment) 0.2602664
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1649044
## climate-vulnerable\n(high peb, high impairment) 0.2193698
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1615716
## climate-vulnerable\n(high peb, high impairment) 0.1982972
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1581357
## climate-vulnerable\n(high peb, high impairment) 0.1992558
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.1727558
## climate-vulnerable\n(high peb, high impairment) 0.2325525
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1539317
## climate-vulnerable\n(high peb, high impairment) 0.2534737
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1564643
## climate-vulnerable\n(high peb, high impairment) 0.2070581
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.1721753
## climate-vulnerable\n(high peb, high impairment) 0.2289367
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1513205
## climate-vulnerable\n(high peb, high impairment) 0.1867438
##
## Residual Deviance: 686.6033
## AIC: 722.6033Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.67492652 2.32638231
## data.lpa_out.data.indif.z -0.02281412 0.62359916
## data.lpa_out.data.emp.pt.z -0.39329015 0.24005875
## data.lpa_out.data.emp.ec.z -0.57569113 0.04418948
## data.lpa_out.data.emo.z -1.42874951 -0.75155925
## data.lpa_out.data.emoreg.ed.z -0.31831142 0.28508973
## data.lpa_out.data.emoreg.ier.z -0.53882353 0.07450506
## data.lpa_out.data.natcon.z -0.83252197 -0.15760718
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z -0.13877352 0.45439211
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.1440926 -0.12386707
## data.lpa_out.data.indif.z -0.4026064 0.45730731
## data.lpa_out.data.emp.pt.z -0.7479414 0.02936949
## data.lpa_out.data.emp.ec.z -0.8416754 -0.06060712
## data.lpa_out.data.emo.z 0.1272453 1.03883449
## data.lpa_out.data.emoreg.ed.z -0.6460084 0.34759035
## data.lpa_out.data.emoreg.ier.z -0.1588135 0.65283940
## data.lpa_out.data.natcon.z -0.8223342 0.07508112
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z -0.1897549 0.542267358.7.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 7.3938932
## climate-vulnerable\n(high peb, high impairment) 0.5304764
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.350389
## climate-vulnerable\n(high peb, high impairment) 1.027728
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9262457
## climate-vulnerable\n(high peb, high impairment) 0.6981747
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7666301
## climate-vulnerable\n(high peb, high impairment) 0.6369009
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.3361646
## climate-vulnerable\n(high peb, high impairment) 1.7914760
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.9835264
## climate-vulnerable\n(high peb, high impairment) 0.8613891
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7928199
## climate-vulnerable\n(high peb, high impairment) 1.2801957
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.6095315
## climate-vulnerable\n(high peb, high impairment) 0.6882339
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.170943
## climate-vulnerable\n(high peb, high impairment) 1.192744Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.3384029 10.2408263
## data.lpa_out.data.indif.z 0.9774442 1.8656307
## data.lpa_out.data.emp.pt.z 0.6748329 1.2713238
## data.lpa_out.data.emp.ec.z 0.5623161 1.0451804
## data.lpa_out.data.emo.z 0.2396084 0.4716306
## data.lpa_out.data.emoreg.ed.z 0.7273762 1.3298814
## data.lpa_out.data.emoreg.ier.z 0.5834342 1.0773508
## data.lpa_out.data.natcon.z 0.4349510 0.8541853
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z 0.8704251 1.5752155
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.3185128 0.8834973
## data.lpa_out.data.indif.z 0.6685752 1.5798143
## data.lpa_out.data.emp.pt.z 0.4733400 1.0298050
## data.lpa_out.data.emp.ec.z 0.4309878 0.9411929
## data.lpa_out.data.emo.z 1.1356955 2.8259215
## data.lpa_out.data.emoreg.ed.z 0.5241338 1.4156522
## data.lpa_out.data.emoreg.ier.z 0.8531555 1.9209875
## data.lpa_out.data.natcon.z 0.4394048 1.0779716
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z 0.8271618 1.71990218.7.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 12.038301
## climate-vulnerable\n(high peb, high impairment) -2.435888
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.8216164
## climate-vulnerable\n(high peb, high impairment) 0.1246774
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.4741905
## climate-vulnerable\n(high peb, high impairment) -1.8118556
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.680524
## climate-vulnerable\n(high peb, high impairment) -2.264131
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -6.310378
## climate-vulnerable\n(high peb, high impairment) 2.507132
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) -0.1079105
## climate-vulnerable\n(high peb, high impairment) -0.5886567
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.483785
## climate-vulnerable\n(high peb, high impairment) 1.192964
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -2.875352
## climate-vulnerable\n(high peb, high impairment) -1.632008
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.0428808
## climate-vulnerable\n(high peb, high impairment) 0.9438396p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.00000000
## climate-vulnerable\n(high peb, high impairment) 0.01485528
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.06851321
## climate-vulnerable\n(high peb, high impairment) 0.90077897
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.63536408
## climate-vulnerable\n(high peb, high impairment) 0.07000852
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.09285546
## climate-vulnerable\n(high peb, high impairment) 0.02356603
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 2.783545e-10
## climate-vulnerable\n(high peb, high impairment) 1.217153e-02
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.9140667
## climate-vulnerable\n(high peb, high impairment) 0.5560916
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1378661
## climate-vulnerable\n(high peb, high impairment) 0.2328833
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.004035775
## climate-vulnerable\n(high peb, high impairment) 0.102677768
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.2970035
## climate-vulnerable\n(high peb, high impairment) 0.34525168.7.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3246132 0.4142029 0.2563293 0.21733718.7.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.012110400
## 2 0.008891217
## 3 0.040463724
## 4 0.005908840
## 5 0.002813976
## 6 0.040255406
## 7 0.018389440
## 8 0.036523012
## 9 0.010265955
## 10 0.022700271
## 11 0.013606683
## 12 0.058313947
## 13 0.054426189
## 14 0.050040197
## 15 0.012583513
## 16 0.019057021
## 17 0.034959022
## 18 0.061614230
## 19 0.027097406
## 20 0.008099071
## 21 0.013084271
## 22 0.002319034
## 23 0.005154143
## 24 0.005154302
## 25 0.010756258
## 26 0.046919339
## 27 0.055815860
## 28 0.008142624
## 29 0.006437928
## 30 0.005156323
## climate-disengaged\n(low peb, low impairment)
## 1 0.9789013
## 2 0.9779019
## 3 0.9531240
## 4 0.9817044
## 5 0.9918858
## 6 0.9493366
## 7 0.9685501
## 8 0.9547088
## 9 0.9830763
## 10 0.9697686
## 11 0.9819772
## 12 0.9324284
## 13 0.8985083
## 14 0.9390693
## 15 0.9837359
## 16 0.9663580
## 17 0.9554531
## 18 0.9305110
## 19 0.9583089
## 20 0.9868063
## 21 0.9822467
## 22 0.9949847
## 23 0.9911161
## 24 0.9896554
## 25 0.9848886
## 26 0.9446637
## 27 0.9394429
## 28 0.9866068
## 29 0.9896684
## 30 0.9926799
## climate-vulnerable\n(high peb, high impairment)
## 1 0.008988292
## 2 0.013206833
## 3 0.006412295
## 4 0.012386804
## 5 0.005300218
## 6 0.010408037
## 7 0.013060509
## 8 0.008768227
## 9 0.006657702
## 10 0.007531153
## 11 0.004416116
## 12 0.009257676
## 13 0.047065547
## 14 0.010890494
## 15 0.003680556
## 16 0.014585025
## 17 0.009587906
## 18 0.007874749
## 19 0.014593722
## 20 0.005094599
## 21 0.004669022
## 22 0.002696299
## 23 0.003729729
## 24 0.005190257
## 25 0.004355098
## 26 0.008416976
## 27 0.004741282
## 28 0.005250529
## 29 0.003893701
## 30 0.0021638178.7.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.7.7 Likelihood ratio tests
Examine significance of predictors to the model
8.7.7.1 Climate emotions
library(lmtest)
lrtest(test, "data.lpa_out.data.emo.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 401.075925
## iter 20 value 391.460478
## final value 391.459975
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -391.46 -2 96.317 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.7.7.2 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.021915
## iter 20 value 345.536251
## final value 345.381013
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -345.38 -2 4.1587 0.125-> not significant predictor
8.7.7.3 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.029618
## iter 20 value 346.001136
## final value 345.035560
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -345.04 -2 3.4678 0.1766-> not significant predictor
8.7.7.4 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 353.976443
## iter 20 value 346.146268
## final value 346.125711
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -346.13 -2 5.6481 0.05936 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.7.7.5 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.126013
## iter 20 value 343.614564
## final value 343.494264
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -343.49 -2 0.3852 0.8248-> not significant predictor
8.7.7.6 Climate emotions * Emotion-focused coping - emotional suppression
# Reduced model without interaction
test_no_int <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.649244
## iter 20 value 344.479611
## final value 344.028777
## converged# Likelihood ratio test
lrtest(test, test_no_int)## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -344.03 -2 1.4543 0.4833-> not significant predictor
8.7.7.7 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 355.684369
## iter 20 value 346.987550
## final value 346.742711
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -346.74 -2 6.8821 0.03203 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.7.7.8 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.833323
## iter 20 value 347.778835
## final value 347.624063
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ed.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -343.30
## 2 16 -347.62 -2 8.6448 0.01327 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.7.8 Visualizing interactions
# Simplified variable names
df <- data.frame(
class.rel=data.lpa$class.rel,
emo=data.lpa$data.lpa_out.data.emo.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
test <- multinom(class.rel ~ indif + emp.pt + emp.ec +
emoreg.ier + emo*emoreg.ed + natcon,
data = df, model = TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 358.480230
## iter 20 value 344.504790
## final value 343.301648
## converged# Predicted probabilities for interaction
preds <- ggpredict(test,
terms = c("emo [-2:2 by=.5]", "emoreg.ed [-1,1]"))
df_preds <- as.data.frame(preds)
# Relabeling legend
df_preds$group <- factor(df_preds$group,
levels = c(-1, 1),
labels = c("-1 SD", "+1 SD"))
# Plotting with ggplot
step3.int.emoreg.ed <- ggplot(df_preds, aes(x = x, y = predicted,
group = group, color = group)) +
geom_line(lwd =.3) +
geom_point() +
facet_wrap(~ response.level) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = NULL) +
theme(
plot.title.position = "plot",
plot.title = element_text(hjust = 0, size = 14)
) +
scale_color_manual(values = c("#fed789", "#476F84"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n", #\nadds a line break
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
coord_cartesian(clip = "off")
print(step3.int.emoreg.ed)
# Plotting with plot function
step3.int.emoreg.ed.simp <- plot(preds) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = "Emotional suppression (z-standardized)")## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.print(step3.int.emoreg.ed.simp)## Ignoring unknown labels:
## • linetype : "emoreg.ed"
## • shape : "emoreg.ed"
# Save the plot as a PNG file
ggsave("Figure-step3.int.emoreg.ed.png", plot = step3.int.emoreg.ed, width = 9, height = 5, dpi = 300)
ggsave("Figure-step3.int.emoreg.ed.simp.png", plot = step3.int.emoreg.ed, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step3.int.emoreg.ed.pdf", plot = step3.int.emoreg.ed, width = 9, height = 5)
ggsave("Figure-step3.int.emoreg.ed.simp.pdf", plot = step3.int.emoreg.ed, width = 9, height = 5)8.8 Step 3d: Climate emotions, resilience factors, and interactions of climate emotions and emotional integration as predictors
8.8.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emo.z*data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 355.305760
## iter 20 value 343.561714
## final value 341.781270
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z, data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 2.0198634
## climate-vulnerable\n(high peb, high impairment) -0.6069498
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.29423225
## climate-vulnerable\n(high peb, high impairment) 0.04387099
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.06714162
## climate-vulnerable\n(high peb, high impairment) -0.34579669
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.2741528
## climate-vulnerable\n(high peb, high impairment) -0.4732855
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.08401336
## climate-vulnerable\n(high peb, high impairment) 0.03625241
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -1.1288148
## climate-vulnerable\n(high peb, high impairment) 0.4991939
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.26350391
## climate-vulnerable\n(high peb, high impairment) -0.07615673
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.5114060
## climate-vulnerable\n(high peb, high impairment) -0.3854224
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.04828564
## climate-vulnerable\n(high peb, high impairment) 0.33526049
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1696419
## climate-vulnerable\n(high peb, high impairment) 0.2580589
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1658494
## climate-vulnerable\n(high peb, high impairment) 0.2189663
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1615093
## climate-vulnerable\n(high peb, high impairment) 0.1980193
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1589077
## climate-vulnerable\n(high peb, high impairment) 0.2000497
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1294022
## climate-vulnerable\n(high peb, high impairment) 0.1618233
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.1788542
## climate-vulnerable\n(high peb, high impairment) 0.2391892
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1781512
## climate-vulnerable\n(high peb, high impairment) 0.2659955
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.1727832
## climate-vulnerable\n(high peb, high impairment) 0.2282213
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1631169
## climate-vulnerable\n(high peb, high impairment) 0.1905729
##
## Residual Deviance: 683.5625
## AIC: 719.5625Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.68737137 2.35235544
## data.lpa_out.data.indif.z -0.03082655 0.61929104
## data.lpa_out.data.emp.pt.z -0.38369411 0.24941088
## data.lpa_out.data.emp.ec.z -0.58560626 0.03730060
## data.lpa_out.data.emoreg.ed.z -0.16961021 0.33763694
## data.lpa_out.data.emo.z -1.47936257 -0.77826694
## data.lpa_out.data.emoreg.ier.z -0.61267382 0.08566599
## data.lpa_out.data.natcon.z -0.85005472 -0.17275719
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z -0.36798880 0.27141752
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.11273592 -0.10116367
## data.lpa_out.data.indif.z -0.38529500 0.47303698
## data.lpa_out.data.emp.pt.z -0.73390740 0.04231402
## data.lpa_out.data.emp.ec.z -0.86537584 -0.08119524
## data.lpa_out.data.emoreg.ed.z -0.28091546 0.35342028
## data.lpa_out.data.emo.z 0.03039159 0.96799615
## data.lpa_out.data.emoreg.ier.z -0.59749842 0.44518496
## data.lpa_out.data.natcon.z -0.83272793 0.06188323
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z -0.03825545 0.708776428.8.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 7.5372953
## climate-vulnerable\n(high peb, high impairment) 0.5450107
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.342096
## climate-vulnerable\n(high peb, high impairment) 1.044848
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9350628
## climate-vulnerable\n(high peb, high impairment) 0.7076563
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7602159
## climate-vulnerable\n(high peb, high impairment) 0.6229522
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.087643
## climate-vulnerable\n(high peb, high impairment) 1.036918
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.3234164
## climate-vulnerable\n(high peb, high impairment) 1.6473927
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7683546
## climate-vulnerable\n(high peb, high impairment) 0.9266710
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.5996519
## climate-vulnerable\n(high peb, high impairment) 0.6801633
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.9528616
## climate-vulnerable\n(high peb, high impairment) 1.3983046Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.4052536 10.5102970
## data.lpa_out.data.indif.z 0.9696437 1.8576106
## data.lpa_out.data.emp.pt.z 0.6813398 1.2832692
## data.lpa_out.data.emp.ec.z 0.5567682 1.0380050
## data.lpa_out.data.emoreg.ed.z 0.8439937 1.4016315
## data.lpa_out.data.emo.z 0.2277828 0.4592011
## data.lpa_out.data.emoreg.ier.z 0.5419000 1.0894424
## data.lpa_out.data.natcon.z 0.4273915 0.8413419
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z 0.6921249 1.3118227
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.3286585 0.9037851
## data.lpa_out.data.indif.z 0.6802499 1.6048607
## data.lpa_out.data.emp.pt.z 0.4800297 1.0432220
## data.lpa_out.data.emp.ec.z 0.4208933 0.9220137
## data.lpa_out.data.emoreg.ed.z 0.7550922 1.4239295
## data.lpa_out.data.emo.z 1.0308581 2.6326637
## data.lpa_out.data.emoreg.ier.z 0.5501863 1.5607789
## data.lpa_out.data.natcon.z 0.4348614 1.0638381
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z 0.9624670 2.03150408.8.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 11.906630
## climate-vulnerable\n(high peb, high impairment) -2.351982
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.774093
## climate-vulnerable\n(high peb, high impairment) 0.200355
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.4157135
## climate-vulnerable\n(high peb, high impairment) -1.7462777
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.725233
## climate-vulnerable\n(high peb, high impairment) -2.365839
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.6492424
## climate-vulnerable\n(high peb, high impairment) 0.2240246
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -6.311368
## climate-vulnerable\n(high peb, high impairment) 2.087025
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.4791028
## climate-vulnerable\n(high peb, high impairment) -0.2863083
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -2.959814
## climate-vulnerable\n(high peb, high impairment) -1.688810
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2960187
## climate-vulnerable\n(high peb, high impairment) 1.7592248p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.00000000
## climate-vulnerable\n(high peb, high impairment) 0.01867369
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.07604773
## climate-vulnerable\n(high peb, high impairment) 0.84120294
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.67761965
## climate-vulnerable\n(high peb, high impairment) 0.08076272
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.08448553
## climate-vulnerable\n(high peb, high impairment) 0.01798926
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.5161817
## climate-vulnerable\n(high peb, high impairment) 0.8227381
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 2.765796e-10
## climate-vulnerable\n(high peb, high impairment) 3.688589e-02
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1391128
## climate-vulnerable\n(high peb, high impairment) 0.7746420
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.003078251
## climate-vulnerable\n(high peb, high impairment) 0.091255935
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.76721579
## climate-vulnerable\n(high peb, high impairment) 0.078539348.8.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3280104 0.4185377 0.2596228 0.22063068.8.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.014683323
## 2 0.006588405
## 3 0.037604551
## 4 0.009131344
## 5 0.004362151
## 6 0.053073690
## 7 0.023412843
## 8 0.024172919
## 9 0.020207275
## 10 0.017543866
## 11 0.011498286
## 12 0.046880522
## 13 0.051123662
## 14 0.034775338
## 15 0.009314835
## 16 0.017371625
## 17 0.025266203
## 18 0.039217424
## 19 0.022227384
## 20 0.005521780
## 21 0.008979736
## 22 0.002001259
## 23 0.006707320
## 24 0.004413609
## 25 0.008167832
## 26 0.047392676
## 27 0.034002019
## 28 0.010102060
## 29 0.006246235
## 30 0.008494376
## climate-disengaged\n(low peb, low impairment)
## 1 0.9763140
## 2 0.9740124
## 3 0.9566279
## 4 0.9475536
## 5 0.9788484
## 6 0.9266748
## 7 0.9544428
## 8 0.9679326
## 9 0.9663120
## 10 0.9561624
## 11 0.9782783
## 12 0.9435260
## 13 0.9296768
## 14 0.9616693
## 15 0.9775118
## 16 0.9577941
## 17 0.9704678
## 18 0.9586066
## 19 0.9625820
## 20 0.9843403
## 21 0.9815908
## 22 0.9774915
## 23 0.9821328
## 24 0.9735213
## 25 0.9806685
## 26 0.9486293
## 27 0.9603485
## 28 0.9791274
## 29 0.9866631
## 30 0.9840935
## climate-vulnerable\n(high peb, high impairment)
## 1 0.009002650
## 2 0.019399177
## 3 0.005767590
## 4 0.043315007
## 5 0.016789440
## 6 0.020251553
## 7 0.022144342
## 8 0.007894473
## 9 0.013480742
## 10 0.026293757
## 11 0.010223409
## 12 0.009593523
## 13 0.019199578
## 14 0.003555403
## 15 0.013173315
## 16 0.024834245
## 17 0.004266008
## 18 0.002175947
## 19 0.015190570
## 20 0.010137943
## 21 0.009429465
## 22 0.020507193
## 23 0.011159858
## 24 0.022065136
## 25 0.011163709
## 26 0.003978066
## 27 0.005649524
## 28 0.010770508
## 29 0.007090634
## 30 0.0074121558.8.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.8.7 Likelihood ratio tests
Examine significance of predictors to the model
8.8.7.1 Climate emotions
library(lmtest)
lrtest(test, "data.lpa_out.data.emo.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 399.382190
## iter 20 value 388.456212
## final value 388.137260
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -388.14 -2 92.712 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.8.7.2 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 351.989565
## iter 20 value 343.948803
## final value 343.715015
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -343.72 -2 3.8675 0.1446-> not significant predictor
8.8.7.3 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.424459
## iter 20 value 343.824430
## final value 343.412864
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -343.41 -2 3.2632 0.1956-> not significant predictor
8.8.7.4 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 353.842335
## iter 20 value 346.444127
## final value 344.834253
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -344.83 -2 6.106 0.04722 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.8.7.5 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.845695
## iter 20 value 342.361781
## final value 341.993571
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -341.99 -2 0.4246 0.8087-> not significant predictor
8.8.7.6 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.679879
## iter 20 value 343.627531
## final value 343.104952
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -343.10 -2 2.6474 0.2662-> not significant predictor
8.8.7.7 Climate emotions * Emotion-focused coping - emotional integration
# Reduced model without interaction
test_no_int <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.649244
## iter 20 value 344.479611
## final value 344.028777
## converged# Likelihood ratio test
lrtest(test, test_no_int)## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -344.03 -2 4.495 0.1057-> not significant predictor
8.8.7.8 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 352.292706
## iter 20 value 346.391220
## final value 346.367149
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z * data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.emoreg.ier.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -341.78
## 2 16 -346.37 -2 9.1718 0.01019 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.8.8 Visualizing interactions
# Simplified variable names
df <- data.frame(
class.rel=data.lpa$class.rel,
emo=data.lpa$data.lpa_out.data.emo.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
test <- multinom(class.rel ~ indif + emp.pt + emp.ec +
emo*emoreg.ier + emoreg.ed + natcon,
data = df, model = TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 355.305760
## iter 20 value 343.561714
## final value 341.781270
## converged# Predicted probabilities for interaction
preds <- ggpredict(test,
terms = c("emo [-2:2 by=.5]", "emoreg.ier [-1,1]"))
df_preds <- as.data.frame(preds)
# Relabeling legend
df_preds$group <- factor(df_preds$group,
levels = c(-1, 1),
labels = c("-1 SD", "+1 SD"))
# Plotting with ggplot
step3.int.emoreg.ier <- ggplot(df_preds, aes(x = x, y = predicted,
group = group, color = group)) +
geom_line(lwd =.3) +
geom_point() +
facet_wrap(~ response.level) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = NULL) +
theme(
plot.title.position = "plot",
plot.title = element_text(hjust = 0, size = 14)
) +
scale_color_manual(values = c("#fed789", "#476F84"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
coord_cartesian(clip = "off")
print(step3.int.emoreg.ier)
# Plotting with plot function
step3.int.emoreg.ier.simp <- plot(preds) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = "Emotional integration (z-standardized)")## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.print(step3.int.emoreg.ier.simp)## Ignoring unknown labels:
## • linetype : "emoreg.ier"
## • shape : "emoreg.ier"
# Save the plot as a PNG file
ggsave("Figure-step3.int.emoreg.ier.png", plot = step3.int.emoreg.ier, width = 9, height = 5, dpi = 300)
ggsave("Figure-step3.int.emoreg.ier.simp.png", plot = step3.int.emoreg.ier, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step3.int.emoreg.ier.pdf", plot = step3.int.emoreg.ier, width = 9, height = 5)
ggsave("Figure-step3.int.emoreg.ier.simp.pdf", plot = step3.int.emoreg.ier, width = 9, height = 5)8.9 Step 3e: Climate emotions, resilience factors, and interactions of climate emotions and nature connectedness as predictors
8.9.1 Run multinomial logistic regression model
Calculate logit coefficients relative to the reference category
test <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.emo.z*data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 350.513876
## iter 20 value 338.054974
## final value 337.315164
## convergedsummary(test)## Call:
## multinom(formula = class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z, data = data.lpa, model = TRUE)
##
## Coefficients:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 2.1050632
## climate-vulnerable\n(high peb, high impairment) -0.6134927
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.3150212
## climate-vulnerable\n(high peb, high impairment) 0.1462384
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.07323928
## climate-vulnerable\n(high peb, high impairment) -0.30904300
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -0.2606983
## climate-vulnerable\n(high peb, high impairment) -0.4322979
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.08840698
## climate-vulnerable\n(high peb, high impairment) 0.07284046
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -0.2470622
## climate-vulnerable\n(high peb, high impairment) 0.1830354
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -1.2934595
## climate-vulnerable\n(high peb, high impairment) 0.2883807
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -0.7050873
## climate-vulnerable\n(high peb, high impairment) -0.8747773
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.2359461
## climate-vulnerable\n(high peb, high impairment) 0.7223276
##
## Std. Errors:
## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.1865549
## climate-vulnerable\n(high peb, high impairment) 0.2752591
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.1678697
## climate-vulnerable\n(high peb, high impairment) 0.2189193
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.1630873
## climate-vulnerable\n(high peb, high impairment) 0.1999974
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1599186
## climate-vulnerable\n(high peb, high impairment) 0.2018747
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.1301174
## climate-vulnerable\n(high peb, high impairment) 0.1626019
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1573864
## climate-vulnerable\n(high peb, high impairment) 0.2089301
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.2051851
## climate-vulnerable\n(high peb, high impairment) 0.2660629
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.2065379
## climate-vulnerable\n(high peb, high impairment) 0.2730351
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.2108158
## climate-vulnerable\n(high peb, high impairment) 0.2114934
##
## Residual Deviance: 674.6303
## AIC: 710.6303Calculate 95% confidence intervals
ci <- confint(test)
ci## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 1.73942236 2.47070413
## data.lpa_out.data.indif.z -0.01399744 0.64403984
## data.lpa_out.data.emp.pt.z -0.39288444 0.24640587
## data.lpa_out.data.emp.ec.z -0.57413298 0.05273634
## data.lpa_out.data.emoreg.ed.z -0.16661838 0.34343234
## data.lpa_out.data.emoreg.ier.z -0.55553393 0.06140946
## data.lpa_out.data.emo.z -1.69561483 -0.89130407
## data.lpa_out.data.natcon.z -1.10989417 -0.30028036
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z -0.17724527 0.64913757
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) -1.1529906 -0.07399485
## data.lpa_out.data.indif.z -0.2828356 0.57531232
## data.lpa_out.data.emp.pt.z -0.7010307 0.08294465
## data.lpa_out.data.emp.ec.z -0.8279649 -0.03663082
## data.lpa_out.data.emoreg.ed.z -0.2458534 0.39153436
## data.lpa_out.data.emoreg.ier.z -0.2264601 0.59253093
## data.lpa_out.data.emo.z -0.2330930 0.80985446
## data.lpa_out.data.natcon.z -1.4099162 -0.33963843
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z 0.3078082 1.136847018.9.2 Odds Ratios
Extract the coefficients from the model and exponentiate -> show Odds ratios in relation to the impaired profile
odds <- exp(coef(test))
odds## (Intercept)
## climate-disengaged\n(low peb, low impairment) 8.2076221
## climate-vulnerable\n(high peb, high impairment) 0.5414564
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.370288
## climate-vulnerable\n(high peb, high impairment) 1.157472
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.9293784
## climate-vulnerable\n(high peb, high impairment) 0.7341492
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.7705133
## climate-vulnerable\n(high peb, high impairment) 0.6490160
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 1.092433
## climate-vulnerable\n(high peb, high impairment) 1.075559
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.7810921
## climate-vulnerable\n(high peb, high impairment) 1.2008569
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 0.2743201
## climate-vulnerable\n(high peb, high impairment) 1.3342652
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.4940655
## climate-vulnerable\n(high peb, high impairment) 0.4169548
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 1.266106
## climate-vulnerable\n(high peb, high impairment) 2.059221Calculate 95% confidence intervals for odds ratios
exp(ci)## , , climate-disengaged
## (low peb, low impairment)
##
## 2.5 % 97.5 %
## (Intercept) 5.6940534 11.8307743
## data.lpa_out.data.indif.z 0.9861001 1.9041578
## data.lpa_out.data.emp.pt.z 0.6751068 1.2794188
## data.lpa_out.data.emp.ec.z 0.5631930 1.0541517
## data.lpa_out.data.emoreg.ed.z 0.8465226 1.4097781
## data.lpa_out.data.emoreg.ier.z 0.5737658 1.0633342
## data.lpa_out.data.emo.z 0.1834864 0.4101206
## data.lpa_out.data.natcon.z 0.3295938 0.7406106
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z 0.8375743 1.9138895
##
## , , climate-vulnerable
## (high peb, high impairment)
##
## 2.5 % 97.5 %
## (Intercept) 0.3156913 0.9286765
## data.lpa_out.data.indif.z 0.7536437 1.7776856
## data.lpa_out.data.emp.pt.z 0.4960738 1.0864817
## data.lpa_out.data.emp.ec.z 0.4369376 0.9640320
## data.lpa_out.data.emoreg.ed.z 0.7820368 1.4792488
## data.lpa_out.data.emoreg.ier.z 0.7973511 1.8085600
## data.lpa_out.data.emo.z 0.7920799 2.2475809
## data.lpa_out.data.natcon.z 0.2441637 0.7120277
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z 1.3604400 3.11692528.9.3 Calculate p-values for regression coefficients, calculating Wald-z first
z <- summary(test)$coefficients/summary(test)$standard.errors
z## (Intercept)
## climate-disengaged\n(low peb, low impairment) 11.283881
## climate-vulnerable\n(high peb, high impairment) -2.228783
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 1.8765812
## climate-vulnerable\n(high peb, high impairment) 0.6680012
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) -0.4490803
## climate-vulnerable\n(high peb, high impairment) -1.5452353
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) -1.630194
## climate-vulnerable\n(high peb, high impairment) -2.141417
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.6794403
## climate-vulnerable\n(high peb, high impairment) 0.4479680
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) -1.5697812
## climate-vulnerable\n(high peb, high impairment) 0.8760603
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) -6.303867
## climate-vulnerable\n(high peb, high impairment) 1.083882
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) -3.413839
## climate-vulnerable\n(high peb, high impairment) -3.203901
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 1.119205
## climate-vulnerable\n(high peb, high impairment) 3.415367p <- (1 - pnorm(abs(z), 0, 1)) * 2
p## (Intercept)
## climate-disengaged\n(low peb, low impairment) 0.00000000
## climate-vulnerable\n(high peb, high impairment) 0.02582835
## data.lpa_out.data.indif.z
## climate-disengaged\n(low peb, low impairment) 0.06057551
## climate-vulnerable\n(high peb, high impairment) 0.50413283
## data.lpa_out.data.emp.pt.z
## climate-disengaged\n(low peb, low impairment) 0.6533737
## climate-vulnerable\n(high peb, high impairment) 0.1222894
## data.lpa_out.data.emp.ec.z
## climate-disengaged\n(low peb, low impairment) 0.1030605
## climate-vulnerable\n(high peb, high impairment) 0.0322404
## data.lpa_out.data.emoreg.ed.z
## climate-disengaged\n(low peb, low impairment) 0.4968589
## climate-vulnerable\n(high peb, high impairment) 0.6541763
## data.lpa_out.data.emoreg.ier.z
## climate-disengaged\n(low peb, low impairment) 0.1164660
## climate-vulnerable\n(high peb, high impairment) 0.3809972
## data.lpa_out.data.emo.z
## climate-disengaged\n(low peb, low impairment) 2.903100e-10
## climate-vulnerable\n(high peb, high impairment) 2.784172e-01
## data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.0006405439
## climate-vulnerable\n(high peb, high impairment) 0.0013557910
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## climate-disengaged\n(low peb, low impairment) 0.2630526409
## climate-vulnerable\n(high peb, high impairment) 0.00063696078.9.4 Calculate Pseudo-R
library(DescTools)
PseudoR2(test, c("CoxSnell","Nagelkerke","McFadden", "McFaddenAdj"))## CoxSnell Nagelkerke McFadden McFaddenAdj
## 0.3378912 0.4311455 0.2692974 0.23030528.9.5 Predicted probabilities for each class/profile
head(test$fitted.values,30)## climate-resilient\n(high peb, low impairment)
## 1 0.0038376315
## 2 0.0014203142
## 3 0.0184695339
## 4 0.0021056358
## 5 0.0006514754
## 6 0.0550588788
## 7 0.0105930028
## 8 0.0244711504
## 9 0.0160075650
## 10 0.0116605402
## 11 0.0029466181
## 12 0.0495933973
## 13 0.0384093208
## 14 0.0414182176
## 15 0.0057530055
## 16 0.0181758680
## 17 0.0135760081
## 18 0.0215870069
## 19 0.0133178940
## 20 0.0018305992
## 21 0.0051893370
## 22 0.0004204528
## 23 0.0033784998
## 24 0.0025220154
## 25 0.0033144020
## 26 0.0445317149
## 27 0.0303410789
## 28 0.0074746779
## 29 0.0029398527
## 30 0.0047215344
## climate-disengaged\n(low peb, low impairment)
## 1 0.9496667
## 2 0.9039521
## 3 0.9680207
## 4 0.9355469
## 5 0.9356069
## 6 0.9400830
## 7 0.9602922
## 8 0.9694567
## 9 0.9795675
## 10 0.9782050
## 11 0.9657878
## 12 0.9444214
## 13 0.9129128
## 14 0.9526316
## 15 0.9884163
## 16 0.9730309
## 17 0.9629124
## 18 0.9569889
## 19 0.9595076
## 20 0.9741967
## 21 0.9861235
## 22 0.9736729
## 23 0.9894355
## 24 0.9886957
## 25 0.9806041
## 26 0.9487117
## 27 0.9644885
## 28 0.9875517
## 29 0.9872218
## 30 0.9918920
## climate-vulnerable\n(high peb, high impairment)
## 1 0.046495624
## 2 0.094627617
## 3 0.013509745
## 4 0.062347447
## 5 0.063741672
## 6 0.004858095
## 7 0.029114841
## 8 0.006072135
## 9 0.004424926
## 10 0.010134505
## 11 0.031265581
## 12 0.005985179
## 13 0.048677895
## 14 0.005950185
## 15 0.005830734
## 16 0.008793248
## 17 0.023511631
## 18 0.021424122
## 19 0.027174547
## 20 0.023972673
## 21 0.008687146
## 22 0.025906679
## 23 0.007185979
## 24 0.008782252
## 25 0.016081515
## 26 0.006756633
## 27 0.005170425
## 28 0.004973617
## 29 0.009838366
## 30 0.0033864718.9.6 Predicted profiles
head(predict(test),30)## [1] climate-disengaged\n(low peb, low impairment)
## [2] climate-disengaged\n(low peb, low impairment)
## [3] climate-disengaged\n(low peb, low impairment)
## [4] climate-disengaged\n(low peb, low impairment)
## [5] climate-disengaged\n(low peb, low impairment)
## [6] climate-disengaged\n(low peb, low impairment)
## [7] climate-disengaged\n(low peb, low impairment)
## [8] climate-disengaged\n(low peb, low impairment)
## [9] climate-disengaged\n(low peb, low impairment)
## [10] climate-disengaged\n(low peb, low impairment)
## [11] climate-disengaged\n(low peb, low impairment)
## [12] climate-disengaged\n(low peb, low impairment)
## [13] climate-disengaged\n(low peb, low impairment)
## [14] climate-disengaged\n(low peb, low impairment)
## [15] climate-disengaged\n(low peb, low impairment)
## [16] climate-disengaged\n(low peb, low impairment)
## [17] climate-disengaged\n(low peb, low impairment)
## [18] climate-disengaged\n(low peb, low impairment)
## [19] climate-disengaged\n(low peb, low impairment)
## [20] climate-disengaged\n(low peb, low impairment)
## [21] climate-disengaged\n(low peb, low impairment)
## [22] climate-disengaged\n(low peb, low impairment)
## [23] climate-disengaged\n(low peb, low impairment)
## [24] climate-disengaged\n(low peb, low impairment)
## [25] climate-disengaged\n(low peb, low impairment)
## [26] climate-disengaged\n(low peb, low impairment)
## [27] climate-disengaged\n(low peb, low impairment)
## [28] climate-disengaged\n(low peb, low impairment)
## [29] climate-disengaged\n(low peb, low impairment)
## [30] climate-disengaged\n(low peb, low impairment)
## 3 Levels: climate-resilient\n(high peb, low impairment) ...8.9.7 Likelihood ratio tests
Examine significance of predictors to the model
8.9.7.1 Climate emotions
library(lmtest)
lrtest(test, "data.lpa_out.data.emo.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 400.976440
## iter 20 value 382.674834
## final value 381.889751
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -381.89 -2 89.149 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.9.7.2 Climate indifference
lrtest(test, "data.lpa_out.data.indif.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 347.773454
## iter 20 value 339.496437
## final value 339.187662
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.emp.pt.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -339.19 -2 3.745 0.1537-> not significant predictor
8.9.7.3 Empathy - perspective taking
library(lmtest)
lrtest(test, "data.lpa_out.data.emp.pt.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 348.687150
## iter 20 value 339.860643
## final value 338.564526
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.ec.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -338.56 -2 2.4987 0.2867-> not significant predictor
8.9.7.4 Empathy - empathic concern
lrtest(test, "data.lpa_out.data.emp.ec.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 349.990868
## iter 20 value 340.337389
## final value 339.875275
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emoreg.ed.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -339.88 -2 5.1202 0.0773 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.9.7.5 Emotion-focused coping - emotional suppression
lrtest(test, "data.lpa_out.data.emoreg.ed.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 348.564151
## iter 20 value 338.613820
## final value 337.560994
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ier.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -337.56 -2 0.4917 0.7821-> not significant predictor
8.9.7.6 Emotion-focused coping - emotional integration
lrtest(test, "data.lpa_out.data.emoreg.ier.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 351.396316
## iter 20 value 341.083396
## final value 340.246724
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emo.z + data.lpa_out.data.natcon.z + data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -340.25 -2 5.8631 0.05331 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> trend
8.9.7.7 Nature connectedness
lrtest(test, "data.lpa_out.data.natcon.z")## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 353.384235
## iter 20 value 345.111622
## final value 344.922789
## converged## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z +
## data.lpa_out.data.emo.z:data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -344.92 -2 15.215 0.0004967 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.9.7.8 Climate emotions * Nature connectedness
# Reduced model without interaction
test_no_int <- multinom(class.rel ~ data.lpa_out.data.indif.z +
data.lpa_out.data.emp.pt.z +
data.lpa_out.data.emp.ec.z +
data.lpa_out.data.emo.z +
data.lpa_out.data.emoreg.ed.z +
data.lpa_out.data.emoreg.ier.z +
data.lpa_out.data.natcon.z, data = data.lpa, model=TRUE)## # weights: 27 (16 variable)
## initial value 662.463210
## iter 10 value 354.649244
## iter 20 value 344.479611
## final value 344.028777
## converged# Likelihood ratio test
lrtest(test, test_no_int)## Likelihood ratio test
##
## Model 1: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.emo.z *
## data.lpa_out.data.natcon.z
## Model 2: class.rel ~ data.lpa_out.data.indif.z + data.lpa_out.data.emp.pt.z +
## data.lpa_out.data.emp.ec.z + data.lpa_out.data.emo.z + data.lpa_out.data.emoreg.ed.z +
## data.lpa_out.data.emoreg.ier.z + data.lpa_out.data.natcon.z
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 18 -337.32
## 2 16 -344.03 -2 13.427 0.001214 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1-> significant predictor
8.9.8 Visualizing interactions
# Simplified variable names
df <- data.frame(
class.rel=data.lpa$class.rel,
emo=data.lpa$data.lpa_out.data.emo.z,
indif=data.lpa$data.lpa_out.data.indif.z,
emp.pt=data.lpa$data.lpa_out.data.emp.pt.z,
emp.ec=data.lpa$data.lpa_out.data.emp.ec.z,
emoreg.ed=data.lpa$data.lpa_out.data.emoreg.ed.z,
emoreg.ier=data.lpa$data.lpa_out.data.emoreg.ier.z,
natcon=data.lpa$data.lpa_out.data.natcon.z
)
test <- multinom(class.rel ~ indif + emp.pt + emp.ec +
emoreg.ier + emoreg.ed + emo*natcon,
data = df, model = TRUE)## # weights: 30 (18 variable)
## initial value 662.463210
## iter 10 value 350.513876
## iter 20 value 338.054974
## final value 337.315164
## converged# Predicted probabilities for interaction
preds <- ggpredict(test,
terms = c("emo [-2:2 by=.5]", "natcon [-1,1]"))
df_preds <- as.data.frame(preds)
# Relabeling legend
df_preds$group <- factor(df_preds$group,
levels = c(-1, 1),
labels = c("-1 SD", "+1 SD"))
# Plotting with ggplot
step3.int.natcon <- ggplot(df_preds, aes(x = x, y = predicted,
group = group, color = group)) +
geom_line(lwd =.3) +
geom_point() +
facet_wrap(~ response.level) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = NULL) +
theme(
plot.title.position = "plot",
plot.title = element_text(hjust = 0, size = 14)
) +
scale_color_manual(values = c("#fed789", "#476F84"),
labels = c("climate-resilient\n(high peb, low impairment)" = "Climate-resilient\n(16.9%)\n",
"climate-disengaged\n(low peb, low impairment)" = "Climate-disengaged\n(72.8%)\n",
"climate-vulnerable\n(high peb, high impairment)"="Climate-vulnerable\n(10.3%)\n")
) +
coord_cartesian(clip = "off")
print(step3.int.natcon)
# Plotting with plot function
step3.int.natcon.simp <- plot(preds) +
scale_color_manual(values = c("#D73027", "#FDAE61", "#4575B4")) +
labs(x = "Climate emotions (z-standardized)",
y = "Predicted probability of profile membership",
color = "Nature connectedness (z-standardized)")## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.print(step3.int.natcon.simp)## Ignoring unknown labels:
## • linetype : "natcon"
## • shape : "natcon"
# Save the plot as a PNG file
ggsave("Figure-step3.int.natcon.png", plot = step3.int.natcon, width = 9, height = 5, dpi = 300)
ggsave("Figure-step3.int.natcon.simp.png", plot = step3.int.natcon, width = 9, height = 5, dpi = 300)
# Save the plot as a PDF file
ggsave("Figure-step3.int.natcon.pdf", plot = step3.int.natcon, width = 9, height = 5)
ggsave("Figure-step3.int.natcon.simp.pdf", plot = step3.int.natcon, width = 9, height = 5)