RTD Exploratory Study
Samantha Grayson
2024-11-11
Hi Daniel! Here are the results of our pilot. We had N = 350 (approximately 100 participants per condition after exclusions) participants respond to a bunch of self report measures after we exposed them to a vignette. In this vignette, we manipulated whether the participants encountered an endorsement of an unconventional idea, a dismissal of an unconventional idea, or no reaction to an unconventional idea.
Here is the vignette we used:
Jamie:
“So, it sounds like we’re going with a two-hour presentation where the new hires will listen to an overview of the company’s history, mission, and key policies. That seems to be working for everyone?”
Taylor:
“Yeah, that works.”
Alex:
“How about this: What if instead of a presentation, we drop new hires into a virtual escape room? They’d solve puzzles that teach them the same things—our history, mission, and policies—but in a different way.”
[This is not shown in the control] Taylor:
“I [don’t really] like it. It’s [not] feasible/efficient/effective and it [doesn’t] aligns with our goals.”
You:
…
Question text is commented below for each of the visuals / analyses.
Load Libraries
library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsLoad data
data <- read.csv("~/Google Drive/My Drive/YEAR 2/PROJECTS/DANIEL/RTDs/Study 1/Data/study1_11.11.24.csv") %>%
slice(-c(1:2)) %>%
filter(attn == 1) %>%
mutate(Condition = ifelse(FL_7_DO == "Endorsementconditions", "Endorse",
ifelse(FL_7_DO == "DismissalConditions", "Dismiss",
ifelse(FL_7_DO == "ControlCondition", "Control", NA))))Assessing Perceived Quality Differences Across Conditions
Question:
Quality: How do you rate the quality of Alex’s idea?
ggplot(data = data,
aes(x = Condition, y = as.numeric(quality))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Idea Quality Rating")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
# Fit model
model <- data %>%
mutate(Condition = relevel(as.factor(Condition), ref = "Control")) %>%
lm(as.numeric(quality) ~ Condition, .)
# Display model summary
summary(model)##
## Call:
## lm(formula = as.numeric(quality) ~ Condition, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9200 -0.8350 0.1650 0.4732 1.4732
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.83505 0.10554 36.336 <2e-16 ***
## ConditionDismiss -0.30827 0.14418 -2.138 0.0333 *
## ConditionEndorse 0.08495 0.14814 0.573 0.5668
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.039 on 306 degrees of freedom
## Multiple R-squared: 0.02699, Adjusted R-squared: 0.02063
## F-statistic: 4.244 on 2 and 306 DF, p-value: 0.0152Interpretation
An RTD of dismissal makes perceptions of deviant idea quality lower (b = -0.30827, p = 0.03). There is not a positive effect of endorsement on perceptions of deviant idea quality (b = 0.08495, p = 0.5).
Relationship between perceived idea quality and influence of RTD
Questions:
Quality: How do you rate the quality of Alex’s idea?
Influence: How much were you influenced by Taylor’s opinion in making your own judgment about Alex’s idea?
ggplot(data,
aes(x = as.numeric(quality), y = as.numeric(taylor_weight), color = Condition))+
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.05)) +
geom_smooth(method=lm, se = F)+
theme_bw()+
labs(x ="Idea Quality Rating", y = "Self-reported RTD Influence")## `geom_smooth()` using formula = 'y ~ x'
# Fit model
model <- data %>%
mutate(Condition = relevel(as.factor(Condition), ref = "Control")) %>%
lm(as.numeric(taylor_weight) ~ Condition * as.numeric(quality), .)
# Display model summary
summary(model)##
## Call:
## lm(formula = as.numeric(taylor_weight) ~ Condition * as.numeric(quality),
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.4306 -0.8022 -0.0940 0.3786 3.1978
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.50083 0.35938 4.176 3.88e-05 ***
## ConditionDismiss 1.13555 0.47339 2.399 0.0171 *
## ConditionEndorse -0.10692 0.54242 -0.197 0.8439
## as.numeric(quality) 0.06027 0.09025 0.668 0.5048
## ConditionDismiss:as.numeric(quality) -0.26603 0.12300 -2.163 0.0313 *
## ConditionEndorse:as.numeric(quality) 0.11476 0.13527 0.848 0.3969
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9524 on 303 degrees of freedom
## Multiple R-squared: 0.05046, Adjusted R-squared: 0.03479
## F-statistic: 3.221 on 5 and 303 DF, p-value: 0.007543Interpretation
Those in the dismissal RTD condition reported that as quality went up, self reported influence of the RTD went down, as compared to the control condition.
Assessing Propensity to Raise a New Idea Across Conditions
Question:
Raise: How likely are you to raise a new idea for onboarding to the group?
ggplot(data = data,
aes(x = Condition, y = as.numeric(raise))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Likelihood of Raising a New Idea")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Assessing Propensity to Generate a New Idea Across Conditions
Question:
Generate: How likely are you to generate a new idea for onboarding?
ggplot(data = data,
aes(x = Condition, y = as.numeric(generate))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Likelihood of Generating a New Idea")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Assessing Interest for the Group Across Conditions
Question:
Group Interest: How much would you want the group to hear more about and discuss Alex’s idea?
ggplot(data = data,
aes(x = Condition, y = as.numeric(group_interest))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Interest in the Idea")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Assessing Interest in Other Directions for the Group Across Conditions
Question:
Group Explore: How much would you want the group to explore other directions in addition to Alex’s idea?
ggplot(data = data,
aes(x = Condition, y = as.numeric(group_explore))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Interest in Exploring Other Ideas")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Interpretation
Not much here for our other DVs.
What do people think about Alex’s status?
ggplot(data = data,
aes(x = Condition, y = as.numeric(WSS2_Alex))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Alex's Status")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
# Fit model
model <- data %>%
mutate(Condition = relevel(as.factor(Condition), ref = "Control")) %>%
lm(as.numeric(WSS2_Alex) ~ Condition, .)
# Display model summary
summary(model)##
## Call:
## lm(formula = as.numeric(WSS2_Alex) ~ Condition, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.96429 -0.43000 0.03571 0.57000 2.03571
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.35052 0.07443 45.013 < 2e-16 ***
## ConditionDismiss -0.38623 0.10168 -3.798 0.000176 ***
## ConditionEndorse 0.07948 0.10447 0.761 0.447353
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7331 on 306 degrees of freedom
## Multiple R-squared: 0.07485, Adjusted R-squared: 0.0688
## F-statistic: 12.38 on 2 and 306 DF, p-value: 6.771e-06Interpretation
An RTD of dismissal makes perceptions of deviant’ idea quality’s status lower (b = -0.38623, p < 0.001). There is not a positive effect of endorsement on perceptions of deviant idea quality (b = 0.07948, p = 0.45).
What do people think about the reactor’s status?
ggplot(data = data,
aes(x = Condition, y = as.numeric(WSS2_Taylor))) +
geom_point(alpha = 0.1,
size = 2,
position = position_jitter(0.1)) +
stat_summary(fun.data = "mean_cl_boot",
size = 1,
geom = "linerange",
color = "grey50")+
stat_summary(fun = "mean",
size = 0.3)+
theme_bw() +
labs(y = "Taylor's Status")## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_segment()`).
# Fit model
model <- data %>%
mutate(Condition = relevel(as.factor(Condition), ref = "Control")) %>%
lm(as.numeric(WSS2_Taylor) ~ Condition, .)
# Display model summary
summary(model)##
## Call:
## lm(formula = as.numeric(WSS2_Taylor) ~ Condition, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2887 -0.5000 -0.2887 0.5000 1.7113
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.28866 0.06791 48.428 <2e-16 ***
## ConditionDismiss 0.21134 0.09276 2.278 0.0234 *
## ConditionEndorse 0.23134 0.09531 2.427 0.0158 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6688 on 306 degrees of freedom
## Multiple R-squared: 0.0233, Adjusted R-squared: 0.01691
## F-statistic: 3.649 on 2 and 306 DF, p-value: 0.02714Interpretation
A reaction makes you higher status than no reaction.
How frequently do people face this type of situation?
Question:
How often: How often are you in a situation where a team member raises an unconventional idea and you have to decide how to respond? (1 = Never, 5 = Very often)
table(data$how_often)##
## 1 2 3 4 5
## 31 98 150 24 6Interpretation
Ok, this is a phenomenon that people encounter rarely/sometimes. Good to know!