Smart Alex solutions Chapter 10

This document contains abridged sections from Discovering Statistics Using R and RStudio by Andy Field so there are some copyright considerations. You can use this material for teaching and non-profit activities but please do not meddle with it or claim it as your own work. See the full license terms at the bottom of the page.

McNulty et al. (2008) found a relationship between a person’s attractiveness and how much support they give their partner among newlywed heterosexual couples. The data are in mcnulty_2008.csv, Is this relationship moderated by spouse (i.e., whether the data were from the husband or wife)?

mcnulty_tib <- readr::read_csv("../data/mcnulty_2008.csv") %>%
dplyr::mutate(
spouse = forcats::as_factor(spouse) %>%
forcats::fct_relevel(., "Husband")
)


Alternative, load the data directly from the discovr package:

mcnulty_tib <- discovr::mcnulty_2008


Centre the predictors

# Create a general function to do the centring
centre <- function(var){
var - mean(var, na.rm = TRUE)
}

# use the general function to centre multiple variables at once
mcnulty_tib <- mcnulty_tib %>%
dplyr::mutate_at(
vars(attractiveness , support, satisfaction),
list(cent = centre)
)


Fit the model

support_lm <- lm(support ~ attractiveness_cent*spouse, data = mcnulty_tib)
broom::glance(support_lm) %>%
knitr::kable(digits = 3)

0.0850.0680.2034.9750.003331.122-52.244-36.7456.57160164
broom::tidy(support_lm, conf.int = TRUE) %>%
knitr::kable(digits = 3)

termestimatestd.errorstatisticp.valueconf.lowconf.high
(Intercept)0.2220.0229.9000.0000.1770.266
attractiveness_cent-0.0600.020-2.9740.003-0.100-0.020
spouseWife0.0240.0320.7550.451-0.0390.086
attractiveness_cent:spouseWife0.1050.0283.7690.0000.0500.161

Fit a robust model:

parameters::model_parameters(support_lm, robust = TRUE, vcov.type = "HC4") %>%
knitr::kable(digits = 3)

ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.2220.0230.1760.2679.5641600.000
attractiveness_cent-0.0600.020-0.100-0.020-2.9551600.004
spouseWife0.0240.032-0.0400.0870.7441600.458
attractiveness_cent:spouseWife0.1050.0300.0470.1643.5681600.000

Moderation is shown up by a significant interaction effect, and in this case the interaction is highly significant, b = 0.105, 95% CI [0.050, 0.16], t = 3.57, p < 0.001, indicating that the relationship between attractiveness and support is moderated by spouse.

Produce the simple slopes analysis for Task 1.

interactions::sim_slopes(
support_lm,
pred = attractiveness_cent,
modx = spouse,
jnplot = FALSE,
robust = TRUE,
confint = TRUE
)

## SIMPLE SLOPES ANALYSIS
##
## Slope of attractiveness_cent when spouse = Wife:
##
##   Est.   S.E.   2.5%   97.5%   t val.      p
## ------ ------ ------ ------- -------- ------
##   0.05   0.02   0.00    0.09     2.12   0.04
##
## Slope of attractiveness_cent when spouse = Husband:
##
##    Est.   S.E.    2.5%   97.5%   t val.      p
## ------- ------ ------- ------- -------- ------
##   -0.06   0.02   -0.10   -0.02    -2.95   0.00


Essentially, the output shows the results of two different regressions:

• When spouse = husband, there is a significant negative relationship between attractiveness and support, b = $-0.06$, 95% CI [$-0.10$, $-0.02$], t = $-2.95$, p < 0.01.
• When spouse = wife, there is a significant positive relationship between attractiveness and support, b = 0.05, 95% CI [0.00, 0.09], t = 2.12, p = 0.04.

These results tell us that the relationship between attractiveness of a person and amount of support given to their spouse is different for husbands and wives. Specifically, for wives, as attractiveness increases the level of support that they give to their husbands increases, whereas for husbands, as attractiveness increases the amount of support they give to their wives decreases:

McNulty et al. (2008) also found a relationship between a person’s attractiveness and their relationship satisfaction among newlyweds. Using the same data as in Tasks 1 and 2, find out if this relationship is moderated by spouse?

satis_lm <- lm(satisfaction ~ attractiveness_cent*spouse, data = mcnulty_tib)
broom::glance(satis_lm) %>%
knitr::kable(digits = 3)

0.0280.014.4441.5470.2043-475.297960.593976.0923159.877160164
broom::tidy(satis_lm, conf.int = TRUE) %>%
knitr::kable(digits = 3)

termestimatestd.errorstatisticp.valueconf.lowconf.high
(Intercept)33.7280.49168.7230.00032.75934.697
attractiveness_cent-0.8840.441-2.0030.047-1.755-0.012
spouseWife-0.0240.694-0.0340.973-1.3941.347
attractiveness_cent:spouseWife0.5470.6130.8920.374-0.6641.757

Fit a robust model:

