Smart Alex solutions Chapter 10

Task 10.1

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)?

Load the data

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)

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

Fit a robust model:

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

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.

Task 10.2

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:

Task 11.3

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)

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

Fit a robust model:

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

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.

Task 11.4

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.

Load the data

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)

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

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 …).

Task 11.5

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’?

Load the data

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
                   product_cool ~ a*advert_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)

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

• Advert coolness significantly predicts desirability, b = 0.20, 95% CI [0.07, 0.33], t = 3.11, p = 0.002. As advert coolness increases, desirability increases also.
• Advert coolness significantly predicts perceptions of a product, b = 0.15, 95% CI [0.02, 0.03], t = 2.43, p = 0.015. As advert coolness increases product coolness incraeses also.
• Product coolness significantly predicts desirability, b = 0.23, 95% CI [0.12, 0.35], t = 3.96, p < 0.001. Products perceived to be more cool are more desitable.
• The indirect effect of advert coolness on desirability through product coolness is significant, b = 0.04, 95% CI [0.00, 0.07], t = 2.03, p = 0.042. As such, there is significant mediation.

Ypu could report this as:

• There was a significant indirect effect of how cool people think a products’ advertising is on the desirability of the product though how cool they think the product is, b = 0.04, 95% CI [0.00, 0.07], t = 2.03, p = 0.042. This represents a relatively small effect.