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
|
##' @export
"functional<-" <- function(x,...,value) UseMethod("functional<-")
##' @export
"functional<-.lvm" <- function(x,to,from,...,value) {
if (inherits(to,"formula")) {
yy <- decomp.specials(getoutcome(to))
myvars <- all.vars(to)
xx <- setdiff(myvars,yy)
if (length(yy)*length(xx)>length(value) & length(value)!=1) stop("Wrong number of values")
count <- 0
for (y in yy) {
count <- count+1
for (i in seq_along(xx)) {
suppressWarnings(x <- regression(x,to=y,from=xx[i],messages=0))
count <- count+1
if (length(value)==1) {
functional(x, to=y, from=xx[i],...) <- value
} else
functional(x, to=y, from=xx[i],...) <- value[[count]]
}
}
return(x)
}
if (missing(from) | missing(to))
return(x)
edges <- paste(from,to,sep="~")
x$attributes$functional[[edges]] <- value
return(x)
}
##' @export
"functional" <- function(x,...) UseMethod("functional")
##' @export
functional.lvm <- function(x,to,from,value,...) {
if (!missing(value)) {
functional(x,to,from,...) <- value
return(x)
}
if (missing(from))
return(x$attributes$functional)
edges <- paste(from,to,sep="~")
x$attributes$functional[edges]
}
|
