It is possible that the effects in Study 3A are due to peculiarities of the messages we crafted and/or that these messages are somehow extreme or unnatural. Study 3B addressed this concern by using crowd-sourced dominant and affiliative messages in the same paradigm as Study 3A, randomly assigning pairs of messages to manager-playing participants. We expected our predicted results from Study 3A to replicate. This variation also allowed us to explore the direction of expectancy errors with naturalistic messages rather than researcher-generated ones.
The procedure and measures of Study 3B were almost identical to those of Study 3A, with one important exception : The messages. Instead of just seeing and rating the same two messages, manager-playing participants were shown one of 15 dominant messages and one of 22 affiliative messages. Messages were collected from an initial sample of 30 participants on Connect by CloudResearch. They were given context about the design, asked to write one dominant message and one affiliative message on behalf of the manager, and told that the writer of the best-performing message (the message that yields the highest score from employee-playing participants) would receive a $50 bonus. Then, messages were rated by a separate sample of 100 participants on Connect by CloudResearch. Participants rated messages’ dominance and affiliation on 1-7 scales ; messages that received mean ratings of 4.5 to 6.5 on these dimensions were selected for their respective pools.
In Phase 2, employee-playing participants were randomly assigned to see either one of 15 dominant messages or one of 22 affiliative messages. This way, regardless of the selection rate in the manager-playing phase, we collected enough responses from employee-playing participants for each type of message, enabling a proper comparison to ground truth.
This study was preregistered here: Open Science Framework
Participants were recruited through Connect by CloudResearch - an online participant pool.
Total N = 302.
Eligible N = 296.
df_s3b_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 | 17 | 5.74 |
| hispanic | 17 | 5.74 |
| multiracial | 9 | 3.04 |
| NA | 3 | 1.01 |
df_s3b_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 |
|---|---|---|
| woman | 173 | 58.45 |
| man | 119 | 40.20 |
| other | 4 | 1.35 |
df_s3b_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.98 | 11.64 |
df_s3b_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 |
|---|---|---|
| GED | 79 | 26.69 |
| 2yearColl | 34 | 11.49 |
| 4yearColl | 125 | 42.23 |
| MA | 42 | 14.19 |
| PHD | 16 | 5.41 |
median_income_num <- df_s3b_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_s3b_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.
Total N = 302.
Eligible N = 302.
df_s3b_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 | 226 | 74.83 |
| black | 34 | 11.26 |
| asian | 15 | 4.97 |
| hispanic | 15 | 4.97 |
| multiracial | 9 | 2.98 |
| NA | 3 | 0.99 |
df_s3b_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 | 178 | 58.94 |
| man | 120 | 39.74 |
| other | 4 | 1.32 |
df_s3b_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 |
|---|---|
| 38.66 | 11.27 |
df_s3b_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 | 2 | 0.66 |
| GED | 76 | 25.17 |
| 2yearColl | 39 | 12.91 |
| 4yearColl | 113 | 37.42 |
| MA | 64 | 21.19 |
| PHD | 5 | 1.66 |
| NA | 3 | 0.99 |
median_income_num <- df_s3b_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_s3b_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.
Manager-playing participants were randomly shown one dominant message and one affiliative message. These messages were crowd-sourced by asking previous Connect by CloudResearch participants to write persuasive messages that fit the definitions of “dominant” and “affiliative” (later validated with a separate sample of participants). The writer of the message that ended up achieivng the highest score on the task from an employee-playing participant received a $50 bonus.
Write a short message (1-2 sentences) that attempts to motivate your employee by asserting your authority. Use coercive, domineering, threatening language.
For example, you might stress consequences if they do not complete the task or remind them that you control their bonus. Write the most coercive, domineering, threatening message that you think will still motivate people to do the task.
*character range: 50-500
*paste disabled
df_s3b_managers_elg %>%
select(message_dom) %>%
distinct() %>%
kbl() %>%
kable_styling(bootstrap_options = "hover",
position = "left") %>%
scroll_box(width = "100%", height = "400px")
| message_dom |
|---|
| Remember this project is very important to the success of the company and your success here. If you can’t accomplish it, you may not be a good fit to continue working here. |
| Please remember that this task directly affects your future pay and performance. Attempting to skate by or not give your full effort will result in severe consequences. |
| There is an activity coming up that you must participate in. This is not optional. You will be automatically enrolled, and the deadline is a hard deadline. Failure to complete the task will result in the potential to be written up. |
| I need for you to complete a task for me. Your performance directly affects not only my bonus, but yours as well. |
| This exercise determines your bonus. So do your best or your bonus will be affected. |
| This task I am assigning you is pretty important and needs to be done as well as possible. If you do not perform well you will not be receiving a possible bonus that I can reward you with. If you want this bonus, you will perform according. |
| I want you to do this job and do it properly. I expect you to get all 50 shapes correct. |
| If you do not do well on this task, you’re at risk of being demoted and also will not receive a bonus. |
| Hello, I am writing you today to notify you that you must complete this task flawlessly. There may be consequences if there is any more than 10% wrong. Pay close attention to the task. |
| This request needs to be completed immediately and if it is not done correctly, your bonus will be affected. In fact, mine is affected as well, so you better do it right. |
| You’ve been selected for a rigorous task that will impact how the company views our team, myself, and you. This is extremely important and you must understand the gravity of the role you’re being assigned. If you were to do poorly, it would impact your standing with the company as well as in my eyes. I want you focus on succeeding in any way possible and remember how much weight this carries. |
| Dear Employee. Your performance on this task is critical to your success at this company. If you cannot complete this task well, I will have to think about whether or not you are the right fit at the ocmpany. Remember, how I see your performance influences how I see you as a performer and whether or not I want to keep you on at this company. Don’t just try your best, do your best. |
| Reminder those that do not complete the task will not be compensated properly. |
| You’ve got to have this task done in its entirety before leaving leaving today. We’re relying on you for accurate work with this one, so please do not let us down. |
| You must complete this task. Do it to the best of your abilities, or else your bonus will be affected. |
Write a short message (1-2 sentences) that attempts to motivate your employee by emphasizing your support. Use supportive, respectful, empathetic language.
For example, you might ask politely, express appreciation, or highlight that you value their choice. Write the most supportive, respectful, empathetic message you can that you think will still motivate people to do the task.
*character range: 50-500
*paste disabled
df_s3b_managers_elg %>%
select(message_aff) %>%
distinct() %>%
kbl() %>%
kable_styling(bootstrap_options = "hover",
position = "left") %>%
scroll_box(width = "100%", height = "400px")
| message_aff |
|---|
| Hey teammate, I chose you to help complete this shape identification task because it is a quick, fun way for both of us to earn a bonus and I know you are the perfect person for the job! I’d really appreciate your attention and focus and I’ll make sure your bonus reflects your hard work. Let’s win this together! |
| I have faith that you will excel and perform this given task to the best of your ability because I know how hard-working my employees are. With that being said, there will be a monetary reward for those that perform this task as accurately and efficiently as possible! |
| Whether you do well or not, I appreciate your hard work at this company and will continue to support you. |
| Hi, I have a task that needs to be completed. You’ve got a sharp eye and I would appreciate if you could do it. |
| Please do your best at this exercise as I have faith that you will try your hardest, but if you make a mistake, no worries. Just take a deep breath focus on the exercise and you will do great! |
| I think you would be great for this job. You are a hard worker with great skills. I know I can count on you to get the job done. |
| We win together! You got this, I believe in your amazing abilities and by doing well, we can both walk away with pride and compensation! |
| Hey, i have a unique opportunity for you to contribute to our team’s success. This task could really make a difference for both of us. Your keen eye for details would be invaluable here. |
| Hey. Our boss has given us a fun and easy task to complete. I think it will allow you to test your intelligence and see exactly how much you know. You will be granting a bonus based on how much you would come up with. Let’s do it! It is definitely worth our time. |
| I am guessing that you will do great on this task and in doing so you will earn yourself a nice little bonus. Do your best and I know the outcome will be favorable. |
| This task is meant to challenge you but I have every faith that you will rise to the occasion. Take your time, think clearly and I know you will succeed. |
| You totally got this! Please match as many as you can as quickly as you can. By helping me with the work, we can achieve a lot together. |
| You are completely capable of successfully completing this task. You are smart, perceptive, and discerning: all things you need to complete this task well. |
| We want to offer you a bonus for completing this task in its entirety to reward you being such a valuable part of our team. We believe in you, so give it your best shot! |
| I am hoping you can lend your expertise on this request, given that I know you have a knack for this type of thing! I really appreciate your help, and please let me know if you have any questions! |
| Please do the best that you can to identify all the shapes that are described. Feel free to take your time and double-check your choices - you don’t need to be perfect, just make your best effort! |
| I’m choosing this assignment for you because I know that I can count on you to do a great job. Thank you so much! |
| Before we begin this task I just want to let you know that I appreciate all the hard work you always do and offer you a chance for a bonus. I am going to assign you a task and if you do well, there is a bonus involved for you. I know that you generally perform well, so I’m not too concerned, but wanted to give you a heads up that the better you perform the better your bonus will be for this task. Thanks again for all your hard work! |
| I’ve given you a relatively easy task that I know you’ll perform your absolute best on! To help make the task a little better, you can earn a nice bonus - so make sure to give it your all! I have no doubt that you’ll find it easy and fun. You’ve got this! |
| Team - We have an opportunity to earn meaningful bonuses on the upcoming pay cycle. This bonus depends on the accuracy of work you guys submit. The better the work, the higher the bonus we each receive. I know you guys are up to the task and I can’t imagine anyone being better suited to nail this challenge than you guys! thanks for all of your hard work. |
| Hi Team! Thank you so much for all your hard work so far this quarter. It has not gone unnoticed. Coming up, you will be automatically enrolled in an activity that requires your participation. It should not take long, and you will receive a small bonus in return. We realize that it has been especially busy, so if you need an extension on any deadlines in order to complete this task please do not hesitate to reach out. |
| Hello everyone! Thank you all for agreeing to participate in this project. Please take your time and put forth your best effort in completing this activity. If any help is needed, please see me so that I can provide clarity and assistance. Good luck to you all! |
What will be the impact of this message on your employee’s attitude towards you? (1 = Extremely Negative to 7 = Extremely Positive)
df_s3b_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_s3b_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"))
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_s3b_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_s3b_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"))
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_s3b_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_s3b_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"))
What will be the impact of this message on your employee’s attitude towards you? (1 = Extremely Negative to 7 = Extremely Positive)
df_s3b_managers_elg %>%
ggplot(aes(x = attitude_aff)) +
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_s3b_managers_elg$attitude_aff,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"))
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_s3b_managers_elg %>%
ggplot(aes(x = comp_aff)) +
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_s3b_managers_elg$comp_aff,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"))
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_s3b_managers_elg %>%
ggplot(aes(x = nompred_aff)) +
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_s3b_managers_elg$nompred_aff,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"))
After indicating their predictions, manager-playing participants were asked to select the message that they wish to send to their employees.
df_s3b_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 |
|---|---|---|
| aff | 272 | 91.89 |
| dom | 24 | 8.11 |
Finally, they completed the Competitive Worldview scale.
1 = Strongly Disagree to 7 = Strongly Agree
R indicates a reverse-scored item.
Cronbach’s alpha = 0.78
df_s3b_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_s3b_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"))
The primary preregistered analyses were conducted on the manager-playing participant sample.
Predictor: Competitive worldview.
Outcome: Selection of dominant message.
Random Effect: Dominant message shown.
m1 <- glmer(is_dom ~ CWV + (1 | MID_dom),
data = df_s3b_managers_elg,
family = binomial)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")
| term | estimate | conf.int | statistic | p.value |
|---|---|---|---|---|
| Intercept | -4.53 | [-6.32, -2.74] | -4.96 | < .001 |
| CWV | 0.72 | [0.16, 1.28] | 2.50 | .012 |
Predictor: Competitive worldview.
Outcome: Relationship expectancy of dominant message.
Random Effect: Dominant message shown.
m1 <- lmerTest::lmer(attitude_dom ~ CWV + (1 | MID_dom),data = df_s3b_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 | 1.81 | [1.22, 2.39] | 6.06 | 250.01 | < .001 | NA |
| CWV | 0.29 | [0.07, 0.50] | 2.65 | 291.45 | .008 | 0.024 |
Predictor: Competitive worldview.
Outcome: Predicted nomination for “good manager” survey in case of sending the dominant message.
Random Effect: Dominant message shown.
m1 <- glmer(nompred_dom ~ CWV + (1 | MID_dom),
data = df_s3b_managers_elg,
family = binomial)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")
| term | estimate | conf.int | statistic | p.value |
|---|---|---|---|---|
| Intercept | -5.22 | [-6.87, -3.56] | -6.18 | < .001 |
| CWV | 1.11 | [0.60, 1.61] | 4.29 | < .001 |
Predictor: Competitive worldview.
Mediator: Relationship expectancy of dominant message.
Outcome: Selection of dominant message.
Random Effect: Dominant message shown.
Bootstraps: 10,000
# Step 1: Fit the mediator model
med.fit <- lme4::lmer(attitude_dom ~ CWV + (1|MID_dom), df_s3b_managers_elg, REML=F)
# Step 2: Fit the outcome model
out.fit <- lme4::lmer(is_dom ~ attitude_dom + CWV + (1|MID_dom), df_s3b_managers_elg, REML=F)
# Step 3: Conduct the mediation analysis
med.out <- mediation::mediate(med.fit, out.fit,
treat = "CWV",
mediator = "attitude_dom",
boot = FALSE,
sims = 10000,
boot.ci.type="bca")
# 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.011 | 0.002 | 0.023 | 0.0082 |
| ADE (direct) | 0.040 | 0.002 | 0.080 | 0.0408 |
| Total Effect | 0.051 | 0.013 | 0.092 | 0.0112 |
| Prop. Mediated | 0.209 | 0.042 | 0.782 | 0.0186 |
Predictor: Competitive worldview.
Mediator: Predicted nomination for “good manager” survey in case of sending the dominant message.
Outcome: Selection of dominant message.
Random Effect: Dominant message shown.
Bootstraps: 10,000
# Step 1: Fit the mediator model
med.fit <- lme4::lmer(nompred_dom ~ CWV + (1|MID_dom), df_s3b_managers_elg, REML=F)
# Step 2: Fit the outcome model
out.fit <- lme4::lmer(is_dom ~ nompred_dom + CWV + (1|MID_dom), df_s3b_managers_elg, REML=F)
# Step 3: Conduct the mediation analysis
med.out <- mediation::mediate(med.fit, out.fit,
treat = "CWV",
mediator = "nompred_dom",
boot = FALSE,
sims = 10000,
boot.ci.type="bca")
# 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.037 | 0.020 | 0.056 | 0.0000 |
| ADE (direct) | 0.016 | -0.022 | 0.054 | 0.4210 |
| Total Effect | 0.053 | 0.013 | 0.093 | 0.0074 |
| Prop. Mediated | 0.694 | 0.342 | 2.288 | 0.0074 |
Predictor: Competitive worldview.
Mediator 1: Relationship expectancy of dominant message.
Mediator 2: Compliance expectancy of dominant message.
Outcome: Selection of dominant message.
Random Effect: Dominant message shown.
Bootstraps: 10,000
model <- '
# Mediator regressions
attitude_dom ~ a1 * CWV
comp_dom ~ a2 * CWV
# Outcome regression
is_dom ~ b1 * attitude_dom + b2 * comp_dom + c_prime * CWV
# Indirect effects
ind1 := a1 * b1
ind2 := a2 * b2
ind_total := ind1 + ind2
total := c_prime + ind_total
'
fit <- sem(model, data = df_s3b_managers_elg,
cluster = "message_dom",
se = "robust.cluster")
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.2874319 | 0.1119319 | 0.0680494 | 0.5068145 | 0.0102312 |
| a2 | 0.7604819 | 1.0204737 | -1.2396097 | 2.7605736 | 0.4561361 |
| b1 | 0.0372953 | 0.0099220 | 0.0178485 | 0.0567422 | 0.0001707 |
| b2 | 0.0004684 | 0.0014003 | -0.0022762 | 0.0032130 | 0.7380086 |
| c_prime | 0.0404075 | 0.0207452 | -0.0002524 | 0.0810674 | 0.0514390 |
| ind1 | 0.0107199 | 0.0048522 | 0.0012097 | 0.0202300 | 0.0271552 |
| ind2 | 0.0003562 | 0.0009081 | -0.0014236 | 0.0021360 | 0.6948640 |
| ind_total | 0.0110761 | 0.0047417 | 0.0017825 | 0.0203697 | 0.0194975 |
| total | 0.0514836 | 0.0209192 | 0.0104828 | 0.0924844 | 0.0138521 |
att_outcome <- df_s3b_employees_elg %>%
filter(!is.na(is_dom)) %>%
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_s3b_employees_elg %>%
filter(!is.na(is_dom)) %>%
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_s3b_employees_elg %>%
filter(!is.na(is_dom)) %>%
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,"aff","dom")) %>%
pivot_wider(names_from = is_dom,
values_from = values) %>%
mutate(aff = round(aff,2),
dom = round(dom,2)) %>%
kbl() %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")
| aff | dom | |
|---|---|---|
| N | 149.00 | 152.00 |
| attitude | 5.38 | 2.82 |
| rec | 0.89 | 0.41 |
| points | 31.74 | 26.24 |
Employees who received the dominant message (N = 152) 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.
mean_points <- df_s3b_employees_elg %>%
filter(is_dom == 1) %>%
summarise(mean = mean(points,na.rm = T)) %>%
pull()
df_s3b_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"))
mean_att <- df_s3b_employees_elg %>%
filter(is_dom == 1) %>%
summarise(mean = mean(attitude,na.rm = T)) %>%
pull()
df_s3b_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"))
mean_rec <- df_s3b_employees_elg %>%
filter(is_dom == 1) %>%
summarise(mean = mean(rec,na.rm = T)) %>%
pull()
df_s3b_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"))
Employees who received the affiliative 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.
mean_points <- df_s3b_employees_elg %>%
filter(is_dom == 0) %>%
summarise(mean = mean(points,na.rm = T)) %>%
pull()
df_s3b_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"))
mean_att <- df_s3b_employees_elg %>%
filter(is_dom == 0) %>%
summarise(mean = mean(attitude,na.rm = T)) %>%
pull()
df_s3b_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"))
mean_rec <- df_s3b_employees_elg %>%
filter(is_dom == 0) %>%
summarise(mean = mean(rec,na.rm = T)) %>%
pull()
df_s3b_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"))
Analyzing if manager CWV is associated with accuracy in relationship expectancy in the case of dominant message selection.
Comparison point: 2.8157895
df_forJNI <- df_s3b_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.828195 | 0.4822376 | 0.1192471 | 0.2480354 | 0.7164397 | 4.0440176 | 0.0000595 |
| 2.607095 | 0.2583570 | 0.0842848 | 0.0928211 | 0.4238930 | 3.0652856 | 0.0022744 |
| 3.385994 | 0.0344765 | 0.1192471 | -0.1997257 | 0.2686787 | 0.2891183 | 0.7725928 |
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. | p |
|---|---|---|---|---|---|---|
| 1.828195 | 2.574671 | 0.0596236 | 2.457570 | 2.691772 | 43.18209 | 0 |
| 2.607095 | 2.686611 | 0.0421424 | 2.603843 | 2.769379 | 63.75077 | 0 |
| 3.385994 | 2.798551 | 0.0596236 | 2.681450 | 2.915652 | 46.93699 | 0 |
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.82, 18.78], the slope of is_outcome is
## p < .05.
##
## Note: The range of observed values of CWV is [1.00, 4.60]
##
## Interval calculated using false discovery rate adjusted t = 2.24
plot <- johnson_neyman(fiti,
pred = "is_outcome",
modx = "CWV",
control.fdr = T,
alpha = 0.05)
plot$plot
Analyzing if CWV is associated with accuracy in nomination for the “good manager” survey in the case of dominant message selection.
Comparison point: 2.8157895
df_forJNI <- df_s3b_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.828195 | 0.3734896 | 0.0263951 | 0.3216495 | 0.4253297 | 14.149979 | 0 |
| 2.607095 | 0.2894737 | 0.0186562 | 0.2528327 | 0.3261147 | 15.516186 | 0 |
| 3.385994 | 0.2054578 | 0.0263951 | 0.1536177 | 0.2572978 | 7.783946 | 0 |
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. | p |
|---|---|---|---|---|---|---|
| 1.828195 | 0.2277289 | 0.0131975 | 0.2018088 | 0.2536489 | 17.25541 | 0 |
| 2.607095 | 0.2697368 | 0.0093281 | 0.2514164 | 0.2880573 | 28.91653 | 0 |
| 3.385994 | 0.3117448 | 0.0131975 | 0.2858248 | 0.3376648 | 23.62145 | 0 |
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 [4.25, 8.36], the slope of is_outcome is p
## < .05.
##
## Note: The range of observed values of CWV is [1.00, 4.60]
##
## Interval calculated using false discovery rate adjusted t = 1.99
plot <- johnson_neyman(fiti,
pred = "is_outcome",
modx = "CWV",
control.fdr = T,
alpha = 0.05)
plot$plot