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
|
##' @export
"parameter<-" <- function(x,...,value) UseMethod("parameter<-")
##' @export
"parameter<-.lvmfit" <- function(x,...,value) {
parameter(Model(x),...) <- value
return(x)
}
##' @export
"parameter<-.lvm" <- function(x,constrain,start,remove=FALSE,...,value) {
if (inherits(value,"formula")) value <- all.vars(value)
x <- rmvar(x, value)
if (remove) {
x$expar[value] <- NULL
x$exfix[value] <- NULL
x$attributes$parameter[value] <- NULL
index(x) <- reindex(x)
return(x)
}
if (!missing(start)) {
if (length(start) != length(value)) stop("'start' and 'value' should be of the same lengths")
start <- as.list(start)
names(start) <- value
} else {
start <- as.list(rep(0,length(value))); names(start) <- value
}
if (!missing(constrain)) {
newfix <- constrain
if (!is.list(newfix)) newfix <- as.list(newfix)
} else {
newfix <- as.list(value);
}
names(newfix) <- value
x$expar[value] <- start
x$exfix[value] <- newfix
index(x) <- reindex(x)
x$attributes$parameter[value] <- TRUE
return(x)
}
##' @export
parameter <- function(x,...,value) UseMethod("parameter")
##' @export
parameter.default <- function(x, var, ...) {
if (missing(var)) return (names(unlist(x$attributes$parameter)))
parameter(x, ...) <- var
return(x)
}
|
