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
|
# last modified 2012-01-06 by J. Fox
# Modified for Compiled code in C/C++ by Zhenghua Nie.
objectiveML <- function(gradient=TRUE, hessian=FALSE){
result <- list(
objective = function(par, model.description){
with(model.description, {
res <- CompiledObjective(par=par, model.description=model.description, objective="objectiveML",gradient=gradient, hessian=hessian)
f <- res$f
C <- res$C
A <- res$A
P <- res$P
grad <- NULL
if(gradient)
grad <- res$gradient
hess <- NULL
if(hessian)
hess <- res$hessian
attributes(f) <- list(C=C, A=A, P=P, gradient=grad, hessian=hess)
f
}
)
}
)
if (gradient)
result$gradient <- function(par, model.description){
with(model.description, {
res <- CompiledObjective(par=par, model.description=model.description, objective="objectiveML",hessian=hessian)
A <- res$A
P <- res$P
C <- res$C
grad <- res$gradient
attributes(grad) <- list(C=C, A=A, P=P, gradient=grad)
grad
}
)
}
if (hessian)
result$hessian <- function(par, model.description){
with(model.description, {
res <- CompiledObjective(par=par, model.description=model.description, objective="objectiveML",hessian=hessian)
A <- res$A
P <- res$P
C <- res$C
hess <- res$hessian
attributes(grad) <- list(C=C, A=A, P=P, hessian=hess)
grad
}
)
}
class(result) <- "semObjective"
result
}
|
