1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
##' Extract subset of latent variable model
##'
##' Extract measurement models or user-specified subset of model
##'
##'
##' @aliases measurement
##' @param x \code{lvm}-object.
##' @param vars Character vector or formula specifying variables to include in
##' subset.
##' @param \dots Additional arguments to be passed to the low level functions
##' @return A \code{lvm}-object.
##' @author Klaus K. Holst
##' @keywords models regression
##' @examples
##'
##' m <- lvm(c(y1,y2)~x1+x2)
##' subset(m,~y1+x1)
##'
##' @export
##' @method subset lvm
subset.lvm <- function(x, vars, ...) {
if (missing(vars)) return(x)
if (inherits(vars,"formula")) vars <- all.vars(vars)
if (!all(vars%in%vars(x))) stop("Not a subset of model")
latentvars <- intersect(vars,latent(x))
## g0 <- subGraph(vars, Graph(x))
## res <- graph2lvm(g0)
res <- lvm(vars)
M <- t(x$M[vars,vars,drop=FALSE])
for (i in seq_len(nrow(M))) {
if (any(M[,i]==1)) {
res <- regression(res, y=rownames(M)[M[,i]==1], x=rownames(M)[i], ...)
}
}
if (length(latentvars)>0)
latent(res) <- latentvars
res$cov[vars,vars] <- x$cov[vars,vars]
## Fixed parameters:
res$par[vars,vars] <- x$par[vars,vars]
res$fix[vars,vars] <- x$fix[vars,vars]
res$covpar[vars,vars] <- x$covpar[vars,vars]
res$covfix[vars,vars] <- x$covfix[vars,vars]
res$mean[vars] <- x$mean[vars]
res$attributes <- x$attributes
for (i in seq_along(x$attributes)) {
val <- x$attributes[[i]]
if (length(val)>0) {
val <- val[intersect(vars,names(val))]
res$attributes[[i]] <- val
}
}
index(res) <- reindex(res)
return(res)
}
|
