[Lme4-commits] r1515 - pkg/lme4Eigen/R

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

Author: bbolker
Date: 2012-01-25 16:58:54 +0100 (Wed, 25 Jan 2012)
New Revision: 1515

Modified:
   pkg/lme4Eigen/R/AllClass.R
   pkg/lme4Eigen/R/profile.R
Log:

   Partial fixes to get profiling working again



Modified: pkg/lme4Eigen/R/AllClass.R
===================================================================
--- pkg/lme4Eigen/R/AllClass.R	2012-01-24 23:30:08 UTC (rev 1514)
+++ pkg/lme4Eigen/R/AllClass.R	2012-01-25 15:58:54 UTC (rev 1515)
@@ -233,6 +233,11 @@
                          'change the offset in the model (used in profiling)'
                          .Call(lm_setOffset, ptr(), as.numeric(oo))
                      },
+                     setWeights = function(oo) {
+                         'change the weights in the model (used in profiling)'
+                         .Call(lm_setWeights, ptr(), as.numeric(oo))
+                     },
+
                      updateMu  = function(gamma) {
                          'update mu, wtres and wrss from the linear predictor'
                          .Call(lm_updateMu, ptr(), as.numeric(gamma))

Modified: pkg/lme4Eigen/R/profile.R
===================================================================
--- pkg/lme4Eigen/R/profile.R	2012-01-24 23:30:08 UTC (rev 1514)
+++ pkg/lme4Eigen/R/profile.R	2012-01-25 15:58:54 UTC (rev 1515)
@@ -29,17 +29,19 @@
     stdErr <- unname(coef(summary(fm))[,2])
     xpp <- fm at pp
     th <- xpp$theta
-    pp <- new(Class=class(xpp), X=xpp$X, Zt=xpp$Zt, Lambdat=xpp$Lambdat, Lind=xpp$Lind, theta=th)
+    pp <- new(Class=class(xpp), X=xpp$X, Zt=xpp$Zt, Lambdat=xpp$Lambdat, Lind=xpp$Lind, theta=th,
+              S=1L)
     opt <- c(sig * th, sig)
     names(opt) <- c(sprintf(".sig%02d", seq_along(pp$theta)), ".sigma")
     opt <- c(opt, fixef(fm))
     rr <- fm at resp
     resp <- new(Class=class(rr), y=rr$y)
-    resp$offset <- rr$offset
-    resp$weights <- rr$weights
+    resp$setOffset(rr$offset)
+    resp$setWeights(rr$weights)
     rm(rr, xpp, fm)
     np <- length(pp$theta) + 1L
-    n <- nrow(pp$V())                   # use V(), not X so it works with nlmer
+    ## n <- nrow(pp$V())                   # use V(), not X so it works with nlmer
+    n <- nrow(pp$V)                   # FIXME: ???
     ans <- function(pars)
     {
         stopifnot(is.numeric(pars), length(pars) == np)
@@ -541,6 +543,8 @@
         for (nm in colnames(x)[sigs]) {
             x[[nm]] <- log(x[[nm]], base = base)
             fr <- subset(x, .par == nm & is.finite(x[[nm]]))
+            ## FIXME: avoid subset for global-variable false positive
+            ## fr <- x[x$.par == nm & is.finite(x[[nm]]),]
             form <- eval(substitute(.zeta ~ nm, list(nm = as.name(nm))))
             attr(x, "forward")[[nm]] <- interpSpline(form, fr)
             attr(x, "backward")[[nm]] <- backSpline(attr(x, "forward")[[nm]])