Labcoat Leni solutions Chapter 8

Labcoat Leni character from Discovering Statistics using R and RStudio

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.

Load packages

Remember to load the tidyverse:

library(tidyverse)

I want to be loved (on Facebook)

Load the file

To load from the csv file use this code. Note that fct_relevel is used to ensure that factor levels match those in the original analysis.

ong_tib <- readr::read_csv("../data/chamorro_premuzic.csv") %>% 
  dplyr::mutate(
    sex = forcats::as_factor(sex) %>% forcats::fct_relevel(., "Female"),
    grade = forcats::as_factor(grade) %>% forcats::fct_relevel(., "Sec 1", "Sec 2", "Sec 3")
  )

Alternative, load the data directly from the discovr package:

ong_tib <- discovr::ong_2011

Fit the models

The first linear model looks at whether narcissism predicts, above and beyond the other variables, the frequency of status updates. Fit this model:

ong_base_lm <- lm(status ~ sex + age + grade, data = ong_tib, na.action = na.exclude)

The second model adds extraversion:

ong_ext_lm <- update(ong_base_lm, .~. + extraversion)

The final mdoel adds narcissism:

ong_ncs_lm <- update(ong_ext_lm, .~. + narcissism)

Compare models

anova(ong_base_lm, ong_ext_lm, ong_ncs_lm) %>% 
  broom::tidy() %>% 
  knitr::kable(digits= 3)
res.dfrssdfsumsqstatisticp.value
2461481.515NANANANA
2451458.360123.1554.0170.046
2441406.600151.7598.9790.003

Adding extroversion and narcissim as predictors both significantly improve the fit of the model. (i.e. they are significant predictors.)

Model parameters:

ong_ncs_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.3810.211-0.0350.7971.8052440.072
sexMale-0.3800.134-0.644-0.115-2.8292440.005
age-0.0030.126-0.2510.244-0.0272440.979
gradeSec 2-0.1690.211-0.5840.245-0.8042440.422
gradeSec 3-0.4170.307-1.0200.187-1.3592440.175
extraversion0.0260.070-0.1130.1650.3672440.714
narcissism0.2110.0700.0720.3502.9962440.003

So basically, Ong et al.’s prediction was supported in that after adjusting for age, grade and gender, narcissism significantly predicted the frequency of Facebook status updates over and above extroversion. The positive standardized beta value (.21) indicates a positive relationship between frequency of Facebook updates and narcissism, in that more narcissistic adolescents updated their Facebook status more frequently than their less narcissistic peers did. Compare these results to the results reported in Ong et al. (2011). The Table 2 from their paper is reproduced at the end of this task below (look at the bottom section).

OK, now let’s fit more models to investigate whether narcissism predicts, above and beyond the other variables, the Facebook profile picture ratings. We use the same code as before but change the outcome from status to profile:

prof_base_lm <- lm(profile ~ sex + age + grade, data = ong_tib, na.action = na.exclude)
prof_ext_lm <- update(prof_base_lm, .~. + extraversion)
prof_ncs_lm <- update(prof_ext_lm, .~. + narcissism)

Compare models

anova(prof_base_lm, prof_ext_lm, prof_ncs_lm) %>% 
  broom::tidy() %>% 
  knitr::kable(digits = 3)
res.dfrssdfsumsqstatisticp.value
1882405.233NANANANA
1872104.9691300.26429.6130
1861885.9581219.01121.6000

Adding extraversion and narcissim as predictors both significantly improve the fit of the model. (i.e. they are significant predictors.)

Model parameters:

prof_ncs_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.0540.211-0.3620.4700.2561860.798
sexMale0.1620.146-0.1270.4501.1041860.271
age0.0990.123-0.1440.3410.8011860.424
gradeSec 2-0.1320.221-0.5670.304-0.5971860.551
gradeSec 3-0.1550.302-0.7510.441-0.5151860.607
extraversion0.1690.0770.0170.3212.1991860.029
narcissism0.3680.0790.2120.5244.6481860.000

These results show that after adjusting for age, grade and gender, narcissism significantly predicted the Facebook profile picture ratings over and above extroversion. The positive beta value (.37) indicates a positive relationship between profile picture ratings and narcissism, in that more narcissistic adolescents rated their Facebook profile pictures more positively than their less narcissistic peers did. Compare these results to the results reported in Table 2 of Ong et al. (2011) below.

Table 2 from Ong et al. (2011)

Why do you like your lecturers?

Load the file

chamorro_tib <- readr::read_csv("../data/chamorro_premuzic.csv") %>% 
  dplyr::mutate(
    sex = forcats::as_factor(sex)
  )

