EXTENDED_TPB_ENVIRONMENTAL_CONSCIOUSNESS
Introduction
- PLS_SEM is well-suited for reflective models, especially with small-to-medium samples,complex or hierarchical latent variables, and a focus on prediction rather than strict theory testing.
- CLASSIC PROCEDURES (BUT DETERMINE FIRST IF YOUR MODEL IS FORMATIVE OR REFLECTIVE) # 1.Load packages
# install.packages("seminr")
library(seminr)
# install.packages("readxl") # run once
library(readxl)2. Load and clean data
my_data <- read_excel(path = "ENV_CON_TPB_Poland_Survey_2025.xlsx", sheet = 3)
my_data3.Review data
head(my_data)colnames(my_data)## [1] "ID" "Time"
## [3] "Sex" "Age_group"
## [5] "Age" "Province"
## [7] "Climate_change_belief" "ATT1"
## [9] "ATT2" "ATT3"
## [11] "SN1" "SN2"
## [13] "SN3" "PBC1"
## [15] "PBC2" "PBC3"
## [17] "ECD1" "ECD2"
## [19] "ECD3" "ECC1"
## [21] "ECC2" "ECC3"
## [23] "ECA1" "ECA2"
## [25] "ECA3" "PI1"
## [27] "PI2" "PI3"
## [29] "Education" "Food_choice_willingness"4. Specify measurement model (mm)
- Measurement model describes the relationship between latent variables and their measures/indicators.
- The aim: to establish the quality criteria: by test for reliability and validity of the model.
- constructs(): specify list of all construct and respective mm definition.
- List of various construct mm can be defined using:
- composite(): measurement of individual constructs. ii)interaction_term(): specifies interaction terms.
- higher_composite(): specifies hierarchial component models.
- Arguments of mm are construct_name, item_names and weights.
- (a)mode_A/correlation_weights/indicator loadings is reflective (bivariate correlation:when arrows flow from CONSTRUCT-ATT to INDICATORS-ATT1:3) and b)mode_B/regression_weights is formative (multiple regression:when arrows flow from ATT1:3 to ATT).
- REFLECTIVE MEASUREMENT MODEL (TPB model is an example: models that reflects perception).
# to create reflective mm (no need to write mode_A)
simple_mm<- constructs(
composite("PI", multi_items("PI",1:3)),
composite("ATT", multi_items("ATT",1:3)),
composite("SN", multi_items("SN",1:3)),
composite("PBC", multi_items("PBC",2:3)), #PBC1 was removed because loading=0.540 and alpha< 0.7its removal has a better effect on reliability and validity metrics/content validity (<0.708 recommendation limit)
composite("ECA", multi_items("ECA",1:3)),
composite("ECC", multi_items("ECC",1:3)),
composite("ECD", multi_items("ECD",1:3))
)
simple_mm## $composite
## [1] "PI" "PI1" "A" "PI" "PI2" "A" "PI" "PI3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ATT" "ATT1" "A" "ATT" "ATT2" "A" "ATT" "ATT3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "SN" "SN1" "A" "SN" "SN2" "A" "SN" "SN3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "PBC" "PBC2" "A" "PBC" "PBC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECA" "ECA1" "A" "ECA" "ECA2" "A" "ECA" "ECA3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECC" "ECC1" "A" "ECC" "ECC2" "A" "ECC" "ECC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECD" "ECD1" "A" "ECD" "ECD2" "A" "ECD" "ECD3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## attr(,"class")
## [1] "list" "measurement_model" "seminr_model"5. Specify structural model (sm)
- Structural model describes the relationship between the latent variables.
- relationships(): specifies all the structural relationships between constructs.
- paths(): specifies relationship between sets of antecedents and outcomes.
# to create sm
simple_sm <- relationships(
paths(from = c("ATT","SN","PBC","ECA","ECC","ECD"), to = "PI")
)
simple_sm## source target
## [1,] "ATT" "PI"
## [2,] "SN" "PI"
## [3,] "PBC" "PI"
## [4,] "ECA" "PI"
## [5,] "ECC" "PI"
## [6,] "ECD" "PI"
## attr(,"class")
## [1] "matrix" "array" "structural_model" "seminr_model"6. Estimate the structural model
- Model estimation using PLS-SEM algorithm - determines the scores of constructs to be used as input for single/multiple regression models
- Estimates are i)indicator weights/loadings of mm ii) path coefficients of sm
- Weighting scheme(ws uses estimate_pls() function) are : i)factor ws ii)path ws (most popular and recommended)
# to estimate the model
simple_model <- estimate_pls(data = my_data,
measurement_model = simple_mm,
structural_model = simple_sm,
inner_weights = path_weighting,
missing = mean_replacement,
missing_value = "-99")## Generating the seminr model## All 999 observations are valid.# summary() [gives info about sub-meta]can be used for estimate_pls(), bootstrap_model() and predict_pls() functions
summary_simple <- summary(simple_model) #shows the path coefficients and reliability
summary_simple##
## Results from package seminr (2.3.7)
##
## Path Coefficients:
## PI
## R^2 0.751
## AdjR^2 0.750
## ATT 0.119
## SN 0.124
## PBC 0.139
## ECA 0.417
## ECC 0.106
## ECD 0.130
##
## Reliability:
## alpha rhoC AVE rhoA
## ATT 0.924 0.952 0.869 0.927
## SN 0.925 0.952 0.870 0.926
## PBC 0.744 0.886 0.796 0.744
## ECA 0.864 0.917 0.787 0.866
## ECC 0.736 0.847 0.649 0.763
## ECD 0.829 0.898 0.747 0.831
## PI 0.950 0.968 0.909 0.950
##
## Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.5# plot the see estimated model
plot(simple_model) #β IS PATH COEFFICIENT ; λ IS outer loadings7.Check if the algorithm of estimated sm converge
- Before you analyse results, check if algorithm converged.
- Algorithm converge when stop criterion was reached and not the max no of iterations.
summary_simple$iterations # should be lower than 300## [1] 38. Bootstrap the estimated model
- Bootstrapping (where bootstrap the estimated PLS model= simple_model).
- Bootstrapping: estimate standard errors and compute confidence intervals.
- Final result computations should draw 10,000 subsamples (takes 4 minutes to load).
boot_simple <- bootstrap_model(
seminr_model = simple_model,
nboot = 10000,
cores = NULL,
seed = 123
)## Bootstrapping model using seminr...## SEMinR Model successfully bootstrapped# store the summary of the bootstrapped model
# A path is significant when its **t-value exceeds 1.96 and its 95% confidence interval does not include zero
summary_boot <- summary(boot_simple,alpha=0.10)
summary_boot ##
## Results from Bootstrap resamples: 10000
##
## Bootstrapped Structural Paths:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## ATT -> PI 0.119 0.119 0.032 3.708 0.067 0.172
## SN -> PI 0.124 0.124 0.027 4.673 0.081 0.168
## PBC -> PI 0.139 0.139 0.033 4.200 0.084 0.193
## ECA -> PI 0.417 0.416 0.037 11.166 0.353 0.476
## ECC -> PI 0.106 0.107 0.029 3.706 0.061 0.154
## ECD -> PI 0.130 0.130 0.036 3.562 0.070 0.190
##
## Bootstrapped Weights:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## PI1 -> PI 0.347 0.347 0.002 148.979 0.343 0.351
## PI2 -> PI 0.348 0.348 0.002 155.279 0.345 0.352
## PI3 -> PI 0.354 0.354 0.004 90.714 0.348 0.361
## ATT1 -> ATT 0.369 0.369 0.007 55.777 0.358 0.380
## ATT2 -> ATT 0.365 0.365 0.007 49.647 0.353 0.377
## ATT3 -> ATT 0.339 0.339 0.007 46.075 0.327 0.351
## SN1 -> SN 0.361 0.362 0.006 62.065 0.352 0.372
## SN2 -> SN 0.345 0.345 0.004 77.355 0.338 0.353
## SN3 -> SN 0.366 0.366 0.006 58.061 0.356 0.377
## PBC2 -> PBC 0.563 0.563 0.014 39.229 0.540 0.587
## PBC3 -> PBC 0.558 0.558 0.014 40.436 0.536 0.581
## ECA1 -> ECA 0.380 0.380 0.008 45.539 0.367 0.394
## ECA2 -> ECA 0.383 0.383 0.007 53.939 0.372 0.395
## ECA3 -> ECA 0.364 0.364 0.008 45.324 0.351 0.377
## ECC1 -> ECC 0.292 0.291 0.020 14.726 0.257 0.322
## ECC2 -> ECC 0.451 0.452 0.019 24.141 0.422 0.483
## ECC3 -> ECC 0.488 0.489 0.020 24.929 0.458 0.522
## ECD1 -> ECD 0.386 0.386 0.012 33.431 0.368 0.406
## ECD2 -> ECD 0.366 0.366 0.008 45.982 0.353 0.379
## ECD3 -> ECD 0.406 0.406 0.009 46.469 0.392 0.421
##
## Bootstrapped Loadings:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## PI1 -> PI 0.954 0.954 0.005 203.625 0.946 0.961
## PI2 -> PI 0.961 0.961 0.004 249.142 0.954 0.967
## PI3 -> PI 0.946 0.946 0.006 163.950 0.936 0.955
## ATT1 -> ATT 0.951 0.951 0.004 223.997 0.944 0.958
## ATT2 -> ATT 0.939 0.939 0.009 109.960 0.924 0.952
## ATT3 -> ATT 0.905 0.905 0.010 92.799 0.888 0.920
## SN1 -> SN 0.929 0.929 0.006 145.910 0.918 0.939
## SN2 -> SN 0.943 0.943 0.006 158.860 0.932 0.952
## SN3 -> SN 0.926 0.926 0.007 132.918 0.914 0.937
## PBC2 -> PBC 0.893 0.893 0.010 93.729 0.877 0.908
## PBC3 -> PBC 0.891 0.891 0.010 87.290 0.873 0.906
## ECA1 -> ECA 0.890 0.890 0.010 84.975 0.872 0.906
## ECA2 -> ECA 0.912 0.912 0.008 108.819 0.897 0.925
## ECA3 -> ECA 0.859 0.859 0.012 71.588 0.838 0.878
## ECC1 -> ECC 0.760 0.759 0.027 28.125 0.712 0.800
## ECC2 -> ECC 0.804 0.804 0.016 49.120 0.776 0.829
## ECC3 -> ECC 0.850 0.850 0.010 84.432 0.833 0.866
## ECD1 -> ECD 0.807 0.807 0.013 60.264 0.784 0.828
## ECD2 -> ECD 0.876 0.876 0.011 80.500 0.857 0.893
## ECD3 -> ECD 0.906 0.906 0.007 125.543 0.893 0.917
##
## Bootstrapped HTMT:
## Original Est. Bootstrap Mean Bootstrap SD 5% CI 95% CI
## ATT -> SN 0.643 0.643 0.025 0.601 0.683
## ATT -> PBC 0.743 0.744 0.029 0.695 0.790
## ATT -> ECA 0.700 0.701 0.025 0.659 0.741
## ATT -> ECC 0.518 0.519 0.036 0.458 0.576
## ATT -> ECD 0.716 0.716 0.024 0.675 0.755
## ATT -> PI 0.713 0.713 0.023 0.673 0.750
## SN -> PBC 0.754 0.754 0.028 0.707 0.799
## SN -> ECA 0.611 0.611 0.027 0.565 0.654
## SN -> ECC 0.686 0.686 0.031 0.633 0.736
## SN -> ECD 0.717 0.717 0.024 0.677 0.755
## SN -> PI 0.696 0.696 0.024 0.656 0.734
## PBC -> ECA 0.705 0.705 0.028 0.658 0.752
## PBC -> ECC 0.799 0.799 0.032 0.746 0.852
## PBC -> ECD 0.847 0.847 0.025 0.807 0.888
## PBC -> PI 0.804 0.804 0.025 0.763 0.844
## ECA -> ECC 0.677 0.677 0.029 0.628 0.724
## ECA -> ECD 0.872 0.872 0.020 0.839 0.903
## ECA -> PI 0.876 0.876 0.016 0.847 0.901
## ECC -> ECD 0.829 0.829 0.028 0.782 0.873
## ECC -> PI 0.735 0.735 0.025 0.694 0.775
## ECD -> PI 0.848 0.848 0.019 0.817 0.878
##
## Bootstrapped Total Paths:
## Original Est. Bootstrap Mean Bootstrap SD 5% CI 95% CI
## ATT -> PI 0.119 0.119 0.032 0.067 0.172
## SN -> PI 0.124 0.124 0.027 0.081 0.168
## PBC -> PI 0.139 0.139 0.033 0.084 0.193
## ECA -> PI 0.417 0.416 0.037 0.353 0.476
## ECC -> PI 0.106 0.107 0.029 0.061 0.154
## ECD -> PI 0.130 0.130 0.036 0.070 0.190# use tstat and CI from Bootstrapped Structural Paths results to check which is significant9. Evaluating estimated structural models (can be done for either formative/reflective model)
STEP 1: Assess multi-collinearity issues (VIF < 5: No multicollinearity problems)
- path coeficient can be biased if there is high collinearity
# inspect the items VIF
summary_simple$validity$vif_items # CONCLUSION: PI1 and PI2 has VIF > 5, So presence of multicollinearity problems (not good)## ATT :
## ATT1 ATT2 ATT3
## 4.792 4.197 2.798
##
## SN :
## SN1 SN2 SN3
## 3.473 4.223 3.270
##
## PBC :
## PBC2 PBC3
## 1.54 1.54
##
## ECA :
## ECA1 ECA2 ECA3
## 2.354 2.692 1.964
##
## ECC :
## ECC1 ECC2 ECC3
## 1.532 1.363 1.531
##
## ECD :
## ECD1 ECD2 ECD3
## 1.517 2.468 2.673
##
## PI :
## PI1 PI2 PI3
## 5.277 5.977 4.389summary_simple$vif_antecedents # CONCLUSION: all constructs VIF < 5, So absence of multicollinearity problems (good)## PI :
## ATT SN PBC ECA ECC ECD
## 2.167 2.110 2.318 2.487 2.117 3.244STEP 2: Assess significance and relevance of sm relationships (path coefficient)
# to inspect specific significance direct effects
summary_boot$bootstrapped_paths #path coefficent is sig at 5% if there is no zeros in between the CI## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## ATT -> PI 0.119 0.119 0.032 3.708 0.067 0.172
## SN -> PI 0.124 0.124 0.027 4.673 0.081 0.168
## PBC -> PI 0.139 0.139 0.033 4.200 0.084 0.193
## ECA -> PI 0.417 0.416 0.037 11.166 0.353 0.476
## ECC -> PI 0.106 0.107 0.029 3.706 0.061 0.154
## ECD -> PI 0.130 0.130 0.036 3.562 0.070 0.190# to inspect the Bootstrapped Structural loadings
summary_boot$bootstrapped_loadings ## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## PI1 -> PI 0.954 0.954 0.005 203.625 0.946 0.961
## PI2 -> PI 0.961 0.961 0.004 249.142 0.954 0.967
## PI3 -> PI 0.946 0.946 0.006 163.950 0.936 0.955
## ATT1 -> ATT 0.951 0.951 0.004 223.997 0.944 0.958
## ATT2 -> ATT 0.939 0.939 0.009 109.960 0.924 0.952
## ATT3 -> ATT 0.905 0.905 0.010 92.799 0.888 0.920
## SN1 -> SN 0.929 0.929 0.006 145.910 0.918 0.939
## SN2 -> SN 0.943 0.943 0.006 158.860 0.932 0.952
## SN3 -> SN 0.926 0.926 0.007 132.918 0.914 0.937
## PBC2 -> PBC 0.893 0.893 0.010 93.729 0.877 0.908
## PBC3 -> PBC 0.891 0.891 0.010 87.290 0.873 0.906
## ECA1 -> ECA 0.890 0.890 0.010 84.975 0.872 0.906
## ECA2 -> ECA 0.912 0.912 0.008 108.819 0.897 0.925
## ECA3 -> ECA 0.859 0.859 0.012 71.588 0.838 0.878
## ECC1 -> ECC 0.760 0.759 0.027 28.125 0.712 0.800
## ECC2 -> ECC 0.804 0.804 0.016 49.120 0.776 0.829
## ECC3 -> ECC 0.850 0.850 0.010 84.432 0.833 0.866
## ECD1 -> ECD 0.807 0.807 0.013 60.264 0.784 0.828
## ECD2 -> ECD 0.876 0.876 0.011 80.500 0.857 0.893
## ECD3 -> ECD 0.906 0.906 0.007 125.543 0.893 0.917STEP 3: Assess the model’s explanatory power
- R^2 of >0.75, >0.5, >0.25 and be substantial, moderate and weak respectively
- f-sq effect size (small if <0.15, medium >0.15 and < 0.35, large if >0.35) replaces the limitations of adjusted R^2
# to inspect the r^square
summary_simple$paths # check for direct effects## PI
## R^2 0.751
## AdjR^2 0.750
## ATT 0.119
## SN 0.124
## PBC 0.139
## ECA 0.417
## ECC 0.106
## ECD 0.130# CONCLUSION: PI model,R2 =0.751; paths coefficients: ATT=0.119, PBC=0.139, SN=0.124,ECA=0.417,ECC=0.106,ECD=0.130
# inspect the effect size
### 0.00 - 0.02 = No/very weak effect
### 0.02 to 0.15 = Small effect
### 0.15 to 0.35 = Medium effect
### 0.35 to 0.50 = Large effect
summary_simple$fSquare #CONCLUSION: large effect (),medium (ECA), small(ATT,SN,PBC,ECC,ECD), no/very weak()## ATT SN PBC ECA ECC ECD PI
## ATT 0.000 0.000 0.000 0.000 0.000 0.000 0.026
## SN 0.000 0.000 0.000 0.000 0.000 0.000 0.029
## PBC 0.000 0.000 0.000 0.000 0.000 0.000 0.034
## ECA 0.000 0.000 0.000 0.000 0.000 0.000 0.280
## ECC 0.000 0.000 0.000 0.000 0.000 0.000 0.021
## ECD 0.000 0.000 0.000 0.000 0.000 0.000 0.021
## PI 0.000 0.000 0.000 0.000 0.000 0.000 0.000STEP 4: Assess the model’s predictive power
- RECOMMENDED setting: fo k=10; lower residual RMSE/MAE is better compared to linear regression model benchmark
- (RMSE/MAE[if prediction error distribution is highly non-symmetric/skewed] is used)
- Direct antecedent (DA): highest accuracy or earliest antecedents (EAs) - exclude mediator i)if all PLS out-of-sample indicators have RMSE/MAE values< LM benchmark =High predictive power
- if majority of PLS out-of-sample indicators have RMSE/MAE values< LM benchmark =medium predictive power
- if minority of PLS out-of-sample indicators have RMSE/MAE values< LM benchmark =low predictive power # STEP 4a: to generate the model predictions based on PLS estimate
predict_model<- predict_pls(
model=simple_model,
technique = predict_DA,
noFolds = 10,
reps = 10
)
# compare PLS out-of-sample metrics: to LM out-of-sample metrics
# summarise the prediction results
summary_predict<- summary(predict_model)
summary_predict ##
## PLS in-sample metrics:
## PI1 PI2 PI3
## RMSE 0.562 0.559 0.540
## MAE 0.425 0.422 0.415
##
## PLS out-of-sample metrics:
## PI1 PI2 PI3
## RMSE 0.569 0.567 0.546
## MAE 0.430 0.427 0.419
##
## LM in-sample metrics:
## PI1 PI2 PI3
## RMSE 0.550 0.548 0.532
## MAE 0.417 0.413 0.408
##
## LM out-of-sample metrics:
## PI1 PI2 PI3
## RMSE 0.567 0.566 0.549
## MAE 0.428 0.424 0.420
##
## Construct Level metrics:
## PI
## IS_MSE 1.75521
## IS_MAE 1.02693
## OOS_MSE 1.75791
## OOS_MAE 1.02745
## overfit 0.00154# Conclusion: Both PLS and LM demonstrate consistent predictive accuracy, with negligible overfitting and strong out-of-sample performance.STEP 4b: to analyse the distribution of prediction error
- use shapiro test: All p-values > 0.05-data is normal.
- or skewness test:
- -0.5 to 0.5 → roughly symmetric (acceptable for normality).
- -1 to -0.5 → moderate skew.
- < -1 → highly skewed.
library(moments)
# All indicators
indicators <- c(paste0("PI",1:3), paste0("ATT",1:3), paste0("SN",1:3),
paste0("PBC",2:3), paste0("ECA",1:3),paste0("ECC",1:3), paste0("ECD",1:3))
# Skewness
skew_values <- sapply(my_data[indicators], skewness, na.rm = TRUE)
# mostly moderate negative skew.
# Shapiro-Wilk p-values
shapiro_p <- sapply(my_data[indicators], function(x) shapiro.test(x)$p.value)
# All p-values are extremely small (< 0.05). all indicators are “statistically non-normal”, but this is normal in large samples.
# Combine results
results <- data.frame(Indicator = indicators, Skewness = skew_values, Shapiro_p = shapiro_p)
print(results) #Shapiro-Wilk is not reliable for large N — rely on skewness and practical judgment.## Indicator Skewness Shapiro_p
## PI1 PI1 -0.58208631 1.437934e-27
## PI2 PI2 -0.57712795 2.198353e-27
## PI3 PI3 -0.63672682 6.417538e-28
## ATT1 ATT1 -0.52195984 1.734718e-28
## ATT2 ATT2 -0.55803035 1.969654e-28
## ATT3 ATT3 -0.37466091 2.241768e-29
## SN1 SN1 -0.15909899 1.315768e-27
## SN2 SN2 -0.18785450 2.464034e-29
## SN3 SN3 -0.27877487 3.100212e-30
## PBC2 PBC2 -0.18079183 5.620343e-29
## PBC3 PBC3 -0.20067175 3.553573e-27
## ECA1 ECA1 -0.91105336 3.433468e-30
## ECA2 ECA2 -0.92903939 1.333552e-30
## ECA3 ECA3 -0.70859269 7.911265e-28
## ECC1 ECC1 -0.01311028 1.072223e-24
## ECC2 ECC2 -0.63870968 7.187108e-29
## ECC3 ECC3 -0.02302262 3.646211e-24
## ECD1 ECD1 -0.16202371 8.344354e-25
## ECD2 ECD2 -0.74530082 3.730539e-28
## ECD3 ECD3 -0.76802716 1.439155e-28#RESULTS:All indicators showed slight negative skewness. Shapiro–Wilk tests indicated non-normal distributions (p < .001)
# Recommendation: Use MAE for PLSpredict metrics and interpret with skewness in mind.
####OR PLOT TO CHECK SKEWNESS#####
## to plot and see for each indicators
par(mfrow=c(1,2))
plot(summary_predict,
indicator = "PI2")
plot(summary_predict,
indicator = "PI3")
par(mfrow=c(1,1))10. ASSESSING RELIABILITY AND VALIDITY OF ESTIMATED MODEL
STEP 1: Assess the indicator reliability: how much of each indicator’s variance is explained by construct
- Loadings >0.708 have good loadings; between 0.4 and 0.708 -consider for removal if they do not affect internal consistency reliability or convergent validity
- Conclusion : only PBC1 was removed from the initial model because it has weak loadings,weakening the construct’s quality
- Check loadings and remove indicators with weak loadings
- Indicator’s variance = square of indicator’s loading[IL>0.708 are recommended] (i.e bivariate correlation between indicator and construct)
# inspect the construct loadings metrics:ideally be ≥ 0.70, with 0.60–0.70 acceptable and < 0.60 considered problematic.
summary_simple$loadings #(indicator loading should be > 0.708)## ATT SN PBC ECA ECC ECD PI
## PI1 0.000 0.000 0.000 0.000 0.000 0.000 0.954
## PI2 0.000 0.000 0.000 0.000 0.000 0.000 0.961
## PI3 0.000 0.000 0.000 0.000 0.000 0.000 0.946
## ATT1 0.951 0.000 0.000 0.000 0.000 0.000 0.000
## ATT2 0.939 0.000 0.000 0.000 0.000 0.000 0.000
## ATT3 0.905 0.000 0.000 0.000 0.000 0.000 0.000
## SN1 0.000 0.929 0.000 0.000 0.000 0.000 0.000
## SN2 0.000 0.943 0.000 0.000 0.000 0.000 0.000
## SN3 0.000 0.926 0.000 0.000 0.000 0.000 0.000
## PBC2 0.000 0.000 0.893 0.000 0.000 0.000 0.000
## PBC3 0.000 0.000 0.891 0.000 0.000 0.000 0.000
## ECA1 0.000 0.000 0.000 0.890 0.000 0.000 0.000
## ECA2 0.000 0.000 0.000 0.912 0.000 0.000 0.000
## ECA3 0.000 0.000 0.000 0.859 0.000 0.000 0.000
## ECC1 0.000 0.000 0.000 0.000 0.760 0.000 0.000
## ECC2 0.000 0.000 0.000 0.000 0.804 0.000 0.000
## ECC3 0.000 0.000 0.000 0.000 0.850 0.000 0.000
## ECD1 0.000 0.000 0.000 0.000 0.000 0.807 0.000
## ECD2 0.000 0.000 0.000 0.000 0.000 0.876 0.000
## ECD3 0.000 0.000 0.000 0.000 0.000 0.906 0.000# Conclusion: all indicators are > 0.708
summary_simple$loadings^2 #(indicator reliability should be>0.5)## ATT SN PBC ECA ECC ECD PI
## PI1 0.000 0.000 0.000 0.000 0.000 0.000 0.910
## PI2 0.000 0.000 0.000 0.000 0.000 0.000 0.923
## PI3 0.000 0.000 0.000 0.000 0.000 0.000 0.895
## ATT1 0.905 0.000 0.000 0.000 0.000 0.000 0.000
## ATT2 0.882 0.000 0.000 0.000 0.000 0.000 0.000
## ATT3 0.819 0.000 0.000 0.000 0.000 0.000 0.000
## SN1 0.000 0.863 0.000 0.000 0.000 0.000 0.000
## SN2 0.000 0.889 0.000 0.000 0.000 0.000 0.000
## SN3 0.000 0.857 0.000 0.000 0.000 0.000 0.000
## PBC2 0.000 0.000 0.798 0.000 0.000 0.000 0.000
## PBC3 0.000 0.000 0.794 0.000 0.000 0.000 0.000
## ECA1 0.000 0.000 0.000 0.791 0.000 0.000 0.000
## ECA2 0.000 0.000 0.000 0.832 0.000 0.000 0.000
## ECA3 0.000 0.000 0.000 0.738 0.000 0.000 0.000
## ECC1 0.000 0.000 0.000 0.000 0.578 0.000 0.000
## ECC2 0.000 0.000 0.000 0.000 0.647 0.000 0.000
## ECC3 0.000 0.000 0.000 0.000 0.723 0.000 0.000
## ECD1 0.000 0.000 0.000 0.000 0.000 0.651 0.000
## ECD2 0.000 0.000 0.000 0.000 0.000 0.768 0.000
## ECD3 0.000 0.000 0.000 0.000 0.000 0.820 0.000# Conclusion: all indicators are > 0.5. No issues of non-reliability of indicatorsSTEP 2: Assess the internal consistency (construct) reliability
- Note: We have i) indicator reliability and Construct level(internal consistency) reliability.
- Composite reliability rhoc is a pry measure (values > 0.70 <0.90 is highly reliable;0.60-0.70 is acceptable in exploratory research;>0.95 are problematic-indicate redundancy).
- Cronbach’s alpha is another measure (same threshold as rhoc but limitation:assumes tau-equivalence-address).
- Reliability coefficient rhoa (acceptable compromise between alpha and rhoc)
# to inspect composite reliability rhoc of estimated model
summary_simple$reliability ### Note: only PBC has alpha<0.7 in the original model (not good);so PBC1 was removed## alpha rhoC AVE rhoA
## ATT 0.924 0.952 0.869 0.927
## SN 0.925 0.952 0.870 0.926
## PBC 0.744 0.886 0.796 0.744
## ECA 0.864 0.917 0.787 0.866
## ECC 0.736 0.847 0.649 0.763
## ECD 0.829 0.898 0.747 0.831
## PI 0.950 0.968 0.909 0.950
##
## Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.5# rhoa values should be between alpha and rhoc
# Conclusion : all are relaible
# to plot reliability chart
plot(summary_simple$reliability) #horizontal blue line is the threshold
# STEP 3: Assess the convergent validity - Validity assessment is AVE. -
Average variance extracted (AVE) = SUM OF SQUARED LOADINGS/NO OF
INDICATORS (>=0.50 is acceptable).
summary_simple$reliability # Conclusion: all AVE values are > 0.5:good## alpha rhoC AVE rhoA
## ATT 0.924 0.952 0.869 0.927
## SN 0.925 0.952 0.870 0.926
## PBC 0.744 0.886 0.796 0.744
## ECA 0.864 0.917 0.787 0.866
## ECC 0.736 0.847 0.649 0.763
## ECD 0.829 0.898 0.747 0.831
## PI 0.950 0.968 0.909 0.950
##
## Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.5STEP 4: Assess the discriminant validity
- Measures the extent a construct is empirically distint from other constructs in the SM.
- AVE must be higher than the squared interconstruct correlation.
- Initially proposed by Fornell and Larcker(1981) but criticised that it should be avoided by Henseler, Ringle and sarstedt (2015) & Radomir & Moisescu (2019). # STEP 4a: to inspect FL proposal
summary_simple$validity$fl_criteria #first value in each column should be higher than other values below## ATT SN PBC ECA ECC ECD PI
## ATT 0.932 . . . . . .
## SN 0.595 0.933 . . . . .
## PBC 0.616 0.626 0.892 . . . .
## ECA 0.627 0.547 0.565 0.887 . . .
## ECC 0.448 0.582 0.604 0.567 0.806 . .
## ECD 0.626 0.629 0.665 0.739 0.672 0.864 .
## PI 0.669 0.653 0.676 0.794 0.639 0.754 0.954
##
## FL Criteria table reports square root of AVE on the diagonal and construct correlations on the lower triangle.STEP 4b: Heterotrait-monotrait ratio (HTMT) [Henseler et al., 2015]is alternative to above criticised measure
- If HTMT >0.9, then absence of discriminant validity;<0.85 is recommended for different constructs and <0.90 for similar constructs.
- HTMT - compares a reflectively measured construct’s discriminant validity to other construct measures in the model.
# to inspect Henseler proposal
summary_simple$validity$htmt #all of the values should be <0.90## ATT SN PBC ECA ECC ECD PI
## ATT . . . . . . .
## SN 0.643 . . . . . .
## PBC 0.743 0.754 . . . . .
## ECA 0.700 0.611 0.705 . . . .
## ECC 0.518 0.686 0.799 0.677 . . .
## ECD 0.716 0.717 0.847 0.872 0.829 . .
## PI 0.713 0.696 0.804 0.876 0.735 0.848 .STEP 4c: Crossloadings for assessment of discriminant validity
summary_simple$validity$cross_loadings #loadings values for each indicators should be the highest at its own construct and not other constructs## ATT SN PBC ECA ECC ECD PI
## PI1 0.630 0.614 0.631 0.756 0.606 0.710 0.954
## PI2 0.628 0.624 0.647 0.754 0.606 0.712 0.961
## PI3 0.655 0.630 0.655 0.762 0.617 0.734 0.946
## ATT1 0.951 0.561 0.574 0.599 0.423 0.605 0.642
## ATT2 0.939 0.571 0.569 0.616 0.425 0.593 0.635
## ATT3 0.905 0.533 0.580 0.537 0.405 0.552 0.591
## SN1 0.592 0.929 0.593 0.521 0.539 0.598 0.615
## SN2 0.524 0.943 0.564 0.481 0.532 0.570 0.588
## SN3 0.548 0.926 0.593 0.526 0.556 0.590 0.623
## PBC2 0.584 0.542 0.893 0.510 0.527 0.584 0.605
## PBC3 0.515 0.575 0.891 0.499 0.552 0.603 0.601
## ECA1 0.597 0.497 0.504 0.890 0.520 0.644 0.713
## ECA2 0.566 0.492 0.521 0.912 0.515 0.692 0.718
## ECA3 0.504 0.466 0.479 0.859 0.475 0.629 0.682
## ECC1 0.209 0.370 0.397 0.272 0.760 0.383 0.354
## ECC2 0.479 0.449 0.507 0.535 0.804 0.600 0.547
## ECC3 0.350 0.555 0.532 0.505 0.850 0.592 0.592
## ECD1 0.467 0.582 0.602 0.558 0.611 0.807 0.650
## ECD2 0.578 0.506 0.540 0.659 0.518 0.876 0.616
## ECD3 0.577 0.539 0.580 0.695 0.606 0.906 0.683STEP 5: Bootstrapping HTMT results (to see if HTMT values are significantly different from 1 or a lower threshold like 0.9/0.85)
- Bootstrap the model for HTMT on the PLS estimated model.
# extract bootstrapped htmt
summary_boot$bootstrapped_HTMT #there should be no 1 in the CI=NO ISSUES OF DISCRIMINALITY## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## ATT -> SN 0.643 0.643 0.025 25.724 0.601 0.683
## ATT -> PBC 0.743 0.744 0.029 25.601 0.695 0.790
## ATT -> ECA 0.700 0.701 0.025 28.068 0.659 0.741
## ATT -> ECC 0.518 0.519 0.036 14.549 0.458 0.576
## ATT -> ECD 0.716 0.716 0.024 29.649 0.675 0.755
## ATT -> PI 0.713 0.713 0.023 30.341 0.673 0.750
## SN -> PBC 0.754 0.754 0.028 26.780 0.707 0.799
## SN -> ECA 0.611 0.611 0.027 22.587 0.565 0.654
## SN -> ECC 0.686 0.686 0.031 22.244 0.633 0.736
## SN -> ECD 0.717 0.717 0.024 29.534 0.677 0.755
## SN -> PI 0.696 0.696 0.024 29.249 0.656 0.734
## PBC -> ECA 0.705 0.705 0.028 24.773 0.658 0.752
## PBC -> ECC 0.799 0.799 0.032 24.720 0.746 0.852
## PBC -> ECD 0.847 0.847 0.025 34.524 0.807 0.888
## PBC -> PI 0.804 0.804 0.025 32.760 0.763 0.844
## ECA -> ECC 0.677 0.677 0.029 23.174 0.628 0.724
## ECA -> ECD 0.872 0.872 0.020 44.533 0.839 0.903
## ECA -> PI 0.876 0.876 0.016 53.207 0.847 0.901
## ECC -> ECD 0.829 0.829 0.028 30.101 0.782 0.873
## ECC -> PI 0.735 0.735 0.025 29.588 0.694 0.775
## ECD -> PI 0.848 0.848 0.019 45.740 0.817 0.87811. Plotting, Printing and Exporting Results
# exporitng
# write.csv(x=summary_boot$bootstrapped_loadings, file = "boot_loadings.csv")
# to plot the constructs' internal consistency reliabilities
plot(summary_simple$reliability)
# to plot pls estimated model
plot(simple_model)# to plot bootstrapped pls estimated model
plot(boot_simple) #shows the significant variablesMEDIATING EFFECT ANALYSIS
- Construct in the middle is the mediator.
- Direct + indirect effect = total effect.
- First, check for relevant assessment criteria of mm and sm before this.
- Check only for only significant constructs.
- If p3 is +ve significant mediation= Complementary (partial mediation); if -ve = Competitive (partial mediation).
- If p3 is not significant =indirect-only (full mediation).
- < 0.02=Very small effect;0.02 – 0.14=Small effect;0.15 – 0.34=Medium effect;≥ 0.35=Large effect # 1. Create measurement model (mm)
# to create reflective mm (no need to write mode_A)
simple_mm<- constructs(
composite("PI", multi_items("PI",1:3)),
composite("ATT", multi_items("ATT",1:3)),
composite("SN", multi_items("SN",1:3)),
composite("PBC", multi_items("PBC",2:3)), #PBC1 was removed because loading=0.540 and alpha< 0.7its removal has a better effect on reliability and validity metrics/content validity (<0.708 recommendation limit)
composite("ECA", multi_items("ECA",1:3)),
composite("ECC", multi_items("ECC",1:3)),
composite("ECD", multi_items("ECD",1:3))
)
simple_mm## $composite
## [1] "PI" "PI1" "A" "PI" "PI2" "A" "PI" "PI3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ATT" "ATT1" "A" "ATT" "ATT2" "A" "ATT" "ATT3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "SN" "SN1" "A" "SN" "SN2" "A" "SN" "SN3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "PBC" "PBC2" "A" "PBC" "PBC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECA" "ECA1" "A" "ECA" "ECA2" "A" "ECA" "ECA3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECC" "ECC1" "A" "ECC" "ECC2" "A" "ECC" "ECC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECD" "ECD1" "A" "ECD" "ECD2" "A" "ECD" "ECD3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## attr(,"class")
## [1] "list" "measurement_model" "seminr_model"2. Create structural model
# to create sm for indirect efffects
simple_sm <- relationships(
paths(from = c("ATT","SN","PBC","ECA","ECC","ECD"), to = "PI"),
paths(from = "ECA", to = c("ATT","SN","PBC")),
paths(from = "ECC", to = c("ATT","SN","PBC")),
paths(from = "ECD", to = c("ATT","SN","PBC"))
)
simple_sm## source target
## [1,] "ATT" "PI"
## [2,] "SN" "PI"
## [3,] "PBC" "PI"
## [4,] "ECA" "PI"
## [5,] "ECC" "PI"
## [6,] "ECD" "PI"
## [7,] "ECA" "ATT"
## [8,] "ECA" "SN"
## [9,] "ECA" "PBC"
## [10,] "ECC" "ATT"
## [11,] "ECC" "SN"
## [12,] "ECC" "PBC"
## [13,] "ECD" "ATT"
## [14,] "ECD" "SN"
## [15,] "ECD" "PBC"
## attr(,"class")
## [1] "matrix" "array" "structural_model" "seminr_model"3. Estimate the structural model
# to estimate the model
simple_model <- estimate_pls(data = my_data,
measurement_model = simple_mm,
structural_model = simple_sm,
inner_weights = path_weighting,
missing = mean_replacement,
missing_value = "-99"
)## Generating the seminr model## All 999 observations are valid.# summary()
summary_simple <- summary(simple_model) #shows the path coefficients and reliability
plot(simple_model) #β IS PATH COEFFICIENT ; λ IS outer loadings4. Check for indirect effects
summary_simple$total_indirect_effects## ATT SN PBC ECA ECC ECD PI
## ATT 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## SN 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## PBC 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## ECA 0.000 0.000 0.000 0.000 0.000 0.000 0.077
## ECC 0.000 0.000 0.000 0.000 0.000 0.000 0.072
## ECD 0.000 0.000 0.000 0.000 0.000 0.000 0.140
## PI 0.000 0.000 0.000 0.000 0.000 0.000 0.000# Conclusion: ECA,ECC,ECD shows a non-zero indirect effect on Purchase Intention (PI), indicating the presence of mediation5. Bootstrap estimated model
boot_simple <- bootstrap_model(
seminr_model = simple_model,
nboot = 10000,
cores = NULL,
seed = 123
)## Bootstrapping model using seminr...## SEMinR Model successfully bootstrapped6. Inspect significance of indirect effects
#FOR ECA
distal <- "ECA"
mediators <- c("ATT","SN","PBC")
target <- "PI"
for (f in distal) for (m in mediators) {
specific_effect_significance(boot_simple, from = f, through = m, to = target, alpha = 0.05)
}
lapply(c("ATT","SN","PBC"), function(m) specific_effect_significance(boot_simple, from="ECA", through=m, to="PI", alpha=0.05))## [[1]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.04287654 0.04342783 0.01402251 3.05769337 0.01837205
## 97.5% CI
## 0.07355362
##
## [[2]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.017479292 0.017568798 0.006836941 2.556595281 0.005940237
## 97.5% CI
## 0.032383708
##
## [[3]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.016922831 0.016754536 0.006886810 2.457281497 0.004958397
## 97.5% CI
## 0.031739199# FOR ECC
distal <- "ECC"
mediators <- c("ATT","SN","PBC")
target <- "PI"
for (f in distal) for (m in mediators) {
specific_effect_significance(boot_simple, from = f, through = m, to = target, alpha = 0.05)
}
lapply(c("ATT","SN","PBC"), function(m) specific_effect_significance(boot_simple, from="ECC", through=m, to="PI", alpha=0.05))## [[1]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.0003941043 0.0002700500 0.0047728167 0.0825726825 -0.0097363184
## 97.5% CI
## 0.0095156251
##
## [[2]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.033775514 0.033908009 0.008895669 3.796849285 0.017854512
## 97.5% CI
## 0.052956168
##
## [[3]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.03790132 0.03781956 0.01085608 3.49125293 0.01837407
## 97.5% CI
## 0.06104004#FOR ECD
distal <- "ECD"
mediators <- c("ATT","SN","PBC")
target <- "PI"
for (f in distal) for (m in mediators) {
specific_effect_significance(boot_simple, from = f, through = m, to = target, alpha = 0.05)
}
lapply(c("ATT","SN","PBC"), function(m) specific_effect_significance(boot_simple, from="ECD", through=m, to="PI", alpha=0.05))## [[1]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.04215713 0.04203382 0.01237027 3.40794034 0.01955751
## 97.5% CI
## 0.06793351
##
## [[2]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.04296576 0.04267250 0.01083841 3.96421263 0.02300067
## 97.5% CI
## 0.06530208
##
## [[3]]
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## 0.05517757 0.05494334 0.01406655 3.92260886 0.02846933
## 97.5% CI
## 0.08375501# to inspect indirect effects
summary_boot_med<-summary(boot_simple)
summary_boot_med$bootstrapped_paths ## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI 97.5% CI
## ATT -> PI 0.118 0.119 0.032 3.665 0.055 0.183
## SN -> PI 0.125 0.125 0.027 4.689 0.073 0.177
## PBC -> PI 0.140 0.139 0.033 4.203 0.074 0.204
## ECA -> ATT 0.363 0.363 0.044 8.246 0.277 0.448
## ECA -> SN 0.140 0.140 0.042 3.358 0.058 0.221
## ECA -> PBC 0.121 0.120 0.039 3.071 0.042 0.197
## ECA -> PI 0.418 0.417 0.037 11.192 0.342 0.489
## ECC -> ATT 0.003 0.004 0.039 0.085 -0.073 0.080
## ECC -> SN 0.271 0.272 0.038 7.030 0.197 0.347
## ECC -> PBC 0.271 0.271 0.036 7.520 0.200 0.342
## ECC -> PI 0.104 0.105 0.029 3.602 0.048 0.162
## ECD -> ATT 0.357 0.356 0.049 7.328 0.260 0.452
## ECD -> SN 0.344 0.343 0.050 6.822 0.245 0.441
## ECD -> PBC 0.395 0.395 0.043 9.147 0.312 0.480
## ECD -> PI 0.130 0.131 0.037 3.551 0.058 0.2027. Inspect significance of direct effects
# to inspect direct effects
summary_simple$paths## PI ATT SN PBC
## R^2 0.751 0.453 0.450 0.494
## AdjR^2 0.749 0.451 0.448 0.493
## ATT 0.118 . . .
## SN 0.125 . . .
## PBC 0.140 . . .
## ECA 0.418 0.363 0.140 0.121
## ECC 0.104 0.003 0.271 0.271
## ECD 0.130 0.357 0.344 0.395# to inspect the confidence intervals for direct effects
summary_boot$bootstrapped_paths #if significant if t-stat >1.96 and there is no zeros between CI, then it shows partial mediation## Original Est. Bootstrap Mean Bootstrap SD T Stat. 5% CI 95% CI
## ATT -> PI 0.119 0.119 0.032 3.708 0.067 0.172
## SN -> PI 0.124 0.124 0.027 4.673 0.081 0.168
## PBC -> PI 0.139 0.139 0.033 4.200 0.084 0.193
## ECA -> PI 0.417 0.416 0.037 11.166 0.353 0.476
## ECC -> PI 0.106 0.107 0.029 3.706 0.061 0.154
## ECD -> PI 0.130 0.130 0.036 3.562 0.070 0.190# Note:
# In PLS-SEM, the total effect of an independent variable on a dependent variable
# is the sum of the direct effect and all indirect effects.
# The percentage of the total effect transmitted via a mediator can be calculated as:
# Indirect Contribution (%) = (Indirect Effect / Total Effect) * 100
# Example:
# 1. Indirect effects via ATT, SN, and PBC:
# 1a. ECA indirects
# via ATT: 0.363 × 0.119 = 0.043197 → 0.0432 ✅
# via SN: 0.140 × 0.124 = 0.01736 → 0.0174 ✅
# via PBC: 0.121 × 0.139 = 0.016819 → 0.0168 ✅
# Total indirect (ECA) = 0.043197 + 0.01736 + 0.016819 ≈ 0.077376 → 0.0774
# 1b. ECC indirects
# via ATT: 0.003 × 0.119 = 0.000357 → 0.00036 ✅
# via SN: 0.271 × 0.124 = 0.033604 → 0.0336 ✅
# via PBC: 0.271 × 0.139 = 0.037669 → 0.0377 (I had rounded 0.0376 before)
# Total indirect (ECC) = 0.000357 + 0.033604 + 0.037669 ≈ 0.07163 → 0.0716 or 0.0717 ✅
# 1c. ECD indirects
# via ATT: 0.357 × 0.119 = 0.042483 → 0.0425 ✅
# via SN: 0.344 × 0.124 = 0.042656 → 0.0427 ✅
# via PBC: 0.395 × 0.139 = 0.054905 → 0.0549 ✅
# Total indirect (ECD) = 0.042483 + 0.042656 + 0.054905 ≈ 0.140044 → 0.1401
# 2.Direct effect of ECA,ECC,ECD on PI: 0.417,0.106,0.130
# 3. Total effect
# Total effect = Direct + Indirect
# ECA: 0.417 + 0.0774 = 0.4944 → 0.494
# ECC: 0.106 + 0.07163 = 0.17763 → 0.178
# ECD: 0.130 + 0.1401 = 0.2701 → 0.270
# 4. % contribution = (Indirect via mediator / Total effect) × 100
# A.ECA:
# ATT: 0.043197 / 0.4944 ≈ 0.0874 → 8.7%
# SN: 0.01736 / 0.4944 ≈ 0.0351 → 3.5%
# PBC: 0.016819 / 0.4944 ≈ 0.0340 → 3.4%
# Cumulative indirect contribution = 8.7 + 3.5 + 3.4 = 15.6% of total effect
# B. ECC:
# ATT: 0.000357 / 0.17763 ≈ 0.002 → 0.2%
# SN: 0.033604 / 0.17763 ≈ 0.189 → 18.9%
# PBC: 0.037669 / 0.17763 ≈ 0.212 → 21.2% (slightly higher than 21.1)
# Cumulative indirect ≈ 0.2 + 18.9 + 21.2 ≈ 40.3% of total effect
# C. ECD:
# ATT: 0.042483 / 0.2701 ≈ 0.1573 → 15.7%
# SN: 0.042656 / 0.2701 ≈ 0.1579 → 15.8%
# PBC: 0.054905 / 0.2701 ≈ 0.2034 → 20.3%
# Cumulative indirect ≈ 15.7 + 15.8 + 20.3 = 51.8% of total effect 8.Inspect the sign of the mediation
- Check whether complementary (+VE)/competitive MEDIATOR(-VE)
- Calculate the sign of p1p2p3
# FOR ECA
summary_simple$paths["ECA","ATT"]*summary_simple$paths["ECA","PI"]*summary_simple$paths["ECA","PI"]## [1] 0.06323801summary_simple$paths["ECA","SN"]*summary_simple$paths["ECA","PI"]*summary_simple$paths["ECA","PI"]## [1] 0.024415summary_simple$paths["ECA","PBC"]*summary_simple$paths["ECA","PI"]*summary_simple$paths["ECA","PI"]## [1] 0.02110333# FOR ECC
summary_simple$paths["ECC","ATT"]*summary_simple$paths["ECC","PI"]*summary_simple$paths["ECC","PI"]## [1] 3.630389e-05summary_simple$paths["ECC","SN"]*summary_simple$paths["ECC","PI"]*summary_simple$paths["ECC","PI"]## [1] 0.002946581summary_simple$paths["ECC","PBC"]*summary_simple$paths["ECC","PI"]*summary_simple$paths["ECC","PI"]## [1] 0.002951997# FOR ECD
summary_simple$paths["ECD","ATT"]*summary_simple$paths["ECD","PI"]*summary_simple$paths["ECD","PI"]## [1] 0.006003909summary_simple$paths["ECD","SN"]*summary_simple$paths["ECD","PI"]*summary_simple$paths["ECD","PI"]## [1] 0.005795088summary_simple$paths["ECD","PBC"]*summary_simple$paths["ECD","PI"]*summary_simple$paths["ECD","PI"]## [1] 0.0066442389.Plot estimated and bootstrapped model
plot(simple_model)plot(boot_simple)MODERATION ANALYSIS (2 stage approach- Chin, Marcolin and Newsted’s 2003)
- For inclusion of moderator # 1. Create mm
# create interaction (two-stage recommended for reflective composites)
simple_mm <- constructs(
composite("PI", multi_items("PI",1:3)),
composite("ATT", multi_items("ATT",1:3)),
composite("SN", multi_items("SN",1:3)),
composite("PBC", multi_items("PBC",2:3)),
composite("ECA", multi_items("ECA",1:3)),
interaction_term(iv = "ATT",moderator = "ECA",method = two_stage),
interaction_term(iv = "SN",moderator = "ECA",method = two_stage),
interaction_term(iv = "PBC",moderator = "ECA",method = two_stage),
composite("ECC", multi_items("ECC",1:3)),
interaction_term(iv = "ATT",moderator = "ECC",method = two_stage),
interaction_term(iv = "SN",moderator = "ECC",method = two_stage),
interaction_term(iv = "PBC",moderator = "ECC",method = two_stage),
composite("ECD", multi_items("ECD",1:3)),
interaction_term(iv = "ATT",moderator = "ECD",method = two_stage),
interaction_term(iv = "SN",moderator = "ECD",method = two_stage),
interaction_term(iv = "PBC",moderator = "ECD",method = two_stage)
)
simple_mm## $composite
## [1] "PI" "PI1" "A" "PI" "PI2" "A" "PI" "PI3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ATT" "ATT1" "A" "ATT" "ATT2" "A" "ATT" "ATT3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "SN" "SN1" "A" "SN" "SN2" "A" "SN" "SN3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "PBC" "PBC2" "A" "PBC" "PBC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $composite
## [1] "ECA" "ECA1" "A" "ECA" "ECA2" "A" "ECA" "ECA3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bbb4da0>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bbb5e78>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bbbb038>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $composite
## [1] "ECC" "ECC1" "A" "ECC" "ECC2" "A" "ECC" "ECC3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bbab418>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bb985c0>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bb996d0>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $composite
## [1] "ECD" "ECD1" "A" "ECD" "ECD2" "A" "ECD" "ECD3" "A"
## attr(,"class")
## [1] "character" "construct" "composite"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bba7a88>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bb96c40>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## $two_stage_interaction
## function (data, mmMatrix, structural_model, ints, estimate_first_stage,
## ...)
## {
## interaction_name <- paste(iv, moderator, sep = "*")
## structural_model <- structural_model[!grepl("\\*", structural_model[,
## "source"]), ]
## measurement_mode_scheme <- sapply(unique(c(structural_model[,
## 1], structural_model[, 2])), get_measure_mode, mmMatrix,
## USE.NAMES = TRUE)
## first_stage <- estimate_first_stage(data = data, smMatrix = structural_model,
## mmMatrix = mmMatrix, measurement_mode_scheme = measurement_mode_scheme,
## ...)
## interaction_term <- as.matrix(first_stage$construct_scores[,
## iv] * first_stage$construct_scores[, moderator], ncol = 1)[,
## , drop = FALSE]
## colnames(interaction_term) <- c(paste(interaction_name, "_intxn",
## sep = ""))
## intxn_mm <- matrix(measure_interaction(interaction_name,
## interaction_term, weights), ncol = 3, byrow = TRUE)
## return(list(name = interaction_name, data = interaction_term[,
## 1, drop = FALSE], mm = intxn_mm))
## }
## <bytecode: 0x000001c82bbcdc28>
## <environment: 0x000001c82bb97d50>
## attr(,"class")
## [1] "function" "interaction" "two_stage_interaction"
##
## attr(,"class")
## [1] "list" "measurement_model" "seminr_model"2. Create the sm
simple_sm <- relationships(
paths(from = c("ATT","SN","PBC","ECA","ATT*ECA","SN*ECA","PBC*ECA","ECC","ATT*ECC","SN*ECC","PBC*ECC","ECD","ATT*ECD","SN*ECD","PBC*ECD"), to = "PI")
)
simple_sm## source target
## [1,] "ATT" "PI"
## [2,] "SN" "PI"
## [3,] "PBC" "PI"
## [4,] "ECA" "PI"
## [5,] "ATT*ECA" "PI"
## [6,] "SN*ECA" "PI"
## [7,] "PBC*ECA" "PI"
## [8,] "ECC" "PI"
## [9,] "ATT*ECC" "PI"
## [10,] "SN*ECC" "PI"
## [11,] "PBC*ECC" "PI"
## [12,] "ECD" "PI"
## [13,] "ATT*ECD" "PI"
## [14,] "SN*ECD" "PI"
## [15,] "PBC*ECD" "PI"
## attr(,"class")
## [1] "matrix" "array" "structural_model" "seminr_model"3. Estimate the model
simple_mod_model <- estimate_pls(data = my_data,simple_mm,simple_sm
)## Generating the seminr model## All 999 observations are valid.# to summarise
summary_mod_simple <- summary(simple_mod_model)
summary_mod_simple##
## Results from package seminr (2.3.7)
##
## Path Coefficients:
## PI
## R^2 0.756
## AdjR^2 0.752
## ATT 0.127
## SN 0.124
## PBC 0.134
## ECA 0.404
## ATT*ECA -0.030
## SN*ECA -0.081
## PBC*ECA 0.089
## ECC 0.106
## ATT*ECC 0.035
## SN*ECC 0.018
## PBC*ECC -0.054
## ECD 0.137
## ATT*ECD 0.028
## SN*ECD 0.054
## PBC*ECD -0.074
##
## Reliability:
## alpha rhoC AVE rhoA
## ATT 0.924 0.952 0.869 0.927
## SN 0.925 0.952 0.870 0.926
## PBC 0.744 0.886 0.796 0.744
## ECA 0.864 0.917 0.787 0.866
## ATT*ECA 1.000 1.000 1.000 1.000
## SN*ECA 1.000 1.000 1.000 1.000
## PBC*ECA 1.000 1.000 1.000 1.000
## ECC 0.736 0.847 0.649 0.763
## ATT*ECC 1.000 1.000 1.000 1.000
## SN*ECC 1.000 1.000 1.000 1.000
## PBC*ECC 1.000 1.000 1.000 1.000
## ECD 0.829 0.898 0.747 0.831
## ATT*ECD 1.000 1.000 1.000 1.000
## SN*ECD 1.000 1.000 1.000 1.000
## PBC*ECD 1.000 1.000 1.000 1.000
## PI 0.950 0.968 0.909 0.950
##
## Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.54. Bootstrap moderating model
boot_mod_simple <- bootstrap_model(
seminr_model = simple_mod_model,
nboot = 10000,
cores = NULL,
seed = 123
)## Bootstrapping model using seminr...## SEMinR Model successfully bootstrapped# to inspect bootstrapped paths
summary_mod_boot<-summary(boot_mod_simple, alpha=0.05)
plot(boot_mod_simple)summary_mod_boot$bootstrapped_paths## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI
## ATT -> PI 0.127 0.127 0.030 4.273 0.070
## SN -> PI 0.124 0.124 0.025 4.967 0.076
## PBC -> PI 0.134 0.133 0.032 4.160 0.070
## ECA -> PI 0.404 0.402 0.036 11.218 0.331
## ATT*ECA -> PI -0.030 -0.030 0.045 -0.653 -0.115
## SN*ECA -> PI -0.081 -0.076 0.038 -2.124 -0.146
## PBC*ECA -> PI 0.089 0.085 0.049 1.807 -0.015
## ECC -> PI 0.106 0.109 0.029 3.604 0.051
## ATT*ECC -> PI 0.035 0.030 0.036 0.972 -0.044
## SN*ECC -> PI 0.018 0.018 0.031 0.561 -0.042
## PBC*ECC -> PI -0.054 -0.053 0.038 -1.433 -0.125
## ECD -> PI 0.137 0.138 0.035 3.959 0.072
## ATT*ECD -> PI 0.028 0.031 0.055 0.512 -0.078
## SN*ECD -> PI 0.054 0.048 0.042 1.289 -0.043
## PBC*ECD -> PI -0.074 -0.070 0.063 -1.172 -0.187
## 97.5% CI
## ATT -> PI 0.187
## SN -> PI 0.174
## PBC -> PI 0.196
## ECA -> PI 0.471
## ATT*ECA -> PI 0.063
## SN*ECA -> PI 0.004
## PBC*ECA -> PI 0.177
## ECC -> PI 0.166
## ATT*ECC -> PI 0.100
## SN*ECC -> PI 0.080
## PBC*ECC -> PI 0.022
## ECD -> PI 0.206
## ATT*ECD -> PI 0.140
## SN*ECD -> PI 0.122
## PBC*ECD -> PI 0.059#main effects significant, interactions mostly not significant except PBC*AF borderline.5. Compute f2 for each endogenous construct
- f2 <- (r2_included - r2_excluded) / (1 - r2_included)
# Extract R2 values
r2_included <- summary_mod_simple$paths
r2_included ## PI
## R^2 0.756
## AdjR^2 0.752
## ATT 0.127
## SN 0.124
## PBC 0.134
## ECA 0.404
## ATT*ECA -0.030
## SN*ECA -0.081
## PBC*ECA 0.089
## ECC 0.106
## ATT*ECC 0.035
## SN*ECC 0.018
## PBC*ECC -0.054
## ECD 0.137
## ATT*ECD 0.028
## SN*ECD 0.054
## PBC*ECD -0.074# = 0.756
r2_excluded <- summary_simple$paths
r2_excluded## PI ATT SN PBC
## R^2 0.751 0.453 0.450 0.494
## AdjR^2 0.749 0.451 0.448 0.493
## ATT 0.118 . . .
## SN 0.125 . . .
## PBC 0.140 . . .
## ECA 0.418 0.363 0.140 0.121
## ECC 0.104 0.003 0.271 0.271
## ECD 0.130 0.357 0.344 0.395# =0.751
# Calculate f2
f2 = (0.756 - 0.751) / (1 - 0.756)
f2 #0.0204918## [1] 0.0204918#use kenny 2018 proposition to determine effects6.Create simple slope analysis plot
# FOR ECA
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECA",
iv="ATT",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECA",
iv="SN",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECA",
iv="PBC",
leg_place = "bottomright")
# FOR ECC
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECC",
iv="ATT",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECC",
iv="SN",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECC",
iv="PBC",
leg_place = "bottomright")
# FOR ECD
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECD",
iv="ATT",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECD",
iv="SN",
leg_place = "bottomright")
# check the steepness of the curve
slope_analysis(moderated_model = simple_mod_model,
dv="PI",
moderator = "ECD",
iv="PBC",
leg_place = "bottomright")
MONTE CARLO SIMULATION
Step 1: Set seed and simulations
- Purpose: Ensures reproducibility and simulation reliability.
set.seed(123)
n_sim <- 10000
n_sim## [1] 10000Step 2: Insert bootstrapped coefficients
✔ These preserve skewness and non-normality ✔ No distributional assumptions - Hypotheses addressed: i) MC-H1: Stability of ATT → PI ii) MC-H2: Stability of SN → PI iii) MC-H3: Stability of PBC → PI iv) MC-H4: Stability of AF → PI - Why: Defines the estimated TPB and labelling effects to be tested for robustness.
# Since we only have the bootstrap means, create vectors by repeating the mean
# This avoids assuming normality, but note: ideally we would use full 10,000 bootstrap resamples
# Create empirical bootstrap-based distributions
# check summary_boot$bootstrapped_paths and use the values of the CI for each of the constructs (no normality assumption)
boot_beta_ATT <- runif(n_sim, min = 0.067, max = 0.172) # ATT -> PI
boot_beta_SN <- runif(n_sim, min = 0.081, max = 0.168) # SN -> PI
boot_beta_PBC <- runif(n_sim, min = 0.084, max = 0.193) # PBC -> PI
boot_beta_ECA <- runif(n_sim, min = 0.353, max = 0.476) # ECA -> PI
boot_beta_ECC <- runif(n_sim, min = 0.061, max = 0.154) # ECC -> PI
boot_beta_ECD <- runif(n_sim, min = 0.070, max = 0.190) # ECD -> PIStep 3: Monte Carlo resampling from bootstrap distributions
✔ This is the key correction for non-normal data ✔ Hypotheses addressed: i) MC-H1 to MC-H4 (all) - Why: Tests whether the estimated effects remain stable under repeated resampling (Monte Carlo logic).
beta_ATT <- sample(boot_beta_ATT, n_sim, replace = TRUE)
beta_PBC <- sample(boot_beta_PBC, n_sim, replace = TRUE)
beta_SN <- sample(boot_beta_SN, n_sim, replace = TRUE)
beta_ECA <- sample(boot_beta_ECA, n_sim, replace = TRUE)
beta_ECC <- sample(boot_beta_ECC, n_sim, replace = TRUE)
beta_ECD <- sample(boot_beta_ECD, n_sim, replace = TRUE)Step 4: Simulate Purchase Intention (PI)
- It generates 10,000 simulated values of purchase intention under coefficient uncertainty.
- Hypothesis addressed:
- MC-H5 (Joint TPB + AF effect):
- ATT, SN, PBC, and WL jointly produce a positive purchase intention.
# Step 4: Simulate Purchase Intention
PI_sim <- beta_ATT +beta_PBC +beta_SN + beta_ECA + beta_ECC + beta_ECDStep 5: Summarise Monte Carlo results
- What this shows:Central tendency of PI, 90% uncertainty interval and Robustness of the TPB + WL effect
- Hypothesis addressed:
- MC-H5 (robustness under uncertainty)
- Why: Shows that PI remains positive across the uncertainty range.
# Step 5: Summary statistics
summary(PI_sim)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.7884 0.9835 1.0344 1.0346 1.0856 1.2859# Uncertainty range
quantile(PI_sim, probs = c(0.05, 0.50, 0.95))## 5% 50% 95%
## 0.9122382 1.0343958 1.1583858# Conclusion: Monte Carlo simulations based on bootstrap confidence intervals indicate that the combined effects of attitude, subjective norms, perceived behavioral control, and affordability on purchase intention remain positive and stable, with a 90% uncertainty interval of [0.901, 1.076].Step 6: Probability statement (VERY IMPORTANT)
- Hypothesis addressed:
- MC-H6 (Policy-relevant probability): ii)There is a high probability that purchase intention is positive.
# Probability that Purchase Intention is positive
mean(PI_sim > 0)## [1] 1# Monte Carlo simulations indicate a 100% probability that purchase intention remains positive, confirming the robustness of the extended TPB model under non-normal data conditions.Step 7: Sensitivity analysis
# Measure contribution of each path to PI variability
sens_ATT <- sd(beta_ATT)
sens_SN <- sd(beta_SN)
sens_PBC <- sd(beta_PBC)
sens_ECA <- sd(beta_ECA)
sens_ECC <- sd(beta_ECC)
sens_ECD <- sd(beta_ECD)
# Combine results
sensitivity_results <- data.frame(
Path = c("ATT → PI", "SN → PI", "PBC → PI", "ECA → PI","ECC→ PI", "ECD → PI"),
Sensitivity_SD = c(sens_ATT, sens_SN, sens_PBC, sens_ECA, sens_ECC, sens_ECD)
)
sensitivity_results# Relative sensitivity (% contribution)
sensitivity_results$Relative_Contribution <-
sensitivity_results$Sensitivity_SD / sum(sensitivity_results$Sensitivity_SD)
sensitivity_results