Purpose

We are pivoting from the full 12-item SEB scale (descriptive + prescriptive) to prescriptive SEBs only (6 items). This document re-runs the key analyses from Study 1 (OCBI, UPB), Study 2 (status affordance), and the Study 3 manipulation pilot using only the prescriptive items, and puts the results side by side.

One question is whether prescriptive SEB has predictive power above and beyond status zero-sum beliefs (SZSB). Every model below is therefore fit in several specifications (bivariate → + SZSB → + all preregistered controls), and incremental tests are reported.

Prescriptive items used

Study Distribution-prescriptive Attribute-prescriptive
Study 1 dist_7, dist_8, dist_10 (original wording) attr_6, attr_8, attr_10
Study 2, Study 3 pilot dist_14, dist_15, dist_16 (revised wording) attr_6, attr_8, attr_10

Heads up: Study 1 used the original distribution-prescriptive wording (alpha = .61 in your Study 1 notes). Studies 2 and 3 used the revised items that match the six statements in the email to Adam. So the Study 1 composite is not item-identical to the Study 2/3 composite. The alpha table below shows whether this matters.

Packages and setup

library(tidyverse)
library(qualtRics)  # read_survey()
library(lme4)
library(lmerTest)   # p-values for lmer; load AFTER lme4
library(psych)
library(car)        # VIF
library(lavaan)
library(knitr)
library(kableExtra)

set.seed(2025)


f_study1 <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/DEREK/Status Distribution/Studies/Study 1: Scale/Final Study 1/raw_study1_data_8.4.25.csv")
f_study2 <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/DEREK/Status Distribution/Studies/Study 2: Status Affordance/raw_study2_fulldata_10.8.25.csv")
f_pilot  <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/DEREK/Status Distribution/Studies/Study 3: SEB Manipulation/pilot_raw_data_11.11.25.csv")

controls <- c("szsb", "nfs", "sdo", "dom", "prest")

Helper functions

# Qualtrics exports have 2 header rows (question text, ImportId) under the names.
# `drop_extra` removes additional rows, e.g., a researcher test response.
read_qualtrics <- function(path, drop_extra = 0) {
  raw <- read.csv(path, na.strings = c("", "NA"), stringsAsFactors = FALSE)
  raw[-seq_len(2 + drop_extra), ]
}

# Same exclusion rules as the preregistrations:
# bot screener, attention check, geolocation appearing 3+ times
apply_exclusions <- function(d) {
  d %>%
    rename_with(make.names) %>%   # "need for status_1" -> "need.for.status_1"
    filter(attn_bots != "14285733",
           suppressWarnings(as.numeric(attn)) == 24) %>%
    mutate(geolocation = paste(LocationLatitude, LocationLongitude, sep = "_")) %>%
    group_by(geolocation) %>%
    mutate(geo_frequency = n()) %>%
    ungroup() %>%
    filter(geo_frequency < 3)
}

# Row mean of items; any item name ending in "R" is reverse-coded (8 - x)
scale_mean <- function(d, items) {
  m <- as.data.frame(lapply(d[, items], as.numeric))
  rev_idx <- endsWith(items, "R")
  m[rev_idx] <- 8 - m[rev_idx]
  rowMeans(m, na.rm = TRUE)
}

# Item lists (names as they appear after read.csv, i.e., spaces become dots)
items_szsb  <- paste0("SZSB_", c(1:4, "5R", "6R", "7R", "8R"))
items_nfs   <- paste0("need.for.status_", c("1", "2R", "3", "4", "5", "6", "7R", "8"))
items_sdo   <- paste0("sdo_", c("1", "2", "3R", "4R", "5", "6", "7R", "8R"))
items_dom   <- paste0("dom_", c("1", "2", "3", "4", "5R", "6", "7R", "8"))
items_prest <- paste0("prest_", c("1", "2R", "3", "4R", "5", "6", "7", "8", "9R"))
items_ocbi  <- paste0("OCBI_", 1:8)
items_upb   <- paste0("UPBs_", 1:6)

items_presc_s1  <- c("dist_7", "dist_8", "dist_10", "attr_6", "attr_8", "attr_10")
items_presc_s23 <- c("dist_14", "dist_15", "dist_16", "attr_6", "attr_8", "attr_10")

# Prescriptive SEB + the preregistered control scales
score_common <- function(d, presc_items) {
  d %>%
    rename_with(make.names) %>%
    mutate(
      presc       = scale_mean(., presc_items),
      presc_dist  = scale_mean(., presc_items[1:3]),
      presc_attr  = scale_mean(., presc_items[4:6]),
      szsb        = scale_mean(., items_szsb),
      nfs         = scale_mean(., items_nfs),
      sdo         = scale_mean(., items_sdo),
      dom         = scale_mean(., items_dom),
      prest       = scale_mean(., items_prest)
    )
}

# Fit the same set of specifications for any DV (lm or random-intercept lmer)
fit_specs <- function(data, dv, mixed = FALSE) {
  rhs <- list(
    bivariate     = "presc",
    szsb_only     = "szsb",
    plus_szsb     = "presc + szsb",
    controls_only = "szsb + nfs + sdo + dom + prest",
    full          = "presc + szsb + nfs + sdo + dom + prest"
  )
  map(rhs, function(r) {
    fml <- as.formula(paste(dv, "~", r, if (mixed) "+ (1 | ResponseId)" else ""))
    if (mixed) lmer(fml, data = data) else lm(fml, data = data)
  })
}

