diff --git a/NAMESPACE b/NAMESPACE index 9b1d8c71..3baa2085 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -93,3 +93,4 @@ export(specific_effect_significance) export(specify_model) export(total_indirect_ci) export(two_stage) +export(unstandardize_scores) diff --git a/R/unstandardize.R b/R/unstandardize.R new file mode 100644 index 00000000..35a75344 --- /dev/null +++ b/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) +} diff --git a/man/unstandardize_scores.Rd b/man/unstandardize_scores.Rd new file mode 100644 index 00000000..21d0a4b4 --- /dev/null +++ b/man/unstandardize_scores.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/unstandardize.R +\name{unstandardize_scores} +\alias{unstandardize_scores} +\title{Rescales standardized construct scores back into same units of items. +Inspired by \code{rescale()} function of \code{plspm} package} +\usage{ +unstandardize_scores(pls_model) +} +\description{ +Rescales standardized construct scores back into same units of items. +Inspired by \code{rescale()} function of \code{plspm} package +} diff --git a/tests/fixtures/V_3_6_0/unstandardized.RData b/tests/fixtures/V_3_6_0/unstandardized.RData new file mode 100644 index 00000000..1334549e Binary files /dev/null and b/tests/fixtures/V_3_6_0/unstandardized.RData differ diff --git a/tests/testthat/test-unstandardize.R b/tests/testthat/test-unstandardize.R new file mode 100644 index 00000000..4d1ab28e --- /dev/null +++ b/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) +})