Skip to content

Commit

Permalink
undo reset
Browse files Browse the repository at this point in the history
  • Loading branch information
@juliuspfadt
juliuspfadt committed May 13, 2024
1 parent a7f3351 commit b985160
Show file tree
Hide file tree
Showing 4 changed files with 164 additions and 135 deletions.
7 changes: 3 additions & 4 deletions R/PLSSEMWrapper.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ PLSSEM <- function(
benchmark = "none",
bootstrapSamples = 200,
ciLevel = 0.95,
compositeCorrelationDisattenuated = TRUE,
consistentPartialLeastSquares = TRUE,
convergenceCriterion = "absoluteDifference",
correctionFactor = "squaredEuclidean",
correlationMatrix = "pearson",
Expand All @@ -50,8 +50,7 @@ PLSSEM <- function(
robustMethod = "bootstrap",
seed = 1,
setSeed = FALSE,
structuralModelIgnored = FALSE,
weightingApproach = "PLS-PM") {
structuralModelIgnored = FALSE) {

defaultArgCalls <- formals(jaspSem::PLSSEM)
defaultArgs <- lapply(defaultArgCalls, eval)
Expand All @@ -62,7 +61,7 @@ PLSSEM <- function(
options[["data"]] <- NULL
options[["version"]] <- NULL

optionsWithFormula <- c("convergenceCriterion", "correctionFactor", "group", "handlingOfFlippedSigns", "innerWeightingScheme", "models", "weightingApproach")
optionsWithFormula <- c("convergenceCriterion", "correctionFactor", "group", "handlingOfFlippedSigns", "innerWeightingScheme", "models")
for (name in optionsWithFormula) {
if ((name %in% optionsWithFormula) && inherits(options[[name]], "formula")) options[[name]] = jaspBase::jaspFormula(options[[name]], data) }

Expand Down
102 changes: 61 additions & 41 deletions R/plssem.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,8 @@ PLSSEMInternal <- function(jaspResults, dataset, options, ...) {
.semMardiasCoefficient(modelContainer, dataset, options, ready)
.plsSemReliabilities(modelContainer, dataset, options, ready)
.plsSemCor(modelContainer, options, ready)

.plsAddConstructScores(jaspResults, modelContainer, options, ready)
}

.plsSemPrepOpts <- function(options) {
Expand Down Expand Up @@ -149,14 +151,15 @@ checkCSemModel <- function(model, availableVars) {


.plsSemModelContainer <- function(jaspResults) {

if (!is.null(jaspResults[["modelContainer"]])) {
modelContainer <- jaspResults[["modelContainer"]]
} else {
modelContainer <- createJaspContainer()
modelContainer$dependOn(c("weightingApproach", "correlationMatrix", "convergenceCriterion",
"estimateStructural", "group", "correctionFactor", "compositeCorrelationDisattenuated",
modelContainer$dependOn(c("correlationMatrix", "convergenceCriterion",
"estimateStructural", "group", "correctionFactor", "consistentPartialLeastSquares",
"structuralModelIgnored", "innerWeightingScheme", "errorCalculationMethod", "robustMethod", "bootstrapSamples", "ciLevel",
"setSeed", "seed", "handlingOfInadmissibles", "Data", "handlingOfFlippedSigns", "endogenousIndicatorPrediction",
"setSeed", "seed", "handlingOfInadmissibles", "endogenousIndicatorPrediction",
"kFolds", "repetitions", "benchmark", "predictedScore"))
jaspResults[["modelContainer"]] <- modelContainer
}
Expand Down Expand Up @@ -237,11 +240,7 @@ checkCSemModel <- function(model, availableVars) {
.user_funs = tickFunction,
.resample_method = options[["robustMethod"]],
.handle_inadmissibles = options[["handlingOfInadmissibles"]],
.sign_change_option = switch(options[["handlingOfFlippedSigns"]],
"individualReestimation" = "individual_reestimate",
"constructReestimation" = "construct_reestimate",
options[["handlingOfFlippedSigns"]]
),
.sign_change_option = "none",
.seed = if (options[["setSeed"]]) options[["seed"]]))


Expand Down Expand Up @@ -278,7 +277,7 @@ checkCSemModel <- function(model, availableVars) {
cSemOpts <- list()

# model features
cSemOpts[[".approach_weights"]] <- options[["weightingApproach"]]
cSemOpts[[".approach_weights"]] <- "PLS-PM"
cSemOpts[[".approach_cor_robust"]] <- if (options[["correlationMatrix"]] == "pearson") "none" else options[["correlationMatrix"]]
cSemOpts[[".approach_nl"]] <- options[["approachNonLinear"]]
cSemOpts[[".conv_criterion"]] <- switch(options[["convergenceCriterion"]],
Expand All @@ -290,7 +289,7 @@ checkCSemModel <- function(model, availableVars) {
cSemOpts[[".PLS_ignore_structural_model"]] <- options[["structuralModelIgnored"]]
cSemOpts[[".PLS_weight_scheme_inner"]] <- options[["innerWeightingScheme"]]

if (options[["compositeCorrelationDisattenuated"]]) {
if (options[["consistentPartialLeastSquares"]]) {
cSemOpts[".disattenuate"] <- TRUE
cSemOpts[".PLS_approach_cf"] <- switch(options[["correctionFactor"]],
"squaredEuclidean" = "dist_squared_euclid",
Expand Down Expand Up @@ -1059,19 +1058,19 @@ checkCSemModel <- function(model, availableVars) {
predictcont <- createJaspContainer(name, initCollapsed = TRUE)
}

#Error messages
# Error messages

if (options[["benchmark"]] != "none" && options[["benchmark"]] != "all") {
benchmarks <- options[["benchmark"]]
}
else if (options[["benchmark"]] == "all") {
benchmarks <- c("lm", "PLS-PM", "GSCA", "PCA", "MAXVAR")
benchmarks <- benchmarks[benchmarks != options[["weightingApproach"]]]
benchmarks <- benchmarks[benchmarks != "PLS-PM"]
} else {
benchmarks <- NULL
}

if (options[["benchmark"]] != "none" && options[["benchmark"]] != "all" && benchmarks == options[["weightingApproach"]]) {
if (options[["benchmark"]] != "none" && options[["benchmark"]] != "all" && benchmarks == "PLS-PM") {
errormsg <- gettextf("The target model uses the same weighting approach as the benchmark model, please choose another benchmark.")
modelContainer$setError(errormsg)
modelContainer$dependOn("benchmark")
Expand Down Expand Up @@ -1961,44 +1960,65 @@ checkCSemModel <- function(model, availableVars) {
return()
}

.plsSEMVIFhelper <- function(fit){
# Make VIFs into a matrix
# Restructure the VIFs into a table.
VIFspath <- cSEM::assess(.object = fit,.quality_criterion = 'vif')

idx <- which(VIFspath$VIF!=0,arr.ind = T)

if(nrow(idx)!=0){
VIFDf <- data.frame(Relation=paste(rownames(VIFspath$VIF)[idx[,'row']],'~',colnames(VIFspath$VIF)[idx[,'col']]),
vif=VIFspath$VIF[cbind(rownames(VIFspath$VIF)[idx[,'row']],colnames(VIFspath$VIF)[idx[,'col']])])
.plsAddConstructScores <- function(jaspResults, modelContainer, options, ready) {

VIFvector <-setNames(VIFDf$vif, VIFDf$Relation)
} else{
VIFvector <- NULL
if (!ready ||
!is.null(jaspResults[["addedScoresContainer"]]) ||
modelContainer$getError() ||
!options[["addConstructScores"]])
{
return()
}
return(VIFvector)
}

.plsSEMVIFBhelper <- function(fit){
VIFsweights <- cSEM::calculateVIFModeB(fit)
container <- createJaspContainer()
container$dependOn(optionsFromObject = modelContainer)
jaspResults[["addedScoresContainer"]] <- container

# If there is only one weight, cSEM::calculateVIFModeB() returns NA for that VIF
# therefore, replace NAs with 0
VIFsweights[is.na(VIFsweights)] <- 0
models <- modelContainer[["models"]][["object"]]
results <- modelContainer[["results"]][["object"]]

modelNames <- sapply(models, function(x) x[["name"]])
modelNames <- gsub(" ", "_", modelNames)
allNamesR <- c()
# loop over the models
for (i in seq_len(length(results))) {
scores <- cSEM::getConstructScores(results[[i]])$Construct_scores

if(!is.null(VIFsweights)&sum(VIFsweights)!=0){
idx <- which(VIFsweights!=0,arr.ind = T)
# then loop over the scores
scoreNames <- colnames(scores)
for (ii in seq_len(ncol(scores))) {

VIFBDf <- data.frame(Relation=paste(rownames(VIFsweights)[idx[,'row']],'<~',colnames(VIFsweights)[idx[,'col']]),
vif=VIFsweights[cbind(rownames(VIFsweights)[idx[,'row']],colnames(VIFsweights)[idx[,'col']])])
colNameR <- paste0(modelNames[i], "_", scoreNames[ii])

VIFBvector <-setNames(VIFBDf$vif, VIFBDf$Relation)
if (jaspBase:::columnExists(colNameR) && !jaspBase:::columnIsMine(colNameR)) {
.quitAnalysis(gettextf("Column '%s' name already exists in the dataset", colNameR))
}

} else{
VIFBvector <- NULL
container[[colNameR]] <- jaspBase::createJaspColumn(colNameR)
container[[colNameR]]$setScale(scores[, ii])

# save the names to keep track of all names
allNamesR <- c(allNamesR, colNameR)
}
}
return(VIFBvector)

}
# check if there are previous colNames that are not needed anymore and delete the cols
oldNames <- jaspResults[["createdColumnNames"]][["object"]]
newNames <- allNamesR
if (!is.null(oldNames)) {
noMatch <- which(!(oldNames %in% newNames))
if (length(noMatch) > 0) {
for (iii in 1:length(noMatch)) {
jaspBase:::columnDelete(oldNames[noMatch[iii]])
}
}
}

# save the created col names
jaspResults[["createdColumnNames"]] <- createJaspState(allNamesR)


return()

}
60 changes: 17 additions & 43 deletions inst/qml/PLSSEM.qml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,16 +45,10 @@ Form

Group
{
CheckBox
{
enabled: approachWeigths.currentValue == "PLS-PM" && approachInner.currentValue != "path"
name: "structuralModelIgnored"
label: qsTr("Ignore structural model")
}

CheckBox
{
name: "compositeCorrelationDisattenuated"; label: qsTr("Disattenuate composite correlations"); checked: true
name: "consistentPartialLeastSquares"; label: qsTr("Consistent partial least squares"); checked: true
DropDown
{
name: "correctionFactor"
Expand Down Expand Up @@ -133,30 +127,9 @@ Form

Group
{

DropDown
{
name: "weightingApproach"
label: qsTr("Weighting approach")
id: approachWeigths
values:
[
{ label: qsTr("PLS-PM"), value: "PLS-PM" },
{ label: qsTr("GSCA"), value: "GSCA" },
{ label: qsTr("SUMCORR"), value: "SUMCORR" },
{ label: qsTr("MAXVAR"), value: "MAXVAR" },
{ label: qsTr("SSQCORR"), value: "SSQCORR" },
{ label: qsTr("MINVAR"), value: "MINVAR" },
{ label: qsTr("GENVAR"), value: "GENVAR" },
{ label: qsTr("PCA"), value: "PCA" },
{ label: qsTr("Unit"), value: "unit" },
{ label: qsTr("Bartlett"), value: "bartlett" },
{ label: qsTr("Regression"), value: "regression" }
]
}

DropDown
{
enabled: approachWeigths.currentValue == "PLS-PM"
name: "innerWeightingScheme"
label: qsTr("Inner weighting scheme")
id: approachInner
Expand All @@ -167,6 +140,13 @@ Form
]
}

CheckBox
{
enabled: approachInner.currentValue != "path"
name: "structuralModelIgnored"
label: qsTr("Ignore structural model")
}

DropDown
{
name: "convergenceCriterion"
Expand Down Expand Up @@ -194,18 +174,6 @@ Form
RadioButton { value: "ignore"; label: qsTr("Ignore") }
RadioButton { value: "drop"; label: qsTr("Drop") }
}

DropDown
{
name: "handlingOfFlippedSigns"
label: qsTr("Handling of flipped signs")
values: [
{ value: "none", label: qsTr("None") },
{ value: "individual", label: qsTr("Individual") },
{ value: "individualReestimation", label: qsTr("Individual re-estimation") },
{ value: "constructReestimation", label: qsTr("Construct re-estimation") }
]
}
}
}

Expand All @@ -215,19 +183,25 @@ Form

Group
{
CheckBox { name: "rSquared"; label: qsTr("R-squared") }
CheckBox { name: "rSquared"; label: qsTr("R-squared") }
CheckBox { name: "additionalFitMeasures"; label: qsTr("Additional fit measures") }
CheckBox { name: "mardiasCoefficient"; label: qsTr("Mardia's coefficient") }
CheckBox { name: "reliabilityMeasures"; label: qsTr("Reliability measures") }
}

Group
{
CheckBox { name: "observedIndicatorCorrelation"; label: qsTr("Observed indicator correlations") }
CheckBox { name: "observedIndicatorCorrelation"; label: qsTr("Observed indicator correlations") }
CheckBox { name: "impliedIndicatorCorrelation"; label: qsTr("Implied indicator correlations") }
CheckBox { name: "observedConstructCorrelation"; label: qsTr("Observed construct correlations") }
CheckBox { name: "impliedConstructCorrelation"; label: qsTr("Implied construct correlations") }
}

CheckBox
{
name: "addConstructScores"
text: qsTr("Add construct scores to data")
}
}

Section
Expand Down
Loading

0 comments on commit b985160

Please sign in to comment.