study1_analysis_7.7.25
Samantha Grayson
2025-07-08
Load packages
library(corrr)
library(corrplot)## corrplot 0.92 loadedlibrary(psych)
library(psy)##
## Attaching package: 'psy'## The following object is masked from 'package:psych':
##
## wkappalibrary(GPArotation)##
## Attaching package: 'GPArotation'## The following objects are masked from 'package:psych':
##
## equamax, variminlibrary(knitr)
library(kableExtra)
library(lavaan)## This is lavaan 0.6-18
## lavaan is FREE software! Please report any bugs.##
## Attaching package: 'lavaan'## The following object is masked from 'package:psych':
##
## cor2covlibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::%+%() masks psych::%+%()
## ✖ ggplot2::alpha() masks psych::alpha()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::group_rows() masks kableExtra::group_rows()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsLoad data
data <- read.csv("~/Google drive/My Drive/YEAR 2/PROJECTS/DEREK/Status Distribution/Studies/Study 1: Scale/raw_study1_data_7.1.25.csv")Exclusions
data <- data %>%
slice(-c(1:4)) %>%
filter(attn_bots != "14285733") %>%
filter(attn == 24) %>%
unite(geolocation, LocationLatitude, LocationLongitude) %>%
group_by(geolocation) %>%
mutate(geo_frequency = n()) %>%
filter(geo_frequency < 3) %>%
ungroup()We lose way less data than with Prolific here! Yay!
Data cleaning
Gather and clean numeric data
df_numeric <- data %>%
select(c(ResponseId, dist_1R:dist_10, attribute_1R:attribute_10, admire_proneness_1:admire_proneness_12, OCBI_1:OCBI_8, UPBs_1:UPBs_6, SZSB_1:SZSB_8R, Extraversion:Open, sdo_1:sdo_8R, need.for.status_1:need.for.status_8, dom_1:prest_9R)) %>%
mutate(across(-ResponseId, as.numeric))df_numeric <- df_numeric %>%
mutate(across(ends_with("R"), ~ 8 - ., .names = "{.col}_Recoded")) Create average scores
df_numeric <- df_numeric %>%
mutate(
dist_avg = rowMeans(select(.,
dist_1R_Recoded,
dist_2R_Recoded,
dist_3,
dist_4,
dist_5R_Recoded,
dist_6R_Recoded,
dist_7,
dist_8,
dist_9R_Recoded,
dist_10),
na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
attribute_avg = rowMeans(select(.,
attribute_1R_Recoded,
attribute_2R_Recoded,
attribute_3,
attribute_4,
attribute_5,
attribute_6,
attribute_7,
attribute_8,
attribute_9R_Recoded,
attribute_10
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
admire_avg = rowMeans(select(.,
admire_proneness_1,
admire_proneness_2,
admire_proneness_3,
admire_proneness_4,
admire_proneness_5,
admire_proneness_6,
admire_proneness_7,
admire_proneness_8,
admire_proneness_9,
admire_proneness_10,
admire_proneness_11,
admire_proneness_12
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
OCBI_avg = rowMeans(select(.,
OCBI_1,
OCBI_2,
OCBI_3,
OCBI_4,
OCBI_5,
OCBI_6,
OCBI_7,
OCBI_8
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
UPB_avg = rowMeans(select(.,
UPBs_1,
UPBs_2,
UPBs_3,
UPBs_4,
UPBs_5,
UPBs_6
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
szsb_avg = rowMeans(select(.,
SZSB_1,
SZSB_2,
SZSB_3,
SZSB_4,
SZSB_5R_Recoded,
SZSB_6R_Recoded,
SZSB_7R_Recoded,
SZSB_8R_Recoded
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
nfs_avg = rowMeans(select(.,
need.for.status_1,
need.for.status_2R_Recoded,
need.for.status_3,
need.for.status_4,
need.for.status_5,
need.for.status_6,
need.for.status_7R_Recoded,
need.for.status_8
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
sdo_avg = rowMeans(select(.,
sdo_1,
sdo_2,
sdo_3R_Recoded,
sdo_4R_Recoded,
sdo_5,
sdo_6,
sdo_7R_Recoded,
sdo_8R_Recoded
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
dominance_avg = rowMeans(select(.,
dom_1,
dom_2,
dom_3,
dom_4,
dom_5R_Recoded,
dom_6,
dom_7R_Recoded,
dom_8
), na.rm = TRUE)
)df_numeric <- df_numeric %>%
mutate(
prestige_avg = rowMeans(select(.,
prest_1,
prest_2R_Recoded,
prest_3,
prest_4R_Recoded,
prest_5,
prest_6,
prest_7,
prest_8,
prest_9R_Recoded
), na.rm = TRUE)
)EFA
initial_items <- df_numeric %>%
select(dist_1R_Recoded,
dist_2R_Recoded,
dist_3,
dist_4,
dist_5R_Recoded,
dist_6R_Recoded,
dist_7,
dist_8,
dist_9R_Recoded,
dist_10,
attribute_1R_Recoded,
attribute_2R_Recoded,
attribute_3,
attribute_4,
attribute_5,
attribute_6,
attribute_7,
attribute_8,
attribute_9R_Recoded,
attribute_10) %>%
na.omit()
cronbach(initial_items) # alpha = 0.886## $sample.size
## [1] 379
##
## $number.of.items
## [1] 20
##
## $alpha
## [1] 0.8861605x <- cor(initial_items)
corrplot(x,method="number")
bartlett.test(initial_items)##
## Bartlett test of homogeneity of variances
##
## data: initial_items
## Bartlett's K-squared = 455.63, df = 19, p-value < 2.2e-16KMO(x) # >.5 minimum, >.9 is great## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = x)
## Overall MSA = 0.91
## MSA for each item =
## dist_1R_Recoded dist_2R_Recoded dist_3
## 0.94 0.88 0.88
## dist_4 dist_5R_Recoded dist_6R_Recoded
## 0.89 0.91 0.91
## dist_7 dist_8 dist_9R_Recoded
## 0.92 0.91 0.87
## dist_10 attribute_1R_Recoded attribute_2R_Recoded
## 0.93 0.90 0.81
## attribute_3 attribute_4 attribute_5
## 0.93 0.92 0.92
## attribute_6 attribute_7 attribute_8
## 0.89 0.94 0.93
## attribute_9R_Recoded attribute_10
## 0.84 0.92Bartlett’s test of sphericity (χ²[19] = 455.63, p < .001) and the Kaiser-Meyer-Olkin measure of sampling adequacy (KMO = .91) indicate sufficient common variance to proceed with factor analysis.
efa_full <- fa(initial_items, nfactors = 4, fm = "pa", rotate = "promax")
print(efa_full)## Factor Analysis using method = pa
## Call: fa(r = initial_items, nfactors = 4, rotate = "promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PA2 PA3 PA1 PA4 h2 u2 com
## dist_1R_Recoded 0.74 -0.09 0.06 0.18 0.67 0.33 1.2
## dist_2R_Recoded 0.79 -0.06 0.07 0.17 0.76 0.24 1.1
## dist_3 0.13 0.08 0.23 0.74 0.81 0.19 1.3
## dist_4 0.11 0.13 0.39 0.18 0.36 0.64 1.8
## dist_5R_Recoded 0.75 -0.04 0.10 0.19 0.75 0.25 1.2
## dist_6R_Recoded 0.60 0.12 0.07 -0.14 0.43 0.57 1.2
## dist_7 -0.02 0.65 -0.03 0.21 0.46 0.54 1.2
## dist_8 -0.09 0.76 0.01 0.06 0.55 0.45 1.0
## dist_9R_Recoded 0.70 0.40 -0.29 -0.23 0.60 0.40 2.3
## dist_10 0.01 0.65 -0.11 0.11 0.39 0.61 1.1
## attribute_1R_Recoded 0.72 -0.16 0.33 -0.13 0.64 0.36 1.6
## attribute_2R_Recoded 0.56 -0.08 -0.07 0.05 0.29 0.71 1.1
## attribute_3 0.09 0.10 0.74 0.03 0.72 0.28 1.1
## attribute_4 0.07 -0.09 0.77 0.11 0.62 0.38 1.1
## attribute_5 0.01 -0.01 0.77 0.11 0.64 0.36 1.0
## attribute_6 -0.14 0.46 0.43 -0.09 0.52 0.48 2.3
## attribute_7 -0.05 0.53 0.29 -0.16 0.49 0.51 1.8
## attribute_8 0.04 0.77 -0.02 -0.06 0.60 0.40 1.0
## attribute_9R_Recoded -0.08 -0.32 0.04 -0.19 0.16 0.84 1.8
## attribute_10 -0.10 0.56 0.37 -0.13 0.61 0.39 1.9
##
## PA2 PA3 PA1 PA4
## SS loadings 3.69 3.34 2.96 1.08
## Proportion Var 0.18 0.17 0.15 0.05
## Cumulative Var 0.18 0.35 0.50 0.55
## Proportion Explained 0.33 0.30 0.27 0.10
## Cumulative Proportion 0.33 0.64 0.90 1.00
##
## With factor correlations of
## PA2 PA3 PA1 PA4
## PA2 1.00 0.41 0.41 0.38
## PA3 0.41 1.00 0.55 0.10
## PA1 0.41 0.55 1.00 0.15
## PA4 0.38 0.10 0.15 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 4 factors are sufficient.
##
## df null model = 190 with the objective function = 10.86 with Chi Square = 4024.61
## df of the model are 116 and the objective function was 0.87
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.04
##
## The harmonic n.obs is 379 with the empirical chi square 170.33 with prob < 0.00077
## The total n.obs was 379 with Likelihood Chi Square = 320.86 with prob < 4.1e-21
##
## Tucker Lewis Index of factoring reliability = 0.912
## RMSEA index = 0.068 and the 90 % confidence intervals are 0.06 0.077
## BIC = -367.9
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## PA2 PA3 PA1 PA4
## Correlation of (regression) scores with factors 0.96 0.94 0.94 0.89
## Multiple R square of scores with factors 0.91 0.88 0.88 0.79
## Minimum correlation of possible factor scores 0.82 0.76 0.76 0.57df_quad <- df_numeric %>%
select(dist_1R_Recoded, dist_2R_Recoded, dist_5R_Recoded, # Distribution descriptive
dist_6R_Recoded, dist_7, dist_8, # Distribution prescriptive
attribute_3, attribute_4, attribute_5, # Attribution descriptive
attribute_6, attribute_8, attribute_10) # Attribution prescriptiveefa_quad <- fa(df_quad, nfactors = 4, fm = "pa", rotate = "promax")
print(efa_quad)## Factor Analysis using method = pa
## Call: fa(r = df_quad, nfactors = 4, rotate = "promax", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PA2 PA1 PA3 PA4 h2 u2 com
## dist_1R_Recoded 0.85 -0.01 -0.05 -0.01 0.68 0.32 1.0
## dist_2R_Recoded 0.97 -0.07 -0.08 0.08 0.84 0.16 1.0
## dist_5R_Recoded 0.92 -0.02 -0.03 0.05 0.81 0.19 1.0
## dist_6R_Recoded 0.40 0.15 0.19 -0.12 0.33 0.67 2.0
## dist_7 0.11 -0.10 0.63 0.06 0.44 0.56 1.1
## dist_8 -0.11 0.02 0.87 -0.10 0.61 0.39 1.1
## attribute_3 0.04 0.75 0.07 0.05 0.71 0.29 1.0
## attribute_4 0.07 0.76 -0.10 0.04 0.58 0.42 1.1
## attribute_5 -0.06 0.90 -0.02 -0.05 0.68 0.32 1.0
## attribute_6 0.03 0.06 0.07 0.77 0.75 0.25 1.0
## attribute_8 0.00 -0.02 0.75 0.03 0.58 0.42 1.0
## attribute_10 -0.07 0.18 0.35 0.39 0.60 0.40 2.5
##
## PA2 PA1 PA3 PA4
## SS loadings 2.65 2.06 1.94 0.96
## Proportion Var 0.22 0.17 0.16 0.08
## Cumulative Var 0.22 0.39 0.55 0.63
## Proportion Explained 0.35 0.27 0.26 0.13
## Cumulative Proportion 0.35 0.62 0.87 1.00
##
## With factor correlations of
## PA2 PA1 PA3 PA4
## PA2 1.00 0.54 0.41 0.16
## PA1 0.54 1.00 0.58 0.60
## PA3 0.41 0.58 1.00 0.62
## PA4 0.16 0.60 0.62 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 4 factors are sufficient.
##
## df null model = 66 with the objective function = 6.38 with Chi Square = 2386.78
## df of the model are 24 and the objective function was 0.06
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic n.obs is 379 with the empirical chi square 7.65 with prob < 1
## The total n.obs was 380 with Likelihood Chi Square = 22.9 with prob < 0.53
##
## Tucker Lewis Index of factoring reliability = 1.001
## RMSEA index = 0 and the 90 % confidence intervals are 0 0.039
## BIC = -119.67
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA2 PA1 PA3 PA4
## Correlation of (regression) scores with factors 0.96 0.94 0.92 0.89
## Multiple R square of scores with factors 0.93 0.88 0.84 0.79
## Minimum correlation of possible factor scores 0.85 0.75 0.68 0.58model_quad <- '
dist_desc =~ dist_1R_Recoded + dist_2R_Recoded + dist_5R_Recoded
dist_prescr =~ dist_7 + dist_8 + dist_10
attr_desc =~ attribute_3 + attribute_4 + attribute_5
attr_prescr =~ attribute_6 + attribute_8 + attribute_10
'
fit_quad <- cfa(model_quad, data = df_numeric, estimator = "MLM")
summary(fit_quad, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-18 ended normally after 47 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 30
##
## Used Total
## Number of observations 379 380
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 98.533 76.406
## Degrees of freedom 48 48
## P-value (Chi-square) 0.000 0.006
## Scaling correction factor 1.290
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 2413.983 1285.786
## Degrees of freedom 66 66
## P-value 0.000 0.000
## Scaling correction factor 1.877
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.978 0.977
## Tucker-Lewis Index (TLI) 0.970 0.968
##
## Robust Comparative Fit Index (CFI) 0.984
## Robust Tucker-Lewis Index (TLI) 0.978
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -6662.852 -6662.852
## Loglikelihood unrestricted model (H1) -6613.586 -6613.586
##
## Akaike (AIC) 13385.704 13385.704
## Bayesian (BIC) 13503.831 13503.831
## Sample-size adjusted Bayesian (SABIC) 13408.647 13408.647
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.053 0.040
## 90 Percent confidence interval - lower 0.038 0.024
## 90 Percent confidence interval - upper 0.068 0.054
## P-value H_0: RMSEA <= 0.050 0.363 0.882
## P-value H_0: RMSEA >= 0.080 0.001 0.000
##
## Robust RMSEA 0.045
## 90 Percent confidence interval - lower 0.024
## 90 Percent confidence interval - upper 0.063
## P-value H_0: Robust RMSEA <= 0.050 0.655
## P-value H_0: Robust RMSEA >= 0.080 0.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.040 0.040
##
## Parameter Estimates:
##
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## dist_desc =~
## dist_1R_Recodd 1.000 1.417 0.822
## dist_2R_Recodd 1.122 0.053 21.342 0.000 1.590 0.912
## dist_5R_Recodd 1.107 0.055 20.248 0.000 1.569 0.903
## dist_prescr =~
## dist_7 1.000 0.930 0.689
## dist_8 0.949 0.085 11.197 0.000 0.883 0.749
## dist_10 1.009 0.107 9.465 0.000 0.939 0.605
## attr_desc =~
## attribute_3 1.000 1.080 0.870
## attribute_4 0.910 0.105 8.649 0.000 0.982 0.745
## attribute_5 0.995 0.065 15.353 0.000 1.074 0.792
## attr_prescr =~
## attribute_6 1.000 0.839 0.746
## attribute_8 0.867 0.100 8.696 0.000 0.727 0.691
## attribute_10 1.023 0.088 11.653 0.000 0.858 0.787
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## dist_desc ~~
## dist_prescr 0.470 0.110 4.286 0.000 0.357 0.357
## attr_desc 0.804 0.114 7.081 0.000 0.526 0.526
## attr_prescr 0.369 0.086 4.295 0.000 0.311 0.311
## dist_prescr ~~
## attr_desc 0.544 0.112 4.841 0.000 0.541 0.541
## attr_prescr 0.675 0.107 6.320 0.000 0.865 0.865
## attr_desc ~~
## attr_prescr 0.674 0.106 6.352 0.000 0.744 0.744
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .dist_1R_Recodd 0.965 0.153 6.318 0.000 0.965 0.325
## .dist_2R_Recodd 0.512 0.090 5.724 0.000 0.512 0.168
## .dist_5R_Recodd 0.557 0.111 5.002 0.000 0.557 0.185
## .dist_7 0.955 0.116 8.269 0.000 0.955 0.525
## .dist_8 0.609 0.095 6.387 0.000 0.609 0.438
## .dist_10 1.524 0.214 7.106 0.000 1.524 0.633
## .attribute_3 0.375 0.071 5.277 0.000 0.375 0.243
## .attribute_4 0.772 0.145 5.304 0.000 0.772 0.444
## .attribute_5 0.687 0.081 8.474 0.000 0.687 0.373
## .attribute_6 0.561 0.107 5.261 0.000 0.561 0.444
## .attribute_8 0.578 0.080 7.224 0.000 0.578 0.523
## .attribute_10 0.453 0.060 7.500 0.000 0.453 0.381
## dist_desc 2.008 0.185 10.827 0.000 1.000 1.000
## dist_prescr 0.866 0.154 5.620 0.000 1.000 1.000
## attr_desc 1.166 0.156 7.481 0.000 1.000 1.000
## attr_prescr 0.703 0.134 5.250 0.000 1.000 1.000Confirmatory factor analysis of the four-factor model (distribution × attribute × descriptive × prescriptive) indicated excellent fit: robust CFI = 0.984, TLI = 0.978, SRMR = 0.040, and RMSEA = 0.045 (90% CI = [.024, .063]). All items loaded significantly onto their respective factors, with standardized loadings ranging from .60 to .91. Inter-factor correlations ranged from r = .31 to r = .74, suggesting that the four constructs are conceptually distinct yet meaningfully related. These results provide strong support for the hypothesized multidimensional structure of status beliefs in teams.
Model fit indices: 1. Robust CFI = 0.984 (> .95 = good) 2. Robust TLI = 0.978 (> .95 = ideal) 3. SRMR = 0.040 (< .08 = acceptable) 4. Robust RMSEA = 0.045 (< .06 = good) 5. Chi-square (SB) χ²(48) = 76.41, p = .006 (χ² often significant with large N; not alone a red flag)
Discriminant validity
Make subscales
# Distribution × Descriptive (3 items)
df_numeric$dist_desc <- rowMeans(df_numeric[, c("dist_1R_Recoded", "dist_2R_Recoded", "dist_5R_Recoded")], na.rm = TRUE)
# Distribution × Prescriptive (3 items)
df_numeric$dist_prescr <- rowMeans(df_numeric[, c("dist_7", "dist_8", "dist_10")], na.rm = TRUE)
# Attribute × Descriptive (3 items)
df_numeric$attr_desc <- rowMeans(df_numeric[, c("attribute_3", "attribute_4", "attribute_5")], na.rm = TRUE)
# Attribute × Prescriptive (3 items)
df_numeric$attr_prescr <- rowMeans(df_numeric[, c("attribute_6", "attribute_8", "attribute_10")], na.rm = TRUE)dist_desc <- df_numeric %>%
select(dist_1R_Recoded,
dist_2R_Recoded,
dist_5R_Recoded) %>%
na.omit()
dist_prescr <- df_numeric %>%
select(dist_7,
dist_8,
dist_10) %>%
na.omit()
attr_desc <- df_numeric %>%
select(attribute_3,
attribute_4,
attribute_5) %>%
na.omit()
attr_prescr <- df_numeric %>%
select(attribute_6,
attribute_8,
attribute_10) %>%
na.omit()
cronbach(dist_desc) # alpha = 0.91## $sample.size
## [1] 379
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9102413cronbach(dist_prescr) # alpha = 0.71## $sample.size
## [1] 379
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.7100182cronbach(attr_desc) # alpha = 0.85## $sample.size
## [1] 380
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.845504cronbach(attr_prescr) # alpha = 0.78## $sample.size
## [1] 380
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.7795063cor_vars <- df_numeric %>%
select(dist_desc, dist_prescr, attr_desc, attr_prescr,
sdo_avg, nfs_avg, szsb_avg, dominance_avg, prestige_avg)
cor_matrix <- cor(cor_vars, use = "pairwise.complete.obs")
round(cor_matrix, 2)## dist_desc dist_prescr attr_desc attr_prescr sdo_avg nfs_avg
## dist_desc 1.00 0.30 0.46 0.26 -0.17 -0.12
## dist_prescr 0.30 1.00 0.40 0.66 -0.36 0.08
## attr_desc 0.46 0.40 1.00 0.59 -0.18 0.16
## attr_prescr 0.26 0.66 0.59 1.00 -0.29 0.17
## sdo_avg -0.17 -0.36 -0.18 -0.29 1.00 0.06
## nfs_avg -0.12 0.08 0.16 0.17 0.06 1.00
## szsb_avg -0.34 -0.28 -0.35 -0.29 0.18 0.02
## dominance_avg -0.26 -0.20 -0.05 -0.20 0.29 0.42
## prestige_avg -0.04 0.15 0.17 0.22 -0.02 0.79
## szsb_avg dominance_avg prestige_avg
## dist_desc -0.34 -0.26 -0.04
## dist_prescr -0.28 -0.20 0.15
## attr_desc -0.35 -0.05 0.17
## attr_prescr -0.29 -0.20 0.22
## sdo_avg 0.18 0.29 -0.02
## nfs_avg 0.02 0.42 0.79
## szsb_avg 1.00 0.27 -0.01
## dominance_avg 0.27 1.00 0.29
## prestige_avg -0.01 0.29 1.00These patterns suggest that the new subscales are measuring something related but novel compared to established constructs like SDO, status zero-sum beliefs, need for status, dominance orientation, and prestige orientation (|r| ≤ .36). The strongest associations were observed between prescriptive distribution beliefs and SDO (r = –.36), and between descriptive attribute beliefs and status zero-sum beliefs (r = –.35).
library(semTools)## ## ################################################################################# This is semTools 0.5-7## All users of R (or SEM) are invited to submit functions or ideas for functions.## #################################################################################
## Attaching package: 'semTools'## The following object is masked from 'package:readr':
##
## clipboard## The following objects are masked from 'package:psych':
##
## reliability, skewAVE(fit_quad) ## dist_desc dist_prescr attr_desc attr_prescr
## 0.775 0.450 0.642 0.553lavInspect(fit_quad, "cor.lv") # get latent variable correlations## dst_ds dst_pr attr_d attr_p
## dist_desc 1.000
## dist_prescr 0.357 1.000
## attr_desc 0.526 0.541 1.000
## attr_prescr 0.311 0.865 0.744 1.000ave_values <- AVE(fit_quad)cor_lv <- lavInspect(fit_quad, "cor.lv")
squared_cor_lv <- cor_lv^2for (i in names(ave_values)) {
max_sq_corr <- max(squared_cor_lv[i, names(ave_values) != i])
cat(i, ": AVE =", round(ave_values[i], 3),
"| Max shared variance =", round(max_sq_corr, 3),
"|", ifelse(ave_values[i] > max_sq_corr, "Pass", "Fail"), "\n")
}## dist_desc : AVE = 0.775 | Max shared variance = 0.276 | Pass
## dist_prescr : AVE = 0.45 | Max shared variance = 0.748 | Fail
## attr_desc : AVE = 0.642 | Max shared variance = 0.553 | Pass
## attr_prescr : AVE = 0.553 | Max shared variance = 0.748 | FailThe Fornell–Larcker criterion was not met between the two prescriptive subscales, suggesting conceptual overlap. However, these constructs are retained based on theoretical distinctions and distinct item content.
Here are the final subscales:
Distribution descriptive: 1. In my team, a small number of members receive the most respect and admiration. (R) 2. In my team, prestige and influence are concentrated in just a few members. (R) 5. In my team, high status is concentrated around certain members not distributed across all members. (R)
Distribution prescriptive: 7. In my team, everyone who wants status should be able to attain it. 8. In my team, there should be opportunity for all members to be admired and valued. 10. In my team, status or influence should not be limited to just a few individuals.
Attribute descriptive: 3. In my team, many different attributes and skills are seen as worthy of respect and admiration. 4. In my team, people gain status for contributing in a wide variety of ways. 5. In my team, a broad range of strengths are valued when determining who gains respect and prestige.
Attribute prescriptive: 6. In my team, high status should be based on wide variety of attributes. 8. In my team, everyone should have a chance to gain status for the unique skills they bring. 10. In my team, people should recognize a wide range of qualities when determining who deserves status.
Do they all hang together?
scale <- df_numeric %>%
select(dist_1R_Recoded, dist_2R_Recoded, dist_5R_Recoded,
dist_7, dist_8, dist_10,
attribute_3, attribute_4, attribute_5,
attribute_6, attribute_8, attribute_10) %>%
na.omit()
cronbach(scale) # alpha is 0.87## $sample.size
## [1] 379
##
## $number.of.items
## [1] 12
##
## $alpha
## [1] 0.8711699Yeah! I am going to predict our outcomes from both the individual subscales and the full measure.
Predicting OCBI, UPB, and Admiration
# Full scale (12 items)
df_numeric$sdbs <- rowMeans(df_numeric[, c("dist_1R_Recoded", "dist_2R_Recoded", "dist_5R_Recoded", "dist_7", "dist_8", "dist_10", "attribute_3", "attribute_4", "attribute_5", "attribute_6", "attribute_8", "attribute_10")], na.rm = TRUE)Starting with subscales are predictors
# Simple regressions
fit_ocbi_sub <- lm(OCBI_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr, data = df_numeric)
fit_upb_sub <- lm(UPB_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr, data = df_numeric)
fit_admire_sub <- lm(admire_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr, data = df_numeric)summary(fit_ocbi_sub)##
## Call:
## lm(formula = OCBI_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0048 -0.6739 0.0181 0.7332 2.5702
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.63547 0.35282 7.470 5.73e-13 ***
## dist_desc 0.02811 0.03847 0.731 0.465366
## dist_prescr -0.01225 0.06654 -0.184 0.854080
## attr_desc 0.03371 0.06337 0.532 0.595141
## attr_prescr 0.32827 0.08961 3.663 0.000285 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.045 on 374 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.09154, Adjusted R-squared: 0.08183
## F-statistic: 9.422 on 4 and 374 DF, p-value: 2.892e-07summary(fit_upb_sub)##
## Call:
## lm(formula = UPB_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8881 -1.0285 -0.2247 0.6881 4.3515
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.94450 0.45869 8.599 2.23e-16 ***
## dist_desc -0.14550 0.05001 -2.909 0.00384 **
## dist_prescr -0.11188 0.08651 -1.293 0.19675
## attr_desc 0.11149 0.08239 1.353 0.17683
## attr_prescr -0.13348 0.11650 -1.146 0.25262
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.359 on 374 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.04855, Adjusted R-squared: 0.03838
## F-statistic: 4.771 on 4 and 374 DF, p-value: 0.000915summary(fit_admire_sub)##
## Call:
## lm(formula = admire_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8981 -0.5554 0.2430 0.7593 2.9763
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.74348 0.36457 4.782 2.50e-06 ***
## dist_desc -0.02943 0.03975 -0.740 0.4595
## dist_prescr 0.18453 0.06876 2.684 0.0076 **
## attr_desc 0.38864 0.06548 5.935 6.71e-09 ***
## attr_prescr 0.02630 0.09259 0.284 0.7766
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.08 on 374 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2094, Adjusted R-squared: 0.201
## F-statistic: 24.77 on 4 and 374 DF, p-value: < 2.2e-16# Regressions w/ controls
fit_ocbi_sub_control <- lm(OCBI_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
fit_upb_sub_control <- lm(UPB_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
fit_admire_sub_control <- lm(admire_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)summary(fit_ocbi_sub_control)##
## Call:
## lm(formula = OCBI_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg +
## prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5352 -0.6469 0.0006 0.7117 2.6750
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.104522 0.553377 3.803 0.000167 ***
## dist_desc 0.052213 0.040009 1.305 0.192697
## dist_prescr -0.038333 0.067394 -0.569 0.569850
## attr_desc 0.006962 0.064807 0.107 0.914515
## attr_prescr 0.284310 0.090758 3.133 0.001871 **
## szsb_avg 0.015595 0.062405 0.250 0.802803
## nfs_avg 0.063109 0.078995 0.799 0.424868
## sdo_avg -0.054854 0.038250 -1.434 0.152397
## dominance_avg -0.004402 0.059339 -0.074 0.940908
## prestige_avg 0.166907 0.096020 1.738 0.083000 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.03 on 369 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.1303, Adjusted R-squared: 0.1091
## F-statistic: 6.143 on 9 and 369 DF, p-value: 4.515e-08summary(fit_upb_sub_control)##
## Call:
## lm(formula = UPB_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg +
## prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.0685 -0.7781 -0.0442 0.6582 4.1082
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.45049 0.64526 -0.698 0.485525
## dist_desc -0.01197 0.04665 -0.257 0.797666
## dist_prescr -0.02586 0.07858 -0.329 0.742294
## attr_desc 0.03456 0.07557 0.457 0.647745
## attr_prescr 0.02760 0.10583 0.261 0.794405
## szsb_avg 0.26068 0.07277 3.582 0.000386 ***
## nfs_avg -0.11342 0.09211 -1.231 0.218968
## sdo_avg 0.09527 0.04460 2.136 0.033332 *
## dominance_avg 0.49467 0.06919 7.149 4.71e-12 ***
## prestige_avg 0.18726 0.11196 1.672 0.095278 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.201 on 369 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2673, Adjusted R-squared: 0.2494
## F-statistic: 14.96 on 9 and 369 DF, p-value: < 2.2e-16summary(fit_admire_sub_control)##
## Call:
## lm(formula = admire_avg ~ dist_desc + dist_prescr + attr_desc +
## attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg +
## prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5879 -0.4281 0.1571 0.6652 2.2730
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.134741 0.548053 -0.246 0.80593
## dist_desc 0.040672 0.039624 1.026 0.30535
## dist_prescr 0.183510 0.066746 2.749 0.00626 **
## attr_desc 0.332043 0.064184 5.173 3.78e-07 ***
## attr_prescr -0.004836 0.089885 -0.054 0.95712
## szsb_avg 0.094290 0.061804 1.526 0.12796
## nfs_avg 0.165944 0.078235 2.121 0.03458 *
## sdo_avg -0.018605 0.037882 -0.491 0.62362
## dominance_avg 0.061303 0.058768 1.043 0.29757
## prestige_avg 0.188548 0.095096 1.983 0.04814 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.02 on 369 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.3047, Adjusted R-squared: 0.2878
## F-statistic: 17.97 on 9 and 369 DF, p-value: < 2.2e-16The shared variance is high across subscales. When predictors are highly correlated their unique contribution becomes hard to detect, standard errors inflate, coefficients can shrink or even flip direction. This leads to apparent “wipe out” of effects in the full model. So, probably best to use the full scale together?
Now using full scale
# Simple regressions
fit_ocbi <- lm(OCBI_avg ~ sdbs, data = df_numeric)
fit_upb <- lm(UPB_avg ~ sdbs, data = df_numeric)
fit_admire <- lm(admire_avg ~ sdbs, data = df_numeric)summary(fit_ocbi)##
## Call:
## lm(formula = OCBI_avg ~ sdbs, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9664 -0.6889 0.0100 0.7746 2.6301
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.12500 0.31702 9.857 < 2e-16 ***
## sdbs 0.31123 0.06072 5.126 4.73e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.06 on 378 degrees of freedom
## Multiple R-squared: 0.065, Adjusted R-squared: 0.06252
## F-statistic: 26.28 on 1 and 378 DF, p-value: 4.733e-07summary(fit_upb)##
## Call:
## lm(formula = UPB_avg ~ sdbs, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6170 -1.0641 -0.3230 0.7354 4.1770
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.0406 0.4078 9.908 < 2e-16 ***
## sdbs -0.2823 0.0781 -3.615 0.000341 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.364 on 378 degrees of freedom
## Multiple R-squared: 0.03342, Adjusted R-squared: 0.03086
## F-statistic: 13.07 on 1 and 378 DF, p-value: 0.0003409summary(fit_admire)##
## Call:
## lm(formula = admire_avg ~ sdbs, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.1923 -0.5369 0.2334 0.7690 2.7520
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.10324 0.33317 6.313 7.68e-10 ***
## sdbs 0.53618 0.06381 8.403 8.92e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.114 on 378 degrees of freedom
## Multiple R-squared: 0.1574, Adjusted R-squared: 0.1552
## F-statistic: 70.61 on 1 and 378 DF, p-value: 8.924e-16# Regressions w/ controls
fit_ocbi_control <- lm(OCBI_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
fit_upb_control <- lm(UPB_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
fit_admire_control <- lm(admire_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)summary(fit_ocbi_control)##
## Call:
## lm(formula = OCBI_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg +
## dominance_avg + prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4054 -0.6950 -0.0179 0.7227 2.7804
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.34079 0.53952 4.339 1.85e-05 ***
## sdbs 0.25260 0.06944 3.638 0.000314 ***
## szsb_avg 0.01890 0.06252 0.302 0.762588
## nfs_avg 0.07627 0.07858 0.971 0.332382
## sdo_avg -0.05253 0.03775 -1.392 0.164883
## dominance_avg -0.02392 0.05841 -0.410 0.682390
## prestige_avg 0.18819 0.09628 1.955 0.051372 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.037 on 373 degrees of freedom
## Multiple R-squared: 0.1162, Adjusted R-squared: 0.102
## F-statistic: 8.176 on 6 and 373 DF, p-value: 2.545e-08summary(fit_upb_control)##
## Call:
## lm(formula = UPB_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg +
## dominance_avg + prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.0655 -0.7693 -0.0682 0.6744 4.0227
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.40663 0.62278 -0.653 0.514209
## sdbs 0.02073 0.08015 0.259 0.796111
## szsb_avg 0.26319 0.07217 3.647 0.000303 ***
## nfs_avg -0.10217 0.09070 -1.126 0.260723
## sdo_avg 0.09505 0.04357 2.182 0.029767 *
## dominance_avg 0.49708 0.06742 7.373 1.09e-12 ***
## prestige_avg 0.17452 0.11114 1.570 0.117187
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.198 on 373 degrees of freedom
## Multiple R-squared: 0.2643, Adjusted R-squared: 0.2525
## F-statistic: 22.33 on 6 and 373 DF, p-value: < 2.2e-16summary(fit_admire_control)##
## Call:
## lm(formula = admire_avg ~ sdbs + szsb_avg + nfs_avg + sdo_avg +
## dominance_avg + prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5642 -0.4388 0.1695 0.6789 2.2547
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.20207 0.53755 -0.376 0.7072
## sdbs 0.54936 0.06918 7.941 2.39e-14 ***
## szsb_avg 0.07690 0.06229 1.234 0.2178
## nfs_avg 0.18683 0.07829 2.386 0.0175 *
## sdo_avg -0.01894 0.03761 -0.504 0.6149
## dominance_avg 0.09892 0.05819 1.700 0.0900 .
## prestige_avg 0.19022 0.09593 1.983 0.0481 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.034 on 373 degrees of freedom
## Multiple R-squared: 0.2841, Adjusted R-squared: 0.2726
## F-statistic: 24.67 on 6 and 373 DF, p-value: < 2.2e-16