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
}
|