Alternative, load the data directly from the discovr package:

chamorro_tib <- discovr::chamorro_premuzic

Lecturer neuroticism

The first model we’ll fit predicts whether students want lecturers to be neurotic. In the first model put age and sex:

cp_neuro_lm <- lm(lec_neurotic ~ age + sex, data = chamorro_tib, na.action = na.exclude)
cp_neuro_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0950.058-0.2090.020-1.6273930.105
age0.0820.050-0.0160.1801.6493930.100
sexMale0.3440.1110.1260.5633.1003930.002

In the next model block, put all of the student personality variables (five variables in all):

cp_neuro_full_lm <- lm(lec_neurotic ~ age + sex + stu_neurotic + stu_extro + stu_open + stu_agree + stu_consc, data = chamorro_tib, na.action = na.exclude)
cp_neuro_full_lm %>% 
  broom::glance() %>% 
  knitr::kable(digits = 3)
r.squaredadj.r.squaredsigmastatisticp.valuedflogLikAICBICdeviancedf.residualnobs
0.0640.0468.6693.5560.0017-1330.7992679.5992714.89327428.95365373
cp_neuro_full_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0580.060-0.1770.061-0.9613650.337
age0.1190.0510.0200.2192.3533650.019
sexMale0.2140.122-0.0260.4551.7543650.080
stu_neurotic-0.0590.058-0.1730.055-1.0223650.307
stu_extro-0.0780.055-0.1860.030-1.4283650.154
stu_open-0.1230.051-0.224-0.022-2.3913650.017
stu_agree0.0730.060-0.0450.1901.2183650.224
stu_consc-0.1570.063-0.281-0.033-2.4823650.013

So basically, age, openness and conscientiousness were significant predictors of wanting a neurotic lecturer (note that for openness and conscientiousness the relationship is negative, i.e. the more a student scored on these characteristics, the less they wanted a neurotic lecturer).

Lecturer extroversion

The second variable we want to predict is lecturer extroversion. You can follow the steps of the first example but with the outcome variable of lec_extro:

cp_extro_lm <- lm(lec_extro ~ age + sex, data = chamorro_tib, na.action = na.exclude)
cp_extro_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0360.069-0.1720.101-0.5112790.610
age0.0130.060-0.1050.1310.2162790.829
sexMale0.1350.136-0.1320.4030.9972790.320
cp_extro_full_lm <- lm(lec_extro ~ age + sex + stu_neurotic + stu_extro + stu_open + stu_agree + stu_consc, data = chamorro_tib, na.action = na.exclude)
cp_extro_full_lm %>% 
  broom::glance() %>% 
  knitr::kable(digits = 3)
r.squaredadj.r.squaredsigmastatisticp.valuedflogLikAICBICdeviancedf.residualnobs
0.0460.0216.7991.8290.0827-903.2591824.5181856.97112204.22264272
cp_extro_full_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0630.072-0.2050.079-0.8682640.386
age0.0030.061-0.1160.1220.0502640.960
sexMale0.2300.147-0.0600.5201.5622640.119
stu_neurotic0.0220.072-0.1200.1630.3052640.761
stu_extro0.1550.0660.0240.2862.3382640.020
stu_open0.0410.061-0.0800.1610.6642640.507
stu_agree0.0140.072-0.1260.1550.2022640.840
stu_consc0.1120.077-0.0390.2621.4612640.145

You should find that student extroversion was the only significant predictor of wanting an extrovert lecturer; the model overall did not explain a significant amount of the variance in wanting an extroverted lecturer.

Lecturer openness to experience

You can follow the steps of the first example but using lec_open as the outcome:

cp_open_lm <- lm(lec_open ~ age + sex, data = chamorro_tib, na.action = na.exclude)
cp_open_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0020.059-0.1180.114-0.0403960.968
age-0.0150.050-0.1140.084-0.2993960.765
sexMale0.0090.112-0.2120.2290.0773960.939
cp_open_full_lm <- lm(lec_open ~ age + sex + stu_neurotic + stu_extro + stu_open + stu_agree + stu_consc, data = chamorro_tib, na.action = na.exclude)
cp_open_full_lm %>% 
  broom::glance() %>% 
  knitr::kable(digits = 3)
