Background

While Studies 1 and 2 supported our model, neither featured a behavioral measure of dominance. Study 3A sought such evidence with a novel paradigm, asking some participants to role-play as managers attempting to induce employees to complete a relatively unpleasant task and other participants to role-play as employees being induced to perform the task (a common dynamic in Study 2’s reports of real-world dominance). This paradigm allowed us to test again for the predictive role of competitive worldviews and relationship expectancies. Importantly, it also offered an empirical opportunity to evaluate errors in expectancies. Studies 1 and 2 do not shed light on whether, say, those with a competitive worldview are underestimating relationship costs of dominance or, alternatively, if those without a competitive worldview are overestimating such costs. The question remains: Are those high in competitive worldview or dominance overly optimistic or are those low in competitive worldview or dominance overly pessimistic about people’s responses to dominant behavior—or both? In the current study, we can assess this by comparing managerial predictions of relationship outcomes to employees’ actual behavior and self-reported attitudes towards their manager.

Procedure

The study was conducted in two phases: One in which one sample of participants acted as managers and one in which another sample of participants acted as employees. Our design was informed by the behavioral reports gathered in Study 2, which tended to revolve around managers pressing employees to complete unpleasant work with some threat for noncompliance or underperformance. Phase 1 participants were asked to imagine that they were managers in a mid-sized company facing a tough task to be assigned to their employee—another participant on Connect by CloudResearch. The employee’s performance on the task determined the manager’s bonus (up to $2 in addition to a base pay of $1.60). The employee also had a $2 “pending” bonus, but the amount they would receive would be determined by their manager (who could factor in the employee’s performance as much or little as they wanted). Importantly, these bonuses were independent: the amount awarded to the employee had no impact on the amount awarded to the manager. After receiving information about the task and bonus payment structure, manager participants were told that they could motivate their employees with one of two messages, one of which was dominant, and the other non-dominant. For each message, the managers predicted how well the employee would perform in the task and how the message would impact the employee’s attitude towards them. Then, the manager selected the message they wished to send to the employee. After selecting the message, they indicated if they believed the employee would nominate them for an additional paid “good manager” survey. Next, they indicated the bonus they wished to grant the employee for every possible level of performance in the task. Finally, they completed a measure of competitive worldview.

Phase 2 participants were asked to imagine that they were employees in a mid-sized firm. We informed them that they had been randomly assigned a manager who had participated in a previous phase of the study. After reading about the scenario, the task, and the bonus payment structure (where the manager’s bonus depended on their performance, but their own bonus was independent, decided solely by the manager), participants were told that the manager chose to send them a message. They then read the message that the manager selected to send (either dominant or non-dominant) and indicated if they wanted to complete the task. If not, they answered a number of questions about the manager and ended the survey at the agreed-upon $0.80 base pay. If yes, they began a five-round task (described below). After completing the task, they saw their score, indicated their attitudes about the manager, and were asked if they would recommend the manager for a paid “good manager” follow-up study. Finally, they were told how much the manager decided to grant them out of the $2 pending bonus. See Figure 3 for a visual description of the procedure.

Preregistered hypotheses

This study was preregistered here: Open Science Framework

Managers’ competitive worldview will be associated with the belief that dominant behavior will harm the relationship with the employee less, rather than more.
Managers’ competitive worldview will be positively associated with choice to behave dominantly toward their employees.
The relationship between managers’ competitive worldview and choice to behave dominantly will be at least partially explained by the expected impact of that dominant behavior on the relationship with the employee.

Data collection

Participants were recruited through Connect by CloudResearch - an online participant pool.

Phase 1 Participants (Managers)

Total N = 301.

Eligible N = 296.

Race/Ethnicity

df_s3a_managers_elg %>% 
  group_by(race) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

race	N	Perc
white	208	70.27
black	42	14.19
asian	16	5.41
hispanic	16	5.41
multiracial	12	4.05
NA	2	0.68

Gender

df_s3a_managers_elg %>% 
  mutate(gender = ifelse(is.na(gender) | gender == "","other",gender)) %>% 
  group_by(gender) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

