Problem Set #3 Assignment
John Majoubi
’5-11-23
Question 1: Moderation
library(interactions)## Warning: package 'interactions' was built under R version 4.2.3library(car)## Warning: package 'car' was built under R version 4.2.3## Loading required package: carData## Warning: package 'carData' was built under R version 4.2.3library(psych)## Warning: package 'psych' was built under R version 4.2.3##
## Attaching package: 'psych'## The following object is masked from 'package:car':
##
## logitlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.2.3##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphalibrary(ppcor)## Loading required package: MASS## Warning: package 'MASS' was built under R version 4.2.3library(lm.beta)## Warning: package 'lm.beta' was built under R version 4.2.3library(haven)1a)
PSY772_ProblemSet3_Moderation <- read_sav("C:/Users/John Majoubi/Downloads/PSY772-ProblemSet3-Moderation.sav")listwise.PS3.Q1 = na.exclude(PSY772_ProblemSet3_Moderation[c(2:6)])str(listwise.PS3.Q1)## tibble [90 × 5] (S3: tbl_df/tbl/data.frame)
## $ Gender : dbl+lbl [1:90] 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1...
## ..@ label : chr "Self-reported gender"
## ..@ format.spss: chr "F8.2"
## ..@ labels : Named num [1:2] 1 2
## .. ..- attr(*, "names")= chr [1:2] "female" "male"
## $ CurrentMood : num [1:90] 5 7 11 4 4 5 5 10 6 10 ...
## ..- attr(*, "label")= chr "how enjoyable was day so far? (current mood)"
## ..- attr(*, "format.spss")= chr "F8.2"
## $ AffectiveForecast: num [1:90] 11 11 11 7 8 6 11 11 8 11 ...
## ..- attr(*, "label")= chr "happiness estimates for first day of Summer Vacation (ascending)"
## ..- attr(*, "format.spss")= chr "F8.2"
## $ Focalism : num [1:90] 11 9 9 6 7 3 11 1 9 11 ...
## ..- attr(*, "label")= chr "focused on predicted event (focalism)"
## ..- attr(*, "format.spss")= chr "F8.2"
## $ SREIS_EM : num [1:90] 4.25 2.5 3 3.5 2 2 3.25 3.5 4.25 3.5 ...
## ..- attr(*, "label")= chr "Average of SREIS Emotion Management items"
## ..- attr(*, "format.spss")= chr "F8.2"
## ..- attr(*, "display_width")= int 10
## - attr(*, "na.action")= 'exclude' Named int [1:52] 1 2 3 4 5 6 7 8 9 10 ...
## ..- attr(*, "names")= chr [1:52] "1" "2" "3" "4" ...names(listwise.PS3.Q1)## [1] "Gender" "CurrentMood" "AffectiveForecast"
## [4] "Focalism" "SREIS_EM"Initial descriptives
describeBy(listwise.PS3.Q1[c(2,4,5,3)], listwise.PS3.Q1$Gender)##
## Descriptive statistics by group
## group: 1
## vars n mean sd median trimmed mad min max range skew
## CurrentMood 1 69 7.22 2.08 7.0 7.28 1.48 1.00 11 10.00 -0.39
## Focalism 2 69 7.77 3.05 9.0 8.11 2.97 1.00 11 10.00 -0.73
## SREIS_EM 3 69 3.34 0.85 3.5 3.38 0.74 1.25 5 3.75 -0.36
## AffectiveForecast 4 69 9.51 2.00 11.0 9.82 0.00 4.00 11 7.00 -1.20
## kurtosis se
## CurrentMood 0.21 0.25
## Focalism -0.49 0.37
## SREIS_EM -0.62 0.10
## AffectiveForecast 0.46 0.24
## ------------------------------------------------------------
## group: 2
## vars n mean sd median trimmed mad min max range skew
## CurrentMood 1 21 7.48 1.66 7.00 7.41 1.48 4.0 11.00 7.00 0.13
## Focalism 2 21 7.38 2.54 8.00 7.47 1.48 3.0 11.00 8.00 -0.46
## SREIS_EM 3 21 3.75 0.60 3.75 3.75 0.37 2.5 4.75 2.25 0.04
## AffectiveForecast 4 21 8.67 2.50 10.00 9.00 1.48 2.0 11.00 9.00 -1.09
## kurtosis se
## CurrentMood -0.56 0.36
## Focalism -1.01 0.55
## SREIS_EM -0.62 0.13
## AffectiveForecast 0.19 0.541b) Yes, the data appear in range. The Enjoy, Happy, and Focus variables are measured on 1 to 11 Likert scales and these values are the mins and maxs. n = 90
The SREIS_EM is between 1 and 5, and the observed min and max values are in range. Although the predictors seem to be skewed.
Mean Centering predictors
listwise.PS3.Q1$centeredSREIS_EM = as.numeric(scale(listwise.PS3.Q1$SREIS_EM, scale = F))
listwise.PS3.Q1$centeredCurrentMood = as.numeric(scale(listwise.PS3.Q1$CurrentMood, scale = F))
listwise.PS3.Q1$centeredFocalism = as.numeric(scale(listwise.PS3.Q1$Focalism, scale = F))listwise.PS3.Q1$FXcodedGender = as.numeric(recode(listwise.PS3.Q1$Gender, '1=1; 2=-1')) attach(listwise.PS3.Q1)OLS.HappyForecast = lm(AffectiveForecast ~ centeredSREIS_EM*FXcodedGender + centeredCurrentMood + centeredFocalism)listwise.PS3.Q1$EMGenderinteraction = listwise.PS3.Q1$centeredSREIS_EM*listwise.PS3.Q1$FXcodedGendersummary(cooks.distance(OLS.HappyForecast))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.470e-06 6.451e-04 3.001e-03 1.815e-02 1.215e-02 2.174e-011c) Max Cook’s D is less than 1.00.
1d) There are zero outliers, so there was no need to delete cases.
Correlational Matrix
names(listwise.PS3.Q1)## [1] "Gender" "CurrentMood" "AffectiveForecast"
## [4] "Focalism" "SREIS_EM" "centeredSREIS_EM"
## [7] "centeredCurrentMood" "centeredFocalism" "FXcodedGender"
## [10] "EMGenderinteraction"cor(listwise.PS3.Q1[c(3, 6:10)])## AffectiveForecast centeredSREIS_EM centeredCurrentMood
## AffectiveForecast 1.00000000 0.01747772 0.33082471
## centeredSREIS_EM 0.01747772 1.00000000 0.17794955
## centeredCurrentMood 0.33082471 0.17794955 1.00000000
## centeredFocalism 0.50021971 0.13776264 0.08123406
## FXcodedGender 0.16671584 -0.21236075 -0.05550183
## EMGenderinteraction 0.14176006 0.69984276 0.10228902
## centeredFocalism FXcodedGender EMGenderinteraction
## AffectiveForecast 0.50021971 0.16671584 0.14176006
## centeredSREIS_EM 0.13776264 -0.21236075 0.69984276
## centeredCurrentMood 0.08123406 -0.05550183 0.10228902
## centeredFocalism 1.00000000 0.05614236 0.03404879
## FXcodedGender 0.05614236 1.00000000 0.11513192
## EMGenderinteraction 0.03404879 0.11513192 1.00000000Scatterplo Matrix
1f) There are no curvilinear relationships.
scatterplotMatrix(listwise.PS3.Q1[c(3,6:10)])
VIF
vif(OLS.HappyForecast)## there are higher-order terms (interactions) in this model
## consider setting type = 'predictor'; see ?vif## centeredSREIS_EM FXcodedGender
## 2.496506 1.243509
## centeredCurrentMood centeredFocalism
## 1.037165 1.048901
## centeredSREIS_EM:FXcodedGender
## 2.3276051g) It is not appropriate to interpret collinearity values of categorical by continuous interactions in the same way as continuous by continuous interactions. High collinearity values in the interaction term of a categorical by continuous interaction do not necessarily indicate a problem that needs to be addressed. Instead, they reflect the nature of the interaction and the presence of different slopes for different categories of the categorical variable.
1h) No assumptions violated.
NHST
OLS.spcor.PS3 = spcor(listwise.PS3.Q1[c(3,6:10)])
OLS.spcor.PS3$estimate[1,]## AffectiveForecast centeredSREIS_EM centeredCurrentMood centeredFocalism
## 1.0000000 -0.1937948 0.3111490 0.4914041
## FXcodedGender EMGenderinteraction
## 0.0506516 0.1966385summary(OLS.HappyForecast)##
## Call:
## lm(formula = AffectiveForecast ~ centeredSREIS_EM * FXcodedGender +
## centeredCurrentMood + centeredFocalism)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.7705 -0.8244 0.1675 1.1176 3.0302
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.35199 0.23602 39.623 < 2e-16 ***
## centeredSREIS_EM -0.80793 0.35141 -2.299 0.023982 *
## FXcodedGender 0.14239 0.23696 0.601 0.549519
## centeredCurrentMood 0.34264 0.09282 3.691 0.000395 ***
## centeredFocalism 0.36796 0.06312 5.830 1e-07 ***
## centeredSREIS_EM:FXcodedGender 0.80466 0.34493 2.333 0.022048 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.705 on 84 degrees of freedom
## Multiple R-squared: 0.4032, Adjusted R-squared: 0.3676
## F-statistic: 11.35 on 5 and 84 DF, p-value: 2.22e-08sqrt(.4032)## [1] 0.63498031j) The value for R\(^{2}\) is 0.403 the value for R is 0.635 Yes, the predictors account for 40.3% of the variance in this outcome. This is good fit for the model.
Expected_Valur_R = (4/(90-1))
print(Expected_Valur_R)## [1] 0.044943821k) The expected value of R is .449
lm.beta(OLS.HappyForecast)##
## Call:
## lm(formula = AffectiveForecast ~ centeredSREIS_EM * FXcodedGender +
## centeredCurrentMood + centeredFocalism)
##
## Standardized Coefficients::
## (Intercept) centeredSREIS_EM
## NA -0.30620227
## FXcodedGender centeredCurrentMood
## 0.05648298 0.31687818
## centeredFocalism centeredSREIS_EM:FXcodedGender
## 0.50327587 0.300001411l) The strongest contributor to movement on the least-squares line is focalism, b\(*\) = .503
spcor(na.exclude(listwise.PS3.Q1[c(3,6:10)]))$estimate[1,]## AffectiveForecast centeredSREIS_EM centeredCurrentMood centeredFocalism
## 1.0000000 -0.1937948 0.3111490 0.4914041
## FXcodedGender EMGenderinteraction
## 0.0506516 0.19663851m) Focalism has the strongest correlation to the outcome, over and above the other predictors, at sr = .459 (with rounding).
sim_slopes(model = OLS.HappyForecast, pred = centeredSREIS_EM, modx = FXcodedGender, modx.labels = c("male", "female"), centered = "none", digits = 5)## JOHNSON-NEYMAN INTERVAL
##
## When FXcodedGender is OUTSIDE the interval [0.31121, 2.98489], the slope of
## centeredSREIS_EM is p < .05.
##
## Note: The range of observed values of FXcodedGender is [-1.00000, 1.00000]
##
## SIMPLE SLOPES ANALYSIS
##
## Slope of centeredSREIS_EM when FXcodedGender = -1.00000 (male):
##
## Est. S.E. t val. p
## ---------- --------- ---------- ---------
## -1.61260 0.65096 -2.47727 0.01524
##
## Slope of centeredSREIS_EM when FXcodedGender = 1.00000 (female):
##
## Est. S.E. t val. p
## ---------- --------- ---------- ---------
## -0.00327 0.24737 -0.01323 0.98948interact_plot(model = OLS.HappyForecast, pred = centeredSREIS_EM, modx = FXcodedGender, modx.labels = c("male", "female")) + ylim(c(1,11)) ## Warning: Removed 29 rows containing missing values (`geom_path()`).
#Figure 1We do have a significant gender interaction and significant simple slope #### 1n) it is not meaningful to talk about the typr of interaction (e.g., “synergistic”, “buffering”, or “antagonistic”) in this case, because both predictors need to be continuous for that to take place. ordinal and disordinal still apply.
1o) The interaction plot shows There is an emotion management and gender interaction, in that as emotional intelligence increases in men there is a decrease in affective forecasting, and the opposite occurs for women in that as emotional intelligence decreases there is also a slight but not significant decrease in affective forecasting.
APA Style Conclusion
We used a simultaneous entry regression equation to predict the extremity of affective forecasts from the following variables: (a) focalism, (b) current mood, and (c)interaction of emotional intelligence and gender identity. The set of predictors accounted for significant variance in the outcome, F(5, 84) = 11.35, p < .001, R\(^{2}\) = .403. Also, current mood was positively predictive of affective forecasting, b\(*\) = .317, t(84)=3.69, p < .001, r\(_{a(g.bcde)}\) = .311. This indicates that as current mood increased so did the their affective forecating. Emotional intelligence negatively predicted affective forecasting, (b\(*\) = -.31, p = .02). Finally, the interaction of emotional management and gender did significantly contribute to the overall prediction(b\(*\) = .30, t(84)=2.33, p = .02). Given that this study was replicating an interaction effect, using the procedures outlined by Aiken and West (1991), the interaction was examined using simple slope analyses. These ahalyses showed that men had decreasing affective forecasting from low to high levels of emotional management b = -1.61, t(84)=-2.48, p < .015), for women affective forecasting also decreases from low to high emotional management, but this was not statistically significant b =-0.003, t(84)=-.01 p < .99. see Figure 1.
Question 2: Mediation Analysis
library(haven)2a)
PSY772_ProblemSet3_Mediation <- read_sav("C:/Users/John Majoubi/Downloads/PSY772-ProblemSet3-Mediation.sav")listwise.PS3.Q2 = na.exclude(PSY772_ProblemSet3_Mediation[c(3,7,8)])listwise.PS3.Q2 = na.exclude(PSY772_ProblemSet3_Mediation[c(3,7,8)])library(psych)str(listwise.PS3.Q2)## tibble [221 × 3] (S3: tbl_df/tbl/data.frame)
## $ Altruism_avg : num [1:221] 6.3 4.9 6 6.2 5.2 4.6 5.6 4.8 4.5 5.4 ...
## ..- attr(*, "label")= chr "Trait Altruism average score"
## ..- attr(*, "format.spss")= chr "F8.2"
## ..- attr(*, "display_width")= int 10
## $ Diffusion_state: num [1:221] 3.38 2.62 3.75 0.25 2.62 ...
## ..- attr(*, "label")= chr "State level diffusion of responsibility"
## ..- attr(*, "format.spss")= chr "F8.2"
## ..- attr(*, "display_width")= int 15
## $ HelpBehave : num [1:221] 4 3.6 3.2 2.9 4 3 3.3 3.5 2.4 3.8 ...
## ..- attr(*, "label")= chr "Extent of Helping Behavior"
## ..- attr(*, "format.spss")= chr "F8.2"
## ..- attr(*, "display_width")= int 10
## - attr(*, "na.action")= 'exclude' Named int [1:40] 2 6 7 9 10 11 25 39 40 41 ...
## ..- attr(*, "names")= chr [1:40] "2" "6" "7" "9" ...names(listwise.PS3.Q2)## [1] "Altruism_avg" "Diffusion_state" "HelpBehave"2b) All values are in their respective ranges.
2c) Screening for outliers
summary(cooks.distance(lm(HelpBehave ~ Altruism_avg + Diffusion_state, data = listwise.PS3.Q2)))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.020e-06 6.635e-04 2.383e-03 4.479e-03 5.679e-03 5.598e-02All values are under 1.00.
2d) There were zero outliers, so there was no need to delete cases.
Assessing linearity of outcome prediction by mediator
cor(listwise.PS3.Q2)## Altruism_avg Diffusion_state HelpBehave
## Altruism_avg 1.0000000 0.6025859 0.2582764
## Diffusion_state 0.6025859 1.0000000 0.4017595
## HelpBehave 0.2582764 0.4017595 1.00000002e) linearity of outcome prediction by mediator (b path) exists and so does the linearity of the mediator (a path) because r > .20.
2f)
plot(listwise.PS3.Q2)
#### There are no curvilinear relationships.
2g) assessing singularity
det(cor(listwise.PS3.Q2), use = "complete")## [1] 0.5338275There is no singularity. Determinant is greater than 0.
2h) All crucial assumptions are met.
2i) The Mediation Model
mediate(HelpBehave ~ Altruism_avg + (Diffusion_state), data = listwise.PS3.Q2, n.iter = 5000)
##
## Mediation/Moderation Analysis
## Call: mediate(y = HelpBehave ~ Altruism_avg + (Diffusion_state), data = listwise.PS3.Q2,
## n.iter = 5000)
##
## The DV (Y) was HelpBehave . The IV (X) was Altruism_avg . The mediating variable(s) = Diffusion_state .
##
## Total effect(c) of Altruism_avg on HelpBehave = 0.16 S.E. = 0.04 t = 3.96 df= 219 with p = 1e-04
## Direct effect (c') of Altruism_avg on HelpBehave removing Diffusion_state = 0.02 S.E. = 0.05 t = 0.33 df= 218 with p = 0.74
## Indirect effect (ab) of Altruism_avg on HelpBehave through Diffusion_state = 0.14
## Mean bootstrapped indirect effect = 0.14 with standard error = 0.03 Lower CI = 0.08 Upper CI = 0.2
## R = 0.4 R2 = 0.16 F = 21.04 on 2 and 218 DF p-value: 5.19e-12
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summarysummary(mediate(HelpBehave ~ Altruism_avg + (Diffusion_state), data = listwise.PS3.Q2, n.iter = 5000))
## Call: mediate(y = HelpBehave ~ Altruism_avg + (Diffusion_state), data = listwise.PS3.Q2,
## n.iter = 5000)
##
## Direct effect estimates (traditional regression) (c') X + M on Y
## HelpBehave se t df Prob
## Intercept 2.77 0.23 12.19 218 2.02e-26
## Altruism_avg 0.02 0.05 0.33 218 7.44e-01
## Diffusion_state 0.18 0.04 4.97 218 1.33e-06
##
## R = 0.4 R2 = 0.16 F = 21.04 on 2 and 218 DF p-value: 4.4e-09
##
## Total effect estimates (c) (X on Y)
## HelpBehave se t df Prob
## Intercept 2.32 0.22 10.58 219 2.17e-21
## Altruism_avg 0.16 0.04 3.96 219 1.03e-04
##
## 'a' effect estimates (X on M)
## Diffusion_state se t df Prob
## Intercept -2.52 0.40 -6.34 219 1.30e-09
## Altruism_avg 0.80 0.07 11.17 219 3.11e-23
##
## 'b' effect estimates (M on Y controlling for X)
## HelpBehave se t df Prob
## Diffusion_state 0.18 0.04 4.97 218 1.33e-06
##
## 'ab' effect estimates (through all mediators)
## HelpBehave boot sd lower upper
## Altruism_avg 0.14 0.14 0.03 0.08 0.2Reporting the a-path, b-path, and c’ (c prime) path coefficient, and reporting the c-path as a reference is the tradition.
2j) The size of the ab-path is .14. The size of the c’ is .02. We need these two values to calculate P\(_{M}\) (“proportion” mediated).
calculating the Effect Size for Mediation ab/(ab+c’)
Proportion.Mediated = .14/(.14 + .02)
Proportion.Mediated## [1] 0.875The effect size is large, P\(_{M}\) = .875.
APA Style Conclusion
A mediation analysis tested the hypothesis that state of diffusion responsibility mediates the relationship between trait altruism and helping behavior (n = 221). The mediation analysis was conducted using the bootstrap method (version 1.8.4; Ravelle, 2018) with 5,000 resamples using the psych package in R (R core team, 2018). The initial path showed that trait altruism positively predicted helping behavior b = 0.16, p < .001. Trait altruism also positively predicted state of diffusion responsibility scores b=0.8, p<.001. state of diffusion responsibility scores positively predicted helping behavior scores, when controlling for trait altruism, b= 0.18, p< .001. Controlling for diffusion state scores the direct effect of trait altruism was attenuated and no longer statistically significant b= .02, p= .70. The 95% confidence interval (bias corrected and accelerated) for the indirect effect ( b = .14) did not include zero [.08, .20], indicating that meditation likely occurred, P\(_{M}\) = .875.