SCM

SCM Repository

[matrix] Annotation of /branches/trunk-lme4/R/ssclme.R
ViewVC logotype

Annotation of /branches/trunk-lme4/R/ssclme.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 46 - (view) (download)

1 : bates 15 setReplaceMethod("LMEoptimize", signature(x="ssclme", value="list"),
2 :     function(x, value)
3 :     {
4 :     if (value$msMaxIter < 1) return(x)
5 :     st = coef(x, unconstr = TRUE) # starting values
6 :     if (value$optimizer == "optim") {
7 :     optimRes =
8 :     if (value$analyticGradient) {
9 :     optim(st,
10 :     fn = function(pars) {
11 :     coef(x, unconstr = TRUE) = pars
12 :     deviance(x, REML = value$REML)
13 :     },
14 :     gr = function(pars) {
15 :     coef(x, unconstr = TRUE) = pars
16 :     gradient(x, REML = value$REML)
17 :     },
18 :     method = "BFGS",
19 :     control = list(trace = value$msVerbose,
20 :     reltol = value$msTol,
21 :     maxit = value$msMaxIter))
22 :     } else {
23 :     optim(st,
24 :     fn = function(pars) {
25 :     coef(x, unconstr = TRUE) = pars
26 :     deviance(x, REML = value$REML)
27 :     },
28 :     method = "BFGS",
29 :     control = list(trace = value$msVerbose,
30 :     reltol = value$msTol,
31 :     maxit = value$msMaxIter))
32 :     }
33 :     if (optimRes$convergence != 0) {
34 :     warning("optim failed to converge")
35 :     }
36 :     coef(x, unconstr = TRUE) = optimRes$par
37 :     } else {
38 :     typsize <- rep(1.0, length(st))
39 :     if (is.null(value$nlmStepMax))
40 :     value$nlmStepMax <-
41 :     max(100 * sqrt(sum((st/typsize)^2)), 100)
42 :     nlmRes =
43 :     nlm(f = if (value$analyticGradient) {
44 :     function(pars) {
45 :     coef(x, unconstr = TRUE) = pars
46 :     ans = deviance(x, REML = value$REML)
47 :     attr(ans, "gradient") =
48 :     gradient(x, REML = value$REML)
49 :     ans
50 :     }
51 :     } else {
52 :     function(pars)
53 :     {
54 :     coef(x, unconstr = TRUE) = pars
55 :     deviance(x, REML = value$REML)
56 :     }
57 :     },
58 :     p = st,
59 :     print.level = if (value$msVerbose) 2 else 0,
60 :     steptol = value$msTol,
61 :     gradtol = value$msTol,
62 :     stepmax = value$nlmStepMax,
63 :     typsize=typsize,
64 :     iterlim = value$msMaxIter)
65 :     coef(x, unconstr = TRUE) = nlmRes$estimate
66 :     }
67 :     return(x)
68 :     })
69 : bates 46
70 :     setMethod("deviance", signature(object = "ssclme"),
71 :     function(object, REML = FALSE, ...) {
72 :     .Call("ssclme_factor", object, PACKAGE = "Matrix")
73 :     object@deviance[ifelse(REML, 2, 1)]
74 :     })
75 :    
76 :     setMethod("coef", signature(object = "ssclme"),
77 :     function(object, ...) {
78 :     .Call("ssclme_coef", object, PACKAGE = "Matrix")
79 :     })
80 :    
81 :     setMethod("ranef", signature(object = "ssclme"),
82 :     function(object, ...) {
83 :     val = .Call("ssclme_ranef", object, PACKAGE = "Matrix")
84 :     bv = object@bVar
85 :     names(val) = names(bv)
86 :     for (i in seq(along = val)) {
87 :     dimnames(val[[i]]) = dimnames(bv[[i]])[-1]
88 :     }
89 :     lapply(val, t)
90 :     })
91 :    
92 :    
93 :     setMethod("fixef", signature(object = "ssclme"),
94 :     function(object, ...) {
95 :     val = .Call("ssclme_fixef", object, PACKAGE = "Matrix")
96 :     names(val) = dimnames(object@XtX)[[2]][seq(along = val)]
97 :     val
98 :     })
99 :    
100 :     setMethod("vcov", signature(object = "ssclme"),
101 :     function(object, ...) {
102 :     sigma = .Call("ssclme_sigma", object, PACKAGE = "Matrix")
103 :     rr = object@RXX
104 :     nr = nrow(rr)
105 :     rr = rr[-nr, -nr, drop = FALSE]
106 :     sigma^2 * rr %*% t(rr)
107 :     })
108 :    

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge