[Lme4-commits] r1660 - in pkg: Gqr SASmixed lme4.0 lme4Eigen/R

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

Author: bbolker
Date: 2012-03-15 21:43:03 +0100 (Thu, 15 Mar 2012)
New Revision: 1660

Modified:
   pkg/Gqr/DESCRIPTION
   pkg/SASmixed/DESCRIPTION
   pkg/lme4.0/DESCRIPTION
   pkg/lme4Eigen/R/profile.R
Log:

  fix typos in descriptions, update e-mail to bolker at mcmaster.ca


Modified: pkg/Gqr/DESCRIPTION
===================================================================
--- pkg/Gqr/DESCRIPTION	2012-03-15 20:20:10 UTC (rev 1659)
+++ pkg/Gqr/DESCRIPTION	2012-03-15 20:43:03 UTC (rev 1660)
@@ -4,11 +4,11 @@
 Title: Determine knots and weights for Gaussian quadrature rules
 Author: Douglas Bates <bates at stat.wisc.edu>,
         Martin Maechler <maechler at R-project.org> and
-	Ben Bolker <bbolker at gmail.com>
+	Ben Bolker <bolker at mcmaster.ca>
 Maintainer: <lme4-authors at R-forge.wu-wien.ac.at>
 Description: Determine the knots and the weights for Gaussian quadrature
- rules based on Legendra, Chebyshev, Gegenbauer, Jacobit, Laguerre,
- Hermite, Expontential or Rational kernels.  Generalized forms of the
+ rules based on Legendre, Chebyshev, Gegenbauer, Jacobi, Laguerre,
+ Hermite, Exponential or Rational kernels.  Generalized forms of the
  kernels can be used.
 Depends: R(>= 2.14.0)
 LinkingTo: Rcpp

Modified: pkg/SASmixed/DESCRIPTION
===================================================================
--- pkg/SASmixed/DESCRIPTION	2012-03-15 20:20:10 UTC (rev 1659)
+++ pkg/SASmixed/DESCRIPTION	2012-03-15 20:43:03 UTC (rev 1660)
@@ -3,10 +3,10 @@
 Date: 2011-10-17
 Title: Data sets from "SAS System for Mixed Models"
 Maintainer: <lme4-authors at R-forge.wu-wien.ac.at>
-Author: Original by Littel, Milliken, Stroup, and Wolfinger
+Author: Original by Littell, Milliken, Stroup, and Wolfinger,
   modifications by Douglas Bates <bates at stat.wisc.edu>
 Description: Data sets and sample lmer analyses corresponding
-  to the examples in Littel, Milliken, Stroup and Wolfinger
+  to the examples in Littell, Milliken, Stroup and Wolfinger
   (1996), "SAS System for Mixed Models", SAS Institute.
 Depends: R (>= 2.10)
 Suggests: lattice, lme4

Modified: pkg/lme4.0/DESCRIPTION
===================================================================
--- pkg/lme4.0/DESCRIPTION	2012-03-15 20:20:10 UTC (rev 1659)
+++ pkg/lme4.0/DESCRIPTION	2012-03-15 20:43:03 UTC (rev 1660)
@@ -7,7 +7,7 @@
   It has been renamed to lme4.0, and is now deprecated in favor of the new lme4 package.
 Author: Douglas Bates <bates at stat.wisc.edu>,
         Martin Maechler <maechler at R-project.org> and
-	Ben Bolker <bbolker at gmail.com>
+	Ben Bolker <bolker at mcmaster.ca>
 Maintainer: <lme4-authors at R-forge.wu-wien.ac.at>
 Depends: methods, R(>= 2.11.1), Matrix(>= 1.0-1), lattice
 LinkingTo: Matrix, stats

Modified: pkg/lme4Eigen/R/profile.R
===================================================================
--- pkg/lme4Eigen/R/profile.R	2012-03-15 20:20:10 UTC (rev 1659)
+++ pkg/lme4Eigen/R/profile.R	2012-03-15 20:43:03 UTC (rev 1660)
@@ -286,25 +286,50 @@
     stdErr <- unname(coef(summary(fm))[,2])
     pp <- fm at pp$copy()
     ## opt <- c(pp$theta*sig, sig)