# z-score DV and predictors so coefficients are comparable across studies
zscore <- function(data, vars) {
  data %>% mutate(across(all_of(vars), ~ as.numeric(scale(.x))))
}

# Pull one coefficient (works for lm and lmerTest::lmer)
get_coef <- function(model, term = "presc") {
  cf <- summary(model)$coefficients
  tibble(b = cf[term, "Estimate"],
         se = cf[term, "Std. Error"],
         p = cf[term, ncol(cf)])
}

# Incremental value of prescriptive SEB over (a) SZSB alone, (b) all controls
incremental <- function(mods, mixed = FALSE) {
  a <- anova(mods$szsb_only, mods$plus_szsb)
  b <- anova(mods$controls_only, mods$full)
  if (!mixed) {
    tibble(
      comparison = c("SZSB  ->  SZSB + prescriptive SEB",
                     "All controls  ->  + prescriptive SEB"),
      delta_R2 = c(summary(mods$plus_szsb)$r.squared - summary(mods$szsb_only)$r.squared,
                   summary(mods$full)$r.squared - summary(mods$controls_only)$r.squared),
      test_stat = c(a$F[2], b$F[2]),
      p = c(a$`Pr(>F)`[2], b$`Pr(>F)`[2]),
      test = "F"
    )
  } else {
    tibble(
      comparison = c("SZSB  ->  SZSB + prescriptive SEB",
                     "All controls  ->  + prescriptive SEB"),
      delta_R2 = NA_real_,
      test_stat = c(a$Chisq[2], b$Chisq[2]),
      p = c(a$`Pr(>Chisq)`[2], b$`Pr(>Chisq)`[2]),
      test = "LRT chi-sq"
    )
  }
}

fmt_p <- function(p) ifelse(p < .001, "<.001", sub("^0", "", sprintf("%.3f", p)))

Load, exclude, and score

# ---- Study 1 -----------------------------------------------------------------
# Drop first row (test)
s1 <- f_study1 %>%
  slice(-1) %>%
  apply_exclusions() %>%
  score_common(items_presc_s1) %>%
  mutate(ocbi = scale_mean(., items_ocbi),
         upb  = scale_mean(., items_upb),
         inclusivity = as.numeric(fv_inclusivity))

# ---- Study 2 -----------------------------------------------------------------
s2 <- f_study2 %>%
  apply_exclusions() %>%
  filter(ResponseId != "R_3YbMmG50lMF2JPv") %>%   # flagged as bot-like in Study 2 notes
  score_common(items_presc_s23) %>%
  mutate(across(matches("^affordance[123]_[123]$"), as.numeric))

# Must nominate 3 subordinates (preregistered)
s2 <- s2 %>% filter(!is.na(selected1), !is.na(selected2), !is.na(selected3))

# ---- Study 3 pilot (SEB manipulation check) ------------------------------------
p <- f_pilot %>%
  apply_exclusions() %>%
  score_common(items_presc_s23) %>%
  mutate(ocbi = scale_mean(., items_ocbi),
         condition = factor(ifelse(FL_31_DO == "manipulation-lowSEB", "low", "high"),
                            levels = c("low", "high")),   # effect = high - low
         cond_high = as.numeric(condition == "high"))

tibble(
  Study = c("Study 1", "Study 2 (rated 3 subordinates)", "Study 3 pilot"),
  `N raw responses` = c(nrow(f_study1), nrow(f_study2), nrow(f_pilot)),
  `N analyzed`      = c(nrow(s1), nrow(s2), nrow(p))
) %>% kable() %>% kable_styling(full_width = FALSE)
Study N raw responses N analyzed
Study 1 414 390
Study 2 (rated 3 subordinates) 227 157
Study 3 pilot 105 99

Scale reliability and descriptives (prescriptive SEB)

alpha_of <- function(d, items) round(psych::alpha(d[, items] %>% mutate(across(everything(), as.numeric)))$total$raw_alpha, 2)

tibble(
  Study = c("Study 1", "Study 2", "Study 3 pilot"),
  `Alpha, 6-item prescriptive` = c(alpha_of(s1, items_presc_s1),
                                   alpha_of(s2, items_presc_s23),
                                   alpha_of(p,  items_presc_s23)),
  `Alpha, distribution (3)` = c(alpha_of(s1, items_presc_s1[1:3]),
                                alpha_of(s2, items_presc_s23[1:3]),
                                alpha_of(p,  items_presc_s23[1:3])),
  `Alpha, attribute (3)` = c(alpha_of(s1, items_presc_s1[4:6]),
                             alpha_of(s2, items_presc_s23[4:6]),
                             alpha_of(p,  items_presc_s23[4:6])),
  M  = c(mean(s1$presc), mean(s2$presc), mean(p$presc)),
  SD = c(sd(s1$presc),   sd(s2$presc),   sd(p$presc))
) %>%
  mutate(across(c(M, SD), ~ round(.x, 2))) %>%
  kable() %>% kable_styling(full_width = FALSE)
