[Lme4-commits] r1776 - pkg/lme4/R

[noreply at r-forge.r-project.org]

Author: mmaechler
Date: 2012-06-25 09:35:58 +0200 (Mon, 25 Jun 2012)
New Revision: 1776

Modified:
   pkg/lme4/R/lmer.R
   pkg/lme4/R/mlirt.R
   pkg/lme4/R/profile.R
Log:
vcov() should not fail when sd=NA  // get rid of ifelse() misuse {and speedup in 1 case}

Modified: pkg/lme4/R/lmer.R
===================================================================
--- pkg/lme4/R/lmer.R	2012-06-24 20:03:18 UTC (rev 1775)
+++ pkg/lme4/R/lmer.R	2012-06-25 07:35:58 UTC (rev 1776)
@@ -981,13 +981,13 @@
 
 ##' @S3method isGLMM merMod
 isGLMM.merMod <- function(x,...) {
-  as.logical(x at devcomp$dims["GLMM"])
+  as.logical(x at devcomp$dims[["GLMM"]])
   ## or: is(x at resp,"glmResp")
 }
 
 ##' @S3method isNLMM merMod
 isNLMM.merMod <- function(x,...) {
-  as.logical(x at devcomp$dims["NLMM"])
+  as.logical(x at devcomp$dims[["NLMM"]])
   ## or: is(x at resp,"nlsResp")
 }
 
@@ -1298,7 +1298,7 @@
     dc <- object at devcomp
     dd <- dc$dims
     if(dd[["useSc"]])
-        dc$cmp[[ifelse(dd[["REML"]], "sigmaREML", "sigmaML")]] else 1.
+        dc$cmp[[if(dd[["REML"]]) "sigmaREML" else "sigmaML"]] else 1.
 }
 
 ##' @importFrom stats simulate
@@ -1721,7 +1721,8 @@
 	stop("Computed variance-covariance matrix is not positive definite")
     dimnames(rr) <- list(nmsX, nmsX)
     if(correlation)
-	rr at factors$correlation <- as(rr, "corMatrix")
+	rr at factors$correlation <-
+	    if(is.na(sigma)) as(rr, "corMatrix") else rr # (is NA anyway)
     rr
 }
 
@@ -1888,11 +1889,11 @@
           colnames(coefs)[4] <- c("Pr(>|z|)")
         }
     }
-    mName <- paste(switch(1L + dd["GLMM"] * 2L + dd["NLMM"],
+    mName <- paste(switch(1L + dd[["GLMM"]] * 2L + dd[["NLMM"]],
 			  "Linear", "Nonlinear",
 			  "Generalized linear", "Generalized nonlinear"),
 		   "mixed model fit by",
-		   ifelse(REML, "REML", "maximum likelihood"))
+		   if(REML) "REML" else "maximum likelihood")
     llik <- logLik(object)   # returns NA for a REML fit - maybe change?
     AICstats <- {
 	if (REML) cmp["REML"] # do *not* show likelihood stats here

Modified: pkg/lme4/R/mlirt.R
===================================================================
--- pkg/lme4/R/mlirt.R	2012-06-24 20:03:18 UTC (rev 1775)
+++ pkg/lme4/R/mlirt.R	2012-06-25 07:35:58 UTC (rev 1776)
@@ -74,7 +74,7 @@
 ##     cat(paste("relative tolerance set to", rel.tol, "\n"))
 
 ##     optimRes <- nlminb(PQLpars, devLaplace,
-##                        lower = ifelse(const, 5e-10, -Inf),
+##                        lower = if(const) 5e-10 else -Inf,
 ##                        control = list(trace = cv$msVerbose,
 ##                        iter.max = cv$msMaxIter,
 ##                        rel.tol = rel.tol))

Modified: pkg/lme4/R/profile.R
===================================================================
--- pkg/lme4/R/profile.R	2012-06-24 20:03:18 UTC (rev 1775)
+++ pkg/lme4/R/profile.R	2012-06-25 07:35:58 UTC (rev 1776)
@@ -6,8 +6,8 @@
 
 globalVariables(".par",package="lme4")
 
-##' 
 ##'
+##'
 ##' @name profile-methods
 ##' @aliases profile-methods profile.merMod
 ##' @docType methods
@@ -179,7 +179,7 @@
     ## bounds on Cholesky: [0,Inf) for diag, (-Inf,Inf) for diag
     ## bounds on sd-corr:  [0,Inf) for diag, (-1.0,1.0) for diag
     lower <- pmax(fitted at lower,-1.0)
-    upper <- ifelse(fitted at lower==0,Inf,1.0)
+    upper <- 1/(fitted at lower != 0)## = ifelse(fitted at lower==0, Inf, 1.0)
     if (useSc) {
         lower <- c(lower,0)
         upper <- c(upper,Inf)
@@ -294,7 +294,7 @@
                 ores <- optwrap(optimizer,
                                 par=thopt, fn=mkdevfun(rho, 0L),
                                 lower = pmax(fitted at lower, -1.0),
-                                upper =  ifelse(fitted at lower==0,Inf,1.0))
+				upper = 1/(fitted at lower != 0))## = ifelse(fitted at lower==0, Inf, 1.0)
                 fv <- ores$fval
                 sig <- sqrt((rr$wrss() + pp1$sqrL(1))/n)
                 c(sign(fw - est) * sqrt(fv - base),
@@ -763,8 +763,8 @@
                            line.lwd = axis.line.lwd)
             lims <- c(-1.07, 1.07) * mlev
             grid::pushViewport(viewport(xscale = lims, yscale = lims))
-            side <- ifelse(j == 1, "right", "bottom")
-            which.half <- ifelse(j == 1, "lower", "upper")
+	    side <- if(j == 1) "right" else "bottom"
+	    which.half <- if(j == 1) "lower" else "upper"
             at <- pretty(lims)
             panel.axis(side = side, at = at, labels = format(at, trim = TRUE),
                        ticks = TRUE, half = TRUE, which.half = which.half,