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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
setClass(Class = "MxExpectationHiddenMarkov",
representation = representation(
initial = "MxCharOrNumber",
transition = "MxOptionalCharOrNumber",
components = "MxOptionalCharOrNumber",
verbose = "integer",
scale = "character"
),
contains = "MxBaseExpectation")
setMethod("initialize", "MxExpectationHiddenMarkov",
function(.Object, components, initial, transition, verbose, scale, name = 'expectation') {
.Object@data = as.integer(NA)
.Object@name <- name
.Object@components <- components
.Object@initial <- initial
.Object@transition <- transition
.Object@verbose <- verbose
.Object@scale <- scale
.Object
})
setMethod("genericExpDependencies", signature("MxExpectationHiddenMarkov"),
function(.Object, dependencies) {
components <- paste(.Object@components, "expectation", sep=".")
sources <- c(.Object@initial, .Object@transition, components)
dependencies <- imxAddDependency(sources, .Object@name, dependencies)
return(dependencies)
})
setMethod("genericExpFunConvert", signature("MxExpectationHiddenMarkov"),
function(.Object, flatModel, model, labelsData, dependencies) {
if (length(.Object@components)) {
origComponents <- .Object@components
.Object@components <- vapply(.Object@components, function(group) {
eNumber <- match(paste(group, "expectation", sep="."),
names(flatModel@expectations))
eNumber - 1L
}, 1L, USE.NAMES = FALSE)
if (any(is.na(.Object@components))) {
stop(paste(model@name,": cannot locate expectation ",
omxQuotes(origComponents[is.na(.Object@components)]), sep=""),
call. = FALSE)
}
}
.Object
})
setMethod("qualifyNames", signature("MxExpectationHiddenMarkov"),
function(.Object, modelname, namespace) {
.Object@name <- imxIdentifier(modelname, .Object@name)
.Object@data <- imxConvertIdentifier(.Object@data,
modelname, namespace)
for (s in c('initial', 'transition')) {
if (is.null(slot(.Object, s))) next;
slot(.Object, s) <-
imxConvertIdentifier(slot(.Object, s), modelname, namespace)
}
.Object
})
setMethod("genericNameToNumber", signature("MxExpectationHiddenMarkov"),
function(.Object, flatModel, model) {
name <- .Object@name
.Object@data <- imxLocateIndex(flatModel, .Object@data, name)
.Object@initial <- imxLocateIndex(flatModel, .Object@initial, name)
.Object@transition <- imxLocateIndex(flatModel, .Object@transition, name)
.Object
})
mxExpectationHiddenMarkov <- function(components, initial="initial", transition=NULL,
..., verbose=0L, scale=c('softmax', 'sum', 'none')) {
prohibitDotdotdot(list(...))
scale <- match.arg(scale)
new("MxExpectationHiddenMarkov", components, initial, transition,
as.integer(verbose), scale)
}
|