gender	N	Perc
man	155	52.36
woman	137	46.28
other	4	1.35

Age

df_s3a_managers_elg %>% 
  summarise(age_mean = round(mean(age,na.rm = T),2),
            age_sd = round(sd(age,na.rm = T),2)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

age_mean	age_sd
38.87	13.34

Education

df_s3a_managers_elg %>% 
  group_by(edu) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

edu	N	Perc
noHS	3	1.01
GED	87	29.39
2yearColl	37	12.50
4yearColl	124	41.89
MA	33	11.15
PHD	11	3.72
NA	1	0.34

Income

median_income_num <- df_s3a_managers_elg %>% 
  summarise(median = median(income_num,na.rm = T))

median_income <- median_income_num %>% 
  mutate(income_char = case_when(median == 1 ~ "$0-$20,000",
                                 median == 2 ~ "$20,001-$40,000",
                                 median == 3 ~ "$40,001-$60,000",
                                 median == 4 ~ "$60,001-$80,000",
                                 median == 5 ~ "$80,001-$100,000",
                                 median == 6 ~ "$100,001-$120,000",
                                 median == 7 ~ "$120,001-$140,000",
                                 median == 8 ~ "$140,001-$160,000",
                                 median == 9 ~ "$160,001-$180,000",
                                 median == 10 ~ "$180,001-$200,000",
                                 median == 11 ~ "Over $200,000")) %>% 
  select(income_char) %>% 
  unlist() %>% 
  unname()

df_s3a_managers_elg %>%
  ggplot(aes(x = income, fill = income == median_income)) +
  geom_bar(show.legend = FALSE) +
  scale_fill_manual(values = c("FALSE" = "grey66", "TRUE" = "red")) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_blank(),
        axis.title.y = element_blank()) +
  coord_flip()

Median income: $60,001-$80,000.

Phase 2 Participants (Employees)

Total N = 299.

Eligible N = 299.

Race/Ethnicity

df_s3a_employees_elg %>% 
  group_by(race) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

race	N	Perc
white	197	65.89
black	35	11.71
asian	31	10.37
multiracial	20	6.69
hispanic	12	4.01
NA	4	1.34

Gender

df_s3a_employees_elg %>% 
  mutate(gender = ifelse(is.na(gender) | gender == "","other",gender)) %>% 
  group_by(gender) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

gender	N	Perc
woman	171	57.19
man	123	41.14
other	5	1.67

Age

df_s3a_employees_elg %>% 
  summarise(age_mean = round(mean(age,na.rm = T),2),
            age_sd = round(sd(age,na.rm = T),2)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

age_mean	age_sd
37.95	12.71

Education

df_s3a_employees_elg %>% 
  group_by(edu) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

edu	N	Perc
noHS	3	1.00
GED	98	32.78
2yearColl	37	12.37
4yearColl	109	36.45
MA	38	12.71
PHD	11	3.68
NA	3	1.00

Income

median_income_num <- df_s3a_employees_elg %>% 
  summarise(median = median(income_num,na.rm = T))

median_income <- median_income_num %>% 
  mutate(income_char = case_when(median == 1 ~ "$0-$20,000",
                                 median == 2 ~ "$20,001-$40,000",
                                 median == 3 ~ "$40,001-$60,000",
                                 median == 4 ~ "$60,001-$80,000",
                                 median == 5 ~ "$80,001-$100,000",
                                 median == 6 ~ "$100,001-$120,000",
                                 median == 7 ~ "$120,001-$140,000",
                                 median == 8 ~ "$140,001-$160,000",
                                 median == 9 ~ "$160,001-$180,000",
                                 median == 10 ~ "$180,001-$200,000",
                                 median == 11 ~ "Over $200,000")) %>% 
  select(income_char) %>% 
  unlist() %>% 
  unname()

df_s3a_employees_elg %>%
  ggplot(aes(x = income, fill = income == median_income)) +
  geom_bar(show.legend = FALSE) +
  scale_fill_manual(values = c("FALSE" = "grey66", "TRUE" = "red")) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_blank(),
        axis.title.y = element_blank()) +
  coord_flip()