r.squaredadj.r.squaredsigmastatisticp.valuedflogLikAICBICdeviancedf.residualnobs
0.0640.0467.9213.6040.0017-1304.1212626.2422661.58523025.6367375
cp_open_full_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.0070.060-0.1110.1260.1223670.903
age-0.0190.051-0.1180.081-0.3703670.712
sexMale-0.0270.122-0.2670.213-0.2223670.824
stu_neurotic0.0070.058-0.1070.1210.1153670.908
stu_extro0.0520.055-0.0560.1600.9453670.345
stu_open0.2170.0510.1160.3184.2383670.000
stu_agree0.1330.0590.0160.2502.2323670.026
stu_consc-0.0510.063-0.1750.073-0.8133670.417

You should find that student openness to experience was the most significant predictor of wanting a lecturer who is open to experience, but student agreeableness predicted this also.

Lecturer agreeableness

The fourth variable we want to predict is lecturer agreeableness. You can follow the steps of the first example but using lec_agree as the outcome:

cp_agree_lm <- lm(lec_agree ~ age + sex, data = chamorro_tib, na.action = na.exclude)
cp_agree_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.0170.058-0.0970.1320.2943930.769
age-0.1690.050-0.267-0.071-3.3993930.001
sexMale-0.0630.111-0.2820.156-0.5633930.574
cp_agree_full_lm <- lm(lec_agree ~ age + sex + stu_neurotic + stu_extro + stu_open + stu_agree + stu_consc, data = chamorro_tib, na.action = na.exclude)
cp_agree_full_lm %>% 
  broom::glance() %>% 
  knitr::kable(digits = 3)
r.squaredadj.r.squaredsigmastatisticp.valuedflogLikAICBICdeviancedf.residualnobs
0.1030.0859.185.94607-1348.5372715.0732750.34330675.33364372
cp_agree_full_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)-0.0280.059-0.1440.088-0.4743640.636
age-0.1750.050-0.273-0.077-3.5203640.000
sexMale0.1040.120-0.1320.3410.8693640.386
stu_neurotic0.1560.0570.0440.2682.7423640.006
stu_extro0.0430.054-0.0630.1490.8053640.421
stu_open-0.1410.050-0.240-0.041-2.7903640.006
stu_agree0.1320.0590.0170.2482.2553640.025
stu_consc0.0720.062-0.0500.1941.1613640.246

You should find that Age, student openness to experience and student neuroticism significantly predicted wanting a lecturer who is agreeable. Age and openness to experience had negative relationships (the older and more open to experienced you are, the less you want an agreeable lecturer), whereas as student neuroticism increases so does the desire for an agreeable lecturer (not surprisingly, because neurotics will lack confidence and probably feel more able to ask an agreeable lecturer questions).

Lecturer conscientiousness

The final variable we want to predict is lecturer conscientiousness. You can follow the steps of the first example but replacing the outcome variable with lec_consc.

cp_consc_lm <- lm(lec_consc ~ age + sex, data = chamorro_tib, na.action = na.exclude)
cp_consc_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.0950.058-0.0200.2091.6283930.104
age0.0720.050-0.0260.1701.4523930.147
sexMale-0.3480.112-0.567-0.128-3.1173930.002
cp_consc_full_lm <- lm(lec_consc ~ age + sex + stu_neurotic + stu_extro + stu_open + stu_agree + stu_consc, data = chamorro_tib, na.action = na.exclude)
cp_consc_full_lm %>% 
  broom::glance() %>% 
  knitr::kable(digits = 3)
r.squaredadj.r.squaredsigmastatisticp.valuedflogLikAICBICdeviancedf.residualnobs
0.0740.0567.2594.13207-1261.1932540.3872575.65719180.05364372
cp_consc_full_lm %>% 
  parameters::model_parameters(standardize = "refit") %>% 
  knitr::kable(digits = 3)
ParameterCoefficientSECI_lowCI_hightdf_errorp
(Intercept)0.0560.060-0.0620.1740.9333640.351
age0.0460.051-0.0540.1450.9013640.368
sexMale-0.2090.122-0.4500.032-1.7063640.089
stu_neurotic0.0120.058-0.1010.1260.2123640.832
stu_extro-0.0590.055-0.1660.049-1.0763640.283
stu_open-0.0090.051-0.1100.092-0.1793640.858
stu_agree0.1440.0590.0280.2612.4363640.015
stu_consc0.1270.0630.0030.2512.0183640.044

Student agreeableness and conscientiousness both signfiicantly predict wanting a lecturer who is conscientious. Note also that gender predicted this in the first step, but its b became slightly non-significant (p = .07) when the student personality variables were forced in as well. However, gender is probably a variable that should be explored further within this context.

Compare all of your results to Table 4 in the actual article (shown below) - our five analyses are represented by the columns labelled N, E, O, A and C).

Table 4 from Chamorro-Premuzic et al. (2008)
Previous
Next