Change syntax (#125)

* Attends to Issue #121. constructs() returns a list and created interaction() construct type

* Not working yet....

* changing parameter names

* All three interaction methods working with new syntax

* Can assign mode A and mode B to interactions. Working

* interactions and higher order construct all working.

* Updating tests - but not fixtures.

* # Updated tests for new syntax

* R CMD Check no warnings errors or notes

* # 122

Author: NicholasDanks

CHANGELOG.md

@@ -5,7 +5,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 ## [Unreleased]
-- Change code syntax to remove interactions() function and add interactions and HOC to composites()
+- Change code syntax to remove interactions() method and add interactions and HOC to composites()
 - Document all the syntax and features
 
 ## [0.7.0] - 2019-09-19
@@ -18,13 +18,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - A test for the bootstrap summary return object
 - Descriptive statistics for item and construct data
 - S3 print method for class "table_output" for printing generic tables
+- new method interaction_term() for specifying a interaction construct
+- new method interaction() for specifying a interaction construct
 - A fSquare function to calculating fSquared
 - A test for fSquared function
 
 ### Changed
 - Fixtures for evaluating bootstrap HTMT for versions of R < 3.6.0
 - Changed the R/* file naming to R/estimate_ R/feature_ R/evaluate_ etc.
 - Summary S3 method to return data descriptives in summary object
+- constructs() method now returns a list with classes
 - Changed references to include Cohen (2013)
 - Updated vignette to reflect fSquare function
 

NAMESPACE

@@ -14,22 +14,22 @@ export(constructs)
 export(correlation_weights)
 export(estimate_pls)
 export(fSquared)
-export(interaction_2stage)
-export(interaction_ortho)
-export(interaction_scaled)
-export(interactions)
+export(higher_composite)
+export(interaction_term)
 export(mode_A)
 export(mode_B)
 export(multi_items)
+export(orthogonal)
 export(path_factorial)
 export(path_weighting)
 export(paths)
 export(plot_scores)
+export(product_indicator)
 export(reflective)
 export(regression_weights)
 export(relationships)
 export(report_paths)
 export(rho_A)
 export(simplePLS)
 export(single_item)
-export(two_stage_HOC)
+export(two_stage)

R/estimate_bootstrap.R

@@ -19,7 +19,7 @@
 #' @usage
 #' bootstrap_model(seminr_model, nboot = 500, cores = NULL, seed = NULL, ...)
 #'
-#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interactions}}
+#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
 #'
 #' @references Hair, J. F., Hult, G. T. M., Ringle, C. M., and Sarstedt, M. (2017). A Primer on Partial Least Squares
 #'  Structural Equation Modeling (PLS-SEM), 2nd Ed., Sage: Thousand Oaks.
@@ -31,13 +31,9 @@
 #'   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 constructs must be created after the measurement model is defined
-#' mobi_xm <- interactions(
-#'   interaction_ortho("Image", "Expectation"),
-#'   interaction_ortho("Image", "Value")
+#'   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
@@ -50,7 +46,6 @@
 #'
 #' seminr_model <- estimate_pls(data = mobi,
 #'                              measurement_model = mobi_mm,
-#'                              interactions = mobi_xm,
 #'                              structural_model = mobi_sm)
 #'
 #' # Load data, assemble model, and bootstrap
@@ -67,7 +62,6 @@ bootstrap_model <- function(seminr_model, nboot = 500, cores = NULL, seed = NULL
       cat("Bootstrapping model using seminr...\n")
 
       # prepare parameters for cluster export (model parameters)
-      interactions = seminr_model$interactions
       d <- seminr_model$rawdata
       measurement_model <- seminr_model$raw_measurement_model
       structural_model <- seminr_model$smMatrix
@@ -89,14 +83,13 @@ bootstrap_model <- function(seminr_model, nboot = 500, cores = NULL, seed = NULL
         if (is.null(seed)) {seed <- sample.int(100000, size = 1)}
 
         # Export variables and functions to cluster
-        parallel::clusterExport(cl=cl, varlist=c("measurement_model", "interactions", "structural_model", "inner_weights", "getRandomIndex", "d", "HTMT", "seed"), envir=environment())
+        parallel::clusterExport(cl=cl, varlist=c("measurement_model", "structural_model", "inner_weights", "getRandomIndex", "d", "HTMT", "seed"), envir=environment())
 
         # Function to get PLS estimate results
         getEstimateResults <- function(i, d = d) {
           set.seed(seed+i)
           boot_model <- seminr::estimate_pls(data = d[getRandomIndex(d),],
                                measurement_model,
-                               interactions,
                                structural_model,
                                inner_weights)
           boot_htmt <- HTMT(boot_model)

R/estimate_model.R

@@ -8,20 +8,17 @@
 #' @param measurement_model A source-to-target matrix representing the outer/measurement model,
 #'   generated by \code{constructs}.
 #'
-#' @param interactions An object of type \code{interactions} as generated by the \code{interactions}
-#'   method. Default setting is \code{NULL} and can be excluded for models with no interactions.
-#'
 #' @param structural_model A source-to-target matrix representing the inner/structural model,
 #'   generated by \code{relationships}.
 #'
 #' @param inner_weights A parameter declaring which inner weighting scheme should be used
 #'   path_weighting is default, alternately path_factorial can be used.
 #'
 #' @usage
-#' estimate_pls(data, measurement_model, interactions=NULL, structural_model,
+#' estimate_pls(data, measurement_model, structural_model,
 #'              inner_weights = path_weighting)
 #'
-#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interactions}}
+#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
 #'          \code{\link{bootstrap_model}}
 #'
 #' @examples
@@ -54,53 +51,39 @@
 #' summary(mobi_pls)
 #' plot_scores(mobi_pls)
 #' @export
-estimate_pls <- function(data, measurement_model, interactions=NULL, structural_model, inner_weights = path_weighting) {
+estimate_pls <- function(data, measurement_model, structural_model, inner_weights = path_weighting) {
   cat("Generating the seminr model\n")
-  warnings(measurement_model, data, structural_model)
   data <- stats::na.omit(data)
   rawdata <- data
   raw_measurement_model <- measurement_model
   # Generate first order model if necessary
-  if ("HOCA" %in% measurement_model[,"type"] | "HOCB" %in% measurement_model[,"type"] ) {
+
+  HOCs <- measurement_model[names(measurement_model) == "higher_order_composite"]
+
+  if ( length(HOCs)>0 ) {
     HOM <- prepare_higher_order_model(data = data,
                                       sm = structural_model,
                                       mm = measurement_model,
-                                      ints = interactions,
-                                      inners = inner_weights)
+                                      inners = inner_weights,
+                                      HOCs = HOCs)
     measurement_model <- HOM$mm
     structural_model <- HOM$sm
     data <- HOM$data
   }
 
-  # Generate interactions
-  if(!is.null(interactions)) {
-    # update data with new interaction items
-    intxns_list <- interactions(data = data,
-                                mm = measurement_model,
-                                sm = structural_model,
-                                ints = interactions,
-                                inners = inner_weights)
-    get_data <- function(intxn) { intxn$data }
-    interaction_data <- do.call("cbind", lapply(intxns_list, get_data))
-
-    # Append data with interaction data
-    data <- cbind(data, interaction_data)
-
-    # update measurement model with interaction constructs
-    intxns_mm <- constructs(do.call("c", lapply(intxns_list, measure_interaction)))
-    measurement_model <- rbind(measurement_model, intxns_mm)
-  }
+  post_interaction_object <- process_interactions(measurement_model, data, structural_model, inner_weights)
+  measurement_model <- post_interaction_object$measurement_model
+  data <- post_interaction_object$data
 
   # warning if the model is incorrectly specified
-  #warning_struc_meas_model_complete(structural_model,measurement_model,data)
+  warnings(measurement_model, data, structural_model)
 
   # Make a named list of construct measurement_mode functions
   measurement_mode_scheme <- sapply(unique(c(structural_model[,1], structural_model[,2])), get_measure_mode, measurement_model, USE.NAMES = TRUE)
 
   # Run the model in simplePLS
   seminr_model = seminr::simplePLS(obsData = data, smMatrix = structural_model, mmMatrix = measurement_model, inner_weights = inner_weights, measurement_mode_scheme = measurement_mode_scheme)
   seminr_model$data <- data
-  seminr_model$interactions <- interactions
   seminr_model$rawdata <- rawdata
   seminr_model$raw_measurement_model <- raw_measurement_model
 

R/estimate_simplePLS.R

@@ -25,7 +25,7 @@
 #' simplePLS(obsData,smMatrix, mmMatrix,inner_weights = path_weighting,
 #'           maxIt=300, stopCriterion=7,measurement_mode_scheme)
 #'
-#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interactions}}
+#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
 #'          \code{\link{estimate_pls}} \code{\link{bootstrap_model}}
 #'
 #' @examples

R/evaluate_effects.R

@@ -7,7 +7,7 @@
 #' @param dv A dependent variable in the model.
 #'
 #' @usage
-#' fsquared(model, iv, dv)
+#' fSquared(seminr_model, iv, dv)
 #'
 #' @references Cohen, J. (2013). Statistical power analysis for the behavioral sciences. Routledge.
 #'
@@ -40,15 +40,48 @@
 fSquared <- function(seminr_model, iv, dv) {
   with_sm <- seminr_model$smMatrix
   without_sm <- subset(with_sm, !((with_sm[, "source"] == iv) & (with_sm[, "target"] == dv)))
-  capture.output(
+
+  # Calculate fSquared using LM of constructs instead of re-estiating the model (this is probably incorrect, but might serve for interaction models)
+  # dvs <- unique(seminr_model$smMatrix[, "target"])
+  # path_matrix <- seminr_model$path_coef
+  # for (dv in dvs) {
+  #   ivs <- names(path_matrix[(path_matrix[,dv] != 0),dv])
+  #   sub("\\*", "x", ivs)
+  #   frmla <- stats::as.formula(paste(dv,paste(sub("\\*", "x", ivs), collapse ="+"), sep = " ~ "))
+  #   data <- as.data.frame(seminr_model$construct_scores)
+  #   colnames(data) <- sub("\\*", "x",colnames(data))
+  #   lm <- stats::lm(formula = frmla, data = data)
+  #   summary(lm)
+  #   }
+  utils::capture.output(
     without_pls <- estimate_pls(data = seminr_model$rawdata,
-                                measurement_model = seminr_model$mmMatrix,
-                                interactions = seminr_model$interactions,
+                                measurement_model = seminr_model$raw_measurement_model,
                                 structural_model = without_sm)
   )
   with_r2 <- seminr_model$rSquared["Rsq", dv]
   ifelse(any(without_sm[,"target"] == dv),
          without_r2 <- without_pls$rSquared["Rsq", dv],
          without_r2 <- 0)
+
   return((with_r2 - without_r2) / (1 - with_r2))
 }
+
+model_fsquares <- function(seminr_model) {
+  if (any(names(seminr_model$raw_measurement_model) == "orthogonal_interaction")
+      | any(names(seminr_model$raw_measurement_model) == "two_stage_interaction")
+      | any(names(seminr_model$raw_measurement_model) == "scaled_interaction" )) {
+    return("The fSquare cannot be calculated as the model contains an interaction term and omitting either the antecedent or moderator in the interaction term will cause model estimation to fail")
+  }
+  path_matrix <- seminr_model$path_coef
+  ivs <- unique(seminr_model$smMatrix[, "source"])
+  dvs <- unique(seminr_model$smMatrix[, "target"])
+  fsquared_matrix <- path_matrix
+  for (dv in dvs) {
+    for (iv in ivs) {
+      fsquared_matrix[iv, dv] <- fSquared(seminr_model = seminr_model,
+                                          iv = iv,
+                                          dv = dv)
+    }
+  }
+  return(fsquared_matrix)
+}

R/evaluate_reliability.R

@@ -8,7 +8,7 @@
 #' @usage
 #' rho_A(seminr_model)
 #'
-#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interactions}}
+#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
 #'          \code{\link{bootstrap_model}}
 #'
 #' @references Dijkstra, T. K., & Henseler, J. (2015). Consistent partial least squares path modeling. MIS quarterly, 39(2).

R/evaluate_warnings.R

@@ -47,6 +47,6 @@ warning_periods_in_col_names <- function(data) {
 warnings <- function(mmMatrix,data, smMatrix) {
   warning_single_item_formative(mmMatrix)
   warning_missing_data(data, mmMatrix)
-  warning_periods_in_col_names(data)
+  #warning_periods_in_col_names(data)
 }
 

R/feature_consistent.R

@@ -9,7 +9,7 @@
 #' @usage
 #' PLSc(seminr_model)
 #'
-#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interactions}}
+#' @seealso \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
 #'          \code{\link{bootstrap_model}}
 #'
 #' @references Dijkstra, T. K., & Henseler, J. (2015). Consistent Partial Least Squares Path Modeling, 39(X).

R/feature_higher_order.R

@@ -1,64 +1,68 @@
 # Takes a HOC name and replaces that constructs relationships with the dimensions of the HOC
 substitute_dimensions_for_HOC <- function(construct, sm, mm) {
   # Identify dimensions of HOCs
-  dimensions <- mm[mm[, "type"] == "HOCA" | mm[, "type"] == "HOCB", ][mm[mm[, "type"] == "HOCB" | mm[, "type"] == "HOCA", ][, "construct"] == construct, "measurement"]
+  dimensions <- matrix(construct, ncol = 3, byrow = TRUE)[,2]
+  #dimensions <- mm[mm[, "type"] == "HOCA" | mm[, "type"] == "HOCB", ][mm[mm[, "type"] == "HOCB" | mm[, "type"] == "HOCA", ][, "construct"] == construct, "measurement"]
   # identify antecedent relationships to HOC
-  antecedents <- sm[which(sm[, "target"] == construct), "source"]
+  antecedents <- sm[which(sm[, "target"] == construct[1]), "source"]
   # change antecedent relationship to first order constructs in structural model
   if (!length(antecedents) == 0) {
     sm <- rbind(sm,
                 relationships(paths(from = antecedents,
                                     to = dimensions)))
-    sm <- sm[-which(sm[, "target"] == construct), ]
+    sm <- sm[-which(sm[, "target"] == construct[1]), ]
   }
 
   # identify outcomes
-  outcomes <- sm[which(sm[, "source"] == construct), "target"]
+  outcomes <- sm[which(sm[, "source"] == construct[1]), "target"]
   if (!length(outcomes) == 0) {
     sm <- rbind(sm,
                 relationships(paths(from = dimensions,
                                     to = outcomes)))
-    sm <- sm[-which(sm[, "source"] == construct), ]
+    sm <- sm[-which(sm[, "source"] == construct[1]), ]
   }
-  return(sm)
+  return(list(sm = sm,
+              dimensions = dimensions))
 }
 
 remove_HOC_in_measurement_model <- function(construct, mm) {
   mm[!mm[, "construct"] == construct, ]
 }
 
 # Function to parse measurement and structural model and create the higher order model with complete information
-prepare_higher_order_model <- function(data, sm , mm, ints, inners) {
+prepare_higher_order_model <- function(data, sm , mm, inners, HOCs) {
   #retain the mm and sm
   orig_mm <- mm
+  new_mm <- matrix(unlist(mm[!(substr(names(mm), nchar(names(mm))-10, nchar(names(mm))) == "interaction") & !(names(mm) == "higher_order_composite")]), ncol = 3, byrow = TRUE,
+         dimnames = list(NULL, c("construct", "measurement", "type")))
   orig_sm <- sm
-  # Identify HOCs
-  HOCs <- unique(mm[which(mm[, "type"] == "HOCA" | mm[, "type"] == "HOCB"), "construct"])
-
   # Rebuild model for first stage
   # Add new HOC paths to SM
+  dimensions <- c()
   for (construct in HOCs) {
-    sm <- substitute_dimensions_for_HOC(construct, sm, mm)
-    #mm <- remove_HOC_in_measurement_model(construct,mm)
+    obj <- substitute_dimensions_for_HOC(construct, sm, new_mm)
+    sm <- obj$sm
+    dimensions <- c(dimensions, obj$dimensions)
   }
+  # Remove interactions from the sm
+  sm <- sm[sm[, "source"] %in% unique(new_mm[, "construct"]),]
+
+
   # Identify all the dimensions
-  dimensions <- orig_mm[which(orig_mm[, "construct"] == HOCs), "measurement"]
-  # remove HOCs from mm
-  new_mm <- mm[-which(mm[, "construct"] == HOCs), ]
+  # dimensions <- orig_mm[which(orig_mm[, "construct"] == HOCs), "measurement"]
 
   # Run first stage
   new_model <- estimate_pls(data = data,
-                            measurement_model = new_mm,
-                            interactions = ints,
+                            measurement_model = mm[!(substr(names(mm), nchar(names(mm))-10, nchar(names(mm))) == "interaction") & !(names(mm) == "higher_order_composite")],
                             structural_model = sm,
                             inner_weights = inners)
 
   # Add the construct scores to data
   data <- cbind(data, new_model$construct_scores[, dimensions])
 
-  # Update the mm to include the type of the new data and item
-  mm[mm[,"type"] == "HOCA", "type"] <- "A"
-  mm[mm[,"type"] == "HOCB", "type"] <- "B"
+  # # Update the mm to include the type of the new data and item
+  # mm[mm[,"type"] == "HOCA", "type"] <- "A"
+  # mm[mm[,"type"] == "HOCB", "type"] <- "B"
 
 
   # pass the updated mm, sm and data back to estimate_model()