Study Alpha, 6-item prescriptive Alpha, distribution (3) Alpha, attribute (3) M SD
Study 1 0.79 0.61 0.81 5.76 0.75
Study 2 0.78 0.69 0.74 5.73 0.75
Study 3 pilot 0.87 0.79 0.82 5.70 0.94 
# How much does prescriptive SEB overlap with SZSB and the other controls?
overlap <- bind_rows(
  s1 %>% select(presc, all_of(controls)) %>% summarise(across(all_of(controls), ~ cor(presc, .x, use = "pair"))) %>% mutate(Study = "Study 1"),
  s2 %>% select(presc, all_of(controls)) %>% summarise(across(all_of(controls), ~ cor(presc, .x, use = "pair"))) %>% mutate(Study = "Study 2"),
  p  %>% select(presc, all_of(controls)) %>% summarise(across(all_of(controls), ~ cor(presc, .x, use = "pair"))) %>% mutate(Study = "Study 3 pilot")
) %>% select(Study, everything())

overlap %>% mutate(across(where(is.numeric), ~ round(.x, 2))) %>%
  kable(caption = "Correlation of prescriptive SEB with each control") %>%
  kable_styling(full_width = FALSE)
Correlation of prescriptive SEB with each control
Study szsb nfs sdo dom prest
Study 1 -0.21 0.13 -0.35 -0.13 0.14
Study 2 -0.21 0.13 -0.42 -0.33 0.16
Study 3 pilot -0.36 0.03 -0.43 -0.40 0.09 
redundancy <- function(d, label) {
  m <- lm(presc ~ szsb + nfs + sdo + dom + prest, data = d)
  r2 <- summary(m)$r.squared
  tibble(Study = label, `R2 (presc SEB ~ controls)` = r2, `VIF (presc SEB)` = 1 / (1 - r2))
}
bind_rows(redundancy(s1, "Study 1"), redundancy(s2, "Study 2"), redundancy(p, "Study 3 pilot")) %>%
  mutate(across(where(is.numeric), ~ round(.x, 2))) %>%
  kable(caption = "High values would mean prescriptive SEB is largely redundant with the controls") %>%
  kable_styling(full_width = FALSE)
High values would mean prescriptive SEB is largely redundant with the controls
Study R2 (presc SEB ~ controls) VIF (presc SEB)
Study 1 0.18 1.21
Study 2 0.26 1.35
Study 3 pilot 0.32 1.47

Study 1: Prescriptive SEB -> OCBI and UPB

Raw-scale models

s1_ocbi <- fit_specs(s1, "ocbi")
s1_upb  <- fit_specs(s1, "upb")

OCBI: preregistered model (full controls)

summary(s1_ocbi$full)
## 
## Call:
## lm(formula = fml, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.64525 -0.73537  0.02422  0.71970  2.63978 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.76659    0.58207   3.035  0.00257 ** 
## presc        0.35252    0.07972   4.422 1.28e-05 ***
## szsb         0.09220    0.06054   1.523  0.12859    
## nfs          0.12074    0.08403   1.437  0.15157    
## sdo         -0.00413    0.04260  -0.097  0.92281    
## dom         -0.18772    0.05944  -3.158  0.00171 ** 
## prest        0.12072    0.08982   1.344  0.17978    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.075 on 383 degrees of freedom
## Multiple R-squared:  0.1194, Adjusted R-squared:  0.1056 
## F-statistic: 8.658 on 6 and 383 DF,  p-value: 7.574e-09

UPB: preregistered model (full controls)

summary(s1_upb$full)
## 
## Call:
## lm(formula = fml, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.9256 -0.8651 -0.2518  0.6898  5.0933 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.06412    0.68170   3.028  0.00263 ** 
## presc       -0.19604    0.09337  -2.100  0.03641 *  
## szsb         0.01690    0.07090   0.238  0.81175    
## nfs         -0.07270    0.09842  -0.739  0.46055    
## sdo          0.11082    0.04989   2.221  0.02692 *  
## dom          0.31276    0.06962   4.493 9.33e-06 ***
## prest        0.15286    0.10520   1.453  0.14703    
## ---
## 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.1458, Adjusted R-squared:  0.1324 
## F-statistic: 10.89 on 6 and 383 DF,  p-value: 3.302e-11

Does prescriptive SEB add anything beyond SZSB?

bind_rows(
  incremental(s1_ocbi) %>% mutate(Outcome = "OCBI"),
  incremental(s1_upb)  %>% mutate(Outcome = "UPB")
) %>%
  select(Outcome, comparison, delta_R2, test, test_stat, p) %>%
  mutate(delta_R2 = round(delta_R2, 3), test_stat = round(test_stat, 2), p = fmt_p(p)) %>%
  kable() %>% kable_styling(full_width = FALSE)
Outcome comparison delta_R2 test test_stat p
OCBI SZSB -> SZSB + prescriptive SEB 0.076 F 31.62 <.001
OCBI All controls -> + prescriptive SEB 0.045 F 19.55 <.001
UPB SZSB -> SZSB + prescriptive SEB 0.026 F 10.30 .001
UPB All controls -> + prescriptive SEB 0.010 F 4.41 .036

