Merge pull request #2 from AnthonyRaborn/devel

v0.4.2

Author: AnthonyRaborn

.Rbuildignore

@@ -9,7 +9,4 @@ README.md
 README.Rmd
 Tabu_example.R
 cran-comments.md
-README-Simulated Annealing example-1.png
-README-ACO example-1.png
-README-ACO example-2.png
-README-ACO example-3.png
+README-*

.gitignore

@@ -4,4 +4,5 @@
 .Ruserdata
 ShortForm.Rproj
 iteration.html
-summary.txt
+summary.txt
+

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: ShortForm
 Type: Package
 Title: Automatic Short Form Creation
-Version: 0.4.1
-Date: 2018-06-12
-Authors@R: c(person("Walter", "Leite", email = "Walter.Leite@coe.ufl.edu", role = "aut"), person("Anthony", "Raborn", email = "anthony.w.raborn@gmail.com", role = c("aut", "cre")))
+Version: 0.4.2
+Date: 2018-10-16
+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 
     package, the ant colony algorithm randomly selects items to build a model of 
@@ -19,7 +19,7 @@ Description: Performs automatic creation of short forms of scales with an
     <doi:10.1080/10705511.2017.1409074> for an applied example of the Tabu search.
 License: LGPL (>= 2.0, < 3) | Mozilla Public License
 LazyData: TRUE
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.0
 Suggests:
     knitr,
     MplusAutomation (>= 0.7),
@@ -34,3 +34,5 @@ Depends:
 Roxygen: list(wrap = FALSE)
 URL: https://github.com/AnthonyRaborn/ShortForm
 BugReports: https://github.com/AnthonyRaborn/ShortForm/issues
+Encoding: UTF-8
+

NAMESPACE

@@ -1,13 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(plot,antcolony)
+S3method(plot,simulatedAnnealing)
+S3method(plot,tabu)
 export(add.param)
 export(antcolony.lavaan)
 export(antcolony.mplus)
-export(antcolony_plot)
 export(refit.model)
 export(search.prep)
 export(simulatedAnnealing)
 export(tabu.sem)
 export(tabuShortForm)
 import(lavaan)
 import(utils)
+importFrom(stats,runif)

NEWS.md

@@ -1,12 +1,21 @@
 # Package v0.4.2
-## Goals:
+## Introduction of Function Classes
+* This version introduces classes to each of the main function outputs (`antcolony.lavaan` == "antcolony", `simulatedAnnealing` == "simulatedAnnealing", `tabuShortForm` == "tabu")
+* This will allow for `plot` and `print` methods for each of these functions
 
-* Create an option for an initial short form to feed into the functions as a starting point
+## Broken functionality: antcolony_plot
+* The function `antcolony_plot` was replaced with `plot.antcolony` (aka, a plot method)
 
-## Bugfixes:
+## New functionality: S3 method for plotting
+* With the addition of classes, a plot method and accompanying documentation has been added.
+* Future updates will expand S3 methods for `print()` and `summary()`
 
-* Fixed a situation where simulatedAnnealing returns the initial model
-* Fixed simulatedAnnealing not correctly accepting a user-defined restartCriteria
+## Bugfixes
+* Bugfixes to the main functions when using them to create shortforms of bifactor models. 
+* They should now produce actual bifactor shortforms (in v0.4.1, sometimes the item names would be cut off in later iterations [FIXED] and the relationship between latent variables would be changed when they should have been kept constant [FIXED]).
+
+## Added a package loading message
+* Now, when using an interactive R session, a package message is printed out (with a little Penguin holding it all up)!
 
 # Package v0.4.1
 ## New functionality: Simulated Annealing

R/ACO_lavaan.R