parameters::model_parameters(satis_lm, robust = TRUE, vcov.type = "HC4") %>%
knitr::kable(digits = 3)

ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)33.7280.40932.91934.53682.4031600.000
attractiveness_cent-0.8840.383-1.640-0.128-2.3091600.022
spouseWife-0.0240.702-1.4111.363-0.0341600.973
attractiveness_cent:spouseWife0.5470.577-0.5931.6870.9471600.345

Moderation is shown up by a significant interaction effect, and in this case the interaction is not significant, b = 0.547, 95% CI [$-0.59$, $1.69$], t = 0.95, p = 0.345, indicating that the relationship between attractiveness and relationship satisfaction is not significantly moderated by spouse.

In this chapter we tested a mediation model of infidelity for Lambert et al.’s data. Repeat this analysis but using hook_ups as the measure of infidelity.

infidelity_tib <- readr::read_csv("../data/lambert_2012.csv")


Alternative, load the data directly from the discovr package:

infidelity_tib <- discovr::lambert_2012


Fit the model

hookup_mod <- 'hook_ups ~ c*ln_porn + b*commit
commit ~ a*ln_porn

indirect_effect := a*b
total_effect := c + (a*b)
'

hookup_fit <- lavaan::sem(hookup_mod, data = infidelity_tib, missing = "FIML", estimator = "MLR")

broom::glance(hookup_fit) %>%
knitr::kable(digits = 3)

agfiAICBICcfichisqnparrmsearmsea.conf.highsrmrtliconvergedestimatorngroupsmissing_methodnobsnorignexcluded
11389.5121413.8761070001TRUEML1ml2402400
broom::tidy(hookup_fit, conf.int = TRUE) %>%
knitr::kable(digits = 3)

termoplabelestimatestd.errorstatisticp.valueconf.lowconf.highstd.lvstd.allstd.nox
hook_ups ~ ln_porn~c1.2880.5162.4970.0130.2772.2991.2880.1870.843
hook_ups ~ commit~b-0.6200.131-4.7160.000-0.877-0.362-0.620-0.298-0.298
commit ~ ln_porn~a-0.4710.229-2.0560.040-0.919-0.022-0.471-0.142-0.639
hook_ups ~~ hook_ups~~2.0090.4044.9680.0001.2172.8022.0090.8600.860
commit ~~ commit~~0.5310.05010.6650.0000.4330.6280.5310.9800.980
ln_porn ~~ ln_porn~~0.0490.000NANA0.0490.0490.0491.0000.049
hook_ups ~1~13.2310.5975.4090.0002.0614.4023.2312.1142.114
commit ~1~14.2030.05379.5760.0004.1004.3074.2035.7115.711
ln_porn ~1~10.1260.000NANA0.1260.1260.1260.5670.126
indirect_effect := a*b:=indirect_effect0.2920.1531.9110.056-0.0070.5910.2920.0420.191
total_effect := c+(a*b):=total_effect1.5800.5472.8880.0040.5082.6521.5800.2291.034

Is there evidence for mediation?

• Pornography consumption significantly predicts hook-ups, b = 1.29, 95% CI [0.28, 2.30], t = 2.50, p = 0.013. As pornography consumption increases, the number of hook-ups increases also.
• Pornography consumption significantly predicts relationship commitment, b = $-0.47$, 95% CI [$-0.92$, $-0.02$], t = $-2.06$, p = .04. As pornography consumption increases commitment declines.
• Relationship commitment significantly predicts hook-ups, b = $-0.62$, 95% CI [$-0.88$, $-0.36$], t = 4.97, p < .001. As relationship commitment increases the number of hook-ups decreases.
• The indirect effect of pornography consumption on hook_ups through relationship commitment is not quite significant, b = $0.29$, 95% CI [$-0.01$, $0.59$], t = 1.91, p = .056.

As such, there is not significant mediation (although there nearly is …).

Tablets like the iPad are very popular. A company owner was interested in how to make his brand of tablets more desirable. He collected data on how cool people perceived a product’s advertising to be (advert_cool), how cool they thought the product was (product_cool), and how desirable they found the product (desirability). Test his theory that the relationship between cool advertising and product desirability is mediated by how cool people think the product is (tablets.csv). Am I showing my age by using the word ‘cool’?

tablet_tib <- readr::read_csv("../data/tablets.csv")


Alternative, load the data directly from the discovr package:

tablet_tib <- discovr::tablets


Fit the model

tablet_mod <- 'desirability ~ c*advert_cool + b*product_cool

indirect_effect := a*b
total_effect := c + (a*b)
'

tablet_fit <- lavaan::sem(tablet_mod, data = tablet_tib, estimator = "MLR")

broom::glance(tablet_fit) %>%
knitr::kable(digits = 3)

agfiAICBICcfichisqnparrmsearmsea.conf.highsrmrtliconvergedestimatorngroupsmissing_methodnobsnorignexcluded
11056.8141074.2171050001TRUEML1listwise2402400
broom::tidy(tablet_fit, conf.int = TRUE) %>%
knitr::kable(digits = 3)

termoplabelestimatestd.errorstatisticp.valueconf.lowconf.highstd.lvstd.allstd.nox
desirability ~ product_cool~b0.2320.0593.9610.0000.1170.3460.2320.2290.229