Release 0.5.0

.Rbuildignore

@@ -9,3 +9,4 @@
 ^SEMinR\.Rproj$
 ^USAGE\.md$
 ^\.travis\.yml$
+^cran-comments\.md$

.travis.yml

@@ -10,3 +10,4 @@ cache: packages
 branches:
   only:
   - develop
+  - master

DESCRIPTION

@@ -1,12 +1,13 @@
 Package: seminr
 Type: Package
 Title: Domain-Specific Language for Building PLS Structural Equation Models
-Version: 0.3.1
-Date: 2018-01-03
+Version: 0.5.0
+Date: 2018-06-26
 Authors@R: c(person("Soumya", "Ray",
               email = "soumya.ray@gmail.com", role = c("aut", "ths")),
              person("Nicholas", "Danks",
-              email = "nicholasdanks@hotmail.com", role = c("aut","cre")))
+              email = "nicholasdanks@hotmail.com", role = c("aut","cre")),
+             person("Juan Manuel Velasquez", "Estrada", role = "aut"))
 Description: A powerful, easy to write and easy to modify syntax for
     specifying and estimating Partial Least Squares (PLS) path models allowing for the latest estimation methods
     for Consistent PLS as per Dijkstra & Henseler (2015, MISQ 39(2): 297-316), adjusted interactions as per 

NAMESPACE

@@ -1,10 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,measurement_model_evaluation.seminr_model)
 S3method(print,summary.boot_seminr_model)
 S3method(print,summary.seminr_model)
 S3method(summary,boot_seminr_model)
 S3method(summary,seminr_model)
 export(PLSc)
+export(SRMR)
 export(bootstrap_model)
 export(composite)
 export(constructs)
@@ -24,6 +26,6 @@ export(reflective)
 export(regression_weights)
 export(relationships)
 export(report_paths)
-export(rhoA)
+export(rho_A)
 export(simplePLS)
 export(single_item)

R/bootstrap.R

@@ -32,18 +32,18 @@
 #'   composite("Satisfaction", multi_items("CUSA", 1:3))
 #' )
 #'
-#' # interaction factors must be created after the measurement model is defined
+#' # interaction constructs must be created after the measurement model is defined
 #' mobi_xm <- interactions(
 #'   interaction_ortho("Image", "Expectation"),
 #'   interaction_ortho("Image", "Value")
 #' )
 #'
-#' # structural model: note that name of the interactions factor should be
-#' #  the names of its two main factors joined by a '.' in between.
+#' # 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"))
+#'                  "Image*Expectation", "Image*Value"))
 #' )
 #'
 #' seminr_model <- estimate_pls(data = mobi,
