## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(seminr)
library(seminrExtras)

# set the theme for plotting output
seminr_theme_set(seminr_theme_academic())

# Create measurement model ----
corp_rep_mm_ext <- constructs(
  composite("QUAL", multi_items("qual_", 1:8), weights = mode_B),
  composite("PERF", multi_items("perf_", 1:5), weights = mode_B),
  composite("CSOR", multi_items("csor_", 1:5), weights = mode_B),
  composite("ATTR", multi_items("attr_", 1:3), weights = mode_B),
  composite("COMP", multi_items("comp_", 1:3)),
  composite("LIKE", multi_items("like_", 1:3)),
  composite("CUSA", single_item("cusa")),
  composite("CUSL", multi_items("cusl_", 1:3))
)

alt_mm <- constructs(
  composite("QUAL", multi_items("qual_", 1:8), weights = mode_B),
  composite("PERF", multi_items("perf_", 1:5), weights = mode_B),
  composite("CSOR", multi_items("csor_", 1:5), weights = mode_B),
  composite("ATTR", multi_items("attr_", 1:3), weights = mode_B),
  composite("COMP", multi_items("comp_", 1:3)),
  composite("LIKE", multi_items("like_", 1:3)),
  composite("CUSA", single_item("cusa")),
  composite("CUSL", multi_items("cusl_", 1:3))
)

# Create structural model ----
corp_rep_sm_ext <- relationships(
  paths(from = c("QUAL", "PERF", "CSOR", "ATTR"), to = c("COMP", "LIKE")),
  paths(from = c("COMP", "LIKE"), to = c("CUSA", "CUSL")),
  paths(from = c("CUSA"),         to = c("CUSL"))
)
alt_sm <- relationships(
  paths(from = c("QUAL", "PERF", "CSOR", "ATTR"), to = c("COMP", "LIKE")),
  paths(from = c("COMP", "LIKE"), to = c("CUSA")),
  paths(from = c("CUSA"),         to = c("CUSL"))
)


# Estimate the models ----
established_model <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_ext,
  structural_model  = corp_rep_sm_ext,
  missing = mean_replacement,
  missing_value = "-99")

competing_model <- estimate_pls(
  data = corp_rep_data,
  measurement_model = alt_mm,
  structural_model  = alt_sm,
  missing = mean_replacement,
  missing_value = "-99")



## ----fig.show='hold'----------------------------------------------------------
plot(established_model)
plot(competing_model)

## ----eval=FALSE, echo=TRUE----------------------------------------------------
# 
# # Create measurement model ----
# corp_rep_mm_ext <- constructs(
#   composite("QUAL", multi_items("qual_", 1:8), weights = mode_B),
#   composite("PERF", multi_items("perf_", 1:5), weights = mode_B),
#   composite("CSOR", multi_items("csor_", 1:5), weights = mode_B),
#   composite("ATTR", multi_items("attr_", 1:3), weights = mode_B),
#   composite("COMP", multi_items("comp_", 1:3)),
#   composite("LIKE", multi_items("like_", 1:3)),
#   composite("CUSA", single_item("cusa")),
#   composite("CUSL", multi_items("cusl_", 1:3))
# )
# 
# alt_mm <- constructs(
#   composite("QUAL", multi_items("qual_", 1:8), weights = mode_B),
#   composite("PERF", multi_items("perf_", 1:5), weights = mode_B),
#   composite("CSOR", multi_items("csor_", 1:5), weights = mode_B),
#   composite("ATTR", multi_items("attr_", 1:3), weights = mode_B),
#   composite("COMP", multi_items("comp_", 1:3)),
#   composite("LIKE", multi_items("like_", 1:3)),
#   composite("CUSA", single_item("cusa")),
#   composite("CUSL", multi_items("cusl_", 1:3))
# )
# 
# # Create structural model ----
# corp_rep_sm_ext <- relationships(
#   paths(from = c("QUAL", "PERF", "CSOR", "ATTR"), to = c("COMP", "LIKE")),
#   paths(from = c("COMP", "LIKE"), to = c("CUSA", "CUSL")),
#   paths(from = c("CUSA"),         to = c("CUSL"))
# )
# alt_sm <- relationships(
#   paths(from = c("QUAL", "PERF", "CSOR", "ATTR"), to = c("COMP", "LIKE")),
#   paths(from = c("COMP", "LIKE"), to = c("CUSA")),
#   paths(from = c("CUSA"),         to = c("CUSL"))
# )
# 
# 
# # Estimate the models ----
# established_model <- estimate_pls(
#   data = corp_rep_data,
#   measurement_model = corp_rep_mm_ext,
#   structural_model  = corp_rep_sm_ext,
#   missing = mean_replacement,
#   missing_value = "-99")
# 
# competing_model <- estimate_pls(
#   data = corp_rep_data,
#   measurement_model = alt_mm,
#   structural_model  = alt_sm,
#   missing = mean_replacement,
#   missing_value = "-99")
# 
# # Function to compare the Loss of two models
# compare_results <- assess_cvpat_compare(established_model = established_model,
#                                         alternative_model = competing_model,
#                                         testtype = "two.sided",
#                                         nboot = 2000,
#                                         technique = predict_DA,
#                                         seed = 123,
#                                         noFolds = 10,
#                                         reps = 10,
#                                         cores = 1)
# 
# 
# print(compare_results,
#       digits = 3)
# 
# # Assess the base model ----
# assess_results <- assess_cvpat(established_model,
#                                seed = 123,
#                                cores = 1)
# print(assess_results$CVPAT_compare_LM,
#       digits = 3)
# print(assess_results$CVPAT_compare_IA,
#       digits = 3)
# 

## ----echo=TRUE----------------------------------------------------------------
# Assess the base model ----
assess_results <- assess_cvpat(established_model,
                               seed = 123, 
                               cores = 1)
print(assess_results$CVPAT_compare_LM,
      digits = 3)
print(assess_results$CVPAT_compare_IA,
      digits = 3)

## ----echo=TRUE----------------------------------------------------------------
# Function to compare the Loss of two models
compare_results <- assess_cvpat_compare(established_model = established_model,
                                        alternative_model = competing_model,
                                        testtype = "two.sided",
                                        nboot = 2000,
                                        technique = predict_DA,
                                        seed = 123,
                                        noFolds = 10,
                                        reps = 10,
                                        cores = 1)

print(compare_results, 
      cores = 1,
      digits = 3)

