#' Interaction function
#'
#' \code{interaction_term} creates interaction measurement items by applying
#' product indicator, two stage, or orthogonal approaches to creating new
#' interaction constructs.
#'
#' This function automatically generates interaction measurement items for a PLS
#' or a CBSEM model.
#'
#' @param iv The independent variable that is subject to moderation.
#' @param moderator The moderator variable.
#' @param method The method to generate the estimated interaction term with a
#' default of `two_stage`.
#' @param weights The weighting mode for interaction items in a PLS model (only)
#' with default of `modeA`.
#'
#' @return An un-evaluated function (promise) for generating a vector of interaction terms.
#'
#' Interaction Combinations as generated by the \code{\link{interaction}} or
#' \code{\link{interaction_term}} methods.
#'
#' @usage
#' interaction_term(iv, moderator, method, weights)
#'
#' @examples
#' data(mobi)
#'
#' # seminr syntax for creating measurement model
#' mobi_mm <- constructs(
#' composite("Image", multi_items("IMAG", 1:5)),
#' composite("Expectation", multi_items("CUEX", 1:3)),
#' composite("Value", multi_items("PERV", 1:2)),
#' composite("Satisfaction", multi_items("CUSA", 1:3)),
#' interaction_term(iv = "Image", moderator = "Expectation", method = orthogonal),
#' interaction_term(iv = "Image", moderator = "Value", method = product_indicator)
#' )
#'
#' # structural model: note that name of the interactions construct should be
#' # the names of its two main constructs joined by a '*' in between.
#' mobi_sm <- relationships(
#' paths(to = "Satisfaction",
#' from = c("Image", "Expectation", "Value",
#' "Image*Expectation", "Image*Value"))
#' )
#'
#' mobi_pls <- estimate_pls(mobi, mobi_mm, mobi_sm)
#' summary(mobi_pls)
#'
#' @export
interaction_term <- function(iv, moderator, method=product_indicator, weights = mode_A) {
intxn <- method(iv, moderator, weights)
class(intxn) <- class(method())
return(intxn)
}
#' \code{orthogonal} creates interaction measurement items by using the
#' orthogonalized approach wherein
#'
#' This function automatically generates interaction measurement items for a PLS SEM using the orthogonalized approach..
#'
#' @param iv The independent variable that is subject to moderation.
#' @param moderator The moderator variable.
#' @param weights is the relationship between the items and the interaction terms. This can be
#' specified as \code{correlation_weights} or \code{mode_A} for correlation weights (Mode A) or as
#' \code{regression_weights} or \code{mode_B} for regression weights (Mode B). Default is correlation weights.
#'
#' @return An un-evaluated function (promise) for estimating an orthogonal interaction effect.
#'
#' @usage
#' # orthogonalization approach as per Henseler & Chin (2010):
#' orthogonal(iv, moderator, weights)
#'
#' @references Henseler & Chin (2010), A comparison of approaches for the analysis of interaction effects
#' between latent variables using partial least squares path modeling. Structural Equation Modeling, 17(1),82-109.
#'
#' @examples
#' data(mobi)
#'
#' # seminr syntax for creating measurement model
#' mobi_mm <- constructs(
#' composite("Image", multi_items("IMAG", 1:5)),
#' composite("Expectation", multi_items("CUEX", 1:3)),
#' composite("Value", multi_items("PERV", 1:2)),
#' composite("Satisfaction", multi_items("CUSA", 1:3)),
#' interaction_term(iv = "Image", moderator = "Expectation", method = orthogonal),
#' interaction_term(iv = "Image", moderator = "Value", method = orthogonal)
#' )
#'
#' # structural model: note that name of the interactions construct should be
#' # the names of its two main constructs joined by a '*' in between.
#' mobi_sm <- relationships(
#' paths(to = "Satisfaction",
#' from = c("Image", "Expectation", "Value",
#' "Image*Expectation", "Image*Value"))
#' )
#'
#' mobi_pls <- estimate_pls(mobi, mobi_mm, mobi_sm)
#' summary(mobi_pls)
#'
#' @export
orthogonal <- function(iv, moderator, weights) {
ortho_construct <- function(data, measurement_model, structural_model, ints, ...) {
interaction_name <- paste(iv, moderator, sep = "*")
iv1_items <- measurement_model[measurement_model[, "construct"] == iv, "measurement"]
iv2_items <- measurement_model[measurement_model[, "construct"] == moderator, "measurement"]
iv1_data <- as.data.frame(scale(data[iv1_items]))
iv2_data <- as.data.frame(scale(data[iv2_items]))
multiples_list <- lapply(iv1_data, mult, iv2_data)
interaction_data <- do.call("cbind", multiples_list)
colnames(interaction_data) <- as.vector(sapply(iv1_items, name_items, iv2_items))
# Create formula
frmla <- stats::as.formula(paste("interaction_data[,i]", paste(as.vector(c(iv1_items,iv2_items)), collapse ="+"), sep = " ~ "))
# iterate and orthogonalize
for(i in 1:ncol(interaction_data)) {
interaction_data[, i] <- stats::lm(formula = frmla, data = data)$residuals
}
intxn_mm <- matrix(measure_interaction(interaction_name, interaction_data, weights), ncol = 3, byrow = TRUE)
return(list(name = interaction_name,
data = interaction_data,
mm = intxn_mm))
}
class(ortho_construct) <- append(class(ortho_construct), c("interaction", "orthogonal_interaction"))
return(ortho_construct)
}
#' \code{product_indicator} creates interaction measurement items by scaled product indicator approach.
#'
#' This function automatically generates interaction measurement items for a PLS SEM using scaled product indicator approach.
#'
#' @param iv The independent variable that is subject to moderation.
#' @param moderator The moderator variable.
#' @param weights is the relationship between the items and the interaction terms. This can be
#' specified as \code{correlation_weights} or \code{mode_A} for correlation weights (Mode A) or as
#' \code{regression_weights} or \code{mode_B} for regression weights (Mode B). Default is correlation weights.
#'
#' @return An un-evaluated function (promise) for estimating a product-indicator interaction effect.
#'
#' @usage
#' # standardized product indicator approach as per Henseler & Chin (2010):
#' product_indicator(iv, moderator, weights)
#'
#' @references Henseler & Chin (2010), A comparison of approaches for the analysis of interaction effects
#' between latent variables using partial least squares path modeling. Structural Equation Modeling, 17(1),82-109.
#'
#' @examples
#' data(mobi)
#'
#' # seminr syntax for creating measurement model
#' mobi_mm <- constructs(
#' composite("Image", multi_items("IMAG", 1:5),weights = mode_A),
#' composite("Expectation", multi_items("CUEX", 1:3),weights = mode_A),
#' composite("Value", multi_items("PERV", 1:2),weights = mode_A),
#' composite("Satisfaction", multi_items("CUSA", 1:3),weights = mode_A),
#' interaction_term(iv = "Image",
#' moderator = "Expectation",
#' method = product_indicator,
#' weights = mode_A),
#' interaction_term(iv = "Image",
#' moderator = "Value",
#' method = product_indicator,
#' weights = mode_A)
#' )
#'
#' # structural model: note that name of the interactions construct should be
#' # the names of its two main constructs joined by a '*' in between.
#' mobi_sm <- relationships(
#' paths(to = "Satisfaction",
#' from = c("Image", "Expectation", "Value",
#' "Image*Expectation", "Image*Value"))
#' )
#'
#' # Load data, assemble model, and estimate using semPLS
#' mobi <- mobi
#' seminr_model <- estimate_pls(mobi, mobi_mm, mobi_sm, inner_weights = path_factorial)
#'
#' @export
product_indicator <- function(iv, moderator, weights) {
scaled_interaction <- function(data, measurement_model, structural_model, ints, ...) {
interaction_name <- paste(iv, moderator, sep = "*")
iv1_items <- measurement_model[measurement_model[, "construct"] == iv, "measurement"]
iv2_items <- measurement_model[measurement_model[, "construct"] == moderator, "measurement"]
iv1_data <- as.data.frame(scale(data[iv1_items]))
iv2_data <- as.data.frame(scale(data[iv2_items]))
multiples_list <- lapply(iv1_data, mult, iv2_data)
interaction_data <- do.call("cbind", multiples_list)
colnames(interaction_data) <- as.vector(sapply(iv1_items, name_items, iv2_items))
intxn_mm <- matrix(measure_interaction(interaction_name, interaction_data, weights), ncol = 3, byrow = TRUE)
return(list(name = interaction_name,
data = interaction_data,
mm = intxn_mm))
}
class(scaled_interaction) <- append(class(scaled_interaction), c("interaction", "scaled_interaction"))
return(scaled_interaction)
}
#' Creates an interaction measurement item using a two-stage approach.
#' The two-stage procedure for both PLS and CBSEM models estimates construct
#' scores in the first stage, and uses them to produce a single-item product
#' item for the interaction term in the second stage.
#' For a PLS model, the first stage uses PLS to compute construct scores.
#' For a CBSEM model, the first stage uses a CFA to produce ten Berge
#' construct scores.
#'
#' @param iv The independent variable that is subject to moderation.
#' @param moderator The moderator variable.
#' @param weights is the relationship between the items and the interaction terms. This can be
#' specified as \code{correlation_weights} or \code{mode_A} for correlation weights (Mode A) or as
#' \code{regression_weights} or \code{mode_B} for regression weights (Mode B). Default is correlation weights.
#'
#' @return An un-evaluated function (promise) for estimating a two-stage interaction effect.
#'
#' @usage
#' # two stage approach as per Henseler & Chin (2010):
#' two_stage(iv, moderator, weights)
#'
#' @references Henseler & Chin (2010), A comparison of approaches for the analysis of interaction effects
#' between latent variables using partial least squares path modeling. Structural Equation Modeling, 17(1),82-109.
#'
#' @examples
#' data(mobi)
#'
#' # seminr syntax for creating measurement model
#' mobi_mm <- constructs(
#' composite("Image", multi_items("IMAG", 1:5)),
#' composite("Expectation", multi_items("CUEX", 1:3)),
#' composite("Value", multi_items("PERV", 1:2)),
#' composite("Satisfaction", multi_items("CUSA", 1:3)),
#' interaction_term(iv = "Image", moderator = "Expectation", method = two_stage)
#' )
#'
#' # structural model: note that name of the interactions construct should be
#' # the names of its two main constructs joined by a '*' in between.
#' mobi_sm <- relationships(
#' paths(to = "Satisfaction",
#' from = c("Image", "Expectation", "Value",
#' "Image*Expectation"))
#' )
#'
#' # PLS example:
#' mobi_pls <- estimate_pls(mobi, mobi_mm, mobi_sm)
#' summary(mobi_pls)
#'
#' # CBSEM example:
#' mobi_cbsem <- estimate_cbsem(mobi, as.reflective(mobi_mm), mobi_sm)
#' summary(mobi_cbsem)
#'
#' @export
two_stage <- function(iv, moderator, weights) {
# Create an interaction function that takes extra params (...) for particular estimation
two_stage_interaction <- function(data, mmMatrix, structural_model, ints, estimate_first_stage, ...) {
interaction_name <- paste(iv, moderator, sep = "*")
# remove interactions from structural model
structural_model <- structural_model[ !grepl("\\*", structural_model[,"source"]), ]
measurement_mode_scheme <- sapply(unique(c(structural_model[,1],structural_model[,2])), get_measure_mode, mmMatrix, USE.NAMES = TRUE)
first_stage <- estimate_first_stage(
data = data, smMatrix = structural_model, mmMatrix = mmMatrix,
measurement_mode_scheme = measurement_mode_scheme, ...)
interaction_term <- as.matrix(first_stage$construct_scores[, iv] * first_stage$construct_scores[, moderator], ncol = 1)[,, drop = FALSE]
# Give interaction data column a unique name
colnames(interaction_term) <- c(paste(interaction_name, "_intxn", sep = ""))
intxn_mm <- matrix(measure_interaction(interaction_name, interaction_term, weights), ncol = 3, byrow = TRUE)
return(list(name = interaction_name,
data = interaction_term[,1, drop = FALSE],
mm = intxn_mm))
}
class(two_stage_interaction) <- append(class(two_stage_interaction), c("interaction", "two_stage_interaction"))
return(two_stage_interaction)
}
first_stage_pls <- function(data, smMatrix, mmMatrix, measurement_mode_scheme, ...) {
seminr::simplePLS(
obsData = data,
smMatrix = smMatrix,
mmMatrix = mmMatrix,
measurement_mode_scheme = measurement_mode_scheme,
...
)
}
first_stage_cbsem <- function(data, smMatrix, mmMatrix, measurement_mode_scheme, ...) {
seminr::estimate_cfa(
data = data,
measurement_model = mmMatrix, lavaan_model=NULL,
...
)
}
process_interactions <- function(measurement_model, data, structural_model, inner_weights) {
ints <- mm_interactions(measurement_model)
mmMatrix <- mm2matrix(measurement_model)
if(length(ints)>0) {
# update data with new interaction items
names(ints) <- c()
create_interaction <- function(intxn_function) { intxn_function(data, mmMatrix, structural_model, ints, first_stage_pls, inner_weights) }
intxns_list <- lapply(ints, create_interaction)
get_data <- function(intxn) { intxn$data }
interaction_data <- do.call("cbind", lapply(intxns_list, get_data))
# Append data with interaction data
intxns_mm <- do.call("rbind", lapply(intxns_list, function(intxn) { intxn$mm }))
data <- cbind(data, interaction_data)
mmMatrix <- rbind(mmMatrix, intxns_mm)
}
return(list(data = data,
mmMatrix = mmMatrix,
ints = ints))
}
process_cbsem_interactions <- function(measurement_model, data, structural_model, ...) {
ints <- mm_interactions(measurement_model)
mmMatrix <- mm2matrix(measurement_model)
if(length(ints) > 0) {
# update data with new interaction items
names(ints) <- c()
# create_interaction <- function(intxn_function) { intxn_function(data, mmMatrix, structural_model, ints, first_stage_pls, inner_weights) }
create_interaction <- function(intxn_function) { intxn_function(data, mmMatrix, structural_model, ints, first_stage_cbsem, ...) }
intxns_list <- lapply(ints, create_interaction)
get_data <- function(intxn) { intxn$data }
interaction_data <- do.call("cbind", lapply(intxns_list, get_data))
# Append data with interaction data
intxns_mm <- do.call("rbind", lapply(intxns_list, function(intxn) { intxn$mm }))
data <- cbind(data, interaction_data)
# mmMatrix <- rbind(mmMatrix, intxns_mm)
mmMatrix <- rbind(mmMatrix, as.reflective(intxns_mm))
}
return(list(data = data,
mmMatrix = mmMatrix,
ints = ints))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.