-    opt <- Cv_to_Sv(pp$theta, n=sapply(fm at cnms,length), s=sig)
-    ## FIXME: alternatively use/allow names as in getME(.,"theta") ?
-    names(opt) <- c(sprintf(".sig%02d", seq_along(pp$theta)), ".sigma")
+    if (!isGLMM(fm)) {
+      opt <- Cv_to_Sv(pp$theta, n=sapply(fm at cnms,length), s=sig)
+      ## FIXME: alternatively use/allow names as in getME(.,"theta") ?
+      names(opt) <- c(sprintf(".sig%02d", seq_along(pp$theta)), ".sigma")
+    } else {
+      opt <- Cv_to_Sv(pp$theta, n=sapply(fm at cnms,length))
+      ## FIXME: alternatively use/allow names as in getME(.,"theta") ?
+      names(opt) <- sprintf(".sig%02d", seq_along(pp$theta))
+    }
     opt <- c(opt, fixef(fm))
     resp <- fm at resp$copy()
-    np <- length(pp$theta) + 1L
+    np <- length(pp$theta)
+    if (!isGLMM(fm)) np <- np + 1L
     n <- nrow(pp$V)                   # use V, not X so it works with nlmer
-    ans <- function(pars)
-    {
-        stopifnot(is.numeric(pars), length(pars) == np)
-        ## Assumption:  all parameters, including the residual SD on SD-scale
-        sigma <- pars[np]
-        ## .Call(lmer_Deviance, pp$ptr(), resp$ptr(), pars[-np]/sigma)
-        ## convert from sdcor vector back to 'unscaled theta' 
-        thpars <- Sv_to_Cv(pars,n=sapply(fm at cnms,length),s=sigma)
-        .Call(lmer_Deviance, pp$ptr(), resp$ptr(), thpars)
-        sigsq <- sigma^2
-        pp$ldL2() + (resp$wrss() + pp$sqrL(1))/sigsq + n * log(2 * pi * sigsq)
-      }
+    if (isLMM(fm)) {
+      ans <- function(pars)
+        {
+          stopifnot(is.numeric(pars), length(pars) == np)
+          ## Assumption:  all parameters, including the residual SD on SD-scale
+          sigma <- pars[np]
+          ## .Call(lmer_Deviance, pp$ptr(), resp$ptr(), pars[-np]/sigma)
+          ## convert from sdcor vector back to 'unscaled theta' 
+          thpars <- Sv_to_Cv(pars,n=sapply(fm at cnms,length),s=sigma)
+          .Call(lmer_Deviance, pp$ptr(), resp$ptr(), thpars)
+          sigsq <- sigma^2
+          pp$ldL2() + (resp$wrss() + pp$sqrL(1))/sigsq + n * log(2 * pi * sigsq)
+        }
+    } else {
+      d0 <- mkdev(fm)
+      ans <- function(pars)
+        {
+          stopifnot(is.numeric(pars), length(pars) == np)
+          thpars <- pars[seq(np)]
+          
+          ## FIXME: allow useSc (i.e. NLMMs)
+          sigma <- pars[np]
+          ## .Call(lmer_Deviance, pp$ptr(), resp$ptr(), pars[-np]/sigma)
+          ## convert from sdcor vector back to 'unscaled theta' 
+          thpars <- Sv_to_Cv(pars,n=sapply(fm at cnms,length))
+          d0(thpars,
+          sigsq <- sigma^2
+          pp$ldL2() + (resp$wrss() + pp$sqrL(1))/sigsq + n * log(2 * pi * sigsq)
+        }
+      
     attr(ans, "optimum") <- opt         # w/ names()
     attr(ans, "basedev") <- basedev
     attr(ans, "thopt") <- pp$theta