@@ -58,73 +58,139 @@
 #' summary(boot_seminr_model)
 #' @export
 bootstrap_model <- function(seminr_model, nboot = 500, cores = NULL,...) {
-  # Bootstrapping for significance as per 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.
-  cat("Bootstrapping model using seminr...\n")
-
-  # prepare parameters for cluster export (model parameters)
-  interactions = seminr_model$mobi_xm
-  d <- seminr_model$rawdata
-  measurement_model <- seminr_model$mmMatrix
-  structural_model <- seminr_model$smMatrix
-  inner_weights <- seminr_model$inner_weights
-
-  if (nboot > 0) {
-    # Initialize the cluster
-    ifelse(is.null(cores), cl <- parallel::makeCluster(parallel::detectCores()), cl <- parallel::makeCluster(cores))
-
-    # Initialize the Estimates Matrix
-    bootstrapMatrix <- seminr_model$path_coef
-    cols <- ncol(bootstrapMatrix)
-    rows <- nrow(bootstrapMatrix)
-
-    # Function to generate random samples with replacement
-    getRandomIndex <- function(d) {return(sample.int(nrow(d),replace = TRUE))}
-
-    # Export variables and functions to cluster
-    parallel::clusterExport(cl=cl, varlist=c("measurement_model", "interactions", "structural_model","inner_weights","getRandomIndex","d"), envir=environment())
-
-    # Function to get PLS estimate results
-    getEstimateResults <- function(i, d = d) {
-      return(seminr::estimate_pls(data = d[getRandomIndex(d),],
-                          measurement_model,interactions,structural_model,inner_weights)$path_coef)
-    }
+  out <- tryCatch(
+    {
+      # Bootstrapping for significance as per 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.
+      cat("Bootstrapping model using seminr...\n")
 
-    # Bootstrap the estimates
-    utils::capture.output(bootmatrix <- parallel::parSapply(cl,1:nboot,getEstimateResults, d))
+      # prepare parameters for cluster export (model parameters)
+      interactions = seminr_model$mobi_xm
+      d <- seminr_model$rawdata
+      measurement_model <- seminr_model$raw_measurement_model
+      structural_model <- seminr_model$smMatrix
+      inner_weights <- seminr_model$inner_weights
 
-    # Add the columns for bootstrap mean and standard error
-    bootstrapMatrix <- cbind(bootstrapMatrix,matrix(apply(bootmatrix,1,mean),nrow = rows, ncol = cols))
-    bootstrapMatrix <- cbind(bootstrapMatrix,matrix(apply(bootmatrix,1,stats::sd),nrow = rows, ncol = cols))
+      if (nboot > 0) {
+        # Initialize the cluster
+        suppressWarnings(ifelse(is.null(cores), cl <- parallel::makeCluster(parallel::detectCores()), cl <- parallel::makeCluster(cores)))
 
-    # Clean the empty paths
-    bootstrapMatrix <- bootstrapMatrix[, colSums(bootstrapMatrix != 0, na.rm = TRUE) > 0]
-    bootstrapMatrix <- bootstrapMatrix[rowSums(bootstrapMatrix != 0, na.rm = TRUE) > 0,]
+        # Initialize the Estimates Matrix
+        bootstrapMatrix <- rbind(seminr_model$path_coef, seminr_model$outer_loadings,seminr_model$outer_weights,HTMT(seminr_model))
+        cols <- ncol(bootstrapMatrix)
+        rows <- nrow(bootstrapMatrix)
 
-    # Get the number of DVs
-    if (length(unique(structural_model[,"target"])) == 1) {
-      dependant <- unique(structural_model[,"target"])
-    } else {
-      dependant <- colnames(bootstrapMatrix[,1:length(unique(structural_model[,"target"]))])
-    }
+        # Function to generate random samples with replacement
+        getRandomIndex <- function(d) {return(sample.int(nrow(d),replace = TRUE))}
 
-    # Construct the vector of column names
-    colnames<-c()
-    # Clean the column names
-    for (parameter in c("PLS Est.", "Boot Mean", "Boot SE")) {
-      for(i in 1:length(dependant)) {
-        colnames <- c(colnames, paste(dependant[i],parameter,sep = " "))
-      }
-    }
+        # Export variables and functions to cluster
+        parallel::clusterExport(cl=cl, varlist=c("measurement_model", "interactions", "structural_model","inner_weights","getRandomIndex","d","HTMT"), envir=environment())
+
+        # Function to get PLS estimate results
+        getEstimateResults <- function(i, d = d) {
+          boot_model <- seminr::estimate_pls(data = d[getRandomIndex(d),],
+                               measurement_model,
+                               interactions,
+                               structural_model,
+                               inner_weights)
+          boot_htmt <- HTMT(boot_model)
+          return(rbind(boot_model$path_coef, boot_model$outer_loadings, boot_model$outer_weights, boot_htmt))
+        }
+
+        # Bootstrap the estimates
+        utils::capture.output(bootmatrix <- parallel::parSapply(cl,1:nboot,getEstimateResults, d))
+
+        # Add the columns for bootstrap mean and standard error
+        bootstrapMatrix <- cbind(bootstrapMatrix,matrix(apply(bootmatrix,1,mean),nrow = rows, ncol = cols))
+        bootstrapMatrix <- cbind(bootstrapMatrix,matrix(apply(bootmatrix,1,stats::sd),nrow = rows, ncol = cols))
+
+        # Create paths matrix
+        boot_paths <- bootstrapMatrix[1:(cols-1),c(1:(3*cols))]
+
+        # Clean the empty paths
+        boot_paths <- boot_paths[, colSums(boot_paths != 0, na.rm = TRUE) > 0]
+        boot_paths <- boot_paths[rowSums(boot_paths != 0, na.rm = TRUE) > 0,]
+
+        # Get the number of DVs
+        if (length(unique(structural_model[,"target"])) == 1) {
+          dependant <- unique(structural_model[,"target"])
+        } else {
+          dependant <- colnames(boot_paths[,1:length(unique(structural_model[,"target"]))])
+        }
+
+        # Construct the vector of column names
+        colnames<-c()
+        # Clean the column names
+        for (parameter in c("PLS Est.", "Boot Mean", "Boot SE")) {
+          for(i in 1:length(dependant)) {
+            colnames <- c(colnames, paste(dependant[i],parameter,sep = " "))
+          }
+        }
+
+        # Assign column names
+        colnames(boot_paths) <- colnames
+
+        # collect loadings matrix
+        boot_loadings <- bootstrapMatrix[(cols+1):((cols)+nrow(seminr_model$outer_loadings)),c(1:(3*cols))]
 
-    # Assign column names
-    colnames(bootstrapMatrix) <- colnames
 
-    # Add the bootstrap matrix to the simplePLS object
-    seminr_model$bootstrapMatrix <- bootstrapMatrix
-    parallel::stopCluster(cl)
-  }
-  seminr_model$boots <- nboot
-  class(seminr_model) <- "boot_seminr_model"
-  return(seminr_model)
+        # Construct the vector of column names 2
+        colnames2<-c()
+        # Clean the column names
+        for (parameter in c("PLS Est.", "Boot Mean", "Boot SE")) {
+          for(i in seminr_model$constructs) {
+            colnames2 <- c(colnames2, paste(i,parameter,sep = " "))
+          }
+        }
+
+        # Assign column names to loadings
+        colnames(boot_loadings) <- colnames2
+
+        # collect weights matrix
+        boot_weights <- bootstrapMatrix[((cols+1)+nrow(seminr_model$outer_loadings)):((cols)+(2*nrow(seminr_model$outer_loadings))),c(1:(3*cols))]
+
+        # Assign column names to weights
+        colnames(boot_weights) <- colnames2
+
+        # Collect HTMT matrix
+        boot_HTMT <- bootstrapMatrix[((cols+1)+(2*nrow(seminr_model$outer_loadings))):((cols+cols)+(2*nrow(seminr_model$outer_loadings))),c(1:(3*cols))]
+
+        # Clean the empty paths
+        #boot_HTMT <- boot_HTMT[, colSums(boot_HTMT != 0, na.rm = TRUE) > 0]
+        #boot_HTMT <- boot_HTMT[rowSums(boot_HTMT != 0, na.rm = TRUE) > 0,]
+
+        # Get boot_HTMT column names
+        colnames(boot_HTMT) <- colnames2
+
+
+
+        parallel::stopCluster(cl)
+      }
+
+      # Add the bootstrap matrix to the simplePLS object
+      seminr_model$bootstrapMatrix <- boot_paths
+      seminr_model$boot_loadings <- boot_loadings
+      seminr_model$boot_weights <- boot_weights
+      seminr_model$boot_HTMT <- boot_HTMT
+      seminr_model$boots <- nboot
+      class(seminr_model) <- "boot_seminr_model"
+      cat("SEMinR Model succesfully bootstrapped")
+      return(seminr_model)
+    },
+    error=function(cond) {
+      message("Bootstrapping encountered this ERROR: ")
+      message(cond)
+      parallel::stopCluster(cl)
+      return(NULL)
+    },
+    warning=function(cond) {
+      message("Bootstrapping encountered this WARNING:")
+      message(cond)
+      parallel::stopCluster(cl)
+      return(NULL)
+    },
+    finally={
+      #
+    }
+  )
 }

