library(seminr)
library(tidyverse)
library(ggrepel) # for a plot later
data <- openxlsx::read.xlsx("MMM_influencer_data.xlsx")MMM WT 2023/24: Exercise 5
Set-up
Load relevant packages.
(If necessary) do all relevant steps from the last exercise.
- transform WTP to a numeric variable
- set up the model (mm and sm)
- estimate the model (model)
- summarize the estimated model (model_sum)
data$WP01_01_num <- gsub(pattern = ",", replacement = ".", data$WP01_01) %>%
as.numeric()
# Model set up
## Measurement model
mm <- constructs(
composite("SIC", multi_items("SC02_0", 1:7)),
composite("PL", multi_items("PL01_0", c(1, 4, 6, 7))),
composite("PQ", multi_items("PQ01_0", 1:4)),
composite("PI", multi_items("PI01_0", c(1, 2, 4, 5, 6))),
composite("WTP", single_item("WP01_01_num"))
)
## Structural model
sm <- relationships(
paths(from = "SIC", to = c("PL", "PQ", "PI")),
paths(from = "PL", to = "PI"),
paths(from = "PQ", to = "PI"),
paths(from = "PI", to = "WTP"))
# Estimate the model:
model <- estimate_pls(data = data,
measurement_model = mm,
structural_model = sm,
inner_weights = path_weighting)Generating the seminr modelAll 223 observations are valid.# Summarize the model
model_sum <- summary(model)formative measurement assessment
redundancy analysis for SIC
set up and estimate model
Measurement model
mm_SIC_redundancy <- constructs(
composite("SIC_multiitems", multi_items("SC02_0", 1:7), weights = mode_B),
composite("SIC_singleitem", single_item("SC05_01"))
)Structural model
sm_SIC_redundancy <- relationships(
paths(from = "SIC_multiitems", to = "SIC_singleitem")
)estimate, plot, bootstrap, and summarize the model
# estimate
model_SIC_redundancy <- estimate_pls(data = data,
measurement_model = mm_SIC_redundancy,
structural_model = sm_SIC_redundancy)Generating the seminr modelAll 223 observations are valid.# plot
plot(model_SIC_redundancy)# summarize model
model_SIC_redundancy_sum <- summary(model_SIC_redundancy)
# bootstrap
model_SIC_redundancy_boot <- bootstrap_model(
seminr_model = model_SIC_redundancy,
nboot = 1000, # number of bootstrap iterations
cores = parallel::detectCores(), # use all cores
seed = 1001) # seed to replicate results on your machine (may differ between different machines/systems etc.)Bootstrapping model using seminr...SEMinR Model successfully bootstrapped## Bootstrapping draws "random" (quasi-random) samples. Thus. the results differ between runs.
# summarize bootstrapped model
model_SIC_redundancy_boot_sum <- summary(model_SIC_redundancy_boot)get estimates and assess formative measurement model
step 1: convergent validity
model_SIC_redundancy_sum$paths SIC_singleitem
R^2 0.551
AdjR^2 0.549
SIC_multiitems 0.742Show an interpretation
# Path coefficient is 0.742 (i.e., higher than 0.707)
# Thus, and as indicated by the R^2 the multi-item measure can explain 0.551 = 55.1% (i.e., more than 50%) of the target construct's variance)
# --> Measurement can be considered as convergent valid.step 2: collinearity
model_SIC_redundancy_sum$validity$vif_itemsSIC_multiitems :
SC02_01 SC02_02 SC02_03 SC02_04 SC02_05 SC02_06 SC02_07
3.244 3.811 3.328 2.124 2.163 2.407 4.329
SIC_singleitem :
SC05_01
1 Show an interpretation
# All VIFs from SIC_multiitems are below 5.
# Thus, no collinearity problemsstep 3: indicator’s significance and relevance
weights
i.e., relative contribution –> considering all other indicators of the construct
redA_boot_weights <- model_SIC_redundancy_boot_sum$bootstrapped_weights
redA_boot_weights Original Est. Bootstrap Mean Bootstrap SD T Stat.
SC02_01 -> SIC_multiitems 0.204 0.211 0.103 1.970
SC02_02 -> SIC_multiitems 0.242 0.245 0.109 2.226
SC02_03 -> SIC_multiitems 0.218 0.215 0.109 2.009
SC02_04 -> SIC_multiitems 0.015 0.016 0.083 0.178
SC02_05 -> SIC_multiitems 0.101 0.108 0.085 1.194
SC02_06 -> SIC_multiitems -0.283 -0.282 0.091 -3.108
SC02_07 -> SIC_multiitems 0.538 0.520 0.122 4.402
SC05_01 -> SIC_singleitem 1.000 1.000 0.000 .
2.5% CI 97.5% CI
SC02_01 -> SIC_multiitems 0.002 0.426
SC02_02 -> SIC_multiitems 0.039 0.473
SC02_03 -> SIC_multiitems 0.014 0.436
SC02_04 -> SIC_multiitems -0.153 0.169
SC02_05 -> SIC_multiitems -0.071 0.267
SC02_06 -> SIC_multiitems -0.464 -0.114
SC02_07 -> SIC_multiitems 0.267 0.752
SC05_01 -> SIC_singleitem 1.000 1.000loadings
i.e., absolute contribution –> the information an indicator provides without considering any other indicators
redA_boot_loadings <- model_SIC_redundancy_boot_sum$bootstrapped_loadings
redA_boot_loadings Original Est. Bootstrap Mean Bootstrap SD T Stat.
SC02_01 -> SIC_multiitems 0.822 0.814 0.051 16.098
SC02_02 -> SIC_multiitems 0.898 0.890 0.032 28.464
SC02_03 -> SIC_multiitems 0.841 0.833 0.033 25.137
SC02_04 -> SIC_multiitems 0.614 0.607 0.066 9.288
SC02_05 -> SIC_multiitems 0.708 0.701 0.058 12.208
SC02_06 -> SIC_multiitems 0.556 0.552 0.069 8.003
SC02_07 -> SIC_multiitems 0.945 0.936 0.019 48.699
SC05_01 -> SIC_singleitem 1.000 1.000 0.000 .
2.5% CI 97.5% CI
SC02_01 -> SIC_multiitems 0.705 0.897
SC02_02 -> SIC_multiitems 0.823 0.946
SC02_03 -> SIC_multiitems 0.766 0.896
SC02_04 -> SIC_multiitems 0.473 0.728
SC02_05 -> SIC_multiitems 0.583 0.801
SC02_06 -> SIC_multiitems 0.412 0.680
SC02_07 -> SIC_multiitems 0.894 0.968
SC05_01 -> SIC_singleitem 1.000 1.000bringing it together
colnames(redA_boot_weights) <- paste0(colnames(redA_boot_weights), "_weights")
colnames(redA_boot_loadings) <- paste0(colnames(redA_boot_loadings), "_loadings")
redA_boot_indicAssess <- cbind(redA_boot_weights, redA_boot_loadings) %>%
as.data.frame()
redA_boot_indicAssess$path <- rownames(redA_boot_indicAssess)
ggplot(redA_boot_indicAssess %>% filter(path != "SC05_01 -> SIC_singleitem"),
aes(x = `Original Est._loadings`, y = `Original Est._weights`)) +
geom_errorbar(aes(xmin = `2.5% CI_loadings`, xmax = `97.5% CI_loadings`),
color = "blue") +
geom_errorbar(aes(ymin = `2.5% CI_weights`, ymax = `97.5% CI_weights`),
color = "red") +
geom_point() +
geom_label_repel(aes(label = path),
alpha = 0.5) +
ylab("Weights") +
xlab("Loadings") +
theme_minimal()
Please note that the estimates can differ on your laptop / system since the bootstrap is a pseudo-random procedure!
Show an interpretation
# Outer weight significance testing (i.e., weights should be significantly different from 0)
## Weights that are significantly different from zero --> keep in model and interpret
### SC02_01 (weight = 0.204; SD = 0.103; t = 1.970; CI95% = [0.002;0.426])
### SC02_02 (weight = 0.242; SD = 0.109; t = 2.226; CI95% = [0.039;0.473])
### SC02_03 (weight = 0.218; SD = 0.109; t = 2.009; CI95% = [0.014;0.436])
### SC02_06 (weight = -0.283; SD = 0.091; t = -3.108; CI95% = [0.464;-0.114])
#### btw: seems weird that this indicator a negative weight --> indicates a misspecification!
### SC02_07 (weight = 0.538; SD = 0.122; t = 4.402; CI95% = [0.267;0.752])
## Weights that are not significantly different from zero --> Analyze the formative indicator’s outer loading
### SC02_04 (weight = 0.015; SD = 0.083; t = 0.178; CI95% = [-0.153;0.169])
### SC02_05 (weight = 0.101; SD = 0.085; t = 1.194; CI95% = [-0.071;0.267])
## Loadings that are at least 0.5 --> Keep the indicator even though it is not significant
### SC02_04 (loading = 0.614)
### SC02_05 (loading = 0.708)
## No indicators should be considered for removal!