tests/testthat/test-plspredict.R

In seminr: Building and Estimating Structural Equation Models

context("SEMinR correctly generates PLS and LM predictions models\n")
set.seed(123)

# 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))
)

# 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"))
)
# Create moderated measurement model ----
corp_rep_mm_mod <- 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("COMP", multi_items("comp_", 1:3)),
  interaction_term("QUAL", "PERF", method = two_stage )
)

# Create moderated structural model ----
corp_rep_sm_mod <- relationships(
  paths(from = c("QUAL", "PERF", "CSOR", "QUAL*PERF"), to = "COMP")
)
# Estimate the model ----
corp_rep_pls_model_ext <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_ext,
  structural_model  = corp_rep_sm_ext,
  missing = mean_replacement,
  missing_value = "-99")

# Generate the model predictions
predict_corp_rep_ext <- predict_pls(
  model = corp_rep_pls_model_ext,
  technique = predict_DA,
  noFolds = 344,
  reps = NULL)

predict_corp_rep_ext_EA <- predict_pls(
  model = corp_rep_pls_model_ext,
  technique = predict_EA,
  noFolds = 344,
  reps = NULL)

# Summarize the prediction results
sum_predict_corp_rep_ext <- summary(predict_corp_rep_ext)
sum_predict_corp_rep_ext_EA <- summary(predict_corp_rep_ext_EA)

DA_predictions <- rbind(sum_predict_corp_rep_ext$PLS_in_sample,
                        sum_predict_corp_rep_ext$PLS_out_of_sample,
                        sum_predict_corp_rep_ext$LM_in_sample,
                        sum_predict_corp_rep_ext$LM_out_of_sample)
EA_predictions <- rbind(sum_predict_corp_rep_ext_EA$PLS_in_sample,
                        sum_predict_corp_rep_ext_EA$PLS_out_of_sample,
                        sum_predict_corp_rep_ext_EA$LM_in_sample,
                        sum_predict_corp_rep_ext_EA$LM_out_of_sample)
rownames(DA_predictions) <- rownames(EA_predictions) <- 1:8

# Fixtures were generated with this code
# write.csv(rbind(sum_predict_corp_rep_ext$PLS_in_sample,
#                 sum_predict_corp_rep_ext$PLS_out_of_sample,
#                 sum_predict_corp_rep_ext$LM_in_sample,
#                 sum_predict_corp_rep_ext$LM_out_of_sample), file = "tests/fixtures/predict_pls_DA.csv")
# write.csv(rbind(sum_predict_corp_rep_ext_EA$PLS_in_sample,
#                 sum_predict_corp_rep_ext_EA$PLS_out_of_sample,
#                 sum_predict_corp_rep_ext_EA$LM_in_sample,
#                 sum_predict_corp_rep_ext_EA$LM_out_of_sample), file = "tests/fixtures/predict_pls_EA.csv")

# Load controls
DA_control <- as.matrix(read.csv(file = paste(test_folder,"predict_pls_DA.csv", sep = ""), row.names = NULL))
EA_control <- as.matrix(read.csv(file = paste(test_folder,"predict_pls_EA.csv", sep = ""), row.names = NULL))
rownames(DA_control) <- rownames(EA_control) <- 1:8

# Testing
test_that("Seminr performs the DA prediction correctly for PLS and LM in and out sample", {
  expect_equal(DA_control, DA_predictions, tolerance = 0.00001)
  expect_equal(EA_control, EA_predictions, tolerance = 0.00001)
})

context("predict.seminr_model correctly generates PLS predictions from two_stage moderated models\n")


# Estimate the model ----
corp_rep_pls_model_mod <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_mod,
  structural_model  = corp_rep_sm_mod,
  missing = mean_replacement,
  missing_value = "-99")

Results <- predict(object = corp_rep_pls_model_mod, testData = corp_rep_data2, technique = predict_EA)
# write.csv(Results$item_residuals, file = "tests/fixtures/V_3_6_0/two_stage_predict.csv")

# Load controls
two_stage_control <- as.matrix(read.csv(file = paste(test_folder,"two_stage_predict.csv", sep = ""), row.names = 1, check.names = FALSE))

test_that("Seminr estimates the construct scores correctly", {
  expect_equal(as.vector(unlist(Results$item_residuals)), as.vector(two_stage_control), tolerance = 0.00001)
})

context("predict.seminr_model throws an error for orthogonal and product indicators moderated models\n")
corp_rep_mm_mod <- 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("COMP", multi_items("comp_", 1:3)),
  interaction_term("QUAL", "PERF", method = orthogonal )
)
corp_rep_mm_mod2 <- 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("COMP", multi_items("comp_", 1:3)),
  interaction_term("QUAL", "PERF", method = product_indicator )
)
# Create structural model ----
corp_rep_sm_mod <- relationships(
  paths(from = c("QUAL", "PERF", "CSOR", "QUAL*PERF"), to = "COMP")
)

# Estimate the model ----
corp_rep_pls_model_mod <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_mod,
  structural_model  = corp_rep_sm_mod,
  missing = mean_replacement,
  missing_value = "-99")
corp_rep_pls_model_mod2 <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_mod2,
  structural_model  = corp_rep_sm_mod,
  missing = mean_replacement,
  missing_value = "-99")

test_that("Seminr errors for orthogonal", {
  expect_error(predict(object = corp_rep_pls_model_mod, testData = corp_rep_data2, technique = predict_EA))
})
test_that("Seminr errors for product indicators", {
  expect_error(predict(object = corp_rep_pls_model_mod2, testData = corp_rep_data2, technique = predict_EA))
})

context("predict_pls yields correct predictions for LM and PLS for moderated models.\n")
corp_rep_mm_mod <- 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("COMP", multi_items("comp_", 1:3)),
  interaction_term("QUAL", "PERF", method = two_stage )
)

# Create structural model ----
corp_rep_sm_mod <- relationships(
  paths(from = c("QUAL", "PERF", "CSOR", "QUAL*PERF"), to = "COMP")
)

# Estimate the model ----
corp_rep_pls_model_mod <- estimate_pls(
  data = corp_rep_data,
  measurement_model = corp_rep_mm_mod,
  structural_model  = corp_rep_sm_mod,
  missing = mean_replacement,
  missing_value = "-99")


nick <- predict(object = corp_rep_pls_model_mod,
                testData = corp_rep_data,
                technique = predict_DA)

pred_results <- predict_pls(model = corp_rep_pls_model_mod,
            technique = predict_DA,
            noFolds = NULL,
            reps = NULL,
            cores = 1
            )

sum_pred_results <- summary(pred_results)

# write.csv(unlist(sum_pred_results), file = "tests/fixtures/V_3_6_0/two_stage_predict_pls.csv")

# Load controls
two_stage_predict_pls_control <- as.matrix(read.csv(file = paste(test_folder,"two_stage_predict_pls.csv", sep = ""), row.names = 1, check.names = FALSE))
res <- unlist(sum_pred_results)
names(res) <- c()

test_that("Seminr generates the predicted scores correctly", {
  expect_equal(res[1:24],two_stage_predict_pls_control[1:24], tolerance = 0.000001)
})