Unstandardization features

NAMESPACE

@@ -93,3 +93,4 @@ export(specific_effect_significance)
 export(specify_model)
 export(total_indirect_ci)
 export(two_stage)
+export(unstandardize_scores)

R/unstandardize.R

@@ -0,0 +1,75 @@
+# # https://rdrr.io/cran/plspm/src/R/rescale.r
+#
+# library(plspm)
+# data(satisfaction)
+#
+# # define path matrix (inner model)
+# IMAG <- c(0,0,0,0,0,0)
+# EXPE <- c(1,0,0,0,0,0)
+# QUAL <- c(0,1,0,0,0,0)
+# VAL <- c(0,1,1,0,0,0)
+# SAT <- c(1,1,1,1,0,0)
+# LOY <- c(1,0,0,0,1,0)
+# sat_path <- rbind(IMAG, EXPE, QUAL, VAL, SAT, LOY)
+#
+# # define list of blocks (outer model)
+# sat_blocks <- list(1:5, 6:10, 11:15, 16:19, 20:23, 24:27)
+#
+# # vector of modes (reflective indicators)
+# sat_modes <- rep("A", 6)
+#
+# # apply plspm with bootstrap validation
+# satpls <- plspm(satisfaction, sat_path, sat_blocks, modes = sat_modes,
+#                 scaled = FALSE, boot.val = TRUE)
+#
+# scores <- satpls$scores[,"IMAG"]
+# imag_data <- as.matrix(satpls$data[1:5])
+#
+# wgs <- satpls$outer_model$weight[1:5]
+# wgs/sum(wgs)
+# rescaled <- imag_data %*% (wgs/sum(wgs))
+#
+# as.vector(rescaled)
+# rescale(satpls)[,"IMAG"]
+
+#' Rescales standardized construct scores back into same units of items.
+#' Inspired by \code{rescale()} function of \code{plspm} package
+#' NOTE: Experimental feature only
+#'
+#' @example
+#' measurements <- constructs(
+#'   composite("Image",       multi_items("IMAG", 1:5)),
+#'   composite("Expectation", multi_items("CUEX", 1:3)),
+#'   composite("Loyalty",     multi_items("CUSL", 1:3)),
+#'   composite("Complaints",  single_item("CUSCO"))
+#' )
+#'
+#' structure <- relationships(
+#'   paths(from = c("Image", "Expectation"), to = c("Complaints", "Loyalty"))
+#' )
+#'
+#' pls_model <- estimate_pls(data = mobi, measurements, structure)
+#' unstandardize_scores(pls_model)
+#'
+#' @export
+unstandardize_scores <- function(pls_model) {
+  construct_names <- seminr:::construct_names(pls_model$smMatrix)
+
+  construct_names -> .
+    sapply(., seminr:::items_of_construct, model=pls_model) -> .
+    unlist(.) -> .
+    unname(.) -> .
+    . -> construct_items
+
+  relevant_data <- pls_model$data[, construct_items]
+  weights <- pls_model$outer_weights[names(relevant_data), ]
+  weight_sums <- matrix(colSums(weights), ncol(weights), ncol(weights))
+
+  weights %*% (1/weight_sums) -> .
+    .[weights == 0] <- 0
+    colnames(.) <- colnames(weights)
+    . -> normalized_wts
+
+  unstd_scores <- as.matrix(relevant_data) %*% normalized_wts
+  as.data.frame(unstd_scores)
+}

tests/testthat/test-unstandardize.R

@@ -0,0 +1,36 @@
+context("SEMinR correctly unstandardizes model elements\n")
+
+# First order model
+measurements <- constructs(
+  composite("Image",       multi_items("IMAG", 1:5)),
+  composite("Expectation", multi_items("CUEX", 1:3)),
+  composite("Loyalty",     multi_items("CUSL", 1:3)),
+  composite("Complaints",  single_item("CUSCO"))
+)
+
+structure <- relationships(
+  paths(from = c("Image", "Expectation"), to = c("Complaints", "Loyalty"))
+)
+
+simple_pls_model <- estimate_pls(data = mobi, measurements, structure)
+unstd_simple <- unstandardize_scores(simple_pls_model)
+
+# correct_unstd_simple <- unstd_simple
+# save(correct_unstd_simple, file="tests/fixtures/V_3_6_0/unstandardized.RData")
+
+# Load correct result objects
+load("../fixtures/V_3_6_0/unstandardized.RData")
+
+test_that("Unstandardized scores are reproduced as previously", {
+  expect_equal(all(unstd_simple == correct_unstd_simple), TRUE)
+})
+
+test_that("Unstandardized scores are in correct scale", {
+  complaints_unstd <- summary(unstd_simple$Complaints)
+  expect_equal(as.numeric(complaints_unstd["Min."]), 1)
+  expect_equal(as.numeric(complaints_unstd["Max."]), 10)
+
+  expectation_unstd <- summary(unstd_simple$Expectation)
+  expect_gte(as.numeric(expectation_unstd["Min."]), 1)
+  expect_equal(as.numeric(expectation_unstd["Max."]), 10)
+})