Distribution vs. attribute prescriptive (which half carries the effect?)

sub_ocbi <- lm(ocbi ~ presc_dist + presc_attr + szsb + nfs + sdo + dom + prest, data = s1)
sub_upb  <- lm(upb  ~ presc_dist + presc_attr + szsb + nfs + sdo + dom + prest, data = s1)
summary(sub_ocbi)
## 
## Call:
## lm(formula = ocbi ~ presc_dist + presc_attr + szsb + nfs + sdo + 
##     dom + prest, data = s1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.73323 -0.71959  0.03664  0.74087  2.66968 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)  1.78423    0.58246   3.063  0.00234 **
## presc_dist   0.11505    0.07618   1.510  0.13182   
## presc_attr   0.24180    0.08013   3.018  0.00272 **
## szsb         0.09075    0.06057   1.498  0.13488   
## nfs          0.11838    0.08408   1.408  0.15996   
## sdo         -0.00816    0.04282  -0.191  0.84896   
## dom         -0.18903    0.05947  -3.179  0.00160 **
## prest        0.11467    0.09007   1.273  0.20373   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.075 on 382 degrees of freedom
## Multiple R-squared:  0.1215, Adjusted R-squared:  0.1054 
## F-statistic: 7.546 on 7 and 382 DF,  p-value: 1.585e-08
summary(sub_upb)
## 
## Call:
## lm(formula = upb ~ presc_dist + presc_attr + szsb + nfs + sdo + 
##     dom + prest, data = s1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.9678 -0.8760 -0.2453  0.6681  5.0788 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.04786    0.68246   3.001  0.00287 ** 
## presc_dist  -0.04159    0.08926  -0.466  0.64150    
## presc_attr  -0.15844    0.09389  -1.688  0.09231 .  
## szsb         0.01824    0.07097   0.257  0.79735    
## nfs         -0.07052    0.09852  -0.716  0.47452    
## sdo          0.11453    0.05017   2.283  0.02299 *  
## dom          0.31397    0.06968   4.506 8.79e-06 ***
## prest        0.15843    0.10553   1.501  0.13409    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.259 on 382 degrees of freedom
## Multiple R-squared:  0.147,  Adjusted R-squared:  0.1314 
## F-statistic: 9.406 on 7 and 382 DF,  p-value: 8.954e-11

Mediation: inclusivity (prescriptive SEB -> inclusivity -> OCBI)

Your earlier Study 1 work found inclusivity fully mediated the full-scale SEB -> OCBI link. This re-tests that with prescriptive SEB only (bootstrapped indirect effect).

med_model <- '
  inclusivity ~ a*presc
  ocbi ~ cprime*presc + b*inclusivity
  indirect := a*b
  total := cprime + a*b
'
fit_med_s1 <- sem(med_model, data = s1, se = "bootstrap", bootstrap = 1000)
summary(fit_med_s1, standardized = TRUE, ci = TRUE)
## lavaan 0.7-2 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                            Bootstrap
##   Number of requested bootstrap draws             1000
##   Number of successful bootstrap draws            1000
## 
## Regressions:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   inclusivity ~                                                         
##     presc      (a)    0.455    0.069    6.546    0.000    0.327    0.590
##   ocbi ~                                                                
##     presc   (cprm)    0.131    0.072    1.817    0.069   -0.010    0.271
##     inclsvt    (b)    0.616    0.071    8.691    0.000    0.485    0.769
##    Std.lv  Std.all
##                   
##     0.455    0.385
##                   
##     0.131    0.087
##     0.616    0.482
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##    .inclusivity       0.671    0.075    8.988    0.000    0.521    0.818
##    .ocbi              0.938    0.056   16.781    0.000    0.819    1.040
##    Std.lv  Std.all
##     0.671    0.852
##     0.938    0.728
## 
## Defined Parameters:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##     indirect          0.280    0.050    5.607    0.000    0.187    0.385
##     total             0.411    0.076    5.389    0.000    0.264    0.563
##    Std.lv  Std.all
##     0.280    0.186
##     0.411    0.272

Study 2: Prescriptive SEB -> status affordance to subordinates

Each manager rated 3 subordinates, so ratings are nested within managers and analyzed with random intercepts (as preregistered).

s2_long <- s2 %>%
  mutate(
    aff_1 = rowMeans(across(c(affordance1_1, affordance1_2, affordance1_3)), na.rm = TRUE),
    aff_2 = rowMeans(across(c(affordance2_1, affordance2_2, affordance2_3)), na.rm = TRUE),
    aff_3 = rowMeans(across(c(affordance3_1, affordance3_2, affordance3_3)), na.rm = TRUE),
    presc_c = presc - mean(presc)          # grand-mean centered (manager level)
  ) %>%
  select(ResponseId, presc, presc_c, presc_dist, presc_attr, all_of(controls),
         aff_1, aff_2, aff_3) %>%
  pivot_longer(starts_with("aff_"), names_to = "slot", values_to = "affordance")

