From 10cac85e04f0b9d66babe504f7e05117bdf579f0 Mon Sep 17 00:00:00 2001 From: Phil Chalmers Date: Wed, 6 Sep 2017 09:11:15 -0400 Subject: [PATCH] throw early error --- DESCRIPTION | 2 +- NEWS.md | 3 +++ R/forward.search.R | 19 +++++++++++-------- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0d460cb..2f7b274 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: faoutlier -Version: 0.7.2 +Version: 0.7.3 Type: Package Title: Influential Case Detection Methods for Factor Analysis and Structural Equation Models diff --git a/NEWS.md b/NEWS.md index aaad839..ffa50d5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ Changes in version 0.7 +- `forward.search()` now throws an error when no unique base set can be found (occurs when the defined + model is exactly identified, and therefore perfectly fits the data) + - added a `progress` argument to `gCD()`, `LD()`, and `GOF()` to print the progress of the iterations Changes in version 0.5 diff --git a/R/forward.search.R b/R/forward.search.R index 4d12053..838b8eb 100644 --- a/R/forward.search.R +++ b/R/forward.search.R @@ -26,12 +26,12 @@ #' @author Phil Chalmers \email{rphilip.chalmers@@gmail.com} #' @references #' -#' Chalmers, R. P. & Flora, D. B. (2015). faoutlier: An R Package for Detecting +#' Chalmers, R. P. & Flora, D. B. (2015). faoutlier: An R Package for Detecting #' Influential Cases in Exploratory and Confirmatory Factor Analysis. #' \emph{Applied Psychological Measurement, 39}, 573-574. \doi{10.1177/0146621615597894} #' -#' Flora, D. B., LaBrish, C. & Chalmers, R. P. (2012). Old and new ideas for data -#' screening and assumption testing for exploratory and confirmatory factor analysis. +#' Flora, D. B., LaBrish, C. & Chalmers, R. P. (2012). Old and new ideas for data +#' screening and assumption testing for exploratory and confirmatory factor analysis. #' \emph{Frontiers in Psychology, 3}, 1-21. \doi{10.3389/fpsyg.2012.00055} #' @seealso #' \code{\link{gCD}}, \code{\link{GOF}}, \code{\link{LD}}, @@ -92,7 +92,6 @@ forward.search <- function(data, model, criteria = c('GOF', 'mah'), stop('All routines require complete datasets (no NA\'s) so that the search gives meaningful results.') N <- nrow(data) - p <- ncol(data) ID <- 1:N Samples <- matrix(0, floor(p.base*N), n.subsets) for(i in 1:n.subsets) @@ -173,7 +172,6 @@ forward.search <- function(data, model, criteria = c('GOF', 'mah'), (ncol(Rhat)*(ncol(Rhat) + 1)))) ret <- list(GOF=GOFstat, RMR=RMR, gCD=Cooksstat, ord=orderentered) } else if(class(model) == "semmod"){ - sampleCov <- cov(data) STATISTICS <- myApply(matrix(1:n.subsets), 1, function(i, data, Samples, model){ tmpdat <- data[Samples[ ,i], ] samplesemMod <- try(sem::sem(model, cov(tmpdat), nrow(tmpdat), ...), TRUE) @@ -183,6 +181,8 @@ forward.search <- function(data, model, criteria = c('GOF', 'mah'), }, data=data, Samples=Samples, model=model) orgbaseID <- baseID <- Samples[ ,(min(STATISTICS) == STATISTICS)] nbaseID <- setdiff(ID, baseID) + if(length(nbaseID) == 0) + stop('No unique starting subset located based-on goodness of fit') basedata <- data[baseID, ] stat <- c() basemodels <- list() @@ -258,6 +258,8 @@ forward.search <- function(data, model, criteria = c('GOF', 'mah'), }, data=data, Samples=Samples, model=model) orgbaseID <- baseID <- Samples[ ,(min(STATISTICS) == STATISTICS)] nbaseID <- setdiff(ID, baseID) + if(length(nbaseID) == 0) + stop('No unique starting subset located based-on goodness of fit') basedata <- data[baseID, ] basemodels <- list() orderentered <- c() @@ -276,9 +278,10 @@ forward.search <- function(data, model, criteria = c('GOF', 'mah'), RANK <- RANK + rank(stat) } if(any(criteria == 'mah')){ - stat <- mahalanobis(data[nbaseID, ], colMeans(data[baseID, ]), - cov(data[baseID, ])) - RANK <- RANK + rank(stat) + stat <- try(mahalanobis(data[nbaseID, ], colMeans(data[baseID, ]), + cov(data[baseID, ])), TRUE) + if(!is(stat, 'try-error')) + RANK <- RANK + rank(stat) } if(any(criteria == 'res')){ stat <- c()