Beispiel Big-Five Offenheit, prospektive Lebenszufriedenheit und negativer Affekt
Rmd
Die Idee: stammt aus einem Poster.
Prospektive Lebenszufriedenheit, Skala von 1 - 10 (), “Wie zufrieden wirst du in 5 Jahren voraussichtlich sein”
Aktuelle Stimmung als Prädiktor für zukünftige Lebenszufriedenheit. PANAS oder als Vergleich engl/deutsch: deutsch Die PANAS kann sich allerdings auf verschiedene Zeitintervalle beziehen vgl.
Hier soll von der aktuellen Stimmung ausgegangen werden. PANAS enthält 10 positive und 10 negative Adjektive. Die Intensitaet eines Affekts ist anhand einer fünfstufigen Skala von “gar nicht” ueber “ein bisschen”, “einigermassen”, “erheblich” bis “aeusserst” einzuschaetzen.
Mood and Temperament by David Watson p. 197 (partial: controlled for neuroticism and extraversion)
conscienciousness agreeableness openness
simple partial simple partial simple partial
NA -.21 -.06 -.25 -.17 -.12 -.09
PA .40 .35 .18 .07 .24 .09Im Datensatz enthalten sind die Big Five Skalenwerte bfagree,bfcon, bfext, bfneur, bfopen. Außerdem das BDI (Beck Depression Inventory). STAI (State und Trait), die Skala negativer Affekt (neg_aff) der Panas, die vorhergesagte Lebenszufriedenheit in 5 Jahren (f_satisf) sowie eine Kategorisierung in einen Offenheitstyp aufgrund der Dichotomisierung der Skala bfopen.
Modell
Vorhergesagt werden soll die vorausgesagte zukünftige Lebenszufriedenheit. Als Prädiktoren dienen der negative aktuelle Affekt sowie die Big-Five-Skala bfopen und deren Wechselwirkung.
# read data
ddf <- read.delim("http://md.psych.bio.uni-goettingen.de/mv/data/virt/satisfaction_open.txt")
# base data come from psych package
# added vars neg_aff (current negative affect) and f_satisf (future life satisfaction, in 5 years)
require("psych")## Loading required package: psychpsych::describe(ddf)## vars n mean sd median trimmed mad min max range skew
## bfagree 1 231 125.00 18.14 126 125.26 17.79 74 167 93 -0.21
## bfcon 2 231 113.25 21.88 114 113.42 22.24 53 178 125 -0.02
## bfext 3 231 102.18 26.45 104 102.99 22.24 8 168 160 -0.41
## bfneur 4 231 87.97 23.34 90 87.70 23.72 34 152 118 0.07
## bfopen 5 231 123.43 20.51 125 123.78 20.76 73 173 100 -0.16
## bdi 6 231 6.78 5.78 6 5.97 4.45 0 27 27 1.29
## traitanx 7 231 39.01 9.52 38 38.36 8.90 22 71 49 0.67
## stateanx 8 231 39.85 11.48 38 38.92 10.38 21 79 58 0.72
## neg_aff 9 231 15.97 5.96 16 16.10 5.93 -2 32 34 -0.30
## f_satisf 10 231 5.02 2.02 6 5.28 1.48 -7 9 16 -1.88
## bfopen_cat 11 231 2.54 0.83 3 2.55 1.48 1 4 3 -0.09
## kurtosis se
## bfagree -0.27 1.19
## bfcon 0.23 1.44
## bfext 0.51 1.74
## bfneur -0.55 1.54
## bfopen -0.16 1.35
## bdi 1.50 0.38
## traitanx 0.47 0.63
## stateanx -0.01 0.76
## neg_aff 0.30 0.39
## f_satisf 6.50 0.13
## bfopen_cat -0.57 0.05cor(data.frame(ddf$neg_aff, ddf$bfopen, ddf$f_satisf))## ddf.neg_aff ddf.bfopen ddf.f_satisf
## ddf.neg_aff 1.0000000 -0.1574235 -0.6135139
## ddf.bfopen -0.1574235 1.0000000 0.6605028
## ddf.f_satisf -0.6135139 0.6605028 1.0000000# fit pure additive model
m.sat_add <- lm(f_satisf ~ neg_aff + bfopen, data=ddf)
# fit full model including interaction
m.sat <- lm(f_satisf ~ neg_aff * bfopen, data=ddf)
summary(m.sat)##
## Call:
## lm(formula = f_satisf ~ neg_aff * bfopen, data = ddf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.63193 -0.22199 -0.00721 0.23729 0.59825
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 17.7818551 0.3336448 53.30 <2e-16 ***
## neg_aff -1.2030774 0.0187191 -64.27 <2e-16 ***
## bfopen -0.0796082 0.0026270 -30.30 <2e-16 ***
## neg_aff:bfopen 0.0083369 0.0001498 55.66 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2894 on 227 degrees of freedom
## Multiple R-squared: 0.9797, Adjusted R-squared: 0.9794
## F-statistic: 3650 on 3 and 227 DF, p-value: < 2.2e-16# check interaction significance by model comparison
anova(m.sat_add, m.sat)## Analysis of Variance Table
##
## Model 1: f_satisf ~ neg_aff + bfopen
## Model 2: f_satisf ~ neg_aff * bfopen
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 228 278.451
## 2 227 19.009 1 259.44 3098.2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# standardized
# fit full model including interaction
m.sat <- lm(scale(f_satisf) ~ scale(neg_aff) + scale(bfopen) + scale(neg_aff):scale(bfopen), data=ddf)
summary(m.sat)##
## Call:
## lm(formula = scale(f_satisf) ~ scale(neg_aff) + scale(bfopen) +
## scale(neg_aff):scale(bfopen), data = ddf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.313265 -0.110047 -0.003574 0.117632 0.296568
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.079142 0.009545 8.291 9.85e-15 ***
## scale(neg_aff) -0.514074 0.009580 -53.663 < 2e-16 ***
## scale(bfopen) 0.543804 0.009598 56.656 < 2e-16 ***
## scale(neg_aff):scale(bfopen) 0.504922 0.009071 55.661 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1435 on 227 degrees of freedom
## Multiple R-squared: 0.9797, Adjusted R-squared: 0.9794
## F-statistic: 3650 on 3 and 227 DF, p-value: < 2.2e-16Visualisierung 3d
Mit der library(rockchalk)
ddf <- read.delim("http://md.psych.bio.uni-goettingen.de/mv/data/virt/satisfaction_open.txt")
m.i <- lm(f_satisf ~ neg_aff * bfopen, data=ddf)
##m.i <- lm(bodysatisf ~ pacs * grade, data=ddf)
require(rockchalk)## Loading required package: rockchalkplotPlane(model = m.i, plotx1 = "neg_aff", plotx2 = "bfopen")
# or to emphasize the view of the interaction
plotPlane(model = m.i, plotx1 = "neg_aff", plotx2 = "bfopen", theta = 0, phi = 10)
#plotPlane(model = m.i, plotx1 = "neg_aff", plotx2 = "bfopen", drawArrows = T)
#plotPlane(model = m.i, plotx1 = "bfopen", plotx2 = "neg_aff", theta = 0, phi = 20)Visualisierung rgl()
df <- read.delim("http://md.psych.bio.uni-goettingen.de/mv/data/virt/satisfaction_open.txt")
m.i <- lm(f_satisf ~ neg_aff * bfopen, data=df)
require(rgl)## Loading required package: rglplot3d(x=df$neg_aff, y=df$bfopen, z=df$f_satisf)
### Visualisierung via ggplot in vier Antwortklassen.
```r
ddf <- read.delim("http://md.psych.bio.uni-goettingen.de/mv/data/virt/satisfaction_open.txt")
# create 4 ranges
limits <- min(ddf$bfopen) - 1 + 0:4*( (max(ddf$bfopen) - min(ddf$bfopen) + 1) / 4)
# calculate the central values of the bfopen classes
zentr <- min(ddf$bfopen) + 0:3 *( (max(ddf$bfopen) - min(ddf$bfopen)) / 4) + (((max(ddf$bfopen) - min(ddf$bfopen)) / 4) * 0.5)
ddf$bfopen_cat <- cut(ddf$bfopen, limits, labels=c(1:4))
ddf$bfopen## [1] 138 132 90 101 118 149 110 114 86 89 129 121 131 128 139 132 109 131
## [19] 107 109 97 126 116 116 119 117 119 118 81 132 143 84 108 115 90 105
## [37] 125 130 110 96 132 133 115 122 99 111 125 109 113 115 128 110 143 94
## [55] 126 118 75 139 137 115 135 125 73 86 146 142 101 121 154 113 127 123
## [73] 107 110 129 141 144 134 152 122 75 102 116 100 142 100 133 131 120 119
## [91] 73 118 121 136 119 158 118 97 74 98 111 126 114 133 93 123 87 98
## [109] 116 116 148 104 131 124 120 113 107 110 130 110 119 133 111 108 111 102
## [127] 128 116 90 93 124 143 131 139 117 86 127 104 126 131 103 144 121 101
## [145] 129 121 107 126 136 112 112 110 131 134 101 101 99 75 139 116 172 134
## [163] 132 158 106 142 136 152 133 157 161 133 88 161 138 143 173 110 147 139
## [181] 135 157 145 140 118 132 173 96 124 153 147 128 159 136 151 138 150 149
## [199] 149 132 142 133 121 134 134 163 122 147 156 131 143 142 130 139 126 152
## [217] 137 129 136 142 151 167 127 131 132 108 127 110 164 138 96ddf$bfopen_cat## [1] 3 3 1 2 2 4 2 2 1 1 3 2 3 3 3 3 2 3 2 2 1 3 2 2 2 2 2 2 1 3 3 1 2 2 1 2 3
## [38] 3 2 1 3 3 2 2 2 2 3 2 2 2 3 2 3 1 3 2 1 3 3 2 3 3 1 1 3 3 2 2 4 2 3 3 2 2
## [75] 3 3 3 3 4 2 1 2 2 2 3 2 3 3 2 2 1 2 2 3 2 4 2 1 1 2 2 3 2 3 1 3 1 2 2 2 4
## [112] 2 3 3 2 2 2 2 3 2 2 3 2 2 2 2 3 2 1 1 3 3 3 3 2 1 3 2 3 3 2 3 2 2 3 2 2 3
## [149] 3 2 2 2 3 3 2 2 2 1 3 2 4 3 3 4 2 3 3 4 3 4 4 3 1 4 3 3 4 2 3 3 3 4 3 3 2
## [186] 3 4 1 3 4 3 3 4 3 4 3 4 4 4 3 3 3 2 3 3 4 2 3 4 3 3 3 3 3 3 4 3 3 3 3 4 4
## [223] 3 3 3 2 3 2 4 3 1
## Levels: 1 2 3 4# use ggplot2
require("ggplot2")## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha# for this we need the coefficients of the model to plot
m.no <- lm(f_satisf ~ neg_aff * bfopen, data=ddf)
m.no##
## Call:
## lm(formula = f_satisf ~ neg_aff * bfopen, data = ddf)
##
## Coefficients:
## (Intercept) neg_aff bfopen neg_aff:bfopen
## 17.781855 -1.203077 -0.079608 0.008337# create base plot object
pplot <- ggplot(ddf, aes(x=neg_aff, y=f_satisf))
# color management
#cbPalette = c('blue', 'red')
cbPalette = c("#FF0000", "#DD0066", "#BB00AA", "#9900FF")
# add scatterplot and gender specific regression lines as estimated by model above - interaction included in model, less distance in parallel regression lines
pplot +
geom_point(aes(color=bfopen_cat, shape=bfopen_cat)) +
scale_color_manual(values=cbPalette) +
# geom_abline(intercept = m.e_s$coefficients['(Intercept)'] + 0 * m.e_s$coefficients['sex'], slope = m.e_s$coefficients['extro'] + 0 * m.e_s$coefficients['extro:sex'], , color=cbPalette[1]) +
# geom_abline(intercept = m.e_s$coefficients['(Intercept)'] + 1 * m.e_s$coefficients['sex'], slope = m.e_s$coefficients['extro'] + 1 * m.e_s$coefficients['extro:sex'], color=cbPalette[2])
geom_abline(intercept = m.no$coefficients['(Intercept)'] + zentr[1] * m.no$coefficients['bfopen'], slope = m.no$coefficients['neg_aff'] + zentr[1] * m.no$coefficients['neg_aff:bfopen'], color=cbPalette[1]) +
geom_abline(intercept = m.no$coefficients['(Intercept)'] + zentr[2] * m.no$coefficients['bfopen'], slope = m.no$coefficients['neg_aff'] + zentr[2] * m.no$coefficients['neg_aff:bfopen'], color=cbPalette[2]) +
geom_abline(intercept = m.no$coefficients['(Intercept)'] + zentr[3] * m.no$coefficients['bfopen'], slope = m.no$coefficients['neg_aff'] + zentr[3] * m.no$coefficients['neg_aff:bfopen'], color=cbPalette[3]) +
geom_abline(intercept = m.no$coefficients['(Intercept)'] + zentr[4] * m.no$coefficients['bfopen'], slope = m.no$coefficients['neg_aff'] + zentr[4] * m.no$coefficients['neg_aff:bfopen'], color=cbPalette[4]) 
#geom_abline(intercept = m.e_s$coefficients['(Intercept)'] + 1 * m.e_s$coefficients['sex'], slope = m.e_s$coefficients['extro'], color=cbPalette[2])