cat("Managers:", n_distinct(s2_long$ResponseId), " | Ratings:", nrow(s2_long))
## Managers: 157  | Ratings: 471
s2_mods <- fit_specs(s2_long, "affordance", mixed = TRUE)

Preregistered Model 1 (no controls)

summary(s2_mods$bivariate)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: fml
##    Data: data
## 
## REML criterion at convergence: 1276.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9932 -0.3320  0.0957  0.4486  2.5029 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2980   0.5459  
##  Residual               0.6525   0.8078  
## Number of obs: 471, groups:  ResponseId, 157
## 
## Fixed effects:
##             Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)   3.4166     0.4448 155.0000   7.682 1.66e-12 ***
## presc         0.3892     0.0770 155.0000   5.055 1.20e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##       (Intr)
## presc -0.992

Preregistered Model 2 (all controls)

(Note: in study2_full_analysis_10_9_25.Rmd, m2 referenced df_long_controls, which is never created. This uses s2_long instead.)

summary(s2_mods$full)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: fml
##    Data: data
## 
## REML criterion at convergence: 1281.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0265 -0.3635  0.1100  0.4761  2.5812 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2747   0.5242  
##  Residual               0.6525   0.8078  
## Number of obs: 471, groups:  ResponseId, 157
## 
## Fixed effects:
##              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)   3.38062    0.69183 149.99999   4.886 2.61e-06 ***
## presc         0.28457    0.08727 150.00000   3.261  0.00137 ** 
## szsb          0.11118    0.07512 150.00000   1.480  0.14094    
## nfs           0.27645    0.09674 150.00000   2.858  0.00488 ** 
## sdo          -0.07701    0.04786 150.00000  -1.609  0.10966    
## dom          -0.09064    0.06458 150.00000  -1.404  0.16253    
## prest        -0.12118    0.10899 150.00000  -1.112  0.26800    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##       (Intr) presc  szsb   nfs    sdo    dom   
## presc -0.725                                   
## szsb  -0.335  0.002                            
## nfs    0.025 -0.194  0.125                     
## sdo   -0.354  0.300 -0.064 -0.070              
## dom   -0.083  0.250 -0.379 -0.371 -0.263       
## prest -0.367  0.006  0.060 -0.656  0.135  0.034

Does prescriptive SEB add anything beyond SZSB?

incremental(s2_mods, mixed = TRUE) %>%
  select(comparison, test, test_stat, p) %>%
  mutate(test_stat = round(test_stat, 2), p = fmt_p(p)) %>%
  kable() %>% kable_styling(full_width = FALSE)
comparison test test_stat p
SZSB -> SZSB + prescriptive SEB LRT chi-sq 24.25 <.001
All controls -> + prescriptive SEB LRT chi-sq 10.75 .001

Distribution vs. attribute prescriptive

lmer(affordance ~ presc_dist + presc_attr + szsb + nfs + sdo + dom + prest + (1 | ResponseId),
     data = s2_long) %>% summary()
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: affordance ~ presc_dist + presc_attr + szsb + nfs + sdo + dom +  
##     prest + (1 | ResponseId)
##    Data: s2_long
## 
## REML criterion at convergence: 1283.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9543 -0.3471  0.0998  0.4895  2.5969 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2740   0.5234  
##  Residual               0.6525   0.8078  
## Number of obs: 471, groups:  ResponseId, 157
## 
## Fixed effects:
##              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)   3.49335    0.69876 149.00001   4.999  1.6e-06 ***
## presc_dist    0.21366    0.07779 149.00000   2.747  0.00676 ** 
## presc_attr    0.04291    0.09973 149.00000   0.430  0.66759    
## szsb          0.08783    0.07796 149.00000   1.127  0.26172    
## nfs           0.29991    0.09896 149.00000   3.031  0.00288 ** 
## sdo          -0.06921    0.04834 149.00000  -1.432  0.15430    
## dom          -0.08809    0.06458 149.00000  -1.364  0.17456    
## prest        -0.12020    0.10892 149.00000  -1.104  0.27155    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##            (Intr) prsc_d prsc_t szsb   nfs    sdo    dom   
## presc_dist -0.281                                          
## presc_attr -0.444 -0.500                                   
## szsb       -0.359 -0.223  0.244                            
## nfs         0.055  0.071 -0.275  0.060                     
## sdo        -0.326  0.287 -0.002 -0.100 -0.037              
## dom        -0.077  0.170  0.077 -0.374 -0.354 -0.255       
## prest      -0.362  0.010 -0.005  0.055 -0.639  0.135  0.034

Study 3 pilot: Does the essay manipulation move prescriptive SEB?

pilot_dvs <- c(presc = "Prescriptive SEB", szsb = "SZSB", nfs = "Need for status", ocbi = "OCBI")

pilot_tbl <- map_dfr(names(pilot_dvs), function(v) {
  hi <- p[[v]][p$condition == "high"]; lo <- p[[v]][p$condition == "low"]
  tt <- t.test(hi, lo)
  sp <- sqrt(((length(hi) - 1) * var(hi) + (length(lo) - 1) * var(lo)) / (length(hi) + length(lo) - 2))
  tibble(DV = pilot_dvs[[v]],
         `M high SEB` = mean(hi), `M low SEB` = mean(lo),
         diff = mean(hi) - mean(lo), d = (mean(hi) - mean(lo)) / sp,
         t = unname(tt$statistic), p = tt$p.value)
})

