# Take-home Exam 3 KEY # # Psych 610: GLM # # Assigned Dec. 16, 2016 # ##################################################### ##################################################### #### PART 1 ######################################### ##################################################### #### Q1. #### d <- dfReadDat("HW9_Data.dat") varDescribe(d) corr.test(d) varPlot(d$polTime) varPlot(d$footTime) varPlot(d$relTime) varPlot(d$ownrel) varPlot(d$numlibs) varPlot(d$numcons) #### Q2. #### # a. alpha(d[,c('swb1','swb2','swb3','swb4','swb5','swb6','swb7')], check.keys = T) # 2, 3, and 5 appear to be reverse-coded. Reversed automatically. alpha(d[,c('swb1','swb2','swb3','swb4','swb6','swb7')], check.keys=T) # b. # Item 5 should be excluded from the composite SWB measure since # it is not very correlated with the other items, and dropping # it raises our alpha from 0.57 to 0.79. # c. d$swbM <- varScore(d, Forward = c('swb1','swb4','swb6','swb7'), Reverse = c('swb2','swb3'), Range = c(1,7)) / 6 varPlot(d$swbM) #### Q3. #### # a. d$ownrelC = d$ownrel - mean(d$ownrel) d$relTimeC = d$relTime - mean(d$relTime,na.rm=T) # b. mod1 <- lm(swbM ~ ownrelC*relTimeC, data=d) modelSummary(mod1) modelEffectSizes(mod1) confint(mod1) # c. # The coefficient for relationship length indicates that # it does not have a significant effect on SWB for people whose # families talked about relationships for an average amount of time, # b = -0.003, F(1, 180) = 0.145, p = .704, partial η² = 0. # The coefficient for time spent talking about relationships indicates # that, for people in a relationship of average length, # talking for longer about relationships has no clear effect on SWB, # b = -0.007, F(1, 180) = 1.805, p = .18, partial η² = .01. # The coefficient for the interaction term indicates that the negative # effect of talking about relationships on SWB is greater for people # who have been in a relationship for less time, b = 0.006, F(1, 180) = 23.745, # p < .001, partial η² = .12. Thus, the data support our hypothesis. # d. mod1b = lm(swbM ~ ownrel*relTimeC, data=d) modelSummary(mod1b,t=F) modelEffectSizes(mod1b) # For people who are single, every additional minute spent # discussing relationships, SWB decreases by .044 units, # F(1, 180) = 21.343, p < .001, partial η² = .11 #### Q6. #### # a. d$polar <-abs(d$numlibs-d$numcons) # This variable is an overall score of the degree # to which the Thanksgiving table for a given participant # was politically polarized, meaning dominated by either # liberals or conservatives. Higher values indicate more # extreme polarization. # b. d$polTimeC = d$polTime - mean(d$polTime) d$polarC = d$polar - mean(d$polar) # b. mod3 = lm(swbM ~ polTimeC*polarC, data=d) modelSummary(mod3) modelEffectSizes(mod3) confint(mod3) # The data support the hypothesis: talking about politics reduces # SWB at average levels of table political polarization, # b = -0.025, F(1, 180) = 62.853, p < .001, partial η² = 0.259, # but this negative effect is lessened the more highly polarized a # Thanksgiving table is, b = 0.003, F(1, 180) = 5.274, p = 0.023, # partial η² = 0.028. # c. mod3b <-lm(swbM~polTimeC*polar,data=d) modelSummary(mod3b,t=F) modelEffectSizes(mod3b) # For families that are perfectly divided between liberals and # conservatives, every additional minute spent talking about # politics reduces participants' SWB by .036 units, F(1, 180) = # 42.054, p < .001, partial η² = 0.189 ################ #### GRAPHS #### ################ # own relationship and relationship time mPlot1 = lm(swbM ~ ownrel*relTime, data=d) modelSummary(mPlot1) varPlot(d$ownrel) # I'm going to include lines for people who have been in a relationship for 0 months and # people who have been in a relationship for mean + sd months XL = data.frame(relTime = seq(min(d$relTime), max(d$relTime), length=200), ownrel = 0) XH = data.frame(relTime = seq(min(d$relTime), max(d$relTime), length=200), ownrel = mean(d$ownrel) + sd(d$ownrel)) YL = modelPredictions(mPlot1, XL) YH = modelPredictions(mPlot1, XH) library(cowplot) plot1 = ggplot(aes(x = relTime, y = swbM, color=ownrel), data=d) + geom_point() + geom_smooth(aes(y = Predicted, ymin = CILo, ymax = CIHi), data=YL, stat='identity') + geom_smooth(aes(y = Predicted, ymin = CILo, ymax = CIHi), data=YH, stat='identity') + coord_cartesian(xlim = c(-1,40), ylim = c(3,6), expand = F) + labs(y = 'Subjective well-being', x = 'Time spent talking about relationships', color = 'Relationship length') + theme(legend.position = c(.85,.9)) plot1 # polarity and time spent talking about politics mPlot2 = lm(swbM ~ polar*polTime, data=d) modelSummary(mPlot2) varPlot(d$polar) # I'm going to make lines for ±1 sd of polarity XL = data.frame(polTime = seq(min(d$polTime), max(d$polTime), length=200), polar = mean(d$polar) - sd(d$polar)) XH = data.frame(polTime = seq(min(d$polTime), max(d$polTime), length=200), polar = mean(d$polar) + sd(d$polar)) YL = modelPredictions(mPlot2, XL) YH = modelPredictions(mPlot2, XH) plot2 = ggplot(aes(x = polTime, y = swbM, color=polar), data=d) + geom_point() + scale_color_gradientn(colors=terrain.colors(12)) + geom_smooth(aes(y = Predicted, ymin = CILo, ymax = CIHi), data=YL, stat='identity') + geom_smooth(aes(y = Predicted, ymin = CILo, ymax = CIHi), data=YH, stat='identity') + coord_cartesian(xlim = c(5,60), ylim = c(3,6), expand = F) + labs(x = 'Time spent talking about politics', y = 'Subjective well-being', color= 'Family polarity') + theme(legend.position = c(.9,.9)) plot2