Outlier Credibility Pre-registered Study
Samantha Grayson
2025-02-25
Study Information
Data collected on Prolific on 2/19/25
N = 200 (100 per condition; 50% woman sample)
Pre-registered: AsPredicted #213323
Data dictionary
credibility_1 = Knowledgeable
credibility_2 = Capable
credibility_3 = Competent
credibility_4 = Trustworthy
credibility_5 = Dependable
credibility_6 = Has good intentions
credibility_avg = average of credibility_1:credibility_6
face-valid credibility = “How credible is Alex as a source of information?”
presc_comfort = “How comfortable would you be with Alex’s seat choice?”
presc_accept = “How acceptable would you find Alex’s seat choice?”
presc_approp = “How appropriate would you find Alex’s seat choice?”
presc_perception = average of presc_comfort:presc_approp
influence = “Where would you be most likely to sit based on Alex’s behavior? Please use the slider to mark the likelihood:” [Values from -50 (Very likely to sit in the same seat as usual) to 50 (Very likely to sit in a different seat than usual]
Takeaways
Replicate factor loading for credibility from pilot data.
Deviants are seen as less credible (t(178) = 6.63, p < .001) [pre-registered primary analysis].
Participants are less likely to sit in their usual seat in the deviant condition (t(165) = -5.51, p < .001).
Credibility does not mediate the relationship between condition and influence [pre-registered exploratory analysis].
Credibility does mediate the relationship between condition and prescriptive norm perceptions [pre-registered exploratory analysis].
When splitting credibility into ability and intent, both ability and intent mediate the relationship between condition and influence.
Only intent mediates the relationship between condition and prescriptive norm perceptions.
Load library and data
library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ 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 errorsdata <- read.csv("~/Google Drive/My Drive/YEAR 2/PROJECTS/DEREK/Outliers and Credibility Full Study/full_data.csv") %>%
slice(-c(1:2)) %>%
filter(attn == 24) data <- data %>%
unite(geolocation, LocationLatitude, LocationLongitude) %>%
group_by(geolocation) %>%
mutate(geo_frequency = n()) %>%
filter(geo_frequency < 3) %>%
ungroup()N = 180 after exclusions
Did the manipulation work?
ggplot(data = data,
aes(x = condition, y = as.numeric(mc))) +
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() ## 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 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Let’s check out our credibility scale we developed by bringing together status beliefs and a few items from a source trustworthiness scale
Exploratory Factor analysis for a single credibility item
data_factor <- data %>%
select(credibility_1:credibility_6) %>%
mutate_if(is.character, as.numeric)
ev <- eigen(cor(data_factor)) # get eigenvalues
ev$values## [1] 4.2936244 0.6763211 0.3503314 0.2555246 0.2426297 0.1815687library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphascree(data_factor, pc=FALSE) 
Nfacs <- 2 # This is for four factors. You can change this as needed.
fit <- factanal(data_factor, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)##
## Call:
## factanal(x = data_factor, factors = Nfacs, rotation = "promax")
##
## Uniquenesses:
## credibility_1 credibility_2 credibility_3 credibility_4 credibility_5
## 0.31 0.26 0.14 0.32 0.25
## credibility_6
## 0.25
##
## Loadings:
## Factor1 Factor2
## credibility_4 0.79
## credibility_5 0.87
## credibility_6 0.80
## credibility_1 0.75
## credibility_2 0.75
## credibility_3 0.96
##
## Factor1 Factor2
## SS loadings 2.06 2.05
## Proportion Var 0.34 0.34
## Cumulative Var 0.34 0.69
##
## Factor Correlations:
## Factor1 Factor2
## Factor1 1.00 -0.76
## Factor2 -0.76 1.00
##
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 9.18 on 4 degrees of freedom.
## The p-value is 0.0568library(psych)
loads <- fit$loadings
fa.diagram(loads)
SWEET! This is exactly what we hoped to see. Factor 1 = Expertise and Factor 2 = Trustworthiness
psych::alpha(data_factor)##
## Reliability analysis
## Call: psych::alpha(x = data_factor)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.92 0.92 0.92 0.66 12 0.0095 3.7 0.75 0.63
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.9 0.92 0.94
## Duhachek 0.9 0.92 0.94
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## credibility_1 0.91 0.91 0.90 0.66 9.8 0.011 0.0057 0.64
## credibility_2 0.90 0.90 0.90 0.65 9.4 0.011 0.0058 0.62
## credibility_3 0.90 0.90 0.89 0.65 9.3 0.011 0.0045 0.64
## credibility_4 0.91 0.91 0.91 0.67 10.1 0.011 0.0067 0.64
## credibility_5 0.91 0.91 0.90 0.66 9.9 0.011 0.0060 0.64
## credibility_6 0.90 0.90 0.90 0.65 9.4 0.012 0.0074 0.61
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## credibility_1 180 0.83 0.84 0.80 0.76 3.7 0.79
## credibility_2 180 0.85 0.86 0.83 0.78 3.8 0.83
## credibility_3 180 0.85 0.86 0.84 0.79 3.8 0.85
## credibility_4 180 0.83 0.83 0.78 0.75 3.6 0.92
## credibility_5 180 0.85 0.84 0.80 0.76 3.7 0.98
## credibility_6 180 0.86 0.86 0.82 0.79 3.8 0.93
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## credibility_1 0.00 0.04 0.38 0.42 0.17 0
## credibility_2 0.00 0.04 0.35 0.38 0.23 0
## credibility_3 0.01 0.04 0.33 0.40 0.22 0
## credibility_4 0.01 0.07 0.43 0.29 0.20 0
## credibility_5 0.01 0.08 0.33 0.31 0.27 0
## credibility_6 0.02 0.03 0.35 0.34 0.26 0Alpha = 0.92. Cool. We can also use it as a single measure of credibility.
Are deviants seen as less credible?
data <- data %>%
mutate(credibility_1 = as.numeric(credibility_1)) %>%
mutate(credibility_2 = as.numeric(credibility_2)) %>%
mutate(credibility_3 = as.numeric(credibility_3)) %>%
mutate(credibility_4 = as.numeric(credibility_4)) %>%
mutate(credibility_5 = as.numeric(credibility_5)) %>%
mutate(credibility_6 = as.numeric(credibility_6)) %>%
rowwise() %>%
mutate(credibility_avg = mean(c(credibility_1, credibility_2, credibility_3, credibility_4, credibility_5, credibility_6), na.rm = T)) %>%
ungroup()ggplot(data = data,
aes(x = condition, y = credibility_avg)) +
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() ## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
t.test(credibility_avg ~ condition, data = data, var.equal = F)##
## Welch Two Sample t-test
##
## data: credibility_avg by condition
## t = 6.6285, df = 177.97, p-value = 3.906e-10
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## 0.4647789 0.8588377
## sample estimates:
## mean in group conform mean in group deviant
## 4.065217 3.403409Yes! Yay!
Deviants are seen as less credible (t(178) = 5.02, p < .001).
Does this look similar to our face valid measure of credibility?
ggplot(data = data,
aes(x = condition, y = as.numeric(credibility))) +
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() ## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
t.test(as.numeric(credibility) ~ condition, data = data, var.equal = F)##
## Welch Two Sample t-test
##
## data: as.numeric(credibility) by condition
## t = 2.9111, df = 175.18, p-value = 0.00407
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## 0.09435309 0.49161529
## sample estimates:
## mean in group conform mean in group deviant
## 3.554348 3.261364Yep. Pretty much.
Are deviants influential?
data <- data %>%
mutate(influence = as.numeric(influence_6))ggplot(data = data,
aes(x = condition, y = influence)) +
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)+
geom_hline(yintercept = 0, col = "red")+
theme_bw() ## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
Above horizontal line is more likely to move and under horizontal line is less likely to move based on Alex’s seat choice.
t.test(as.numeric(influence) ~ condition, data = data, var.equal = F)##
## Welch Two Sample t-test
##
## data: as.numeric(influence) by condition
## t = -5.5078, df = 165.16, p-value = 1.369e-07
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## -27.86701 -13.15967
## sample estimates:
## mean in group conform mean in group deviant
## -36.95652 -16.44318People were not likely to change their seat in general… But, the mean is higher in the norm deviant condition.
Do people perceive prescriptive norms differently by condition?
data <- data %>%
mutate(presc_accept = as.numeric(presc_accept)) %>%
mutate(presc_comfort = as.numeric(presc_comfort)) %>%
mutate(Presc_approp = as.numeric(Presc_approp)) %>%
rowwise() %>%
mutate(presc_perception = mean(c(presc_comfort, presc_accept, Presc_approp), na.rm = T)) %>%
ungroup()ggplot(data = data,
aes(x = condition, y = presc_perception)) +
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() ## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
t.test(presc_perception ~ condition, data = data, var.equal = F)##
## Welch Two Sample t-test
##
## data: presc_perception by condition
## t = 9.3495, df = 163.28, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## 0.9682039 1.4866709
## sample estimates:
## mean in group conform mean in group deviant
## 4.329710 3.102273Participants report that team members view deviant behavior as less acceptable.
Mediation Model: Credibility
# Define the SEM model with specified coefficients
library(lavaan)## This is lavaan 0.6-18
## lavaan is FREE software! Please report any bugs.##
## Attaching package: 'lavaan'## The following object is masked from 'package:psych':
##
## cor2covlibrary(parallel)
model <- '
# Regression coefficients
credibility_avg ~ a*condition
influence ~ cprime*condition + b*credibility_avg
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = data)## Warning: lavaan->lav_data_full():
## some observed variances are (at least) a factor 1000 times larger than
## others; use varTable(fit) to investigate# Summarize results
summary(fit)## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## credibility_avg ~
## conditn (a) -0.662 0.099 -6.661 0.000
## influence ~
## conditn (cprm) 19.366 4.109 4.713 0.000
## crdblt_ (b) -1.733 2.761 -0.628 0.530
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .credibility_vg 0.444 0.047 9.487 0.000
## .influence 609.186 64.214 9.487 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 1.147 1.835 0.625 0.532SHOOT!
library(lavaanPlot)
lavaanPlot(model = fit,
labels = list(condition = "Condition", credibility_avg = "Credibility", influence = "Influence"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Mediation Model: Predicting prescriptive norm perception via credibility
# Define the SEM model with specified coefficients
model <- '
# Regression coefficients
credibility_avg ~ a*condition
presc_perception ~ cprime*condition + b*credibility_avg
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = data)
# Summarize results
summary(fit)## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## credibility_avg ~
## conditn (a) -0.662 0.099 -6.661 0.000
## presc_perception ~
## conditn (cprm) -0.845 0.130 -6.500 0.000
## crdblt_ (b) 0.578 0.087 6.624 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .credibility_vg 0.444 0.047 9.487 0.000
## .presc_perceptn 0.609 0.064 9.487 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect -0.383 0.081 -4.697 0.000library(lavaanPlot)
lavaanPlot(model = fit,
labels = list(condition = "Condition", credibility_avg = "Credibility", presc_perception = "Precriptive Norms"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Ok, so here we have mediation…
Correlation between credibility and influence in the deviant condition
data_deviant <- data %>%
filter(condition == "deviant")ggplot(data = data_deviant,
aes(x = credibility_avg, y = influence)) +
geom_smooth(method = "lm",
se = TRUE,
size = 1) +
theme_bw()## `geom_smooth()` using formula = 'y ~ x'
cor.test(data_deviant$credibility_avg, data_deviant$influence)##
## Pearson's product-moment correlation
##
## data: data_deviant$credibility_avg and data_deviant$influence
## t = 0.9341, df = 86, p-value = 0.3529
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.111564 0.303296
## sample estimates:
## cor
## 0.10022Parallel Mediation with ability and intent
data <- data %>%
rowwise() %>%
mutate(ability = mean(c(credibility_1, credibility_2, credibility_3), na.rm = T)) %>%
mutate(intent = mean(c(credibility_4, credibility_5, credibility_6), na.rm = T)) %>%
ungroup()model <- '
# Direct effects
ability ~ a1*condition
intent ~ a2*condition
influence ~ c*condition + b1*ability + b2*intent
# Covariance between mediators
ability ~~ intent
# Indirect effects
indirect1 := a1 * b1
indirect2 := a2 * b2
# Total effect
total := c + (a1*b1) + (a2*b2)
'
fit <- sem(model = model, data = data)## Warning: lavaan->lav_data_full():
## some observed variances are (at least) a factor 1000 times larger than
## others; use varTable(fit) to investigatesummary(fit, standardized = TRUE, fit.measures = TRUE)## lavaan 0.6-18 ended normally after 12 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 230.874
## Degrees of freedom 6
## P-value 0.000
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000
## Tucker-Lewis Index (TLI) 1.000
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -1161.393
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 2340.786
## Bayesian (BIC) 2369.523
## Sample-size adjusted Bayesian (SABIC) 2341.020
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.000
## P-value H_0: RMSEA <= 0.050 NA
## P-value H_0: RMSEA >= 0.080 NA
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.000
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## ability ~
## condition (a1) -0.451 0.107 -4.213 0.000 -0.451 -0.300
## intent ~
## condition (a2) -0.872 0.108 -8.057 0.000 -0.872 -0.515
## influence ~
## condition (c) 22.934 4.246 5.402 0.000 22.934 0.429
## ability (b1) -9.568 3.531 -2.710 0.007 -9.568 -0.269
## intent (b2) 7.724 3.492 2.212 0.027 7.724 0.245
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability ~~
## .intent 0.366 0.048 7.713 0.000 0.366 0.703
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability 0.516 0.054 9.487 0.000 0.516 0.910
## .intent 0.527 0.056 9.487 0.000 0.527 0.735
## .influence 586.001 61.770 9.487 0.000 586.001 0.819
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 4.318 1.894 2.279 0.023 4.318 0.081
## indirect2 -6.738 3.159 -2.133 0.033 -6.738 -0.126
## total 20.513 3.684 5.568 0.000 20.513 0.383lavaanPlot(model = fit,
labels = list(condition = "Condition",
ability = "Ability",
intent = "Intent",
influence = "Influence"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Exploratory DV parallel Mediation with ability and intent
model <- '
# Direct effects
ability ~ a1*condition
intent ~ a2*condition
presc_perception ~ c*condition + b1*ability + b2*intent
# Covariance between mediators
ability ~~ intent
# Indirect effects
indirect1 := a1 * b1
indirect2 := a2 * b2
# Total effect
total := c + (a1*b1) + (a2*b2)
'
fit <- sem(model = model, data = data)
summary(fit, standardized = TRUE, fit.measures = TRUE)## lavaan 0.6-18 ended normally after 12 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 314.428
## Degrees of freedom 6
## P-value 0.000
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000
## Tucker-Lewis Index (TLI) 1.000
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -539.368
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1096.737
## Bayesian (BIC) 1125.474
## Sample-size adjusted Bayesian (SABIC) 1096.971
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.000
## P-value H_0: RMSEA <= 0.050 NA
## P-value H_0: RMSEA >= 0.080 NA
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.000
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## ability ~
## condition (a1) -0.451 0.107 -4.213 0.000 -0.451 -0.300
## intent ~
## condition (a2) -0.872 0.108 -8.057 0.000 -0.872 -0.515
## presc_perception ~
## condition (c) -0.726 0.134 -5.421 0.000 -0.726 -0.341
## ability (b1) 0.001 0.111 0.008 0.994 0.001 0.001
## intent (b2) 0.574 0.110 5.205 0.000 0.574 0.456
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability ~~
## .intent 0.366 0.048 7.713 0.000 0.366 0.703
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability 0.516 0.054 9.487 0.000 0.516 0.910
## .intent 0.527 0.056 9.487 0.000 0.527 0.735
## .presc_perceptn 0.584 0.062 9.487 0.000 0.584 0.515
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 -0.000 0.050 -0.008 0.994 -0.000 -0.000
## indirect2 -0.501 0.114 -4.372 0.000 -0.501 -0.235
## total -1.227 0.130 -9.456 0.000 -1.227 -0.576lavaanPlot(model = fit,
labels = list(condition = "Condition",
ability = "Ability",
intent = "Intent",
presc_perception = "Prescriptive Norm Perception"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Interesting. Seems to be that intent is pulling weight here.
New Analyses 2.26.25
Standardized credibility and influence
data <- data %>%
mutate(influence_scaled = scale(as.numeric(influence))) %>%
mutate(credibility_avg_scaled = scale(as.numeric(credibility_avg))) %>%
mutate(ability_scaled = scale(ability)) %>%
mutate(intent_scaled = scale(intent))Mediation with scaled influence and credibility
model <- '
# Regression coefficients
credibility_avg_scaled ~ a*condition
influence_scaled ~ cprime*condition + b*credibility_avg_scaled
# Indirect effect
indirect := a*b
'
# Fit the model
fit <- sem(model, data = data)
# Summarize results
summary(fit)## lavaan 0.6-18 ended normally after 1 iteration
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 5
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|)
## credibility_avg_scaled ~
## conditn (a) -0.887 0.133 -6.661 0.000
## influence_scaled ~
## conditn (cprm) 0.722 0.153 4.713 0.000
## crdbl__ (b) -0.048 0.077 -0.628 0.530
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .crdblty_vg_scl 0.798 0.084 9.487 0.000
## .influence_scld 0.846 0.089 9.487 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 0.043 0.068 0.625 0.532lavaanPlot(model = fit,
labels = list(condition = "Condition", credibility_avg_scaled = "Credibility Scaled", influence_scaled = "Influence Scaled"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Parallel Mediation
model <- '
# Direct effects
ability_scaled ~ a1*condition
intent_scaled ~ a2*condition
influence_scaled ~ c*condition + b1*ability_scaled + b2*intent_scaled
# Covariance between mediators
ability_scaled ~~ intent_scaled
# Indirect effects
indirect1 := a1 * b1
indirect2 := a2 * b2
# Total effect
total := c + (a1*b1) + (a2*b2)
'
fit <- sem(model = model, data = data)
summary(fit, standardized = TRUE, fit.measures = TRUE)## lavaan 0.6-18 ended normally after 17 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 180
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 230.874
## Degrees of freedom 6
## P-value 0.000
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000
## Tucker-Lewis Index (TLI) 1.000
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -649.286
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1316.571
## Bayesian (BIC) 1345.308
## Sample-size adjusted Bayesian (SABIC) 1316.805
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.000
## P-value H_0: RMSEA <= 0.050 NA
## P-value H_0: RMSEA >= 0.080 NA
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.000
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Regressions:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## ability_scaled ~
## condition (a1) -0.598 0.142 -4.213 0.000 -0.598 -0.300
## intent_scaled ~
## condition (a2) -1.027 0.127 -8.057 0.000 -1.027 -0.515
## influence_scaled ~
## condition (c) 0.855 0.158 5.402 0.000 0.855 0.429
## ablty_scl (b1) -0.269 0.099 -2.710 0.007 -0.269 -0.269
## intnt_scl (b2) 0.245 0.111 2.212 0.027 0.245 0.245
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability_scaled ~~
## .intent_scaled 0.572 0.074 7.713 0.000 0.572 0.703
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability_scaled 0.905 0.095 9.487 0.000 0.905 0.910
## .intent_scaled 0.731 0.077 9.487 0.000 0.731 0.735
## .influence_scld 0.814 0.086 9.487 0.000 0.814 0.819
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 0.161 0.071 2.279 0.023 0.161 0.081
## indirect2 -0.251 0.118 -2.133 0.033 -0.251 -0.126
## total 0.765 0.137 5.568 0.000 0.765 0.383lavaanPlot(model = fit,
labels = list(condition = "Condition",
ability_scaled = "Ability Scaled",
intent_scaled = "Intent Scaled",
influence_scaled = "Influence Scaled"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Regression models with face-valid credibility predicting influence and presc norm
data <- data %>%
mutate(credibility_fv_scaled = scale(as.numeric(credibility)))lm(influence_scaled ~ credibility_fv_scaled, data=data) %>% summary()##
## Call:
## lm(formula = influence_scaled ~ credibility_fv_scaled, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.1755 -0.7830 -0.5041 0.9127 2.9446
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.620e-17 7.444e-02 0.000 1.000
## credibility_fv_scaled -9.046e-02 7.465e-02 -1.212 0.227
##
## Residual standard error: 0.9987 on 178 degrees of freedom
## Multiple R-squared: 0.008183, Adjusted R-squared: 0.002611
## F-statistic: 1.469 on 1 and 178 DF, p-value: 0.2272lm(presc_perception ~ as.numeric(credibility), data=data) %>% summary()##
## Call:
## lm(formula = presc_perception ~ as.numeric(credibility), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1082 -0.4654 -0.1081 0.8680 2.8202
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.5370 0.3664 4.195 4.29e-05 ***
## as.numeric(credibility) 0.6428 0.1053 6.106 6.25e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9739 on 178 degrees of freedom
## Multiple R-squared: 0.1732, Adjusted R-squared: 0.1685
## F-statistic: 37.28 on 1 and 178 DF, p-value: 6.251e-09Regression models with ability predicting influence and presc norm
lm(influence_scaled ~ ability_scaled, data=data) %>% summary()##
## Call:
## lm(formula = influence_scaled ~ ability_scaled, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.3740 -0.7648 -0.4051 0.7432 3.0317
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.030e-16 7.292e-02 0 1.00000
## ability_scaled -2.194e-01 7.313e-02 -3 0.00309 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9784 on 178 degrees of freedom
## Multiple R-squared: 0.04813, Adjusted R-squared: 0.04278
## F-statistic: 9 on 1 and 178 DF, p-value: 0.003087lm(presc_perception ~ as.numeric(ability), data=data) %>% summary()##
## Call:
## lm(formula = presc_perception ~ as.numeric(ability), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4882 -0.5516 0.1278 0.7171 1.7438
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.40821 0.36683 3.839 0.000172 ***
## as.numeric(ability) 0.61600 0.09545 6.453 1e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9641 on 178 degrees of freedom
## Multiple R-squared: 0.1896, Adjusted R-squared: 0.1851
## F-statistic: 41.65 on 1 and 178 DF, p-value: 1.003e-09Regression models with intent predicting influence and presc norm
lm(influence_scaled ~ intent_scaled, data=data) %>% summary()##
## Call:
## lm(formula = influence_scaled ~ intent_scaled, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.4109 -0.7387 -0.4329 0.8432 2.9255
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.018e-16 7.363e-02 0.000 1.0000
## intent_scaled -1.723e-01 7.383e-02 -2.334 0.0207 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9878 on 178 degrees of freedom
## Multiple R-squared: 0.0297, Adjusted R-squared: 0.02425
## F-statistic: 5.449 on 1 and 178 DF, p-value: 0.02069lm(presc_perception ~ as.numeric(intent), data=data) %>% summary()##
## Call:
## lm(formula = presc_perception ~ as.numeric(intent), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.15310 -0.44135 0.04362 0.50538 1.83871
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.77602 0.27819 2.79 0.00585 **
## as.numeric(intent) 0.79509 0.07301 10.89 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8297 on 178 degrees of freedom
## Multiple R-squared: 0.3998, Adjusted R-squared: 0.3965
## F-statistic: 118.6 on 1 and 178 DF, p-value: < 2.2e-16Regression models with all three predicting influence and presc norm
lm(influence_scaled ~ ability_scaled + intent_scaled + credibility_fv_scaled, data=data) %>% summary()##
## Call:
## lm(formula = influence_scaled ~ ability_scaled + intent_scaled +
## credibility_fv_scaled, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.5320 -0.7226 -0.3835 0.7609 2.9859
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.846e-16 7.316e-02 0.000 1.0000
## ability_scaled -2.311e-01 1.128e-01 -2.050 0.0419 *
## intent_scaled -5.693e-02 1.125e-01 -0.506 0.6135
## credibility_fv_scaled 8.658e-02 9.769e-02 0.886 0.3767
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9816 on 176 degrees of freedom
## Multiple R-squared: 0.05269, Adjusted R-squared: 0.03654
## F-statistic: 3.263 on 3 and 176 DF, p-value: 0.02278lm(presc_perception ~ as.numeric(ability) + as.numeric(intent) + as.numeric(credibility), data=data) %>% summary()##
## Call:
## lm(formula = presc_perception ~ as.numeric(ability) + as.numeric(intent) +
## as.numeric(credibility), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3556 -0.4675 0.0298 0.4790 2.0170
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.7662 0.3496 2.192 0.0297 *
## as.numeric(ability) -0.1110 0.1266 -0.877 0.3818
## as.numeric(intent) 0.8154 0.1123 7.264 1.17e-11 ***
## as.numeric(credibility) 0.1033 0.1197 0.863 0.3895
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8317 on 176 degrees of freedom
## Multiple R-squared: 0.4037, Adjusted R-squared: 0.3936
## F-statistic: 39.73 on 3 and 176 DF, p-value: < 2.2e-16correlations
cor.test(data$intent, data$ability)##
## Pearson's product-moment correlation
##
## data: data$intent and data$ability
## t = 14.208, df = 178, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6522533 0.7909074
## sample estimates:
## cor
## 0.7289722cor.test(as.numeric(data$credibility), data$intent)##
## Pearson's product-moment correlation
##
## data: as.numeric(data$credibility) and data$intent
## t = 10.35, df = 178, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5126507 0.6967513
## sample estimates:
## cor
## 0.6129536cor.test(as.numeric(data$credibility), data$ability)##
## Pearson's product-moment correlation
##
## data: as.numeric(data$credibility) and data$ability
## t = 10.405, df = 178, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5150452 0.6984216
## sample estimates:
## cor
## 0.6149806lm(presc_perception ~ credibility_avg + as.numeric(credibility), data=data) %>% summary()##
## Call:
## lm(formula = presc_perception ~ credibility_avg + as.numeric(credibility),
## data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3709 -0.4643 0.0246 0.5620 2.0638
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.51971 0.36239 1.434 0.153
## credibility_avg 0.77528 0.11649 6.655 3.42e-10 ***
## as.numeric(credibility) 0.09061 0.12569 0.721 0.472
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8734 on 177 degrees of freedom
## Multiple R-squared: 0.3387, Adjusted R-squared: 0.3312
## F-statistic: 45.32 on 2 and 177 DF, p-value: < 2.2e-16lm(intent ~ condition, data = data) %>% summary()##
## Call:
## lm(formula = intent ~ condition, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.26894 -0.47464 0.06439 0.73106 1.73106
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.14130 0.07613 54.398 < 2e-16 ***
## conditiondeviant -0.87236 0.10888 -8.012 1.43e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7302 on 178 degrees of freedom
## Multiple R-squared: 0.2651, Adjusted R-squared: 0.2609
## F-statistic: 64.2 on 1 and 178 DF, p-value: 1.427e-13lm(ability ~ condition, data = data) %>% summary()##
## Call:
## lm(formula = ability ~ condition, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.53788 -0.53788 0.01087 0.46212 1.46212
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.9891 0.0753 52.97 < 2e-16 ***
## conditiondeviant -0.4512 0.1077 -4.19 4.39e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7223 on 178 degrees of freedom
## Multiple R-squared: 0.08977, Adjusted R-squared: 0.08466
## F-statistic: 17.56 on 1 and 178 DF, p-value: 4.387e-05