MMM WT 2022/23: Exercise 6

Author

Affiliation

Susanne Adler

Institute for Marketing, Ludwig-Maximilians-University Munich

Set-up

Load relevant packages.

library(seminr)
library(dplyr)

data <- openxlsx::read.xlsx("MMM_influencer_data.xlsx")

(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)
bootstrap and summarize the model (model_boot and model_boot_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 model

All 223 observations are valid.

# Summarize the model
model_sum <- summary(model)

# Bootstrap

model_boot <- bootstrap_model(
  seminr_model = model,
  nboot = 1000, # number of bootstrap iterations
  cores = parallel::detectCores(), # use all cores
  seed = 1001)

Bootstrapping model using seminr...

SEMinR Model successfully bootstrapped

model_boot_sum <- summary(model_boot)

Explanatory power

R²

model_sum$paths

          PL    PQ    PI   WTP
R^2    0.206 0.159 0.622 0.194
AdjR^2 0.203 0.155 0.616 0.190
SIC    0.454 0.398 0.044     .
PL         .     . 0.654     .
PQ         .     . 0.145     .
PI         .     .     . 0.441

Show an interpretation

# Explanatory power for PI: R² = 0.622 --> moderate to substantial explanatory power
# Explanatory power for WTP: R² = 0.194 --> at best weak explanatory power

f²

model_sum$fSquare

      SIC    PL    PQ    PI   WTP
SIC 0.000 0.260 0.189 0.004 0.000
PL  0.000 0.000 0.000 0.477 0.000
PQ  0.000 0.000 0.000 0.025 0.000
PI  0.000 0.000 0.000 0.000 0.241
WTP 0.000 0.000 0.000 0.000 0.000

Show an interpretation

# PI antecedents:

## SIC: f² = 0.004 --> only explains an additional 0.4% of PI's variance --> no effect
## PL: f² = 0.477 -->  explains an additional 47.4% of PI's variance --> strong effect
## PQ: f² = 0.025 -->  explains an additional 2.5% of PI's variance --> weak effect

Predictive power

generate predictions

set.seed(1001) # to set  seed for the pseudo-random procedure
predict_model <- predict_pls(
  model = model,
  technique = predict_DA,
  noFolds = 10,
  reps = 10)

predict_model_sum <- summary(predict_model)

assuming that Q² > 0 (task said so!)

evaluate whether errors are symmetrically distributed

plot(predict_model_sum,
     indicator = "WP01_01_num")

Show an interpretation

# Graph does not show a symmetric distribution

compare RMSE and MAE for WTP (out-of-sample prediction)

predict_model_sum


PLS in-sample metrics:
     PL01_01 PL01_04 PL01_06 PL01_07 PQ01_01 PQ01_02 PQ01_03 PQ01_04 PI01_01
RMSE   1.620   1.725   1.635   1.645   1.375   1.455   1.400   1.435   1.196
MAE    1.340   1.499   1.379   1.423   1.087   1.168   1.112   1.170   0.933
     PI01_02 PI01_04 PI01_05 PI01_06 WP01_01_num
RMSE   1.380   1.244   1.330   1.245      15.235
MAE    1.072   0.977   1.056   1.006      10.517

PLS out-of-sample metrics:
     PL01_01 PL01_04 PL01_06 PL01_07 PQ01_01 PQ01_02 PQ01_03 PQ01_04 PI01_01
RMSE   1.635   1.740   1.651   1.665   1.394   1.473   1.416   1.455   1.214
MAE    1.351   1.511   1.389   1.439   1.105   1.184   1.125   1.187   0.948
     PI01_02 PI01_04 PI01_05 PI01_06 WP01_01_num
RMSE   1.392   1.263   1.344   1.262      15.484
MAE    1.080   0.991   1.066   1.019      10.684

LM in-sample metrics:
     PL01_01 PL01_04 PL01_06 PL01_07 PQ01_01 PQ01_02 PQ01_03 PQ01_04 PI01_01
RMSE   0.927   1.107   1.031   1.259   0.974   1.061   1.056   1.021   1.090
MAE    0.715   0.858   0.788   1.018   0.765   0.794   0.805   0.817   0.829
     PI01_02 PI01_04 PI01_05 PI01_06 WP01_01_num
RMSE   1.293   1.134   1.193   1.130      13.357
MAE    1.013   0.888   0.951   0.902       8.991

LM out-of-sample metrics:
     PL01_01 PL01_04 PL01_06 PL01_07 PQ01_01 PQ01_02 PQ01_03 PQ01_04 PI01_01
RMSE   1.047   1.234   1.148   1.371   1.097   1.194   1.172   1.142   1.208
MAE    0.792   0.947   0.871   1.106   0.856   0.889   0.892   0.912   0.915
     PI01_02 PI01_04 PI01_05 PI01_06 WP01_01_num
RMSE   1.420   1.284   1.316   1.239      15.434
MAE    1.099   0.994   1.045   0.999      10.262

Show an interpretation

# RMSE larger in PLS (15.484) than in LM (15.434)
# MAE larger in PLS (10.684) than in LM (10.262)

# both error metrics larger in PLS than in LM --> larger errors in PLS than in LM --> bad predictive power