R/consistent.R

@@ -1,8 +1,8 @@
 #' seminr PLSc Function
 #'
 #' The \code{PLSc} function calculates the consistent PLS path coefficients and loadings for
-#' a common factor model. It returns a \code{seminr_model} containing the adjusted and consistent
-#' path coefficients and loadings for common factor models and composite models.
+#' a common-factor model. It returns a \code{seminr_model} containing the adjusted and consistent
+#' path coefficients and loadings for common-factor models and composite models.
 #'
 #' @param seminr_model A \code{seminr_model} containing the estimated seminr model.
 #'
@@ -51,23 +51,23 @@ PLSc <- function(seminr_model) {
   path_coef <- seminr_model$path_coef
   loadings <- seminr_model$outer_loadings
   rSquared <- seminr_model$rSquared
-  fscores <- seminr_model$fscores
+  construct_scores <- seminr_model$construct_scores
 
-  # Calculate rhoA for adjustments and adjust the correlation matrix
-  rho <- rhoA(seminr_model)
+  # Calculate rho_A for adjustments and adjust the correlation matrix
+  rho <- rho_A(seminr_model)
   adjustment <- sqrt(rho %*% t(rho))
   diag(adjustment) <- 1
-  adj_fscore_cors <- stats::cor(seminr_model$fscores) / adjustment
+  adj_construct_score_cors <- stats::cor(seminr_model$construct_scores) / adjustment
 
-  # iterate over endogenous latents and adjust path coefficients and R-squared
+  # iterate over endogenous constructs and adjust path coefficients and R-squared
   for (i in unique(smMatrix[,"target"]))  {
 
     #Indentify the exogenous variables
     exogenous<-smMatrix[smMatrix[,"target"]==i,"source"]
 
     #Solve the system of equations
-    results <- solve(adj_fscore_cors[exogenous,exogenous],
-                    adj_fscore_cors[exogenous,i])
+    results <- solve(adj_construct_score_cors[exogenous,exogenous],
+                    adj_construct_score_cors[exogenous,i])
     # Assign the path names
     names(results) <- exogenous
 
@@ -76,15 +76,15 @@ PLSc <- function(seminr_model) {
   }
 
   #calculate insample metrics
-  rSquared <- calc_insample(seminr_model$data, fscores, smMatrix, unique(smMatrix[,"target"]),adj_fscore_cors)
+  rSquared <- calc_insample(seminr_model$data, construct_scores, smMatrix, unique(smMatrix[,"target"]),adj_construct_score_cors)
 
-  # get all common-factor latents (Mode A Consistent) in a vector
-  reflective <- unique(mmMatrix[mmMatrix[,"type"]=="C", "latent"])
+  # get all common-factor constructs (Mode A Consistent) in a vector
+  reflective <- unique(mmMatrix[mmMatrix[,"type"]=="C", "construct"])
 
   # function to adjust the loadings of a common-factor
   adjust_loadings <- function(i) {
-    w <- as.matrix(seminr_model$outer_weights[mmMatrix[mmMatrix[,"latent"]==i,"measurement"],i])
-    loadings[mmMatrix[mmMatrix[,"latent"]==i,"measurement"],i] <- w %*% (sqrt(rho[i,]) / t(w) %*% w )
+    w <- as.matrix(seminr_model$outer_weights[mmMatrix[mmMatrix[,"construct"]==i,"measurement"],i])
+    loadings[mmMatrix[mmMatrix[,"construct"]==i,"measurement"],i] <- w %*% (sqrt(rho[i,]) / t(w) %*% w )
     loadings[,i]
   }
 

R/constructs.R

@@ -1,13 +1,13 @@
 #' Measurement functions
 #'
-#' \code{constructs} creates the factors from measurement items by assigning the
-#' relevant items to each factor and specifying reflective or formative (composite/causal) measurement models
+#' \code{constructs} creates the constructs from measurement items by assigning the
+#' relevant items to each construct and specifying reflective or formative (composite/causal) measurement models
 #'
-#' This function conveniently maps measurement items to factors using
+#' This function conveniently maps measurement items to constructs using
 #' root name, numbers, and affixes with explicit definition of formative
 #' or reflective relationships
 #'
-#' @param ... Comma separated list of the latent variable measurement specifications, as generated by the
+#' @param ... Comma separated list of the construct variable measurement specifications, as generated by the
 #'    \code{reflective()}, or \code{composite()} methods.
 #'
 #' @usage
@@ -28,16 +28,16 @@
 #' @export
 constructs <- function(...) {
   return(matrix(c(...), ncol = 3, byrow = TRUE,
-                dimnames = list(NULL, c("latent", "measurement", "type"))))
+                dimnames = list(NULL, c("construct", "measurement", "type"))))
 }
 
 #' Reflective construct measurement model specification
 #'
 #' \code{reflective} creates the reflective measurement model matrix for a specific common-factor,
-#' specifying the relevant items of the factor and assigning the relationship of reflective.
+#' specifying the relevant items of the construct and assigning the relationship of reflective.
 #' By definition this construct will be estimated by PLS consistent.
 #'
-#' This function conveniently maps reflectively defined measurement items to a factor and is estimated
+#' This function conveniently maps reflectively defined measurement items to a construct and is estimated
 #' using PLS consistent.
 #'
 #' @param construct_name of construct