pilot_tbl %>%
  mutate(across(where(is.numeric), ~ round(.x, 2)), p = fmt_p(p)) %>%
  kable(caption = "High vs. low SEB condition (positive = higher in high SEB)") %>%
  kable_styling(full_width = FALSE)
High vs. low SEB condition (positive = higher in high SEB)
DV M high SEB M low SEB diff d t p
Prescriptive SEB 6.00 5.41 0.59 0.65 3.24 <.001
SZSB 2.81 3.39 -0.58 -0.65 -3.25 <.001
Need for status 4.72 4.47 0.24 0.21 1.05 .290
OCBI 5.18 4.53 0.66 0.52 2.59 .010

The manipulation may move SZSB as well as prescriptive SEB (it did in your pilot notes). That is the same confound raised in the email, so here is the effect on prescriptive SEB with and without SZSB held constant, plus a test of whether prescriptive SEB carries the condition effect on OCBI.

lm(presc ~ condition, data = p) %>% summary()
## 
## Call:
## lm(formula = presc ~ condition, data = p)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2467 -0.4133  0.0867  0.5867  1.5867 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.4133     0.1275  42.442  < 2e-16 ***
## conditionhigh   0.5867     0.1813   3.236  0.00166 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9019 on 97 degrees of freedom
## Multiple R-squared:  0.09743,    Adjusted R-squared:  0.08813 
## F-statistic: 10.47 on 1 and 97 DF,  p-value: 0.001659
lm(presc ~ condition + szsb + nfs + sdo + dom + prest, data = p) %>% summary()
## 
## Call:
## lm(formula = presc ~ condition + szsb + nfs + sdo + dom + prest, 
##     data = p)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.34596 -0.47593  0.05799  0.44707  1.44449 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    6.57894    0.52872  12.443  < 2e-16 ***
## conditionhigh  0.59743    0.16302   3.665 0.000414 ***
## szsb          -0.09076    0.09403  -0.965 0.336985    
## nfs            0.18600    0.12083   1.539 0.127141    
## sdo           -0.23676    0.06049  -3.914 0.000174 ***
## dom           -0.25277    0.08323  -3.037 0.003107 ** 
## prest         -0.09147    0.15342  -0.596 0.552489    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7504 on 92 degrees of freedom
## Multiple R-squared:  0.4074, Adjusted R-squared:  0.3688 
## F-statistic: 10.54 on 6 and 92 DF,  p-value: 6.999e-09
med_pilot <- '
  presc ~ a*cond_high
  ocbi  ~ cprime*cond_high + b*presc
  indirect := a*b
  total := cprime + a*b
'
fit_med_p <- sem(med_pilot, data = p, se = "bootstrap", bootstrap = 1000)
summary(fit_med_p, standardized = TRUE, ci = TRUE)
## lavaan 0.7-2 ended normally after 1 iteration
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                         5
## 
##   Number of observations                            99
## 
## Model Test User Model:
##                                                       
##   Test statistic                                 0.000
##   Degrees of freedom                                 0
## 
## Parameter Estimates:
## 
##   Standard errors                            Bootstrap
##   Number of requested bootstrap draws             1000
##   Number of successful bootstrap draws             995
## 
## Regressions:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   presc ~                                                               
##     cnd_hgh    (a)    0.587    0.183    3.203    0.001    0.213    0.946
##   ocbi ~                                                                
##     cnd_hgh (cprm)    0.478    0.244    1.963    0.050   -0.021    0.973
##     presc      (b)    0.307    0.146    2.097    0.036    0.014    0.571
##    Std.lv  Std.all
##                   
##     0.587    0.312
##                   
##     0.478    0.184
##     0.307    0.222
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##    .presc             0.797    0.206    3.872    0.000    0.458    1.253
##    .ocbi              1.500    0.209    7.159    0.000    1.079    1.900
##    Std.lv  Std.all
##     0.797    0.903
##     1.500    0.891
## 
## Defined Parameters:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##     indirect          0.180    0.105    1.717    0.086    0.004    0.402
##     total             0.659    0.252    2.609    0.009    0.123    1.168
##    Std.lv  Std.all
##     0.180    0.069
##     0.659    0.254
# Parallel mediation: prescriptive SEB and SZSB as competing mediators of condition -> OCBI
med_par <- '
  presc ~ a1*cond_high
  szsb  ~ a2*cond_high
  ocbi  ~ cprime*cond_high + b1*presc + b2*szsb
  presc ~~ szsb
  ind_presc := a1*b1
  ind_szsb  := a2*b2
