library(corrr)
library(corrplot)
## corrplot 0.92 loaded
library(psych)
library(psy)
##
## Attaching package: 'psy'
## The following object is masked from 'package:psych':
##
## wkappa
library(GPArotation)
##
## Attaching package: 'GPArotation'
## The following objects are masked from 'package:psych':
##
## equamax, varimin
library(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':
##
## cor2cov
library(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 errors
data <- read.csv("~/Google drive/My Drive/YEAR 2/PROJECTS/DEREK/Status Distribution/Studies/Study 1: Scale/Final Study 1/raw_study1_data_8.4.25.csv")
data <- data %>%
slice(-c(1:3)) %>%
filter(attn_bots != "14285733") %>%
filter(attn == 24) %>%
unite(geolocation, LocationLatitude, LocationLongitude) %>%
group_by(geolocation) %>%
mutate(geo_frequency = n()) %>%
filter(geo_frequency < 3) %>%
ungroup()
df_numeric <- data %>%
select(c(ResponseId, dist_1R:attr_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, IRI_1:IRI_7, fv_inclusivity)) %>%
mutate(across(-ResponseId, as.numeric))
df_numeric <- df_numeric %>%
mutate(across(ends_with("R"), ~ 8 - ., .names = "{.col}_Recoded"))
df_numeric <- df_numeric %>%
mutate(
status_expansion_belief = rowMeans(select(.,
dist_1R_Recoded,
dist_2R_Recoded,
dist_5R_Recoded,
dist_7,
dist_8,
dist_10,
attr_3,
attr_4,
attr_5,
attr_6,
attr_8,
attr_10),
na.rm = TRUE)
)
df_numeric <- df_numeric %>%
mutate(
dist_avg = rowMeans(select(.,
dist_1R_Recoded,
dist_2R_Recoded,
dist_5R_Recoded,
dist_7,
dist_8,
dist_10),
na.rm = TRUE)
)
df_numeric <- df_numeric %>%
mutate(
attribute_avg = rowMeans(select(.,
attr_3,
attr_4,
attr_5,
attr_6,
attr_8,
attr_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)
)
df_numeric <- df_numeric %>%
mutate(
perspective_avg = rowMeans(select(.,
IRI_1,
IRI_2R_Recoded,
IRI_3,
IRI_4,
IRI_5R_Recoded,
IRI_6,
IRI_7
), na.rm = TRUE)
)
items <- df_numeric %>%
select(dist_1R_Recoded,
dist_2R_Recoded,
dist_5R_Recoded,
dist_7,
dist_8,
dist_10,
attr_3,
attr_4,
attr_5,
attr_6,
attr_8,
attr_10) %>%
na.omit()
cronbach(items) # alpha = 0.8264
## $sample.size
## [1] 390
##
## $number.of.items
## [1] 12
##
## $alpha
## [1] 0.8264258
x <- cor(items)
corrplot(x,method="number")
bartlett.test(items)
##
## Bartlett test of homogeneity of variances
##
## data: items
## Bartlett's K-squared = 506.42, df = 11, p-value < 2.2e-16
KMO(x) # >.5 minimum, >.9 is great
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = x)
## Overall MSA = 0.82
## MSA for each item =
## dist_1R_Recoded dist_2R_Recoded dist_5R_Recoded dist_7 dist_8
## 0.85 0.79 0.75 0.87 0.85
## dist_10 attr_3 attr_4 attr_5 attr_6
## 0.87 0.80 0.89 0.82 0.81
## attr_8 attr_10
## 0.87 0.79
model_quad <- '
dist_desc =~ dist_1R_Recoded + dist_2R_Recoded + dist_5R_Recoded
dist_prescr =~ dist_7 + dist_8 + dist_10
attr_desc =~ attr_3 + attr_4 + attr_5
attr_prescr =~ attr_6 + attr_8 + attr_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 49 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 30
##
## Number of observations 390
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 142.000 94.306
## Degrees of freedom 48 48
## P-value (Chi-square) 0.000 0.000
## Scaling correction factor 1.506
## Satorra-Bentler correction
##
## Model Test Baseline Model:
##
## Test statistic 2126.037 1174.719
## Degrees of freedom 66 66
## P-value 0.000 0.000
## Scaling correction factor 1.810
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.954 0.958
## Tucker-Lewis Index (TLI) 0.937 0.943
##
## Robust Comparative Fit Index (CFI) 0.965
## Robust Tucker-Lewis Index (TLI) 0.952
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -6676.754 -6676.754
## Loglikelihood unrestricted model (H1) -6605.754 -6605.754
##
## Akaike (AIC) 13413.508 13413.508
## Bayesian (BIC) 13532.492 13532.492
## Sample-size adjusted Bayesian (SABIC) 13437.304 13437.304
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.071 0.050
## 90 Percent confidence interval - lower 0.058 0.038
## 90 Percent confidence interval - upper 0.084 0.062
## P-value H_0: RMSEA <= 0.050 0.006 0.497
## P-value H_0: RMSEA >= 0.080 0.139 0.000
##
## Robust RMSEA 0.061
## 90 Percent confidence interval - lower 0.043
## 90 Percent confidence interval - upper 0.079
## P-value H_0: Robust RMSEA <= 0.050 0.152
## P-value H_0: Robust RMSEA >= 0.080 0.042
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.048 0.048
##
## 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.432 0.803
## dist_2R_Recodd 1.094 0.057 19.211 0.000 1.566 0.885
## dist_5R_Recodd 1.109 0.063 17.593 0.000 1.589 0.904
## dist_prescr =~
## dist_7 1.000 0.661 0.513
## dist_8 1.074 0.134 8.019 0.000 0.710 0.706
## dist_10 1.052 0.145 7.271 0.000 0.696 0.556
## attr_desc =~
## attr_3 1.000 0.948 0.793
## attr_4 0.905 0.071 12.758 0.000 0.858 0.692
## attr_5 1.001 0.072 13.935 0.000 0.949 0.817
## attr_prescr =~
## attr_6 1.000 0.753 0.759
## attr_8 0.978 0.072 13.573 0.000 0.737 0.757
## attr_10 1.003 0.075 13.348 0.000 0.755 0.807
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## dist_desc ~~
## dist_prescr 0.290 0.078 3.708 0.000 0.307 0.307
## attr_desc 0.579 0.100 5.798 0.000 0.427 0.427
## attr_prescr 0.108 0.073 1.487 0.137 0.100 0.100
## dist_prescr ~~
## attr_desc 0.314 0.066 4.777 0.000 0.501 0.501
## attr_prescr 0.382 0.067 5.662 0.000 0.767 0.767
## attr_desc ~~
## attr_prescr 0.392 0.083 4.745 0.000 0.549 0.549
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .dist_1R_Recodd 1.128 0.187 6.026 0.000 1.128 0.355
## .dist_2R_Recodd 0.680 0.122 5.593 0.000 0.680 0.217
## .dist_5R_Recodd 0.567 0.131 4.315 0.000 0.567 0.183
## .dist_7 1.222 0.141 8.668 0.000 1.222 0.737
## .dist_8 0.507 0.085 5.971 0.000 0.507 0.501
## .dist_10 1.079 0.163 6.638 0.000 1.079 0.690
## .attr_3 0.529 0.125 4.212 0.000 0.529 0.370
## .attr_4 0.802 0.124 6.453 0.000 0.802 0.521
## .attr_5 0.448 0.093 4.813 0.000 0.448 0.332
## .attr_6 0.417 0.068 6.185 0.000 0.417 0.424
## .attr_8 0.404 0.059 6.906 0.000 0.404 0.427
## .attr_10 0.304 0.053 5.723 0.000 0.304 0.348
## dist_desc 2.052 0.210 9.790 0.000 1.000 1.000
## dist_prescr 0.437 0.091 4.821 0.000 1.000 1.000
## attr_desc 0.899 0.139 6.450 0.000 1.000 1.000
## attr_prescr 0.567 0.119 4.786 0.000 1.000 1.000
Confirmatory factor analysis of the four-factor model (distribution × attribute × descriptive × prescriptive) indicated good fit: robust CFI = 0.958, TLI = 0.943, SRMR = 0.048, and RMSEA = 0.050 (90% CI = [.038, .062]). All items loaded significantly onto their respective factors, with standardized loadings ranging from .51 to .90. Inter-factor correlations ranged from r = .10 to r = .77, 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.958 (> .95 = good) 2. Robust TLI = 0.943 (> .95 = ideal) 3. SRMR = 0.048 (< .08 = acceptable) 4. Robust RMSEA = 0.050 (< .06 = good) 5. Chi-square (SB) χ²(48) = 94.31, p < .001 (χ² often significant with large N; not alone a red flag)
# 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("attr_3", "attr_4", "attr_5")], na.rm = TRUE)
# Attribute × Prescriptive (3 items)
df_numeric$attr_prescr <- rowMeans(df_numeric[, c("attr_6", "attr_8", "attr_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(attr_3,
attr_4,
attr_5) %>%
na.omit()
attr_prescr <- df_numeric %>%
select(attr_6,
attr_8,
attr_10) %>%
na.omit()
cronbach(dist_desc) # alpha = 0.89
## $sample.size
## [1] 390
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8972146
cronbach(dist_prescr) # alpha = 0.61
## $sample.size
## [1] 390
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.6120017
cronbach(attr_desc) # alpha = 0.81
## $sample.size
## [1] 390
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8061591
cronbach(attr_prescr) # alpha = 0.81
## $sample.size
## [1] 390
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8147245
cor_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.26 0.37 0.09 -0.15 -0.11
## dist_prescr 0.26 1.00 0.34 0.53 -0.37 0.04
## attr_desc 0.37 0.34 1.00 0.47 -0.16 0.14
## attr_prescr 0.09 0.53 0.47 1.00 -0.24 0.19
## sdo_avg -0.15 -0.37 -0.16 -0.24 1.00 0.08
## nfs_avg -0.11 0.04 0.14 0.19 0.08 1.00
## szsb_avg -0.29 -0.21 -0.22 -0.16 0.16 0.05
## dominance_avg -0.28 -0.18 0.01 -0.05 0.40 0.39
## prestige_avg -0.05 0.05 0.16 0.20 0.03 0.77
## szsb_avg dominance_avg prestige_avg
## dist_desc -0.29 -0.28 -0.05
## dist_prescr -0.21 -0.18 0.05
## attr_desc -0.22 0.01 0.16
## attr_prescr -0.16 -0.05 0.20
## sdo_avg 0.16 0.40 0.03
## nfs_avg 0.05 0.39 0.77
## szsb_avg 1.00 0.27 -0.01
## dominance_avg 0.27 1.00 0.30
## prestige_avg -0.01 0.30 1.00
These patterns suggest that the new subscales are measuring something related but novel compared to established constructs like Social Dominance Orientation (SDO), status zero-sum beliefs, need for status, dominance orientation, and prestige orientation (|r| ≤ .40). The strongest associations were observed between prescriptive distribution beliefs and SDO (r = –.37), and between descriptive distribution beliefs and status zero-sum beliefs (r = –.29). Other correlations were small to moderate, supporting the discriminant validity of the new subscales.
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, skew
AVE(fit_quad)
## dist_desc dist_prescr attr_desc attr_prescr
## 0.747 0.337 0.588 0.599
lavInspect(fit_quad, "cor.lv") # get latent variable correlations
## dst_ds dst_pr attr_d attr_p
## dist_desc 1.000
## dist_prescr 0.307 1.000
## attr_desc 0.427 0.501 1.000
## attr_prescr 0.100 0.767 0.549 1.000
ave_values <- AVE(fit_quad)
cor_lv <- lavInspect(fit_quad, "cor.lv")
squared_cor_lv <- cor_lv^2
for (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.747 | Max shared variance = 0.182 | Pass
## dist_prescr : AVE = 0.337 | Max shared variance = 0.588 | Fail
## attr_desc : AVE = 0.588 | Max shared variance = 0.301 | Pass
## attr_prescr : AVE = 0.599 | Max shared variance = 0.588 | Pass
Three out of four factors pass the Fornell-Larcker test, indicating that they are more distinct than overlapping with other constructs. dist_prescr fails. This means: 1. It explains less variance in its own items (AVE = .337) than it shares with another factor (MSV = .588). 2. This likely reflects high overlap with attr_prescr (based on CFA and correlation results). 3. This is consistent with what we saw earlier in the modest alpha and the moderate inter-factor correlation (r = .53).
Even though the Fornell–Larcker criterion was not met for one subscale, suggesting conceptual overlap, this construct is retained based on theoretical distinctions and distinct item content.
Maybe as we go forward, we can update some of the wording for prescriptive distribution beliefs since the alpha is relatively low and it does not pass the Fornell-Larcker test.
fit_ocbi <- lm(OCBI_avg ~ status_expansion_belief + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
summary(fit_ocbi)
##
## Call:
## lm(formula = OCBI_avg ~ status_expansion_belief + szsb_avg +
## nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.69850 -0.73869 0.07913 0.74530 2.73322
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.97246 0.56962 3.463 0.000595 ***
## status_expansion_belief 0.32438 0.07856 4.129 4.47e-05 ***
## szsb_avg 0.11915 0.06231 1.912 0.056591 .
## nfs_avg 0.14351 0.08396 1.709 0.088210 .
## sdo_avg -0.02417 0.04167 -0.580 0.562161
## dominance_avg -0.17365 0.05983 -2.902 0.003917 **
## prestige_avg 0.11112 0.09021 1.232 0.218785
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.078 on 383 degrees of freedom
## Multiple R-squared: 0.1139, Adjusted R-squared: 0.1
## F-statistic: 8.207 on 6 and 383 DF, p-value: 2.286e-08
Supports preregistered hypothesis: Status expansion beliefs (i.e., beliefs that status is and should be widely accessible and based on diverse attributes) predict greater organizational citizenship behaviors.
fit_upb <- lm(UPB_avg ~ status_expansion_belief + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
summary(fit_upb)
##
## Call:
## lm(formula = UPB_avg ~ status_expansion_belief + szsb_avg + nfs_avg +
## sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9895 -0.8731 -0.2383 0.6620 5.2029
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.086275 0.664585 3.139 0.00183 **
## status_expansion_belief -0.203702 0.091659 -2.222 0.02684 *
## szsb_avg -0.003168 0.072699 -0.044 0.96526
## nfs_avg -0.084409 0.097958 -0.862 0.38940
## sdo_avg 0.119178 0.048614 2.452 0.01467 *
## dominance_avg 0.303408 0.069803 4.347 1.77e-05 ***
## prestige_avg 0.159727 0.105254 1.518 0.12996
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.258 on 383 degrees of freedom
## Multiple R-squared: 0.147, Adjusted R-squared: 0.1336
## F-statistic: 11 on 6 and 383 DF, p-value: 2.581e-11
Status expansion beliefs (i.e., beliefs that status is and should be widely accessible and based on diverse attributes) predict lower unethical pro-organization behaviors.
fit_ocbi_subscale <- lm(OCBI_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_subscale)
##
## 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
## -2.78928 -0.74392 0.05587 0.75305 2.76820
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.517878 0.607329 2.499 0.01287 *
## dist_desc 0.025093 0.039755 0.631 0.52830
## dist_prescr 0.094724 0.077707 1.219 0.22360
## attr_desc 0.075281 0.066666 1.129 0.25952
## attr_prescr 0.211230 0.086334 2.447 0.01487 *
## szsb_avg 0.111854 0.062162 1.799 0.07275 .
## nfs_avg 0.121885 0.084149 1.448 0.14831
## sdo_avg -0.007114 0.042861 -0.166 0.86827
## dominance_avg -0.187889 0.061022 -3.079 0.00223 **
## prestige_avg 0.106985 0.090140 1.187 0.23602
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.074 on 380 degrees of freedom
## Multiple R-squared: 0.1273, Adjusted R-squared: 0.1066
## F-statistic: 6.159 on 9 and 380 DF, p-value: 4.121e-08
We replicate what we observed in the first iteration of this study: attr_prescr is the only subscale that predicts OCBIs
fit_upb_subscale <- lm(UPB_avg ~ dist_desc + dist_prescr + attr_desc + attr_prescr + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg, data = df_numeric)
summary(fit_upb_subscale)
##
## 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
## -2.9828 -0.8604 -0.2215 0.6643 5.1806
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.2590720 0.7127535 3.169 0.00165 **
## dist_desc -0.0472363 0.0466555 -1.012 0.31197
## dist_prescr -0.0208366 0.0911955 -0.228 0.81939
## attr_desc -0.0089095 0.0782387 -0.114 0.90940
## attr_prescr -0.1606451 0.1013206 -1.586 0.11368
## szsb_avg 0.0003157 0.0729524 0.004 0.99655
## nfs_avg -0.0762075 0.0987558 -0.772 0.44079
## sdo_avg 0.1158918 0.0503010 2.304 0.02176 *
## dominance_avg 0.3014781 0.0716150 4.210 3.2e-05 ***
## prestige_avg 0.1644008 0.1057868 1.554 0.12100
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.26 on 380 degrees of freedom
## Multiple R-squared: 0.1499, Adjusted R-squared: 0.1298
## F-statistic: 7.446 on 9 and 380 DF, p-value: 4.867e-10
Also replicate that none of the individual subscales predict UPBs.
demo <- data %>%
select(ResponseId, race, gender, ses, overall_poli) %>%
mutate(race = ifelse(grepl(",", race), "8", race),
race = as.factor(race),
gender = as.factor(gender),
ses = as.factor(ses),
overall_poli = as.numeric(overall_poli))
df_numeric_demo <- df_numeric %>%
left_join(demo, by = "ResponseId")
fit_ocbi_demo <- lm(OCBI_avg ~ status_expansion_belief + szsb_avg + nfs_avg + sdo_avg + dominance_avg + prestige_avg + Extraversion + Agreeable + Conscientious + Stable + Open + race + gender + ses + overall_poli, data = df_numeric_demo)
summary(fit_ocbi_demo)
##
## Call:
## lm(formula = OCBI_avg ~ status_expansion_belief + szsb_avg +
## nfs_avg + sdo_avg + dominance_avg + prestige_avg + Extraversion +
## Agreeable + Conscientious + Stable + Open + race + gender +
## ses + overall_poli, data = df_numeric_demo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.12089 -0.72763 0.03792 0.66842 2.88883
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.83860 1.07783 -1.706 0.088897 .
## status_expansion_belief 0.26416 0.07947 3.324 0.000978 ***
## szsb_avg 0.15130 0.06201 2.440 0.015175 *
## nfs_avg 0.06800 0.08383 0.811 0.417776
## sdo_avg -0.01666 0.05303 -0.314 0.753627
## dominance_avg -0.10695 0.06339 -1.687 0.092452 .
## prestige_avg 0.06923 0.09149 0.757 0.449725
## Extraversion 0.11669 0.03243 3.598 0.000365 ***
## Agreeable 0.18256 0.05472 3.336 0.000938 ***
## Conscientious 0.06179 0.05486 1.126 0.260830
## Stable -0.01207 0.04460 -0.271 0.786844
## Open 0.05694 0.04652 1.224 0.221753
## race2 -0.16369 0.20036 -0.817 0.414486
## race3 -0.46728 0.22013 -2.123 0.034455 *
## race4 -0.41798 0.42889 -0.975 0.330428
## race5 -0.19139 0.25530 -0.750 0.453943
## race6 0.10264 1.05026 0.098 0.922200
## race7 0.70228 0.75475 0.930 0.352742
## race8 0.07298 0.22893 0.319 0.750085
## gender2 0.07151 0.11668 0.613 0.540338
## gender3 -0.95197 0.53515 -1.779 0.076102 .
## gender4 0.86688 1.04395 0.830 0.406866
## ses2 2.61742 0.76106 3.439 0.000652 ***
## ses3 2.51851 0.75319 3.344 0.000913 ***
## ses4 2.48205 0.76434 3.247 0.001274 **
## ses5 2.40323 0.77337 3.107 0.002036 **
## ses6 2.65776 0.83074 3.199 0.001500 **
## overall_poli -0.03005 0.04134 -0.727 0.467716
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.023 on 361 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.248, Adjusted R-squared: 0.1918
## F-statistic: 4.41 on 27 and 361 DF, p-value: 2.27e-11
Controlling for demographic information, status expansion beliefs still predict organizational citizenship behaviors. Reference groups are: race = white ses = upper class gender = man
# Define the SEM model with specified coefficients
library(lavaan)
library(parallel)
model <- '
# Regression coefficients
admire_avg ~ a*status_expansion_belief
OCBI_avg ~ cprime*status_expansion_belief + b*admire_avg
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = df_numeric)
# Summarize results
summary(fit)
## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 390
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## admire_avg ~
## stts_x_ (a) 0.431 0.076 5.684 0.000
## OCBI_avg ~
## stts_x_ (cprm) 0.194 0.068 2.840 0.005
## admr_vg (b) 0.398 0.044 9.081 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .admire_avg 1.334 0.096 13.964 0.000
## .OCBI_avg 0.998 0.071 13.964 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 0.171 0.036 4.818 0.000
library(lavaanPlot)
lavaanPlot(model = fit,
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))
Admiration proneness partially mediates the relationship between status_expansion_belief and OCBI_avg. Both the indirect and direct effects are meaningful: 1. People who believe status can expand tend to admire others more → leading to more OCBI. 2. But there’s also a direct path, suggesting additional mechanisms beyond admiration may connect belief in status expansion and prosocial behavior.
model <- '
# Regression coefficients
perspective_avg ~ a*status_expansion_belief
OCBI_avg ~ cprime*status_expansion_belief + b*perspective_avg
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = df_numeric)
# Summarize results
summary(fit)
## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 390
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## perspective_avg ~
## stts_x_ (a) 0.281 0.064 4.398 0.000
## OCBI_avg ~
## stts_x_ (cprm) 0.278 0.071 3.911 0.000
## prspct_ (b) 0.310 0.055 5.632 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .perspective_vg 0.946 0.068 13.964 0.000
## .OCBI_avg 1.118 0.080 13.964 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 0.087 0.025 3.466 0.001
lavaanPlot(model = fit,
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))
Perspective taking partially mediates the relationship between status_expansion_belief and OCBI_avg. Both the indirect and direct effects are meaningful: 1. People who believe status can expand tend to take others’ perspectives more → leading to more OCBI. 2. But there’s also a direct path, suggesting additional mechanisms beyond PT may connect belief in status expansion and prosocial behavior.
model <- '
# Regression coefficients
fv_inclusivity ~ a*status_expansion_belief
OCBI_avg ~ cprime*status_expansion_belief + b*fv_inclusivity
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = df_numeric)
# Summarize results
summary(fit)
## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 390
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## fv_inclusivity ~
## stts_x_ (a) 0.458 0.053 8.552 0.000
## OCBI_avg ~
## stts_x_ (cprm) 0.076 0.069 1.092 0.275
## fv_ncls (b) 0.633 0.060 10.479 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .fv_inclusivity 0.664 0.048 13.964 0.000
## .OCBI_avg 0.943 0.068 13.964 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 0.289 0.044 6.626 0.000
lavaanPlot(model = fit,
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))
A mediation analysis tested whether self-perceived inclusive behavior explained the link between status expansion beliefs and organizational citizenship behavior toward individuals (OCBI). Participants who endorsed the belief that status is expandable were more likely to report acting inclusively on their teams (β = 0.46, p < .001). In turn, inclusivity predicted greater OCBI (β = 0.63, p < .001). The direct effect of status expansion beliefs on OCBI was nonsignificant (β = 0.08), indicating full mediation. These results suggest that individuals who see status as expansive may act more inclusively, which fosters prosocial behavior toward teammates.
This suggests we should run with inclusivity going forward I think.