R/estimate_simplePLS.R

Defines functions simplePLS

Documented in simplePLS

#' 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)
}
sem-in-r/seminr documentation built on Aug. 26, 2022, 8:47 p.m.