Merge pull request #7 from AnthonyRaborn/devel

v0.4.4

Author: AnthonyRaborn

.Rbuildignore

@@ -10,3 +10,4 @@ README.Rmd
 Tabu_example.R
 cran-comments.md
 README-*
+^CRAN-RELEASE$

.gitignore

@@ -5,4 +5,4 @@
 ShortForm.Rproj
 iteration.html
 summary.txt
-
+cran-comments.md

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: ShortForm
 Type: Package
 Title: Automatic Short Form Creation
-Version: 0.4.3
-Date: 2019-8-7
+Version: 0.4.4
+Date: 2019-10-9
 Authors@R: c(person("Anthony", "Raborn", email = "anthony.w.raborn@gmail.com", role = c("aut", "cre")), person("Walter", "Leite", email = "Walter.Leite@coe.ufl.edu", role = "aut"))
 Description: Performs automatic creation of short forms of scales with an 
     ant colony optimization algorithm and a Tabu search. As implemented in the 

R/ACO_lavaan.R

@@ -305,7 +305,7 @@ antcolony.lavaan = function(data = NULL, sample.cov = NULL, sample.nobs = NULL,
 
 
           #replaces the lavaan syntax for factor specification.
-          factor.position = grep(paste(factors[factor],"=~"),input,ignore.case=T)
+          factor.position = grep(paste(factors[factor],"[ ]{0,}=~"),input,ignore.case=T)
           input[factor.position]  = paste(factors[factor],"=~", paste(items,collapse =" + "))
           all.items = c(all.items, items)
           #finishes loop

R/Tabu_shortform.R

@@ -81,8 +81,8 @@ tabuShortForm <-
 
       # save the external relationships
       vectorModel =  unlist(strsplit(x = initialModel, split = "\\n"))
-      externalRelation = vectorModel[grep(" ~ ", vectorModel)]
-      factorRelation = vectorModel[grep(" ~~ ", vectorModel)]
+      externalRelation = vectorModel[grep("[ ]{0,}(?<!=)~ ", vectorModel, perl=T)]
+      factorRelation = vectorModel[grep("[ ]{0,}~~ ", vectorModel)]
 
       # reduce the number of items for each factor according to maxItems
       newItemsPerFactor = list()
@@ -104,7 +104,7 @@ tabuShortForm <-
                                   paste(newItemsPerFactor[[i]], collapse = " + "))
       }
       newModelSyntax = c(newModelSyntax, externalRelation, factorRelation)
-      
+      newModelSyntax = paste(newModelSyntax, collapse = "\n")
       # fit the new model
       newModel = modelWarningCheck(
         lavaan::lavaan(
@@ -226,8 +226,7 @@ tabuShortForm <-
                   )
                 )
 
-                if (fitmodel$lavaan.output@Fit@converged &
-                    !any(is.na(fitmodel$lavaan.output@Fit@se))) {
+                if (fitmodel$lavaan.output@Fit@converged) {
                   fit.val <- criterion(fitmodel$lavaan.output)
                 } else {
                   fit.val <- NA
@@ -276,8 +275,7 @@ tabuShortForm <-
                   )
                 )
 
-                if (fitmodel$lavaan.output@Fit@converged &
-                    !any(is.na(fitmodel$lavaan.output@Fit@se))) {
+                if (fitmodel$lavaan.output@Fit@converged) {
                   fit.val <- criterion(fitmodel$lavaan.output)
                 } else {
                   fit.val <- NA
@@ -322,8 +320,7 @@ tabuShortForm <-
               )
             )
 
-            if (fitmodel$lavaan.output@Fit@converged &
-                !any(is.na(fitmodel$lavaan.output@Fit@se))) {
+            if (fitmodel$lavaan.output@Fit@converged) {
               fit.val <- criterion(fitmodel$lavaan.output)
             } else {
               fit.val <- NA
@@ -347,6 +344,40 @@ tabuShortForm <-
       # Out of valid models, pick model with best objective function value
       indx <- which.min(tmp.obj[valid])
 
+      # if no valid models, recreate a random short form and start over
+      if (length(indx)==0) {
+        cat("Creating initial short form.\n")
+        initialShortModel <- randomInitialModel()
+        cat("The initial short form is: \n")
+        cat(paste(initialShortModel$model.syntax, collapse = "\n"))
+        best.obj <- all.obj <- current.obj <- criterion(initialShortModel$lavaan.output)
+        best.model <- current.model <- initialShortModel$lavaan.output
+        tabu.list <- vector("numeric")
+        
+        factors = unique(lavaan::lavaanify(initialModel)[lavaan::lavaanify(initialModel)$op ==
+                                                           "=~", 'lhs'])
+        externalRelation = unlist(strsplit(x = initialModel, split = "\\n"))[grep(" ~ ", unlist(strsplit(x = initialModel, split = "\\n")))]
+        factorRelation = unlist(strsplit(x = initialModel, split = "\\n"))[grep(" ~~ ", unlist(strsplit(x = initialModel, split = "\\n")))]
+        
+        if (is.list(allItems)) {
+          included.items <-
+            stringr::str_extract_all(string = initialShortModel$model.syntax,
+                                     pattern = paste0("(\\b", paste0(
+                                       paste0(unlist(allItems), collapse = "\\b)|(\\b"), "\\b)"
+                                     )))
+        } else {
+          included.items <-
+            unlist(as.vector(
+              stringr::str_extract_all(
+                string = initialShortModel$model.syntax,
+                pattern = paste0("(\\b", paste0(
+                  paste0(allItems, collapse = "\\b)|(\\b"), "\\b)"
+                ))
+              )
+            ))
+        }
+        next
+      }
       # Move current state to next model
       current.obj <- (tmp.obj[valid])[indx]
       all.obj <- c(all.obj, current.obj)

R/simulated_annealing_internals.R

@@ -149,7 +149,7 @@ syntaxExtraction = function(initialModelSyntaxFile, items) {
   factorSyntax = c()
   itemSyntax = c()
   for (i in 1:length(factors)) {
-    chosenFactorLocation = c(1:length(vectorModelSyntax))[grepl(x = vectorModelSyntax, pattern = paste0(factors[i], " =~ "))]
+    chosenFactorLocation = c(1:length(vectorModelSyntax))[grepl(x = vectorModelSyntax, pattern = paste0(factors[i], "[ ]{0,}=~ "))]
     factorSyntax[i] = vectorModelSyntax[chosenFactorLocation]
     # remove the factors from the syntax
     itemSyntax[i] <-

cran-comments.md

@@ -1,21 +1,11 @@
 ## Resubmission
-This is a resubmission. In this version I have:
-
-* Added classes to the results of the major package functions
-
-* Introduced an S3 Plot method
-
-* Fixed bugs related to bifactor models
-
-* Added a loading message that prints the package version when the package is attached
-
-* Updated the simulatedAnnealing documentation so it is easier on the eyes
+This is a resubmission. In this version I have fixed a bug that caused the lavaan-based functions to improperly use the initial model syntax instead of building the intermediate model syntax when the initial model syntax was specified in an untested manner.
 
 ## Test Environments
 
-* local Windows 10 Home install, R 3.5.0
+* local Windows 10 Enterprise install, R 3.6.1
 
-* ubuntu 14.04.5 LTS trusty (travis ci), R 3.5.1
+* Ubuntu 16.04.5 LTS xenial (travis ci), R 3.6.1
 
 ## R CMD check results
 0 errors | 0 warnings | 0 notes