R/interactions.R

In ISS-Analytics/modelr: Natural, friendly, domain-specific language for building PLS structural equation models

#' Interaction Functions
#'
#' \code{interact} creates interaction measurement items by multipying all combination of factor items.
#'
#' This function automatically generates interaction measurement items for a PLS SEM.
#'
#' @param ... Interaction Combinations as generated by the \code{interaction_combo} function
#'
#' @usage
#'   Create two new interactions: factor1.factor2 and factor1.factor3
#'   interact( interaction_combo("factor1", "factor2"),
#'             interaction_combo("factor1", "factor3")
#'   )
#'
#' @examples
#' data("mobi", package = "semPLS")
#'
#' mobi_xm <- interact(
#'   interaction_combo("Image", "Expectation"),
#'   interaction_combo("Image", "Value")
#' )
#'
#' mobi_pls <- modelr(mobi, mobi_mm, mobi_xm, mobi_sm)
#' print_paths(mobi_pls)
#'
#' @aliases interaction_combo
#'
interact <- function(...) {
  function(data, mm, all_intxns=list(...)) {
    create_interaction <- function(intxn_function) { intxn_function(data, mm) }
    intxns_list <- lapply(all_intxns, create_interaction)
    return(intxns_list)
  }
}

interaction_combo <- function(factor1, factor2) {
  function(data, mm) {
    interaction_name <- paste(factor1, factor2, sep=".")
    iv1_items <- mm[mm[, "source"] == factor1, ][, "target"]
    iv2_items <- mm[mm[, "source"] == factor2, ][, "target"]

    iv1_data <- data[iv1_items]
    iv2_data <- data[iv2_items]

    mult <- function(col) {
      iv2_data*col
    }

    multiples_list <- lapply(iv1_data, mult)
    interaction_data <- do.call("cbind", multiples_list)

    return(list(name = interaction_name, data = interaction_data))
  }
}