# R/sparsegrid.R In lme4: Linear Mixed-Effects Models using 'Eigen' and S4

#### Documented in GQdk

```## Generate sparse multidimensional Gaussian quadrature grids --->  ../man/GQdk.Rd
## Unused currently; rather GHrule() --> ./GHrule.R
GQdk <- function(d=1L, k=1L) {
stopifnot(0L < (d <- as.integer(d)[1]),
d <= 20L,
0L < (k <- as.integer(k)[1]),
k <= length(GQNd <- GQN[[d]]))## -> GQN, stored in ./sysdata.rda
tmat <- t(GQNd[[k]])
##rperms<- combinat::permn(seq_len(d) + 1L, function(v) c(1L,v))
## rperms <- lapply(.Call(allPerm_int, seq_len(d) + 1L), function(v) c(1L, v))
perms <- tryCatch (
.Call(allPerm_int, seq_len(d) + 1L, as.integer(factorial(d))),
warning = function (w) w,
error = function (e) e)
if (methods::is(perms, "error") | methods::is(perms, "warning"))
stop("Can not allocate a vector that large")
rperms <- lapply(perms, function(v) c(1L, v))

dd <- unname(as.matrix(do.call(expand.grid, c(rep.int(list(c(-1,1)), d), KEEP.OUT.ATTRS=FALSE))))
#unname(unique(t(do.call(cbind,
#                        lapply(as.data.frame(t(cbind(1, dd))),
#                               "*", e2=do.call(cbind, lapply(rperms, function(ind) tmat[ind,])))))))
e2 <- do.call(cbind, lapply(rperms, function(ind) tmat[ind,]))
ddf <- as.data.frame(t(cbind(1,dd)))
res <- NULL
for (i in 1:ncol(ddf))
res <- unique(rbind(res, t(ddf[, i] * e2)))
return(res)
}
```

## Try the lme4 package in your browser

Any scripts or data that you put into this service are public.

lme4 documentation built on Nov. 1, 2022, 1:06 a.m.