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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
grad_ram_wMean = function(par,ImpCov,SampCov22,Areg,Sreg,
A,S,F,SampMean,lambda,type,m,mu,m.pars){
#mats = extractMatrices(fit.growth)
#A = mats$A
#Areg = mats$A.est
#S = mats$S
#Sreg = mats$S.est
#F = mats$F
I = diag(nrow(Areg))
#ImpCov = F %*% solve(I-Areg) %*% Sreg %*% t(solve(I-Areg)) %*% t(F)
grad.out <- rep(0,length(par))
B = solve(I - Areg)
C = diag(nrow(ImpCov)) - (solve(ImpCov) %*% SampCov22)
E = B %*% Sreg %*% t(B)
dd=SampMean
b = dd - mu
#lik = log(((2*pi)^length(b)) * det(ImpCov)) + trace(solve(ImpCov) %*% SampCov22) + t(b) %*% solve(ImpCov) %*% b
#lik = log(det(ImpCov)) + trace(SampCov %*% solve(ImpCov)) - log(det(SampCov)) - m
A.iter <- max(A)
#
if(type=="none"){
for(i in 1:length(grad.out)){
A2 <- A == i;
A2[A2==T] <- 1
S2 <- S == i;
S2[S2==T] <- 1
m2 = m.pars == i
m2[m2==T] <- 1
deriv15 <- F %*% B %*% A2 %*% E %*% t(F) + F %*% B %*% S2 %*% t(B) %*% t(F)
deriv20 <- F %*% B %*% A2 %*% B %*% m + F %*% B %*% m2
grad.out[i] <- trace(solve(ImpCov) %*% deriv15 %*% C) -
(t(b) %*% solve(ImpCov) %*% deriv15 + 2 * t(deriv20)) %*% solve(ImpCov) %*% b
}
}
else if(type=="lasso"){
for(i in 1:length(grad.out)){
A2 <- A == i;
A2[A2==T] <- 1
S2 <- S == i;
S2[S2==T] <- 1
deriv15 <- F %*% B %*% A2 %*% E %*% t(F) + F %*% B %*% S2 %*% t(B) %*% t(F)
# left out mean part
grad.out[i] <- trace(solve(ImpCov) %*% deriv15 %*% C) + if(i <= A.iter) lambda*sign(Areg[A==i]) else(0)# just penalize when A
}
}
else if(type=="ridge"){
for(i in 1:length(grad.out)){
A2 <- A == i;
A2[A2==T] <- 1
S2 <- S == i;
S2[S2==T] <- 1
deriv15 <- F %*% B %*% A2 %*% E %*% t(F) + F %*% B %*% S2 %*% t(B) %*% t(F)
# left out mean part
grad.out[i] <- trace(solve(ImpCov) %*% deriv15 %*% C) +
if(i <= A.iter) 2*lambda*Areg[A==i] else(0)
}
}
grad.out
}
|