'
fit_par <- sem(med_par, data = p, se = "bootstrap", bootstrap = 1000)
summary(fit_par, standardized = TRUE, ci = TRUE)
## lavaan 0.7-2 ended normally after 9 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                         9
## 
##   Number of observations                            99
## 
## Model Test User Model:
##                                                       
##   Test statistic                                 0.000
##   Degrees of freedom                                 0
## 
## Parameter Estimates:
## 
##   Standard errors                            Bootstrap
##   Number of requested bootstrap draws             1000
##   Number of successful bootstrap draws             993
## 
## Regressions:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   presc ~                                                               
##     cnd_hgh   (a1)    0.587    0.184    3.194    0.001    0.213    0.946
##   szsb ~                                                                
##     cnd_hgh   (a2)   -0.584    0.178   -3.281    0.001   -0.942   -0.221
##   ocbi ~                                                                
##     cnd_hgh (cprm)    0.485    0.267    1.815    0.070   -0.034    1.024
##     presc     (b1)    0.312    0.152    2.053    0.040    0.013    0.603
##     szsb      (b2)    0.016    0.184    0.085    0.932   -0.308    0.415
##    Std.lv  Std.all
##                   
##     0.587    0.312
##                   
##    -0.584   -0.313
##                   
##     0.485    0.187
##     0.312    0.226
##     0.016    0.011
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##  .presc ~~                                                              
##    .szsb             -0.231    0.115   -2.008    0.045   -0.482   -0.022
##    Std.lv  Std.all
##                   
##    -0.231   -0.293
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##    .presc             0.797    0.206    3.871    0.000    0.462    1.253
##    .szsb              0.784    0.102    7.657    0.000    0.586    0.992
##    .ocbi              1.499    0.207    7.231    0.000    1.050    1.878
##    Std.lv  Std.all
##     0.797    0.903
##     0.784    0.902
##     1.499    0.891
## 
## Defined Parameters:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##     ind_presc         0.183    0.110    1.664    0.096    0.007    0.435
##     ind_szsb         -0.009    0.115   -0.080    0.937   -0.298    0.181
##    Std.lv  Std.all
##     0.183    0.070
##    -0.009   -0.004

Integration across studies

Standardized (z-scored) coefficients for prescriptive SEB from every model, so Studies 1 and 2 are on the same metric. The key comparison is how much the coefficient shrinks going from bivariate to + SZSB to full controls.

z1 <- zscore(s1, c("ocbi", "upb", "presc", controls))
z2 <- zscore(s2_long, c("affordance", "presc", controls))

zm <- list(
  `Study 1: OCBI`                 = fit_specs(z1, "ocbi"),
  `Study 1: UPB`                  = fit_specs(z1, "upb"),
  `Study 2: Status affordance`    = fit_specs(z2, "affordance", mixed = TRUE)
)

spec_labels <- c(bivariate = "Prescriptive SEB alone",
                 plus_szsb = "+ SZSB",
                 full      = "+ all controls")

cross <- imap_dfr(zm, function(mods, label) {
  map_dfr(names(spec_labels), function(s) {
    get_coef(mods[[s]]) %>% mutate(Outcome = label, Specification = spec_labels[[s]])
  })
}) %>%
  mutate(lo = b - 1.96 * se, hi = b + 1.96 * se,
         Specification = factor(Specification, levels = spec_labels),
         Outcome = factor(Outcome, levels = names(zm)))

cross %>%
  transmute(Outcome, Specification,
            `std. b` = round(b, 2), SE = round(se, 2),
            `95% CI` = sprintf("[%.2f, %.2f]", lo, hi), p = fmt_p(p)) %>%
  kable() %>% kable_styling(full_width = FALSE) %>%
  collapse_rows(columns = 1, valign = "top")
Outcome Specification std. b SE 95% CI p
Study 1: OCBI Prescriptive SEB alone 0.27 0.05 [0.18, 0.37] <.001
  • SZSB
0.28 0.05 [0.18, 0.38] <.001
  • all controls
0.23 0.05 [0.13, 0.34] <.001
Study 1: UPB Prescriptive SEB alone -0.18 0.05 [-0.28, -0.08] <.001
  • SZSB
-0.16 0.05 [-0.26, -0.06] .001
  • all controls
-0.11 0.05 [-0.21, -0.01] .036
Study 2: Status affordance Prescriptive SEB alone 0.29 0.06 [0.17, 0.40] <.001
  • SZSB
0.29 0.06 [0.18, 0.41] <.001
  • all controls
