## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) library(seminr) library(seminrExtras) # 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---------------------------------------------------------------- # 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) ## ----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)