Median income: $60,001-$80,000.

Phase 1: Measures

Messages

Manager-playing participants were shown two messages: A dominant message and a non-dominant message. For each message, they indicated the expected impact it would have on the employee’s attitude towards them, the employee’s compliance with the task, and whether they believe the employee would nominate them for a “good manager” survey (in which they could win more bonus money) after completing the task.

Dominant message

By now you know the task at hand. It’s time to get in there and do your absolute best across all rounds. If you don’t complete it and do it well, you will not get the full bonus.

Relationship expectancy

What will be the impact of this message on your employee’s attitude towards you? (1 = Extremely Negative to 7 = Extremely Positive)

df_s3a_managers_elg %>% 
  ggplot(aes(x = attitude_dom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(0,8)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$attitude_dom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Compliance expectancy

If they choose to do the task after receiving your message, how well will they perform? Their performance can range from 0 points up to 50 points (for perfect performance).

df_s3a_managers_elg %>% 
  ggplot(aes(x = comp_dom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 5) +
  scale_x_continuous(breaks = seq(0,50,5),
                     limits = c(-5,55)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$comp_dom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Predicted nomination for “good manager” survey

We are planning a paid follow-up to this study.

For the follow-up survey, we are specifically interested in targeting good managers - those who show an ability to effectively lead their workers to achieve goals while fostering a positive work environment.

After the task, but before they know your bonus decision, we will ask your employee if they would recommend you for this study.

Do you think your employee will recommend you as a participant in this “good manager” paid follow-up survey? (No = 0; Yes = 1)

df_s3a_managers_elg %>% 
  ggplot(aes(x = nompred_dom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(0,1,1),
                     limits = c(-1,2)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$nompred_dom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Non-Dominant message

Your job in this task is to select the shapes that match the description. Please make sure you look at them carefully. It would be great if you can get as many of them right as possible.

Relationship expectancy

What will be the impact of this message on your employee’s attitude towards you? (1 = Extremely Negative to 7 = Extremely Positive)

df_s3a_managers_elg %>% 
  ggplot(aes(x = attitude_nondom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(0,8)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$attitude_nondom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Compliance expectancy

If they choose to do the task after receiving your message, how well will they perform? Their performance can range from 0 points up to 50 points (for perfect performance).

df_s3a_managers_elg %>% 
  ggplot(aes(x = comp_nondom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 5) +
  scale_x_continuous(breaks = seq(0,50,5),
                     limits = c(-5,55)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$comp_nondom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Predicted nomination for “good manager” survey

We are planning a paid follow-up to this study.

After the task, but before they know your bonus decision, we will ask your employee if they would recommend you for this study.

Do you think your employee will recommend you as a participant in this “good manager” paid follow-up survey? (No = 0; Yes = 1)

df_s3a_managers_elg %>% 
  ggplot(aes(x = nompred_nondom)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(0,1,1),
                     limits = c(-1,2)) +
  ylab("count") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$nompred_nondom,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Message Selection

After indicating their predictions, manager-playing participants were asked to select the message that they wish to send to their employees.

df_s3a_managers_elg %>% 
  group_by(message_choice) %>% 
  summarise(N = n()) %>% 
  ungroup() %>% 
  mutate(Perc = round(100*(N/sum(N)),2)) %>% 
  ungroup() %>% 
  arrange(desc(Perc)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

message_choice	N	Perc
nondom	212	71.62
dom	84	28.38

Competitive worldview

Finally, they completed the Competitive Worldview scale.

1 = Strongly Disagree to 7 = Strongly Agree

It’s a dog-eat-dog world where you have to be ruthless at times
Life is not governed by the “survival of the fittest.” We should let compassion and moral laws be our guide [R]
There is really no such thing as “right” and “wrong.” It all boils down to what you can get away with
One of the most useful skills a person should develop is how to look someone straight in the eye and lie convincingly
It is better to be loved than to be feared [R]
My knowledge and experience tell me that the social world we live in is basically a competitive “jungle” in which the fittest survive and succeed, in which power, wealth, and winning are everything, and might is right
Do unto others as you would have them do unto you, and never do anything unfair to someone else [R]
Basically people are objects to be quietly and coolly manipulated for one’s own benefit
Honesty is the best policy in all cases [R]
One should give others the benefit of the doubt. Most people are trustworthy if you have faith in them [R]

R indicates a reverse-scored item.

Cronbach’s alpha = 0.81

df_s3a_managers_elg %>% 
  ggplot(aes(x = CWV)) +
  geom_density(fill = "lightblue",
                 color = NA) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(1,7)) +
  ylab("density") +
  geom_vline(xintercept = mean(df_s3a_managers_elg$CWV,na.rm = T),
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Phase 1: Analysis

The primary preregistered analyses were conducted on the manager-playing participant sample.

Model 1: Logistic Regression

Predictor: Competitive worldview.

Outcome: Selection of dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

m1 <- glm(is_dom ~ CWV + age + man + white + income_num + edu_num,
               data = df_s3a_managers_elg,
               family = binomial)

eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>% 
  mutate(eta2 = round(etas_for_table,3))

kbl(table_for_print) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	p.value	eta2
Intercept	-3.22	[-4.90, -1.63]	-3.88	< .001	NA
CWV	0.51	[0.20, 0.83]	3.22	.001	0.033
Age	0.01	[-0.01, 0.04]	1.32	.188	0.006
Man	0.12	[-0.42, 0.65]	0.43	.666	0.001
White	-0.02	[-0.62, 0.59]	-0.08	.938	0.000
Income num	0.06	[-0.05, 0.17]	1.09	.277	0.005
Edu num	0.00	[-0.25, 0.25]	-0.02	.981	0.000

Model 2: Linear Model

Predictor: Competitive worldview.

Outcome: Relationship expectancy of dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

m1 <- lm(attitude_dom ~ CWV + age + man + white + income_num + edu_num,data = df_s3a_managers_elg)

eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>% 
  mutate(eta2 = round(etas_for_table,3))

kbl(table_for_print) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	df	p.value	eta2
Intercept	2.25	[1.11, 3.38]	3.90	280	< .001	NA
CWV	0.42	[0.20, 0.64]	3.68	280	< .001	0.049
Age	0.01	[-0.01, 0.02]	1.13	280	.257	0.001
Man	-0.09	[-0.47, 0.29]	-0.46	280	.646	0.000
White	-0.47	[-0.91, -0.03]	-2.12	280	.035	0.018
Income num	0.07	[-0.01, 0.16]	1.81	280	.071	0.016
Edu num	0.04	[-0.13, 0.22]	0.48	280	.629	0.001

Model 3: Logistic Regression

Predictor: Competitive worldview.

Outcome: Predicted nomination for “good manager” survey in case of sending the dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

m1 <- glm(nompred_dom ~ CWV + age + man + white + income_num + edu_num,
               data = df_s3a_managers_elg,
               family = binomial)

eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>% 
  mutate(eta2 = round(etas_for_table,3))

kbl(table_for_print) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

term	estimate	conf.int	statistic	p.value	eta2
Intercept	-2.67	[-4.22, -1.19]	-3.47	< .001	NA
CWV	0.63	[0.33, 0.94]	4.08	< .001	0.057
Age	0.01	[-0.01, 0.03]	0.52	.605	0.002
Man	0.05	[-0.44, 0.55]	0.21	.832	0.000
White	0.37	[-0.19, 0.95]	1.29	.196	0.005
Income num	0.05	[-0.06, 0.15]	0.88	.378	0.003
Edu num	-0.03	[-0.26, 0.20]	-0.26	.794	0.000

Model 4: Mediation model

Predictor: Competitive worldview.

Mediator: Relationship expectancy of dominant message.

Outcome: Selection of dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

Bootstraps: 10,000

# Step 1: Fit the mediator model
med.fit <- lm(attitude_dom ~ CWV + age + man + white + income_num + edu_num,
              data = df_s3a_managers_elg)

# Step 2: Fit the outcome model
out.fit <- lm(is_dom ~ attitude_dom + CWV + age + man + white + income_num + edu_num,
              data = df_s3a_managers_elg)

# Step 3: Conduct the mediation analysis
med.out <- mediation::mediate(med.fit, out.fit,
                   treat = "CWV",
                   mediator = "attitude_dom",
                   boot = TRUE, sims = 10000) 

# Step 4: Create table
med_results <- data.frame(
  Effect = c("ACME (indirect)", "ADE (direct)", "Total Effect", "Prop. Mediated"),
  Estimate = round(c(med.out$d0, med.out$z0, med.out$tau.coef, med.out$n0), 3),
  `95% CI Lower` = round(c(med.out$d0.ci[1], med.out$z0.ci[1], med.out$tau.ci[1], med.out$n0.ci[1]), 3),
  `95% CI Upper` = round(c(med.out$d0.ci[2], med.out$z0.ci[2], med.out$tau.ci[2], med.out$n0.ci[2]), 3),
  `p-value` = signif(c(med.out$d0.p, med.out$z0.p, med.out$tau.p, med.out$n0.p), 3)
)

kbl(med_results) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Effect	Estimate	X95..CI.Lower	X95..CI.Upper	p.value
ACME (indirect)	0.038	0.015	0.065	0.0012
ADE (direct)	0.066	0.002	0.131	0.0430
Total Effect	0.103	0.040	0.167	0.0018
Prop. Mediated	0.366	0.141	0.945	0.0030

Model 5: Mediation model

Predictor: Competitive worldview.

Mediator: Predicted nomination for “good manager” survey in case of sending the dominant message.

Outcome: Selection of dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

Bootstraps: 10,000

# Step 1: Fit the mediator model
med.fit <- lm(nompred_dom ~ CWV + age + man + white + income_num + edu_num,
              data = df_s3a_managers_elg)

# Step 2: Fit the outcome model
out.fit <- lm(is_dom ~ nompred_dom + CWV + age + man + white + income_num + edu_num,
              data = df_s3a_managers_elg)

# Step 3: Conduct the mediation analysis
med.out <- mediation::mediate(med.fit, out.fit,
                   treat = "CWV",
                   mediator = "nompred_dom",
                   boot = TRUE, sims = 10000) 

# Step 4: Create table
med_results <- data.frame(
  Effect = c("ACME (indirect)", "ADE (direct)", "Total Effect", "Prop. Mediated"),
  Estimate = round(c(med.out$d0, med.out$z0, med.out$tau.coef, med.out$n0), 3),
  `95% CI Lower` = round(c(med.out$d0.ci[1], med.out$z0.ci[1], med.out$tau.ci[1], med.out$n0.ci[1]), 3),
  `95% CI Upper` = round(c(med.out$d0.ci[2], med.out$z0.ci[2], med.out$tau.ci[2], med.out$n0.ci[2]), 3),
  `p-value` = signif(c(med.out$d0.p, med.out$z0.p, med.out$tau.p, med.out$n0.p), 3)
)

kbl(med_results) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Effect	Estimate	X95..CI.Lower	X95..CI.Upper	p.value
ACME (indirect)	0.053	0.027	0.083	0.0000
ADE (direct)	0.050	-0.010	0.111	0.1100
Total Effect	0.103	0.038	0.166	0.0016
Prop. Mediated	0.514	0.259	1.225	0.0016

Model 6: Simultaneous mediation model

Predictor: Competitive worldview.

Mediator 1: Relationship expectancy of dominant message.

Mediator 2: Compliance expectancy of dominant message.

Outcome: Selection of dominant message.

Controls: Age, race (white = 1; non-white = 0), gender (man = 1; non-man = 0), education (numeric), income (numeric).

Bootstraps: 10,000

model <- '
  # Regressions for mediators
  attitude_dom  ~ a1 * CWV + age + white + man + edu_num + income_num
  comp_dom ~ a2 * CWV + age + white + man + edu_num + income_num

  # Regression for outcome
  is_dom ~ b1 * attitude_dom + b2 * comp_dom  + c_prime * CWV + age + white + man + edu_num + income_num

  # Indirect effects
  ind1 := a1 * b1
  ind2 := a2 * b2

  # Total indirect and total effect
  ind_total := ind1 + ind2
  total := c_prime + ind_total
'

fit <- sem(model, data = df_s3a_managers_elg, se = "bootstrap", bootstrap = 10000)

estimates <- parameterEstimates(fit, standardized = TRUE, ci = TRUE, boot.ci.type = "perc")

effects_table <- estimates %>%
  filter(label %in% c("a1","a2","b1","b2","c_prime","ind1","ind2","ind_total","total")) %>%
  dplyr::select(label, est, se, ci.lower, ci.upper, pvalue)

kbl(effects_table) %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

label	est	se	ci.lower	ci.upper	pvalue
a1	0.4198409	0.1193509	0.1778962	0.6503623	0.0004353
a2	-0.5315991	0.8225683	-2.1762326	1.0809505	0.5181062
b1	0.0578398	0.0199807	0.0198512	0.0981133	0.0037942
b2	0.0088184	0.0023232	0.0041679	0.0132589	0.0001471
c_prime	0.0838967	0.0318348	0.0209978	0.1460370	0.0084044
ind1	0.0242835	0.0109942	0.0062438	0.0490448	0.0271918
ind2	-0.0046878	0.0076230	-0.0217915	0.0091914	0.5385799
ind_total	0.0195957	0.0153304	-0.0099970	0.0506803	0.2011694
total	0.1034924	0.0323106	0.0397634	0.1666246	0.0013598

Phase 2: Measures

att_outcome <- df_s3a_employees_elg %>%  
  group_by(is_dom) %>% 
  summarise(N = n(),
            attitude = mean(attitude,na.rm = T),
            rec = mean(rec,na.rm = T),
            points = mean(points,na.rm = T)) %>% 
  ungroup() %>% 
  filter(is_dom == 1) %>% 
  select(attitude) %>% 
  unlist() %>% 
  unname()

rec_outcome <- df_s3a_employees_elg %>%  
  group_by(is_dom) %>% 
  summarise(N = n(),
            attitude = mean(attitude,na.rm = T),
            rec = mean(rec,na.rm = T),
            points = mean(points,na.rm = T)) %>% 
  ungroup() %>% 
  filter(is_dom == 1) %>% 
  select(rec) %>% 
  unlist() %>% 
  unname()

df_s3a_employees_elg %>%  
  group_by(is_dom) %>% 
  summarise(N = n(),
            attitude = mean(attitude,na.rm = T),
            rec = mean(rec,na.rm = T),
            points = mean(points,na.rm = T)) %>% 
  ungroup() %>% 
  pivot_longer(-c(is_dom),
               names_to = " ",
               values_to = "values") %>% 
  mutate(is_dom = ifelse(is_dom == 0,"nondom","dom")) %>% 
  pivot_wider(names_from = is_dom,
              values_from = values) %>% 
  mutate(nondom = round(nondom,2),
         dom = round(dom,2)) %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

	nondom	dom
N	149.00	150.00
attitude	4.67	3.24
rec	0.72	0.48
points	33.26	29.78

Dominant message

Employees who received the dominant message (N = 150) were asked to complete the task and, indicate their attitude towards the manager, and were then given the chance to nominate them for the “good manager” survey.

Compliance

mean_points <- df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  summarise(mean = mean(points,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  ggplot(aes(x = points)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 5) +
  scale_x_continuous(breaks = seq(0,50,5),
                     limits = c(-5,55)) +
  ylab("count") +
  geom_vline(xintercept = mean_points,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Relationship (attitude)

mean_att <- df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  summarise(mean = mean(attitude,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  ggplot(aes(x = attitude)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(0,8)) +
  ylab("count") +
  geom_vline(xintercept = mean_att,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Nomination for “good manager” survey

mean_rec <- df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  summarise(mean = mean(rec,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 1) %>% 
  ggplot(aes(x = rec)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(0,1,1),
                     limits = c(-1,2)) +
  ylab("count") +
  geom_vline(xintercept = mean_rec,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Non-dominant message

Employees who received the non-dominant message (N = 149) were asked to complete the task and, indicate their attitude towards the manager, and were then given the chance to nominate them for the “good manager” survey.

Compliance

mean_points <- df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  summarise(mean = mean(points,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  ggplot(aes(x = points)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 5) +
  scale_x_continuous(breaks = seq(0,50,5),
                     limits = c(-5,55)) +
  ylab("count") +
  geom_vline(xintercept = mean_points,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Relationship (attitude)

mean_att <- df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  summarise(mean = mean(attitude,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  ggplot(aes(x = attitude)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(1,7,1),
                     limits = c(0,8)) +
  ylab("count") +
  geom_vline(xintercept = mean_att,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Nomination for “good manager” survey

mean_rec <- df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  summarise(mean = mean(rec,na.rm = T)) %>% 
  pull()

df_s3a_employees_elg %>% 
  filter(is_dom == 0) %>% 
  ggplot(aes(x = rec)) +
  geom_histogram(fill = "lightblue",
                 color = NA,
                 binwidth = 1) +
  scale_x_continuous(breaks = seq(0,1,1),
                     limits = c(-1,2)) +
  ylab("count") +
  geom_vline(xintercept = mean_rec,
             color = "black",
             linetype = "dashed",
             size = 1.1) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_line(color = "grey66"),
        axis.text.y = element_text(color = "black"),
        axis.text.x = element_text(color = "black",
                                   face = "bold"),
        axis.title.x = element_text(color = "black",
                                   face = "bold"))

Phase 2: Analysis

Johnson-Neyman 1

Analyzing if manager CWV is associated with accuracy in relationship expectancy in the case of dominant message selection.

Comparison point: 3.24

df_forJNI <- df_s3a_managers_elg %>% 
  select(PID,CWV,attitude_dom) %>% 
  mutate(truth = att_outcome) %>% 
  rename(pred = attitude_dom) %>% 
  pivot_longer(-c(PID,CWV),
               names_to = "type",
               values_to = "score") %>% 
  mutate(is_outcome = ifelse(type == "truth",1,0))
  
fiti <- lm(score ~ CWV * is_outcome,data = df_forJNI)

interact_plot(fiti,
              pred = "is_outcome",
              modx = "CWV",
              interval = T)

*is_outcome: 0 = predictions made by managers; 1 = mean of employee responses.

Simple Slopes:

sim_slopes <- sim_slopes(fiti,
              pred = "is_outcome",
              modx = "CWV",
           johnson_neyman = F)

sim_slopes$slopes %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Value of CWV	Est.	S.E.	2.5%	97.5%	t val.	p
1.843756	-0.1930259	0.1347971	-0.4577683	0.0717165	-1.431974	0.1526827
2.731419	-0.5640541	0.0952757	-0.7511761	-0.3769320	-5.920233	0.0000000
3.619082	-0.9350822	0.1347971	-1.1998246	-0.6703398	-6.936960	0.0000000

Intercepts:

sim_slopes$ints %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Value of CWV	Est.	S.E.	2.5%	97.5%	t val.
1.843756	3.336513	0.0673986	3.204142	3.468884	49.50422
2.731419	3.522027	0.0476378	3.428466	3.615588	73.93341
3.619082	3.707541	0.0673986	3.575170	3.839912	55.00921

jn <- sim_slopes(
    fiti,
              pred = "is_outcome",
              modx = "CWV",
    johnson_neyman = TRUE,
    control.fdr = TRUE,
    # correction for type I and II
    
    # include conditional intercepts
    # conf.int = TRUE, 
    
    robust = "HC3",
    # rubust SE
    
    # don't mean-centered non-focal variables
    # centered = "none",
    jnalpha = 0.05
)

jn$jn

## [[1]]
## JOHNSON-NEYMAN INTERVAL 
## 
## When CWV is OUTSIDE the interval [-0.48, 2.01], the slope of is_outcome is
## p < .05.
## 
## Note: The range of observed values of CWV is [1.00, 5.50]
## 
## Interval calculated using false discovery rate adjusted t = 2.07

plot <- johnson_neyman(fiti,
              pred = "is_outcome",
              modx = "CWV",
               control.fdr = T,
               alpha = 0.05)

plot$plot

Johnson-Neyman 2

Analyzing if CWV is associated with accuracy in nomination for the “good manager” survey in the case of dominant message selection.

Comparison point: 3.24

df_forJNI <- df_s3a_managers_elg %>% 
  select(PID,CWV,nompred_dom) %>% 
  mutate(truth = rec_outcome) %>% 
  rename(pred = nompred_dom) %>% 
  pivot_longer(-c(PID,CWV),
               names_to = "type",
               values_to = "score") %>% 
  mutate(is_outcome = ifelse(type == "truth",1,0))
  
fiti <- lm(score ~ CWV * is_outcome,data = df_forJNI)

interact_plot(fiti,
              pred = "is_outcome",
              modx = "CWV",
              interval = T)

*is_outcome: 0 = predictions made by managers; 1 = mean of employee responses.

Simple Slopes:

sim_slopes <- sim_slopes(fiti,
              pred = "is_outcome",
              modx = "CWV",
           johnson_neyman = F)

sim_slopes$slopes %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Value of CWV	Est.	S.E.	2.5%	97.5%	t val.	p
1.843756	0.1908510	0.0393286	0.1136095	0.2680926	4.852735	0.0000016
2.731419	0.0678378	0.0277977	0.0132429	0.1224328	2.440409	0.0149648
3.619082	-0.0551753	0.0393286	-0.1324169	0.0220662	-1.402934	0.1611645

Intercepts:

sim_slopes$ints %>% 
  kbl() %>% 
  kable_styling(bootstrap_options = "hover",
                full_width = F,
                position = "left")

Value of CWV	Est.	S.E.	2.5%	97.5%	t val.
1.843756	0.3845745	0.0196643	0.3459537	0.4231953	19.55701
2.731419	0.4460811	0.0138989	0.4187836	0.4733785	32.09479
3.619082	0.5075877	0.0196643	0.4689669	0.5462084	25.81268

jn <- sim_slopes(
    fiti,
              pred = "is_outcome",
              modx = "CWV",
    johnson_neyman = TRUE,
    control.fdr = TRUE,
    # correction for type I and II
    
    # include conditional intercepts
    # conf.int = TRUE, 
    
    robust = "HC3",
    # rubust SE
    
    # don't mean-centered non-focal variables
    # centered = "none",
    jnalpha = 0.05
)

jn$jn

## [[1]]
## JOHNSON-NEYMAN INTERVAL 
## 
## When CWV is OUTSIDE the interval [2.80, 3.90], the slope of is_outcome is p
## < .05.
## 
## Note: The range of observed values of CWV is [1.00, 5.50]
## 
## Interval calculated using false discovery rate adjusted t = 2.08

plot <- johnson_neyman(fiti,
              pred = "is_outcome",
              modx = "CWV",
               control.fdr = T,
               alpha = 0.05)

plot$plot

Dominance Through the Lens of a Competitive Worldview

Study 3A: Analysis Report

Background

Procedure

Preregistered hypotheses

Data collection

Phase 1 Participants (Managers)

Race/Ethnicity

Gender

Age

Education

Income

Phase 2 Participants (Employees)

Race/Ethnicity

Gender

Age

Education

Income

Phase 1: Measures

Messages

Dominant message

Relationship expectancy

Compliance expectancy

Predicted nomination for “good manager” survey

Non-Dominant message

Relationship expectancy

Compliance expectancy

Predicted nomination for “good manager” survey

Message Selection

Competitive worldview

Phase 1: Analysis

Model 1: Logistic Regression

Model 2: Linear Model

Model 3: Logistic Regression

Model 4: Mediation model

Model 5: Mediation model

Model 6: Simultaneous mediation model

Phase 2: Measures

Dominant message

Compliance

Relationship (attitude)

Nomination for “good manager” survey

Non-dominant message

Compliance

Relationship (attitude)

Nomination for “good manager” survey

Phase 2: Analysis

Johnson-Neyman 1

Johnson-Neyman 2