0.21 0.06 [0.08, 0.33] .001 
ggplot(cross, aes(x = b, y = Outcome, color = Specification)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
  geom_pointrange(aes(xmin = lo, xmax = hi), position = position_dodge(width = 0.6)) +
  scale_y_discrete(limits = rev) +
  labs(x = "Standardized coefficient for prescriptive SEB (95% CI)", y = NULL,
       title = "Prescriptive SEB effects across studies") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"))

# Incremental value over SZSB / controls, all outcomes in one table
bind_rows(
  incremental(fit_specs(s1, "ocbi")) %>% mutate(Outcome = "Study 1: OCBI"),
  incremental(fit_specs(s1, "upb"))  %>% mutate(Outcome = "Study 1: UPB"),
  incremental(s2_mods, mixed = TRUE) %>% mutate(Outcome = "Study 2: Status affordance")
) %>%
  transmute(Outcome, comparison, test,
            delta_R2 = ifelse(is.na(delta_R2), "-", sprintf("%.3f", delta_R2)),
            stat = round(test_stat, 2), p = fmt_p(p)) %>%
  kable() %>% kable_styling(full_width = FALSE) %>%
  collapse_rows(columns = 1, valign = "top")
Outcome comparison test delta_R2 stat p
Study 1: OCBI SZSB -> SZSB + prescriptive SEB F 0.076 31.62 <.001
All controls -> + prescriptive SEB F 0.045 19.55 <.001
Study 1: UPB SZSB -> SZSB + prescriptive SEB F 0.026 10.30 .001
All controls -> + prescriptive SEB F 0.010 4.41 .036
Study 2: Status affordance SZSB -> SZSB + prescriptive SEB LRT chi-sq
24.25 <.001
All controls -> + prescriptive SEB LRT chi-sq
10.75 .001

Placeholder: email-paradigm pilot (dominance / prestige tactics)

The N = 100 email pilot described in the message to Adam (manager SEB manipulation -> dominance tactics, prestige tactics, need for status) was not among the uploaded files, so this chunk is off (eval = FALSE). Once that CSV is available, edit the file path and column names below. It tests the concern in the email: whether the SEB manipulation still predicts dominance tactics after accounting for perceived manager SZSB.

# Expected columns after scoring (rename to match your file):
#   cond_high        0 = low SEB, 1 = high SEB
#   manager_seb      perceived manager SEB (manipulation check)
#   manager_szsb     perceived manager SZSB
#   dominance, prestige, nfs
ep <- read_qualtrics("PATH_TO_EMAIL_PILOT.csv") %>%
  apply_exclusions()
  # ... score scales here with scale_mean() ...

# 1. Total effect of condition
lm(dominance ~ cond_high, data = ep) %>% summary()

# 2. Does it survive controlling perceived SZSB?
lm(dominance ~ cond_high + manager_szsb, data = ep) %>% summary()

# 3. Does perceived manager SZSB carry the effect? (bootstrapped indirect effect)
sem('
  manager_szsb ~ a*cond_high
  dominance ~ cprime*cond_high + b*manager_szsb
  indirect := a*b
  total := cprime + a*b
', data = ep, se = "bootstrap", bootstrap = 5000) %>%
  summary(standardized = TRUE, ci = TRUE)

# 4. Same test for prestige (expected null) and need for status
lm(prestige ~ cond_high + manager_szsb, data = ep) %>% summary()

Session info

sessionInfo()
## R version 4.6.0 (2026-04-24)
## Platform: aarch64-apple-darwin23
## Running under: macOS Ventura 13.3
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/New_York
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] kableExtra_1.4.0 knitr_1.51       lavaan_0.7-2     car_3.1-5       
##  [5] carData_3.0-6    psych_2.6.5      lmerTest_3.2-1   lme4_2.0-1      
##  [9] Matrix_1.7-5     qualtRics_3.3.0  lubridate_1.9.5  forcats_1.0.1   
## [13] stringr_1.6.0    dplyr_1.2.1      purrr_1.2.2      readr_2.2.0     
## [17] tidyr_1.3.2      tibble_3.3.1     ggplot2_4.0.3    tidyverse_2.0.0 
## 
## loaded via a namespace (and not attached):
##  [1] sjlabelled_1.2.0    tidyselect_1.2.1    viridisLite_0.4.3  
##  [4] farver_2.1.2        S7_0.2.2            fastmap_1.2.0      
##  [7] digest_0.6.39       timechange_0.4.0    lifecycle_1.0.5    
## [10] magrittr_2.0.5      compiler_4.6.0      rlang_1.2.0        
## [13] sass_0.4.10         tools_4.6.0         yaml_2.3.12        
## [16] labeling_0.4.3      bit_4.6.0           mnormt_2.1.2       
## [19] xml2_1.5.2          RColorBrewer_1.1-3  abind_1.4-8        
## [22] withr_3.0.2         numDeriv_2016.8-1.1 grid_4.6.0         
## [25] stats4_4.6.0        scales_1.4.0        MASS_7.3-66        
## [28] insight_1.5.1       cli_3.6.6           rmarkdown_2.31     
## [31] crayon_1.5.3        reformulas_0.4.4    generics_0.1.4     
## [34] otel_0.2.0          rstudioapi_0.19.0   tzdb_0.5.0         
## [37] minqa_1.2.8         cachem_1.1.0        splines_4.6.0      
## [40] parallel_4.6.0      vctrs_0.7.3         boot_1.3-32        
## [43] jsonlite_2.0.0      hms_1.1.4           bit64_4.8.2        
## [46] Formula_1.2-5       systemfonts_1.3.2   jquerylib_0.1.4    
## [49] glue_1.8.1          nloptr_2.2.1        stringi_1.8.7      
## [52] gtable_0.3.6        quadprog_1.5-8      pillar_1.11.1      
## [55] htmltools_0.5.9     R6_2.6.1            textshaping_1.0.5  
## [58] Rdpack_2.6.6        vroom_1.7.1         evaluate_1.0.5     
## [61] pbivnorm_0.6.0      lattice_0.22-9      rbibutils_2.4.1    
## [64] bslib_0.11.0        Rcpp_1.1.1-1.1      svglite_2.2.2      
## [67] nlme_3.1-169        xfun_0.58           pkgconfig_2.0.3