#' seminr estimate_pls() function
#'
#' Estimates a pair of measurement and structural models using PLS-SEM, with optional estimation methods
#'
#' @param data A \code{dataframe} containing the manifest measurement items in named columns.
#'
#' The pair of measurement and structural models can optionally be specified as separate model objects
#'
#' @param measurement_model An optional \code{measurement_model} object representing the outer/measurement model,
#' as generated by \code{constructs}.
#'
#' @param structural_model An optional \code{smMatrix} object representing the inner/structural model,
#' as generated by \code{relationships}.
#'
#' The pair of measurement and structural models can also be specified as a single \code{specified_model} object
#'
#' @param model An optional \code{specified_model} object containing both the the outer/measurement and inner/structural models,
#' as generated by \code{specify_model}.
#'
#' @param inner_weights Function that implements inner weighting scheme:
#' \code{path_weighting} (default) or \code{path_factorial} can be used.
#'
#' @param missing Function that replaces missing values.
#' \code{mean_replacement} is default.
#'
#' @param missing_value Value in dataset that indicates missing values.
#' NA is used by default.
#'
#' @param maxIt A parameter that specifies that maximum number of iterations when estimating the
#' PLS model. Default value is 300.
#'
#' @param stopCriterion A parameter specifying the stop criterion for estimating the PLS model.
#' Default value is 7.
#'
#' @return A list of the estimated parameters for the SEMinR model including:
#' \item{meanData}{A vector of the indicator means.}
#' \item{sdData}{A vector of the indicator standard deviations}
#' \item{mmMatrix}{A Matrix of the measurement model relations.}
#' \item{smMatrix}{A Matrix of the structural model relations.}
#' \item{constructs}{A vector of the construct names.}
#' \item{mmVariables}{A vector of the indicator names.}
#' \item{outer_loadings}{The matrix of estimated indicator loadings.}
#' \item{outer_weights}{The matrix of estimated indicator weights.}
#' \item{path_coef}{The matrix of estimated structural model relationships.}
#' \item{iterations}{A numeric indicating the number of iterations required before the algorithm converged.}
#' \item{weightDiff}{A numeric indicating the minimum weight difference between iterations of the algorithm.}
#' \item{construct_scores}{A matrix of the estimated construct scores for the PLS model.}
#' \item{rSquared}{A matrix of the estimated R Squared for each construct.}
#' \item{inner_weights}{The inner weight estimation function.}
#' \item{data}{A matrix of the data upon which the model was estimated (INcluding interactions.}
#' \item{rawdata}{A matrix of the data upon which the model was estimated (EXcluding interactions.}
#' \item{measurement_model}{The SEMinR measurement model specification.}
#'
#' @usage
#' estimate_pls(data,
#' measurement_model = NULL, structural_model = NULL, model = NULL,
#' inner_weights = path_weighting,
#' missing = mean_replacement,
#' missing_value = NA,
#' maxIt = 300,
#' stopCriterion = 7)
#'
#' @seealso \code{\link{specify_model}} \code{\link{relationships}} \code{\link{constructs}} \code{\link{paths}} \code{\link{interaction_term}}
#' \code{\link{bootstrap_model}}
#'
#' @examples
#' mobi <- mobi
#'
#' #seminr syntax for creating measurement model
#' mobi_mm <- constructs(
#' reflective("Image", multi_items("IMAG", 1:5)),
#' reflective("Expectation", multi_items("CUEX", 1:3)),
#' reflective("Quality", multi_items("PERQ", 1:7)),
#' reflective("Value", multi_items("PERV", 1:2)),
#' reflective("Satisfaction", multi_items("CUSA", 1:3)),
#' reflective("Complaints", single_item("CUSCO")),
#' reflective("Loyalty", multi_items("CUSL", 1:3))
#' )
#' #seminr syntax for creating structural model
#' mobi_sm <- relationships(
#' paths(from = "Image", to = c("Expectation", "Satisfaction", "Loyalty")),
#' paths(from = "Expectation", to = c("Quality", "Value", "Satisfaction")),
#' paths(from = "Quality", to = c("Value", "Satisfaction")),
#' paths(from = "Value", to = c("Satisfaction")),
#' paths(from = "Satisfaction", to = c("Complaints", "Loyalty")),
#' paths(from = "Complaints", to = "Loyalty")
#' )
#'
#' mobi_pls <- estimate_pls(data = mobi,
#' measurement_model = mobi_mm,
#' structural_model = mobi_sm,
#' missing = mean_replacement,
#' missing_value = NA)
#'
#' summary(mobi_pls)
#' plot_scores(mobi_pls)
#' @export
estimate_pls <- function(data,
measurement_model = NULL,
structural_model = NULL,
model = NULL,
inner_weights = path_weighting,
missing = mean_replacement,
missing_value = NA,
maxIt=300,
stopCriterion=7) {
# NOTE: update rerun.pls_model() if parameters change!
message("Generating the seminr model")
data[data == missing_value] <- NA
rawdata <- data
if (!is.null(model)) {
data <- data[,all_loc_non_int_items(model$measurement_model)]
} else {
data <- data[,all_loc_non_int_items(measurement_model)]
}
data <- missing(data)
data <- stats::na.omit(data)
# Extract model specifications
specified_model <- extract_models(model, measurement_model, structural_model)
measurement_model <- specified_model$measurement_model
structural_model <- specified_model$structural_model
# Generate first order model if necessary
HOCs <- HOCs_in_model(measurement_model, structural_model)
if ( length(HOCs)>0 ) {
HOM <- prepare_higher_order_model(data = data,
sm = structural_model,
mm = measurement_model,
inners = inner_weights,
HOCs = HOCs,
maxIt=maxIt,
stopCriterion=stopCriterion)
measurement_model <- HOM$mm
structural_model <- HOM$sm
data <- HOM$data
first_stage_model <- HOM$first_stage_model
}
processed_measurements <- process_interactions(measurement_model, data, structural_model, inner_weights)
mmMatrix <- processed_measurements$mmMatrix
data <- processed_measurements$data
# warning if the model is incorrectly specified
warnings(mmMatrix, 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, mmMatrix, USE.NAMES = TRUE)
# Run the model in simplePLS
seminr_model = seminr::simplePLS(obsData = data,
smMatrix = structural_model,
mmMatrix = mmMatrix,
inner_weights = inner_weights,
maxIt=maxIt,
stopCriterion=stopCriterion,
measurement_mode_scheme = measurement_mode_scheme)
# Store all settings needed for a rerun
seminr_model$data <- data
seminr_model$rawdata <- rawdata
seminr_model$measurement_model <- measurement_model
seminr_model$structural_model <- structural_model
seminr_model$settings$inner_weights <- inner_weights
seminr_model$settings$missing_value <- missing_value
seminr_model$settings$maxIt <- maxIt
seminr_model$settings$stopCriterion <- stopCriterion
seminr_model$settings$missing <- missing
# Correct for Bias in Reflective models using PLS Consistent
seminr_model <- model_consistent(seminr_model)
if ( length(HOCs)>0 ) {
# Append return list with first stage model and
seminr_model$first_stage_model <- first_stage_model
seminr_model$hoc <- TRUE
# Combine first and second stage measurement model matrices
new_mm <- combine_first_order_second_order_matrices(model1 = first_stage_model, model2 = seminr_model, mmMatrix)
seminr_model$outer_loadings <- new_mm$new_outer_loadings
seminr_model$outer_weights <- new_mm$new_outer_weights
}
if(length(processed_measurements$ints)>0) {
seminr_model$interaction <- TRUE
}
class(seminr_model) <- c("pls_model", "seminr_model")
return(seminr_model)
}
not_null <- function(a, b) {
if(!is.null(a)) {
a
} else {
b
}
}
#' Reruns a previously specified seminr model/analysis
#'
#' @param x An estimated seminr_model object - refer to specific rerun methods
#'
#' @param ... Any parameters to change during the rerun.
#'
#' @return A re-estimated model of the same class
#'
#' @seealso \code{\link{rerun.pls_model}}
#'
#' @export
rerun <- function (x, ...) {
UseMethod("rerun", x)
}
#' Reruns a previously specified seminr PLS model
#'
#' @param x An estimated pls_model object produced by \code{\link{estimate_pls}}
#'
#' @param ... Any parameters to change during the re-estimation (e.g., data, measurement_model, etc.)
#'
#' @return A re-estimated pls_model object
#'
#' @examples
#'
#' mobi <- mobi
#'
#' mobi_mm <- constructs(
#' composite("Image", multi_items("IMAG", 1:5)),
#' composite("Loyalty", multi_items("CUSL", 1:3))
#' )
#'
#' mobi_sm <- relationships(
#' paths(from = "Image", to = c("Loyalty"))
#' )
#'
#' mobi_pls <- estimate_pls(data = mobi,
#' measurement_model = mobi_mm,
#' structural_model = mobi_sm,
#' missing = mean_replacement,
#' missing_value = NA)
#'
#' # Re-estimate model faithfully
#' mobi_pls2 <- rerun(mobi_pls)
#'
#' # Re-estimated model with altered measurement model
#' mobi_pls3 <- rerun(mobi_pls, measurement_model=as.reflective(mobi_mm))
#'
#' @export
rerun.pls_model <- function(x, ...) {
args <- list(...)
estimate_pls(
data = not_null(args$data, x$rawdata),
measurement_model = not_null(args$measurement_model, x$measurement_model),
structural_model = not_null(args$structural_model, x$structural_model),
model = not_null(args$model, x$model),
inner_weights = not_null(args$inner_weights, x$settings$inner_weights),
missing = not_null(args$missing, x$settings$missing),
missing_value = not_null(args$missing_value, x$settings$missing_value),
maxIt = not_null(args$maxIt, x$settings$maxIt),
stopCriterion = not_null(args$stopCriterion, x$settings$stopCriterion)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.