#' seminr simplePLS Function
#'
#' The \code{seminr} package provides a natural syntax for researchers to describe PLS
#' structural equation models. \code{seminr} is compatible with simplePLS.
#' \code{simplePLS} provides the verb for estimating a pls model.
#'
#' @param obsData A \code{dataframe} containing the indicator measurement data.
#'
#' @param smMatrix A source-to-target matrix representing the inner/structural model,
#' generated by \code{relationships}.
#'
#' @param mmMatrix A source-to-target matrix representing the outer/measurement model,
#' generated by \code{constructs}.
#'
#' @param inner_weights A parameter declaring which inner weighting scheme should be used
#' path_weighting is default, alternately path_factorial can be used.
#'
#' @param maxIt The maximum number of iterations to run (default is 300).
#'
#' @param stopCriterion The criterion to stop iterating (default is 7).
#'
#' @param measurement_mode_scheme A named list of constructs and measurement scheme functions
#'
#' @return A list of the estimated parameters for the SimplePLS 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.}
#'
#' @usage
#' 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{interaction_term}}
#' \code{\link{estimate_pls}} \code{\link{bootstrap_model}}
#'
#' @examples
#' #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)
#'
#' @export
simplePLS <- function(obsData, smMatrix, mmMatrix, inner_weights = path_weighting, maxIt=300, stopCriterion=7, measurement_mode_scheme){
#Create list of Measurements Variables
mmVariables <- mmMatrix[mmMatrix[,"construct"] %in% construct_names(smMatrix), "measurement"]
#Create list of construct Variables
constructs <- construct_names(smMatrix)
#Extract and Normalize the measurements for the model
# normData <- scale(obsData[, mmVariables], TRUE, TRUE)
normData <- standardize_safely(obsData[, mmVariables])
#Extract Mean and Standard Deviation of measurements for future prediction
meanData <- attr(normData, "scaled:center")
sdData <- attr(normData, "scaled:scale")
#Identify which variables have incoming paths (endogenous)
dependant <- all_endogenous(smMatrix)
#Create a matrix of outer_weights
outer_weights <- matrix(data=0,
nrow=length(mmVariables),
ncol=length(constructs),
dimnames = list(mmVariables,constructs))
#Initialize outer_weights matrix with value 1 for each relationship in the measurement model
for (i in 1:length(constructs)) {
outer_weights[mmMatrix[mmMatrix[, "construct"]==constructs[i], "measurement"], constructs[i]] =1
}
# create a weights matrix with value 1 for each relationship
weights_matrix <- outer_weights
#Create a matrix of inner paths
paths_matrix <- matrix(data=0,
nrow=length(constructs),
ncol=length(constructs),
dimnames = list(constructs,constructs))
#Initialize inner_paths matrix with value 1 for each relationship in the structural model
for (i in 1:length(constructs)) {
paths_matrix[smMatrix[smMatrix[, "target"]==constructs[i], "source"], constructs[i]] =1
}
#Iterative Process Starts here
for (iterations in 0:maxIt) {
#Estimate construct Scores from Outter Path
#? construct_scores <- normData%*%outer_weights
construct_scores <- normData[, mmVariables]%*%outer_weights
#Standardize construct Scores
# construct_scores <- scale(construct_scores,TRUE,TRUE)
construct_scores <- standardize_safely(construct_scores)
#Estimate inner paths using weighting scheme - factorial or path-weighting
inner_paths <- inner_weights(smMatrix, construct_scores, dependant, paths_matrix)
#Estimate construct Scores from Inner Path
construct_scores<-construct_scores%*%inner_paths
#Standarize construct Scores
#construct_scores <- scale(construct_scores, TRUE, TRUE)
construct_scores <- standardize_safely(construct_scores)
#Save last outer_weights
last_outer_weights <- outer_weights
#Update outer_weights
for(i in constructs) {
outer_weights[mmMatrix[mmMatrix[, "construct"]==i, "measurement"], i] <- measurement_mode_scheme[[i]]( mmMatrix, i, normData, construct_scores)
}
#Standarize outer_weights
outer_weights <- standardize_outer_weights(normData, mmVariables, outer_weights)
#Verify the stop criteria
weightDiff <- sum(abs(outer_weights-last_outer_weights))
if (weightDiff <(10^(-(stopCriterion))))
break
} #Finish Iterative Process
#Estimate construct Scores from Outter Path
construct_scores <- normData[, mmVariables]%*%outer_weights
#Calculate Outer Loadings
outer_loadings <- calculate_loadings(weights_matrix, construct_scores, normData)
# interaction adjustment
construct_scores <- adjust_interaction(constructs, mmMatrix, outer_loadings, construct_scores, obsData)
#Calculate Outer Loadings
outer_loadings <- calculate_loadings(weights_matrix, construct_scores, normData)
#Calculate and assign path coefficients
path_coef <- estimate_path_coef(smMatrix, construct_scores, dependant, paths_matrix)
#Calculate and assign rSquared
rSquared <- calc_insample(obsData, construct_scores, smMatrix, dependant,stats::cor(construct_scores))
#Prepare return Object
plsModel <- list(meanData = meanData,
sdData = sdData,
smMatrix = smMatrix,
mmMatrix = mmMatrix,
constructs = constructs,
mmVariables = mmVariables,
outer_loadings = outer_loadings,
outer_weights = outer_weights,
path_coef = path_coef,
iterations = iterations,
weightDiff = weightDiff,
construct_scores = construct_scores,
rSquared = rSquared,
inner_weights = inner_weights)
class(plsModel) <- "simple_pls_model"
return(plsModel)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.