library(readxl)
library(psych)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(seminr)data <- read_excel("Data.xlsx")
head(data)## # A tibble: 6 × 21
## Timestamp Gender `Age Group` I am interested in finding out th…¹
## <dttm> <chr> <chr> <dbl>
## 1 2020-02-11 12:08:02 Female 21-25 years old 3
## 2 2020-02-11 13:34:27 Female 26-30 tahun 4
## 3 2020-02-11 14:03:23 Female 21-25 tahun 5
## 4 2020-02-11 14:08:24 Female 21-25 tahun 4
## 5 2020-02-11 15:00:58 Female 16-20 tahun 4
## 6 2020-02-11 15:02:29 Female 21-25 tahun 5
## # ℹ abbreviated name:
## # ¹`I am interested in finding out the products (clothing, cosmetics, food, beverages) used by celebrities/athletes/public figures that I like`
## # ℹ 17 more variables:
## # `If I find the product I'm looking for, I'll most likely buy it` <dbl>,
## # `I use an online shopping application that is endorsed/used by celebrities/athletes/public figures that I like` <dbl>,
## # `Social media helps me get information about the product I'm looking for` <dbl>,
## # `On social media, testimonials / reviews in the comments column help me in considering the product I will buy` <dbl>, …colnames(data)## [1] "Timestamp"
## [2] "Gender"
## [3] "Age Group"
## [4] "I am interested in finding out the products (clothing, cosmetics, food, beverages) used by celebrities/athletes/public figures that I like"
## [5] "If I find the product I'm looking for, I'll most likely buy it"
## [6] "I use an online shopping application that is endorsed/used by celebrities/athletes/public figures that I like"
## [7] "Social media helps me get information about the product I'm looking for"
## [8] "On social media, testimonials / reviews in the comments column help me in considering the product I will buy"
## [9] "When I come across a product, I find out more through its official social media accounts"
## [10] "In the era of internet technology like now, it's hard to trust the credibility of a product that doesn't have its own social media account"
## [11] "The existence of promotions (cashback, free shipping, speed of delivery, vouchers, discounted prices) affects the products I want to buy"
## [12] "The existence of promotions (cashback, free shipping, speed of delivery, vouchers, discounted prices) makes me more efficient"
## [13] "The existence of promotions (cashback, free shipping, speed of delivery, vouchers, discounted prices) must be used immediately before the validity period expires"
## [14] "The existence of promotions (cashback, free shipping, speed of delivery, vouchers, discounted prices) helps me to fulfill the product I want"
## [15] "The existence of promotions (cashback, free shipping, speed of delivery, vouchers, discounted prices) helps me to meet the products I need"
## [16] "Endorsements or promotions by celebrities/athletes/public figures that I like motivate me to buy the product"
## [17] "Product advertisements on social media convinced me to buy the product"
## [18] "Sales promotions (cashback, free delivery, vouchers, speed of delivery) encourage me to buy the product"
## [19] "I feel satisfied buying products that are also used by celebrities/athletes/public figures"
## [20] "I feel satisfied buying products that I get information from social media"
## [21] "I am satisfied after successfully using the promos (cashback, free delivery, vouchers, delivery speed) that are offered"colnames(data)[4:21] <- c(
"CE1", "CE2", "CE3",
"SM1", "SM2", "SM3", "SM4",
"P1", "P2", "P3", "P4", "P5",
"PD1", "PD2", "PD3",
"CS1", "CS2", "CS3"
)colnames(data)## [1] "Timestamp" "Gender" "Age Group" "CE1" "CE2" "CE3"
## [7] "SM1" "SM2" "SM3" "SM4" "P1" "P2"
## [13] "P3" "P4" "P5" "PD1" "PD2" "PD3"
## [19] "CS1" "CS2" "CS3"str(data)## tibble [306 × 21] (S3: tbl_df/tbl/data.frame)
## $ Timestamp: POSIXct[1:306], format: "2020-02-11 12:08:02" "2020-02-11 13:34:27" ...
## $ Gender : chr [1:306] "Female" "Female" "Female" "Female" ...
## $ Age Group: chr [1:306] "21-25 years old" "26-30 tahun" "21-25 tahun" "21-25 tahun" ...
## $ CE1 : num [1:306] 3 4 5 4 4 5 5 1 2 5 ...
## $ CE2 : num [1:306] 4 5 5 5 3 5 5 1 4 5 ...
## $ CE3 : num [1:306] 3 5 5 4 4 5 5 1 2 3 ...
## $ SM1 : num [1:306] 5 5 5 5 5 5 5 4 4 5 ...
## $ SM2 : num [1:306] 5 5 5 5 5 5 5 4 5 5 ...
## $ SM3 : num [1:306] 5 4 5 5 5 5 5 5 4 5 ...
## $ SM4 : num [1:306] 4 5 5 3 4 5 5 3 4 5 ...
## $ P1 : num [1:306] 5 5 5 5 5 5 5 3 5 5 ...
## $ P2 : num [1:306] 5 5 5 4 5 5 5 3 5 5 ...
## $ P3 : num [1:306] 3 4 5 2 4 5 5 1 3 2 ...
## $ P4 : num [1:306] 5 4 5 4 5 5 5 2 5 4 ...
## $ P5 : num [1:306] 5 4 5 3 5 5 5 4 4 4 ...
## $ PD1 : num [1:306] 3 4 5 4 4 4 5 1 3 4 ...
## $ PD2 : num [1:306] 4 4 5 5 4 4 5 1 3 3 ...
## $ PD3 : num [1:306] 4 5 5 4 4 5 5 1 3 4 ...
## $ CS1 : num [1:306] 4 4 5 3 4 4 5 1 3 4 ...
## $ CS2 : num [1:306] 4 4 5 4 4 5 5 4 4 4 ...
## $ CS3 : num [1:306] 4 4 5 5 4 5 5 1 4 4 ...dim(data)## [1] 306 21head(data)## # A tibble: 6 × 21
## Timestamp Gender `Age Group` CE1 CE2 CE3 SM1 SM2 SM3
## <dttm> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2020-02-11 12:08:02 Female 21-25 years old 3 4 3 5 5 5
## 2 2020-02-11 13:34:27 Female 26-30 tahun 4 5 5 5 5 4
## 3 2020-02-11 14:03:23 Female 21-25 tahun 5 5 5 5 5 5
## 4 2020-02-11 14:08:24 Female 21-25 tahun 4 5 4 5 5 5
## 5 2020-02-11 15:00:58 Female 16-20 tahun 4 3 4 5 5 5
## 6 2020-02-11 15:02:29 Female 21-25 tahun 5 5 5 5 5 5
## # ℹ 12 more variables: SM4 <dbl>, P1 <dbl>, P2 <dbl>, P3 <dbl>, P4 <dbl>,
## # P5 <dbl>, PD1 <dbl>, PD2 <dbl>, PD3 <dbl>, CS1 <dbl>, CS2 <dbl>, CS3 <dbl>data_sem <- data %>%
select(
CE1, CE2, CE3,
SM1, SM2, SM3, SM4,
P1, P2, P3, P4, P5,
PD1, PD2, PD3,
CS1, CS2, CS3
)deskriptif <- psych::describe(data_sem)
deskriptif## vars n mean sd median trimmed mad min max range skew kurtosis se
## CE1 1 306 3.36 1.16 3 3.44 1.48 1 5 4 -0.38 -0.55 0.07
## CE2 2 306 3.42 1.09 3 3.48 1.48 1 5 4 -0.40 -0.34 0.06
## CE3 3 306 2.87 1.21 3 2.84 1.48 1 5 4 0.13 -0.84 0.07
## SM1 4 306 4.50 0.86 5 4.70 0.00 1 5 4 -2.14 4.85 0.05
## SM2 5 306 4.41 0.88 5 4.58 0.00 1 5 4 -1.74 3.22 0.05
## SM3 6 306 4.38 0.96 5 4.57 0.00 1 5 4 -1.81 3.12 0.05
## SM4 7 306 3.97 1.03 4 4.11 1.48 1 5 4 -0.82 0.02 0.06
## P1 8 306 4.33 0.91 5 4.49 0.00 1 5 4 -1.52 2.25 0.05
## P2 9 306 4.36 0.90 5 4.52 0.00 1 5 4 -1.47 1.91 0.05
## P3 10 306 3.72 1.10 4 3.81 1.48 1 5 4 -0.43 -0.58 0.06
## P4 11 306 4.12 0.88 4 4.21 1.48 1 5 4 -0.75 0.04 0.05
## P5 12 306 4.11 0.92 4 4.21 1.48 1 5 4 -0.75 -0.13 0.05
## PD1 13 306 3.12 1.09 3 3.15 1.48 1 5 4 -0.20 -0.26 0.06
## PD2 14 306 3.31 0.94 3 3.30 1.48 1 5 4 -0.08 -0.06 0.05
## PD3 15 306 3.77 0.88 4 3.80 1.48 1 5 4 -0.27 -0.41 0.05
## CS1 16 306 3.21 1.04 3 3.24 1.48 1 5 4 -0.32 -0.25 0.06
## CS2 17 306 3.63 0.89 4 3.68 1.48 1 5 4 -0.37 -0.11 0.05
## CS3 18 306 4.09 0.90 4 4.19 1.48 1 5 4 -0.95 0.84 0.05sum(is.na(data_sem))## [1] 0sum(duplicated(data))## [1] 0range_check <- sapply(data_sem, function(x) {
c(min = min(x, na.rm = TRUE),
max = max(x, na.rm = TRUE))
})
range_check## CE1 CE2 CE3 SM1 SM2 SM3 SM4 P1 P2 P3 P4 P5 PD1 PD2 PD3 CS1 CS2 CS3
## min 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## max 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5KMO(cor(data_sem))## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = cor(data_sem))
## Overall MSA = 0.9
## MSA for each item =
## CE1 CE2 CE3 SM1 SM2 SM3 SM4 P1 P2 P3 P4 P5 PD1 PD2 PD3 CS1
## 0.90 0.96 0.91 0.90 0.89 0.86 0.90 0.91 0.91 0.92 0.87 0.87 0.86 0.91 0.90 0.89
## CS2 CS3
## 0.90 0.92#Estimasi Parameter (OLS) ## Spesifikasi measurement model (outer model)
measurement_model <- constructs(
composite("CE", multi_items("CE", 1:3)),
composite("SM", multi_items("SM", 1:4)),
composite("P", multi_items("P", 1:5)),
composite("PD", multi_items("PD", 1:3)),
composite("CS", multi_items("CS", 1:3))
)structural_model <- relationships(
paths(from = c("CE", "SM", "P"),
to = c("PD", "CS")),
paths(from = "PD",
to = "CS")
)pls_model <- estimate_pls(
data = data_sem,
measurement_model = measurement_model,
structural_model = structural_model
)## Generating the seminr model## All 306 observations are valid.pls_model$outer_loadings## CE SM P PD CS
## CE1 0.8255428 0.0000000 0.0000000 0.0000000 0.0000000
## CE2 0.7594101 0.0000000 0.0000000 0.0000000 0.0000000
## CE3 0.8137399 0.0000000 0.0000000 0.0000000 0.0000000
## SM1 0.0000000 0.8288466 0.0000000 0.0000000 0.0000000
## SM2 0.0000000 0.8552974 0.0000000 0.0000000 0.0000000
## SM3 0.0000000 0.8476172 0.0000000 0.0000000 0.0000000
## SM4 0.0000000 0.6091003 0.0000000 0.0000000 0.0000000
## P1 0.0000000 0.0000000 0.7180864 0.0000000 0.0000000
## P2 0.0000000 0.0000000 0.7735169 0.0000000 0.0000000
## P3 0.0000000 0.0000000 0.6513138 0.0000000 0.0000000
## P4 0.0000000 0.0000000 0.8642381 0.0000000 0.0000000
## P5 0.0000000 0.0000000 0.8189494 0.0000000 0.0000000
## PD1 0.0000000 0.0000000 0.0000000 0.8229782 0.0000000
## PD2 0.0000000 0.0000000 0.0000000 0.8655732 0.0000000
## PD3 0.0000000 0.0000000 0.0000000 0.6927566 0.0000000
## CS1 0.0000000 0.0000000 0.0000000 0.0000000 0.7976963
## CS2 0.0000000 0.0000000 0.0000000 0.0000000 0.8261867
## CS3 0.0000000 0.0000000 0.0000000 0.0000000 0.7841342CRAVE <- summary(pls_model)$reliability
CRAVE## alpha rhoA rhoC AVE
## CE 0.719 0.723 0.842 0.640
## SM 0.795 0.815 0.869 0.627
## P 0.824 0.835 0.877 0.591
## PD 0.711 0.729 0.838 0.635
## CS 0.725 0.728 0.845 0.645
##
## Alpha, rhoA, and rhoC should exceed 0.7 while AVE should exceed 0.5summary(pls_model)$validity$htmt## CE SM P PD CS
## CE . . . . .
## SM 0.424 . . . .
## P 0.523 0.756 . . .
## PD 0.888 0.507 0.651 . .
## CS 0.776 0.639 0.741 0.945 .summary(pls_model)$validity$fl_criteria## CE SM P PD CS
## CE 0.800 . . . .
## SM 0.324 0.792 . . .
## P 0.403 0.609 0.769 . .
## PD 0.652 0.374 0.490 0.797 .
## CS 0.576 0.477 0.574 0.692 0.803
##
## FL Criteria table reports square root of AVE on the diagonal and construct correlations on the lower triangle.Indikator yang masih dipertimbangkan saat loading faktor yaitu (SM4, P3, PD3). Karena di HTMT yang bermasalah itu CS dengan PD, maka dihapus PD3 terlebih dahulu
data_sem_test <- data_sem %>%
select(-PD3)measurement_model_test <- constructs(
composite("CE", multi_items("CE", 1:3)),
composite("SM", multi_items("SM", 1:4)),
composite("P", multi_items("P", 1:5)),
composite("PD", multi_items("PD", 1:2)),
composite("CS", multi_items("CS", 1:3))
)structural_model <- relationships(
paths(from = c("CE","SM","P"),
to = c("PD","CS")),
paths(from = "PD",
to = "CS")
)pls_model_test <- estimate_pls(
data = data_sem_test,
measurement_model = measurement_model_test,
structural_model = structural_model
)## Generating the seminr model## All 306 observations are valid.summary(pls_model_test)$validity$htmt## CE SM P PD CS
## CE . . . . .
## SM 0.424 . . . .
## P 0.523 0.756 . . .
## PD 0.909 0.418 0.502 . .
## CS 0.776 0.639 0.741 0.889 .summary(pls_model_test)$reliability## alpha rhoA rhoC AVE
## CE 0.719 0.726 0.842 0.640
## SM 0.795 0.811 0.869 0.627
## P 0.824 0.836 0.877 0.591
## PD 0.734 0.743 0.882 0.789
## CS 0.725 0.730 0.844 0.644
##
## Alpha, rhoA, and rhoC should exceed 0.7 while AVE should exceed 0.5pls_model_test$outer_loadings## CE SM P PD CS
## CE1 0.8279249 0.0000000 0.0000000 0.0000000 0.0000000
## CE2 0.7517625 0.0000000 0.0000000 0.0000000 0.0000000
## CE3 0.8181950 0.0000000 0.0000000 0.0000000 0.0000000
## SM1 0.0000000 0.8278638 0.0000000 0.0000000 0.0000000
## SM2 0.0000000 0.8522975 0.0000000 0.0000000 0.0000000
## SM3 0.0000000 0.8483586 0.0000000 0.0000000 0.0000000
## SM4 0.0000000 0.6136244 0.0000000 0.0000000 0.0000000
## P1 0.0000000 0.0000000 0.7129005 0.0000000 0.0000000
## P2 0.0000000 0.0000000 0.7698613 0.0000000 0.0000000
## P3 0.0000000 0.0000000 0.6589751 0.0000000 0.0000000
## P4 0.0000000 0.0000000 0.8669040 0.0000000 0.0000000
## P5 0.0000000 0.0000000 0.8162243 0.0000000 0.0000000
## PD1 0.0000000 0.0000000 0.0000000 0.9041824 0.0000000
## PD2 0.0000000 0.0000000 0.0000000 0.8721808 0.0000000
## CS1 0.0000000 0.0000000 0.0000000 0.0000000 0.8018332
## CS2 0.0000000 0.0000000 0.0000000 0.0000000 0.8269678
## CS3 0.0000000 0.0000000 0.0000000 0.0000000 0.7783731summary(pls_model_test)$validity$fl_criteria## CE SM P PD CS
## CE 0.800 . . . .
## SM 0.323 0.792 . . .
## P 0.403 0.605 0.768 . .
## PD 0.670 0.315 0.397 0.888 .
## CS 0.578 0.475 0.573 0.664 0.803
##
## FL Criteria table reports square root of AVE on the diagonal and construct correlations on the lower triangle.summary(pls_model_test)$validity$cross_loadings## CE SM P PD CS
## CE1 0.828 0.316 0.349 0.575 0.507
## CE2 0.752 0.259 0.343 0.447 0.458
## CE3 0.818 0.198 0.278 0.577 0.421
## SM1 0.336 0.828 0.544 0.241 0.404
## SM2 0.247 0.852 0.500 0.281 0.431
## SM3 0.250 0.848 0.487 0.247 0.343
## SM4 0.179 0.614 0.368 0.221 0.312
## P1 0.284 0.661 0.713 0.278 0.447
## P2 0.292 0.535 0.770 0.207 0.347
## P3 0.370 0.224 0.659 0.356 0.395
## P4 0.342 0.447 0.867 0.366 0.538
## P5 0.252 0.483 0.816 0.283 0.432
## PD1 0.681 0.236 0.336 0.904 0.596
## PD2 0.499 0.330 0.373 0.872 0.584
## CS1 0.666 0.224 0.359 0.704 0.802
## CS2 0.378 0.485 0.438 0.490 0.827
## CS3 0.305 0.466 0.606 0.369 0.778summary(pls_model_test)$paths## PD CS
## R^2 0.469 0.579
## AdjR^2 0.464 0.573
## CE 0.605 0.147
## SM 0.042 0.136
## P 0.128 0.266
## PD . 0.417summary(pls_model_test)$fSquare## CE SM P PD CS
## CE 0.000 0.000 0.000 0.566 0.032
## SM 0.000 0.000 0.000 0.002 0.017
## P 0.000 0.000 0.000 0.017 0.075
## PD 0.000 0.000 0.000 0.000 0.221
## CS 0.000 0.000 0.000 0.000 0.000summary(pls_model_test)$vif_antecedents## PD :
## CE SM P
## 1.209 1.597 1.708
##
## CS :
## CE SM P PD
## 1.898 1.600 1.739 1.884boot_model <- bootstrap_model(
seminr_model = pls_model_test,
nboot = 5000,
cores = 1
)## Bootstrapping model using seminr...## SEMinR Model successfully bootstrappedsummary(boot_model)##
## Results from Bootstrap resamples: 5000
##
## Bootstrapped Structural Paths:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI 97.5% CI
## CE -> PD 0.605 0.605 0.041 14.777 0.520 0.682
## CE -> CS 0.147 0.148 0.062 2.375 0.030 0.272
## SM -> PD 0.042 0.043 0.071 0.587 -0.101 0.179
## SM -> CS 0.136 0.141 0.053 2.542 0.042 0.250
## P -> PD 0.128 0.130 0.063 2.033 0.001 0.249
## P -> CS 0.266 0.266 0.054 4.934 0.157 0.370
## PD -> CS 0.417 0.414 0.070 5.936 0.265 0.542
## Bootstrap P Val
## CE -> PD 0.000
## CE -> CS 0.015
## SM -> PD 0.538
## SM -> CS 0.004
## P -> PD 0.047
## P -> CS 0.000
## PD -> CS 0.000
##
## Bootstrapped Weights:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI 97.5% CI
## CE1 -> CE 0.452 0.452 0.025 17.835 0.405 0.505
## CE2 -> CE 0.376 0.376 0.027 13.808 0.319 0.429
## CE3 -> CE 0.420 0.420 0.023 18.006 0.377 0.470
## SM1 -> SM 0.331 0.330 0.035 9.420 0.261 0.400
## SM2 -> SM 0.362 0.364 0.036 10.000 0.303 0.446
## SM3 -> SM 0.297 0.295 0.029 10.144 0.233 0.349
## SM4 -> SM 0.269 0.270 0.042 6.340 0.189 0.355
## P1 -> P 0.261 0.260 0.026 9.932 0.209 0.311
## P2 -> P 0.200 0.200 0.025 7.983 0.145 0.245
## P3 -> P 0.261 0.261 0.030 8.660 0.206 0.326
## P4 -> P 0.322 0.322 0.030 10.912 0.270 0.385
## P5 -> P 0.256 0.256 0.025 10.207 0.206 0.305
## PD1 -> PD 0.600 0.600 0.024 25.002 0.557 0.651
## PD2 -> PD 0.524 0.525 0.016 33.396 0.494 0.556
## CS1 -> CS 0.466 0.464 0.027 17.175 0.416 0.524
## CS2 -> CS 0.398 0.400 0.020 19.628 0.360 0.439
## CS3 -> CS 0.381 0.382 0.027 14.021 0.326 0.433
## Bootstrap P Val
## CE1 -> CE 0.000
## CE2 -> CE 0.000
## CE3 -> CE 0.000
## SM1 -> SM 0.000
## SM2 -> SM 0.000
## SM3 -> SM 0.000
## SM4 -> SM 0.000
## P1 -> P 0.000
## P2 -> P 0.000
## P3 -> P 0.000
## P4 -> P 0.000
## P5 -> P 0.000
## PD1 -> PD 0.000
## PD2 -> PD 0.000
## CS1 -> CS 0.000
## CS2 -> CS 0.000
## CS3 -> CS 0.000
##
## Bootstrapped Loadings:
## Original Est. Bootstrap Mean Bootstrap SD T Stat. 2.5% CI 97.5% CI
## CE1 -> CE 0.828 0.827 0.023 36.482 0.778 0.867
## CE2 -> CE 0.752 0.750 0.037 20.457 0.668 0.811
## CE3 -> CE 0.818 0.818 0.023 35.590 0.769 0.858
## SM1 -> SM 0.828 0.825 0.030 27.540 0.759 0.876
## SM2 -> SM 0.852 0.853 0.023 37.388 0.802 0.892
## SM3 -> SM 0.848 0.844 0.031 27.127 0.771 0.895
## SM4 -> SM 0.614 0.610 0.066 9.326 0.473 0.725
## P1 -> P 0.713 0.710 0.046 15.626 0.609 0.787
## P2 -> P 0.770 0.767 0.035 21.910 0.685 0.825
## P3 -> P 0.659 0.659 0.038 17.295 0.579 0.729
## P4 -> P 0.867 0.868 0.020 43.001 0.822 0.901
## P5 -> P 0.816 0.815 0.030 26.870 0.748 0.868
## PD1 -> PD 0.904 0.904 0.012 77.021 0.880 0.925
## PD2 -> PD 0.872 0.871 0.023 37.450 0.820 0.911
## CS1 -> CS 0.802 0.800 0.028 28.934 0.739 0.847
## CS2 -> CS 0.827 0.827 0.027 30.279 0.767 0.873
## CS3 -> CS 0.778 0.778 0.034 22.655 0.701 0.836
## Bootstrap P Val
## CE1 -> CE 0.000
## CE2 -> CE 0.000
## CE3 -> CE 0.000
## SM1 -> SM 0.000
## SM2 -> SM 0.000
## SM3 -> SM 0.000
## SM4 -> SM 0.000
## P1 -> P 0.000
## P2 -> P 0.000
## P3 -> P 0.000
## P4 -> P 0.000
## P5 -> P 0.000
## PD1 -> PD 0.000
## PD2 -> PD 0.000
## CS1 -> CS 0.000
## CS2 -> CS 0.000
## CS3 -> CS 0.000
##
## Bootstrapped HTMT:
## Original Est. Bootstrap Mean Bootstrap SD 2.5% CI 97.5% CI
## CE -> SM 0.424 0.426 0.062 0.307 0.546
## CE -> P 0.523 0.524 0.059 0.405 0.638
## CE -> PD 0.909 0.910 0.046 0.816 1.002
## CE -> CS 0.776 0.777 0.060 0.656 0.893
## SM -> P 0.756 0.755 0.051 0.647 0.850
## SM -> PD 0.418 0.420 0.079 0.263 0.571
## SM -> CS 0.639 0.644 0.072 0.495 0.776
## P -> PD 0.502 0.503 0.060 0.385 0.620
## P -> CS 0.741 0.743 0.055 0.631 0.846
## PD -> CS 0.889 0.894 0.065 0.758 1.013
## Bootstrap P Val
## CE -> SM 0.000
## CE -> P 0.000
## CE -> PD 0.055
## CE -> CS 0.000
## SM -> P 0.000
## SM -> PD 0.000
## SM -> CS 0.000
## P -> PD 0.000
## P -> CS 0.000
## PD -> CS 0.079
##
## Bootstrapped Total Paths:
## Original Est. Bootstrap Mean Bootstrap SD 2.5% CI 97.5% CI
## CE -> PD 0.605 0.605 0.041 0.520 0.682
## CE -> CS 0.399 0.398 0.046 0.306 0.487
## SM -> PD 0.042 0.043 0.071 -0.101 0.179
## SM -> CS 0.153 0.158 0.063 0.039 0.281
## P -> PD 0.128 0.130 0.063 0.001 0.249
## P -> CS 0.319 0.320 0.060 0.198 0.438
## PD -> CS 0.417 0.414 0.070 0.265 0.542# jumlah bootstrap
n_boot <- dim(boot_model$boot_paths)[3]
# simpan hasil
indirect_CE <- numeric(n_boot)
indirect_SM <- numeric(n_boot)
indirect_P <- numeric(n_boot)
for(i in 1:n_boot){
# bootstrap matrix ke-i
b <- boot_model$boot_paths[,,i]
# indirect effect
indirect_CE[i] <- b["CE","PD"] * b["PD","CS"]
indirect_SM[i] <- b["SM","PD"] * b["PD","CS"]
indirect_P[i] <- b["P","PD"] * b["PD","CS"]
}
# original indirect effect
orig_CE <- pls_model_test$path_coef["CE","PD"] *
pls_model_test$path_coef["PD","CS"]
orig_SM <- pls_model_test$path_coef["SM","PD"] *
pls_model_test$path_coef["PD","CS"]
orig_P <- pls_model_test$path_coef["P","PD"] *
pls_model_test$path_coef["PD","CS"]
# ringkasan bootstrap
boot_summary <- function(orig, boot_dist){
sd_boot <- sd(boot_dist)
t_stat <- abs(orig / sd_boot)
p_val <- 2 * (1 - pnorm(t_stat))
c(
Original = orig,
STDEV = sd_boot,
T_Stat = t_stat,
P_Value = p_val
)
}
hasil_indirect <- rbind(
"CE -> PD -> CS" = boot_summary(orig_CE, indirect_CE),
"SM -> PD -> CS" = boot_summary(orig_SM, indirect_SM),
"P -> PD -> CS" = boot_summary(orig_P, indirect_P)
)
round(hasil_indirect, 3)## Original STDEV T_Stat P_Value
## CE -> PD -> CS 0.252 0.044 5.700 0.000
## SM -> PD -> CS 0.017 0.030 0.586 0.558
## P -> PD -> CS 0.053 0.029 1.826 0.068