Outlier Credibility Pilot 2
Samantha Grayson
2025-02-12
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.3 ✔ 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 Pilot 2/raw_pilot_data.csv") %>%
slice(-c(1:2)) %>%
filter(attn == 24) 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.6600366 0.5144854 0.2963141 0.2093874 0.1821505 0.1376260library(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.21 0.21 0.16 0.10 0.22
## credibility_6
## 0.31
##
## Loadings:
## Factor1 Factor2
## credibility_1 0.84
## credibility_2 0.92
## credibility_3 0.81
## credibility_4 0.97
## credibility_5 0.78
## credibility_6 0.31 0.56
##
## Factor1 Factor2
## SS loadings 2.30 1.89
## Proportion Var 0.38 0.31
## Cumulative Var 0.38 0.70
##
## Factor Correlations:
## Factor1 Factor2
## Factor1 1.00 0.81
## Factor2 0.81 1.00
##
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 9.59 on 4 degrees of freedom.
## The p-value is 0.0479library(psych)
loads <- fit$loadings
fa.diagram(loads)
SWEET! This is exactly what we hoped to see. Factor 1 = Expertise and Factor 2 = Trustworthiness
alpha(data_factor, check.keys=TRUE)##
## Reliability analysis
## Call: alpha(x = data_factor, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.94 0.94 0.94 0.73 16 0.0065 3.6 0.78 0.73
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.93 0.94 0.95
## Duhachek 0.93 0.94 0.95
##
## 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.93 0.93 0.93 0.73 14 0.0078 0.0038 0.74
## credibility_2 0.93 0.93 0.93 0.74 14 0.0076 0.0029 0.74
## credibility_3 0.93 0.93 0.92 0.72 13 0.0083 0.0038 0.69
## credibility_4 0.93 0.93 0.92 0.73 13 0.0081 0.0037 0.71
## credibility_5 0.93 0.93 0.93 0.74 14 0.0077 0.0038 0.75
## credibility_6 0.93 0.93 0.93 0.74 14 0.0077 0.0044 0.72
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## credibility_1 199 0.87 0.88 0.85 0.82 3.6 0.81
## credibility_2 199 0.86 0.87 0.84 0.81 3.8 0.83
## credibility_3 199 0.91 0.91 0.90 0.86 3.7 0.86
## credibility_4 199 0.89 0.89 0.87 0.84 3.5 0.91
## credibility_5 199 0.88 0.87 0.85 0.82 3.6 1.00
## credibility_6 199 0.87 0.86 0.82 0.80 3.7 0.90
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## credibility_1 0.01 0.05 0.43 0.37 0.15 0
## credibility_2 0.01 0.03 0.39 0.38 0.21 0
## credibility_3 0.01 0.06 0.33 0.40 0.21 0
## credibility_4 0.01 0.11 0.40 0.34 0.15 0
## credibility_5 0.02 0.12 0.35 0.30 0.21 0
## credibility_6 0.01 0.07 0.38 0.34 0.22 0Alpha = 0.94. 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(credibility_1: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 = 5.1274, df = 196.06, p-value = 7.023e-07
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## 0.3295185 0.7414336
## sample estimates:
## mean in group conform mean in group deviant
## 3.911765 3.376289Yes! Yay!
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 = 4.224, df = 196.17, p-value = 3.672e-05
## alternative hypothesis: true difference in means between group conform and group deviant is not equal to 0
## 95 percent confidence interval:
## 0.2278155 0.6268438
## sample estimates:
## mean in group conform mean in group deviant
## 3.509804 3.082474Yep. Pretty much.
Are deviants influential?
data <- data %>%
mutate(influence = as.numeric(influence))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)+
theme_bw() ## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_segment()`).
The item was: How likely are you to change your seating pattern based on Alex’s behavior. What we see here is that some participants will follow Alex’s lead in the deviant condition. Obviously, in the conform condition, participants aren’t changing their seats, because Alex didn’t change (maybe rethink item for future). I think it’s a good sign that we see some variance in the 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(presc_comfort: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 = 15.004, df = 171.9, 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:
## 1.643364 2.141253
## sample estimates:
## mean in group conform mean in group deviant
## 4.289216 2.396907Participants report that team members view deviant behavior as less acceptable.
Are deviants seen as more self interested / less team interested
data <- data %>%
mutate(selfinterest_1 = as.numeric(selfinterest_1)) %>%
mutate(selfinterest_2 = as.numeric(selfinterest_2)) %>%
mutate(selfinterest_3 = as.numeric(selfinterest_3)) %>%
mutate(teaminterest_1 = as.numeric(teaminterest_1)) %>%
mutate(teaminterest_2 = as.numeric(teaminterest_2)) %>%
mutate(teaminterest_3 = as.numeric(teaminterest_3)) %>%
rowwise() %>%
mutate(selfinterest = mean(selfinterest_1:selfinterest_3, na.rm = T)) %>%
mutate(teaminterest = mean(teaminterest_1:teaminterest_3, na.rm = T)) %>%
ungroup()ggplot(data = data,
aes(x = condition, y = selfinterest)) +
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()`).
ggplot(data = data,
aes(x = condition, y = teaminterest)) +
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()`).
Yes! This suggests another potential mechanism. Deviants are seen as more self interested and therefore may be less influential. Is there a literature to suggest perceived self interest varies depending on demographic information?
Difference score approach
data <- data %>%
rowwise() %>%
mutate(interest_diff = selfinterest - teaminterest) %>%
ungroup()ggplot(data = data,
aes(x = condition, y = interest_diff)) +
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()`).
This suggests that deviants are more self interested than team interested,. while conformists are more team interested than self interested.
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)
# 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 199
##
## 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.535 0.104 -5.156 0.000
## influence ~
## conditn (cprm) 0.671 0.161 4.167 0.000
## crdblt_ (b) 0.233 0.103 2.261 0.024
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .credibility_vg 0.536 0.054 9.975 0.000
## .influence 1.136 0.114 9.975 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect -0.125 0.060 -2.071 0.038Ok! We have evidence of mediation! The indirect path is significant.
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: Self-interest
# Define the SEM model with specified coefficients
model <- '
# Regression coefficients
selfinterest ~ a*condition
influence ~ cprime*condition + b*selfinterest
# 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 199
##
## 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|)
## selfinterest ~
## conditn (a) 0.599 0.115 5.184 0.000
## influence ~
## conditn (cprm) 0.418 0.161 2.597 0.009
## slfntrs (b) 0.213 0.093 2.299 0.022
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .selfinterest 0.663 0.066 9.975 0.000
## .influence 1.135 0.114 9.975 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect 0.128 0.061 2.102 0.036Also evidence of mediation here
lavaanPlot(model = fit,
labels = list(condition = "Condition", selfinterest = "Self Interest", influence = "Influence"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Mediation Model: Self-interest diff score
# Define the SEM model with specified coefficients
model <- '
# Regression coefficients
interest_diff ~ a*condition
influence ~ cprime*condition + b*interest_diff
# 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 199
##
## 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|)
## interest_diff ~
## conditn (a) 1.415 0.172 8.226 0.000
## influence ~
## conditn (cprm) 0.548 0.177 3.093 0.002
## intrst_ (b) -0.002 0.063 -0.027 0.978
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .interest_diff 1.471 0.148 9.975 0.000
## .influence 1.166 0.117 9.975 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect -0.002 0.089 -0.027 0.978Doesn’t hold…
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 199
##
## 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.535 0.104 -5.156 0.000
## presc_perception ~
## conditn (cprm) -1.671 0.124 -13.438 0.000
## crdblt_ (b) 0.413 0.080 5.186 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .credibility_vg 0.536 0.054 9.975 0.000
## .presc_perceptn 0.678 0.068 9.975 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect -0.221 0.061 -3.656 0.000Mediation Model: Predicting prescriptive norm perception via self interest diff score
# Define the SEM model with specified coefficients
model <- '
# Regression coefficients
interest_diff ~ a*condition
presc_perception ~ cprime*condition + b*interest_diff
# 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 199
##
## 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|)
## interest_diff ~
## conditn (a) 1.415 0.172 8.226 0.000
## presc_perception ~
## conditn (cprm) -1.423 0.128 -11.117 0.000
## intrst_ (b) -0.332 0.046 -7.274 0.000
##
## Variances:
## Estimate Std.Err z-value P(>|z|)
## .interest_diff 1.471 0.148 9.975 0.000
## .presc_perceptn 0.608 0.061 9.975 0.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|)
## indirect -0.469 0.086 -5.449 0.000Correlation 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 = 3.2264, df = 95, p-value = 0.00172
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1224821 0.4833987
## sample estimates:
## cor
## 0.3142507Parallel Mediation with interest and credibility
model <- '
# Direct effects
credibility_avg ~ a1*condition
interest_diff ~ a2*condition
influence ~ c*condition + b1*credibility_avg + b2*interest_diff
# Covariance between mediators
credibility_avg ~~ interest_diff
# 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 9 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 199
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 132.659
## 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) -820.221
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1658.442
## Bayesian (BIC) 1688.082
## Sample-size adjusted Bayesian (SABIC) 1659.569
##
## 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
## credibility_avg ~
## condition (a1) -0.535 0.104 -5.156 0.000 -0.535 -0.343
## interest_diff ~
## condition (a2) 1.415 0.172 8.226 0.000 1.415 0.504
## influence ~
## condition (c) 0.605 0.176 3.435 0.001 0.605 0.272
## crdblty_v (b1) 0.272 0.111 2.440 0.015 0.272 0.190
## intrst_df (b2) 0.061 0.067 0.905 0.366 0.061 0.077
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .credibility_avg ~~
## .interest_diff -0.339 0.067 -5.027 0.000 -0.339 -0.381
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .credibility_vg 0.536 0.054 9.975 0.000 0.536 0.882
## .interest_diff 1.471 0.148 9.975 0.000 1.471 0.746
## .influence 1.132 0.113 9.975 0.000 1.132 0.913
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 -0.146 0.066 -2.205 0.027 -0.146 -0.065
## indirect2 0.086 0.096 0.899 0.369 0.086 0.039
## total 0.546 0.153 3.564 0.000 0.546 0.245lavaanPlot(model = fit,
labels = list(condition = "Condition",
interest_diff = "Self Interest",
credibility_avg = "Credibility",
influence = "Influence"),
coefs = TRUE,
stars = "regress",
node_options = list(shape = "box", fontname = "Helvetica"),
edge_options = list(color = "grey"))Parallel Mediation with ability and intent
data <- data %>%
rowwise() %>%
mutate(ability = mean(credibility_1:credibility_3, na.rm = T)) %>%
mutate(intent = mean(credibility_4: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)
summary(fit, standardized = TRUE, fit.measures = TRUE)## lavaan 0.6-18 ended normally after 14 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 199
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 262.702
## 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) -658.096
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1334.193
## Bayesian (BIC) 1363.833
## Sample-size adjusted Bayesian (SABIC) 1335.320
##
## 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.459 0.108 -4.255 0.000 -0.459 -0.289
## intent ~
## condition (a2) -0.704 0.109 -6.444 0.000 -0.704 -0.416
## influence ~
## condition (c) 0.731 0.166 4.409 0.000 0.731 0.328
## ability (b1) 0.039 0.158 0.247 0.805 0.039 0.028
## intent (b2) 0.237 0.156 1.518 0.129 0.237 0.181
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability ~~
## .intent 0.458 0.053 8.688 0.000 0.458 0.782
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability 0.578 0.058 9.975 0.000 0.578 0.917
## .intent 0.593 0.059 9.975 0.000 0.593 0.827
## .influence 1.123 0.113 9.975 0.000 1.123 0.905
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 -0.018 0.073 -0.247 0.805 -0.018 -0.008
## indirect2 -0.167 0.113 -1.478 0.139 -0.167 -0.075
## total 0.546 0.153 3.564 0.000 0.546 0.245lavaanPlot(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 interest and credibility
model <- '
# Direct effects
credibility_avg ~ a1*condition
interest_diff ~ a2*condition
presc_perception ~ c*condition + b1*credibility_avg + b2*interest_diff
# Covariance between mediators
credibility_avg ~~ interest_diff
# 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 9 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 199
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 323.587
## 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) -754.041
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1526.082
## Bayesian (BIC) 1555.722
## Sample-size adjusted Bayesian (SABIC) 1527.209
##
## 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
## credibility_avg ~
## condition (a1) -0.535 0.104 -5.156 0.000 -0.535 -0.343
## interest_diff ~
## condition (a2) 1.415 0.172 8.226 0.000 1.415 0.504
## presc_perception ~
## condition (c) -1.373 0.126 -10.867 0.000 -1.373 -0.532
## crdblty_v (b1) 0.239 0.080 2.988 0.003 0.239 0.144
## intrst_df (b2) -0.277 0.048 -5.734 0.000 -0.277 -0.301
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .credibility_avg ~~
## .interest_diff -0.339 0.067 -5.027 0.000 -0.339 -0.381
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .credibility_vg 0.536 0.054 9.975 0.000 0.536 0.882
## .interest_diff 1.471 0.148 9.975 0.000 1.471 0.746
## .presc_perceptn 0.582 0.058 9.975 0.000 0.582 0.350
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 -0.128 0.049 -2.585 0.010 -0.128 -0.050
## indirect2 -0.391 0.083 -4.704 0.000 -0.391 -0.152
## total -1.892 0.124 -15.208 0.000 -1.892 -0.733lavaanPlot(model = fit,
labels = list(condition = "Condition",
interest_diff = "Self Interest",
credibility_avg = "Credibility",
presc_perception = "Prescriptive Norm Perception"),
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 14 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 9
##
## Number of observations 199
##
## Model Test User Model:
##
## Test statistic 0.000
## Degrees of freedom 0
##
## Model Test Baseline Model:
##
## Test statistic 432.147
## 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) -602.658
## Loglikelihood unrestricted model (H1) NA
##
## Akaike (AIC) 1223.316
## Bayesian (BIC) 1252.956
## Sample-size adjusted Bayesian (SABIC) 1224.444
##
## 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.459 0.108 -4.255 0.000 -0.459 -0.289
## intent ~
## condition (a2) -0.704 0.109 -6.444 0.000 -0.704 -0.416
## presc_perception ~
## condition (c) -1.566 0.125 -12.481 0.000 -1.566 -0.607
## ability (b1) -0.016 0.120 -0.136 0.892 -0.016 -0.010
## intent (b2) 0.475 0.118 4.009 0.000 0.475 0.311
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability ~~
## .intent 0.458 0.053 8.688 0.000 0.458 0.782
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .ability 0.578 0.058 9.975 0.000 0.578 0.917
## .intent 0.593 0.059 9.975 0.000 0.593 0.827
## .presc_perceptn 0.643 0.064 9.975 0.000 0.643 0.386
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## indirect1 0.007 0.055 0.136 0.892 0.007 0.003
## indirect2 -0.334 0.098 -3.404 0.001 -0.334 -0.129
## total -1.892 0.124 -15.208 0.000 -1.892 -0.733lavaanPlot(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"))