@@ -235,6 +235,9 @@ antcolony.lavaan = function(data = NULL, sample.cov = NULL, sample.nobs = NULL,
 
   #creates a vector with all items. UNIQUE USED FOR CASES WHEN ITEMS CROSS-LOAD
   item.vector = unique(unlist(list.items, use.names = F))
+  if (!is.null(bifactor)) {
+    item.vector = item.vector[which(item.vector!=bifactor)]
+    }
 
   #reads the Lavaan model syntax input into the function
   input = unlist(strsplit(antModel, '\n'))
@@ -358,8 +361,13 @@ antcolony.lavaan = function(data = NULL, sample.cov = NULL, sample.nobs = NULL,
         # Check the above messages and set pheromone to zero under certain circumstances
         # the circumstances in question:
         bad.warnings <- c("WARNING: could not compute standard errors",
-                          "WARNING: could not compute scaled test statistic", "WARNING: covariance matrix of latent variables is not positive definite", "WARNING: model has NOT converged")
-        bad.errors <- c("ERROR: initial model-implied matrix (Sigma) is not positive definite","ERROR: initial model-implied matrix (Sigma) is not positive definite", "ERROR: missing observed variables in dataset")
+                          "WARNING: could not compute scaled test statistic", 
+                          "WARNING: covariance matrix of latent variables is not positive definite", 
+                          "WARNING: model has NOT converged", 
+                          "WARNING: could not invert information matrix", 
+                          "WARNING: the optimizer warns that a solution has NOT been found")
+         bad.errors <- c("ERROR: initial model-implied matrix (Sigma) is not positive definite",
+                         "ERROR: missing observed variables in dataset")
         if(any(errors %in% bad.errors) || any(warnings %in% bad.warnings)){
           pheromone = 0
           if(verbose == TRUE) {
@@ -529,8 +537,10 @@ antcolony.lavaan = function(data = NULL, sample.cov = NULL, sample.nobs = NULL,
 
   final.solution = matrix(c(best.so.far.fit.indices,best.so.far.pheromone,best.so.far.solution),1,,
                           dimnames=list(NULL,c(names(model.fit),"mean_gamma",item.vector)))
-
+  results = list(final.solution, summary, 'best.model' = best.so.far.model, 'best.syntax' = best.so.far.syntax)
+  class(results) = "antcolony"
   #FINISH FUNCTION.
   # return(list(final.solution, results, summary))
-  return(list(final.solution, summary, 'best.model' = best.so.far.model, 'best.syntax' = best.so.far.syntax))
+  
+  return(results)
 }

R/ShortForm.R

@@ -0,0 +1,59 @@
+#' \code{ShortForm} package
+#'
+#' Automated Item Selection Algorithms for Short Forms
+#'
+#' See the README on \href{https://github.com/AnthonyRaborn/ShortForm#readme}{GitHub} for more information.
+#'
+#' @docType package
+#' @name ShortForm
+#' @importFrom stats runif
+NULL
+
+## quiets concerns of R CMD check about internal variables
+if(getRversion() >= "2.15.1")  {
+  utils::globalVariables(c("allItems", "auto.cov.lv.x", "auto.cov.y", "auto.delta", "auto.fix.first",
+                           "auto.fix.single", "auto.th", "auto.var", "bestModel", "currentModel", "estimator",
+                           "factors", "int.lv.free", "int.ov.free", "itemsPerFactor", "model.type", "numItems",
+                           "std.lv"
+                           ))
+}
+
+#' Create Package Startup Message
+#'
+#' Makes package startup message.
+#' 
+#' Idea taken from https://github.com/ntguardian/MCHT/blob/master/R/StartupMessage.R
+#'
+#' @import utils
+#' @examples
+#' ShortForm:::ShortFormStartup()
+
+ShortFormStartup <- function() {
+  ShortForm <- c("  #####                             #######                      \n #     # #    #  ####  #####  ##### #        ####  #####  #    # \n #       #    # #    # #    #   #   #       #    # #    # ##  ## \n  #####  ###### #    # #    #   #   #####   #    # #    # # ## # \n       # #    # #    # #####    #   #       #    # #####  #    # \n #     # #    # #    # #   #    #   #       #    # #   #  #    # \n  #####  #    #  ####  #    #   #   #        ####  #    # #    # \n ")
+  version <- paste("\t\t Version", as.character(utils::packageVersion("ShortForm")))
+  penguin <- c("\t\t\t (o<", "\t\t\t //\\", "\t\t\t V_/_ ")
+  
+  message <- c(ShortForm, version, penguin)
+  
+  cat(message, sep = "\n")
+}
+
+#' Package Attach Hook Function
+#'
+#' Hook triggered when package attached.
+#' 
+#' Idea taken from https://github.com/ntguardian/MCHT/blob/master/R/StartupMessage.R
+#'
+#' @param lib a character string giving the library directory where the package
+#'            defining the namespace was found
+#' @param pkg a character string giving the name of the package 
+#' @examples
+#' ShortForm:::.onAttach(.libPaths()[1], "ShortForm")
+
+.onAttach <- function(lib, pkg) {
+  msg <- ShortFormStartup()
+  if (!interactive())
+    msg[1] <- paste("Package 'ShortForm' version", packageVersion("ShortForm"))
+  packageStartupMessage(msg)
+  invisible()
+}

R/Tabu_sem.R

@@ -47,15 +47,15 @@ tabu.sem <- function(init.model,
                      tabu.size = 5) {
   # source(Tabu_internal.R)
   # Initialize objective function and best model
-  best.obj <- current.obj <- obj(init.model)
-  best.model <- current.model <- init.model
-  best.binvec <- current.binvec <- ptab
+  best.obj<-all.obj<-current.obj<-obj(init.model)
+  best.model<-current.model<-init.model
+  best.binvec<-current.binvec<-ptab
 
   tabu.list <- vector("numeric")
 
   # Do iterations
-  for (it in 1:niter) {
-    print(paste0("Running iteration ", it, "."))
+  for(it in 1:niter){
+    cat(paste0("\rRunning iteration ", it, " of ", niter, ".   "))
     # Loop through all neighbors
     tmp.obj <- vector("numeric")
     tmp.mod <- list()
@@ -87,9 +87,10 @@ tabu.sem <- function(init.model,
     indx <- which.min(tmp.obj[valid])
 
     # Move current state to next model
-    current.obj <- (tmp.obj[valid])[indx]
-    current.mod <- (tmp.mod[valid])[[indx]]
-    current.binvec <- (tmp.vec[valid])[[indx]]
+    current.obj<-(tmp.obj[valid])[indx]
+    all.obj<-c(all.obj,current.obj)
+    current.mod<-(tmp.mod[valid])[[indx]]
+    current.binvec<-(tmp.vec[valid])[[indx]]
 
     # Update Tabu list
     tabu.list <- c(valid[indx], tabu.list)
@@ -106,10 +107,12 @@ tabu.sem <- function(init.model,
     }
   }
 
-  ret <- list()
-  ret$best.obj <- best.obj
-  ret$best.mod <- best.mod
-  ret$best.binvec <- best.binvec
+  ret<-list()
+  ret$best.obj<-best.obj
+  ret$best.mod<-best.mod
+  ret$best.binvec<-best.binvec
+  ret$all.obj<-all.obj
+  class(ret)<-"tabu"
 
   return(ret)
 }

R/Tabu_shortform.R

@@ -134,8 +134,7 @@ tabuShortForm <-
     initialShortModel <- randomInitialModel()
     cat("The initial short form is: \n")
     cat(paste(initialShortModel$model.syntax, collapse = "\n"))
-    best.obj <-
-      current.obj <- criterion(initialShortModel$lavaan.output)
+    best.obj <- all.obj <- current.obj <- criterion(initialShortModel$lavaan.output)
     best.model <- current.model <- initialShortModel$lavaan.output
     tabu.list <- vector("numeric")
 
@@ -350,6 +349,7 @@ tabuShortForm <-
 
       # Move current state to next model
       current.obj <- (tmp.obj[valid])[indx]
+      all.obj <- c(all.obj, current.obj)
       current.mod <- (tmp.mod[valid])[indx]
       current.syntax <- unlist((tmp.syntax[valid])[indx])
       # current.binvec<-(tmp.vec[valid])[[indx]]
@@ -373,8 +373,9 @@ tabuShortForm <-
 
     ret <- list()
     ret$best.obj <- best.obj
-    ret$best.mod <- best.mod
+    ret$best.mod <- best.mod[[1]]
     ret$best.syntax <- best.syntax
-    
+    ret$all.obj <- all.obj
+    class(ret) = "tabu"
     return(ret)
   }