Model MBAW
Problem badawczy: Czy wyniki sportowe zależą od motywacij zawodnika i podejmowanych przez niego aktywności i jaką rolę pełnią napotykane bariery w uprawianiu sportu?
A <- c(1.84, 2.57, 3.03, 1.84, 3.57, 2.95, 1.62, 3.57, 2.14, 2.78, 3.51, 2.30, 2.68, 3.35, 1.51, 2.46, 2.73, 2.73, 2.49, 1.76, 3.35, 2.16, 3.32, 2.89, 2.27, 2.43, 3.35, 2.86, 2.16, 1.70, 1.86, 2.83, 2.65, 2.43, 2.78, 3.27, 2.95, 4.08, 2.35, 3.16, 3.62, 2.59, 1.95, 3.22, 2.73, 3.16, 3.97, 1.95, 3.35, 3.89, 3.41, 4.65, 3.70, 2.38, 3.65, 2.81, 2.92, 2.62, 3.49, 4.38, 2.59, 2.30, 4.03, 2.49, 3.00, 2.57, 3.08, 2.65, 3.92, 3.16, 3.05, 1.65, 2.16)
M <- c(1.50, 2.70, 2.29, 1.38, 2.29, 1.71, 1.50, 3.42, 2.13, 2.29, 3.13, 2.00, 2.21, 2.88, 1.83, 1.58, 2.08, 1.83, 1.88, 1.46, 2.96, 1.54, 2.46, 2.29, 1.67, 2.13, 3.17, 2.79, 1.58, 1.63, 1.50, 2.75, 2.67, 2.08, 2.50, 2.58, 2.08, 3.25, 1.50, 1.50, 3.33, 2.50, 1.67, 2.54, 1.92, 1.96, 2.67, 2.04, 2.58, 2.75, 2.46, 3.54, 3.38, 2.29, 1.71, 2.13, 2.29, 2.63, 2.54, 3.29, 2.29, 1.79, 3.88, 2.04, 2.67, 1.79, 3.67, 2.38, 3.13, 2.04, 2.79, 1.25, 2.04)
B <- c(3.51, 3.00, 2.65, 3.24, 3.18, 2.43, 4.20, 2.49, 3.59, 2.10, 2.94, 3.57, 3.04, 3.14, 4.31, 4.59, 3.47, 1.78, 3.02, 3.69, 3.20, 4.02, 2.45, 2.86, 3.51, 2.86, 2.69, 2.67, 3.76, 2.00, 3.98, 3.12, 2.51, 2.59, 2.90, 2.96, 2.57, 3.06, 3.35, 2.69, 3.04, 3.65, 2.18, 2.37, 2.78, 2.98, 2.67, 3.16, 1.98, 3.78, 2.08, 2.65, 2.86, 3.76, 1.78, 3.35, 3.31, 3.59, 1.65, 2.35, 3.04, 3.71, 2.27, 2.61, 3.16, 2.06, 3.02, 3.20, 3.63, 2.22, 3.29, 3.27, 4.14)
W <- c(2.08, 2.86, 2.81, 1.54, 2.32, 3.03, 1.95, 3.49, 2.59, 2.41, 3.05, 2.16, 2.86, 3.46, 1.84, 3.08, 2.84, 1.95, 1.89, 1.84, 3.05, 2.03, 2.73, 3.35, 2.81, 2.22, 3.24, 2.78, 1.95, 1.97, 4.62, 2.49, 2.81, 2.05, 2.73, 2.62, 2.54, 2.86, 2.49, 2.57, 3.14, 2.59, 1.84, 2.57, 2.65, 2.84, 3.35, 2.27, 3.16, 2.65, 3.32, 3.00, 3.84, 1.27, 1.54, 2.84, 2.76, 2.03, 2.78, 4.30, 2.62, 2.27, 3.70, 2.32, 2.11, 2.81, 3.05, 2.22, 3.95, 2.76, 2.35, 1.51, 3.03)
MAT <- data.frame(cbind(M,B,A,W))Statystyki opisowe zmiennych
summary(MAT)## M B A W
## Min. :1.250 Min. :1.650 Min. :1.510 Min. :1.270
## 1st Qu.:1.830 1st Qu.:2.590 1st Qu.:2.380 1st Qu.:2.220
## Median :2.290 Median :3.020 Median :2.780 Median :2.650
## Mean :2.311 Mean :3.004 Mean :2.841 Mean :2.649
## 3rd Qu.:2.670 3rd Qu.:3.470 3rd Qu.:3.350 3rd Qu.:3.030
## Max. :3.880 Max. :4.590 Max. :4.650 Max. :4.620Test normalności rozkładów i poszukiwanie wartości odstających
apply(MAT, 2, nortest::lillie.test)## $M
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: newX[, i]
## D = 0.088856, p-value = 0.1646
##
##
## $B
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: newX[, i]
## D = 0.044217, p-value = 0.9771
##
##
## $A
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: newX[, i]
## D = 0.042857, p-value = 0.9845
##
##
## $W
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: newX[, i]
## D = 0.096374, p-value = 0.09005car::outlierTest(lm(A~B+M))## No Studentized residuals with Bonferonni p < 0.05
## Largest |rstudent|:
## rstudent unadjusted p-value Bonferonni p
## 55 2.513148 0.014306 NAcar::outlierTest(lm(W~A+M))## rstudent unadjusted p-value Bonferonni p
## 31 6.179054 3.9437e-08 2.8789e-06plot(lm(W~A+M),6)
MAT <- MAT[-c(31,55),] ## usuwam 'bad boys'Analiza
Podstawowy model w oparciu o SEM
library(lavaan)## This is lavaan 0.6-3## lavaan is BETA software! Please report any bugs.model <- '
W ~ A + B + M
A ~ B + M
B ~~ M
'
fit <- cfa(model, data=MAT, fixed.x = F, estimator = "MLM")
summary(fit, standardized=T, fit.measures=F)## lavaan 0.6-3 ended normally after 27 iterations
##
## Optimization method NLMINB
## Number of free parameters 10
##
## Number of observations 71
##
## Estimator ML Robust
## Model Fit Test Statistic 0.000 0.000
## Degrees of freedom 0 0
## Scaling correction factor NA
## for the Satorra-Bentler correction
##
## Parameter Estimates:
##
## Information Expected
## Information saturated (h1) model Structured
## Standard Errors Robust.sem
##
## Regressions:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## W ~
## A 0.506 0.127 3.992 0.000 0.506 0.593
## B 0.023 0.094 0.246 0.806 0.023 0.024
## M 0.191 0.107 1.785 0.074 0.191 0.200
## A ~
## B -0.228 0.084 -2.694 0.007 -0.228 -0.206
## M 0.830 0.095 8.754 0.000 0.830 0.744
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## B ~~
## M -0.096 0.042 -2.272 0.023 -0.096 -0.255
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .W 0.147 0.026 5.737 0.000 0.147 0.433
## .A 0.151 0.025 6.070 0.000 0.151 0.326
## B 0.381 0.060 6.381 0.000 0.381 1.000
## M 0.373 0.055 6.825 0.000 0.373 1.000# fitMeasures(fit, c("nfi", "rmsea", "agfi"))Jeszcze raz ten sam model, ale tym razem z obliczeniem wartości zadanych parametrów wynikających z założeń o mediacji
# model z dwiema mediacjami
model.m <- '
# direct effect
W ~ c1*B
# mediator
A ~ a1*B
W ~ b*A
# indirect effect
ab1 := a1*b
# total efect
total1 := c1 + (a1*b)
# direct effect
W ~ c2*M
# mediator
A ~ a2*M
# W ~ b*A # już zdefiniowany
# indirect effect
ab2 := a2*b
# total efect
total2 := c2 + (a2*b)
M ~~ B
'
fit.m <- sem(model.m, data=MAT, fixed.x = F, estimator = "MLM")
summary(fit.m, standardized=T, fit.measures=F)## lavaan 0.6-3 ended normally after 27 iterations
##
## Optimization method NLMINB
## Number of free parameters 10
##
## Number of observations 71
##
## Estimator ML Robust
## Model Fit Test Statistic 0.000 0.000
## Degrees of freedom 0 0
## Scaling correction factor NA
## for the Satorra-Bentler correction
##
## Parameter Estimates:
##
## Information Expected
## Information saturated (h1) model Structured
## Standard Errors Robust.sem
##
## Regressions:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## W ~
## B (c1) 0.023 0.094 0.246 0.806 0.023 0.024
## A ~
## B (a1) -0.228 0.084 -2.694 0.007 -0.228 -0.206
## W ~
## A (b) 0.506 0.127 3.992 0.000 0.506 0.593
## M (c2) 0.191 0.107 1.785 0.074 0.191 0.200
## A ~
## M (a2) 0.830 0.095 8.754 0.000 0.830 0.744
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## B ~~
## M -0.096 0.042 -2.272 0.023 -0.096 -0.255
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .W 0.147 0.026 5.737 0.000 0.147 0.433
## .A 0.151 0.025 6.070 0.000 0.151 0.326
## B 0.381 0.060 6.381 0.000 0.381 1.000
## M 0.373 0.055 6.825 0.000 0.373 1.000
##
## Defined Parameters:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## ab1 -0.115 0.053 -2.155 0.031 -0.115 -0.122
## total1 -0.092 0.104 -0.889 0.374 -0.092 -0.098
## ab2 0.420 0.108 3.877 0.000 0.420 0.441
## total2 0.611 0.087 7.016 0.000 0.611 0.641# fitMeasures(fit.m, c("nfi", "rmsea", "agfi"))Rysunek poglądowy
semPlot::semPaths(fit.m,"mod","std",
intAtSide=TRUE,
curveAdjacent = F,
layout="tree3", rotation = 2,
#layout = "spring","
style = "lisrel")
Oszacowanie wielkości mediacji za pomocą CMA
a <- lm(A~M+B, data = MAT)
bc <- lm(W~A+M+B, data = MAT)
test <- mediation::mediate(a, bc, treat="M", mediator="A", boot=TRUE, sims=500)
plot(test)
#* ACME - Averge Causual Mediation Effect - efekt pośredni
#* ADE - Average Direct Effect - efekt bezpośredni
#* Total effect - efekt całkowity
summary(test)##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.4201 0.2278 0.67 <2e-16 ***
## ADE 0.1907 -0.0204 0.39 0.096 .
## Total Effect 0.6108 0.4296 0.79 <2e-16 ***
## Prop. Mediated 0.6877 0.4007 1.03 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 71
##
##
## Simulations: 500summary(bc)##
## Call:
## lm(formula = W ~ A + M + B, data = MAT)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.14245 -0.20805 0.03609 0.24625 0.76778
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.68533 0.38830 1.765 0.0821 .
## A 0.50584 0.12029 4.205 7.92e-05 ***
## M 0.19073 0.12749 1.496 0.1394
## B 0.02299 0.08307 0.277 0.7828
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3944 on 67 degrees of freedom
## Multiple R-squared: 0.5669, Adjusted R-squared: 0.5475
## F-statistic: 29.23 on 3 and 67 DF, p-value: 3.377e-12summary(lm(W~M))##
## Call:
## lm(formula = W ~ M)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.36724 -0.31918 -0.07107 0.29491 2.43778
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.3182 0.2420 5.447 6.98e-07 ***
## M 0.5760 0.1012 5.691 2.63e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5313 on 71 degrees of freedom
## Multiple R-squared: 0.3133, Adjusted R-squared: 0.3036
## F-statistic: 32.39 on 1 and 71 DF, p-value: 2.635e-07OPIS:
Analiza rozkładów zmiennych wykazała, że wskaźniki charakteryzują się rozkładem normalnym (\(p\) > 0.05). W celu określenia wzajemnych powiązań między wskaźnikami użyto metody SEM - analizy równań strukturalnych. Hipotetyczny model sprawdzono w kolejnych krokach analizy prezentując ostateczny model z najlepszymi parametrami dopasowania do danych.
W modelu wykorzystano CMA - przyczynową analizę mediacji, do oszacowania efektu pośredniego jaką pełni Aktywność w relacji między Motywatorami a Wynikami. Między Barierami i Motywatorami istnieje słaba ujemna korelacja (\(r\) = -.25), ponadto Bariery, co wydaje się naturalne, osłabiają Aktywności (\(\beta\) = -0.228). Poziom Wyników zależy w większym stopniu (mediacja wyjaśnia 68.77% wielkości efektu) od Aktywności ( \(\beta\) = 0.506), niż od Motywatorów (\(\beta\) = 0.191), które wywołują także dodatkowy dodatni efekt za pośrednictwem Aktywności (efekt pośredni \(\beta\) = 0.420, \(CI_{.95}\) [0.216–0.660]). Motywatory wywierają silny wpływ bezpośrednio na Aktywności (\(\beta\) = 0.830). W modelu wykazano brak bezpośredniej zależności między Barierami a Wynikami (\(p\) = 0.806).