File: ram_calc.R

package info (click to toggle)
r-cran-regsem 1.6.2+dfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 496 kB
  • sloc: cpp: 263; ansic: 15; makefile: 2
file content (77 lines) | stat: -rw-r--r-- 1,555 bytes parent folder | download
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

ram_calc = function(par,SampCov22,A,S,F,SampMean){

  #mult = extractMatrices(fit.growth)
  #A <- mult$A
 # S <- mult$S
 # F <- mult$F


  ret <- list()

  #coefs = coef(fit.growth)
 # par = c(coefs[1:2],coefs[10:11],coefs[3:9])

  A2 <- A
  S2 <- S
  # doesn't work for
  for(i in 1:length(par)){
    A2[A2== i] <- par[i]
    S2[S2== i] <- par[i]
  }

  #A2[A.fixed] <- A.est[A.fixed]
  #S2[S.fixed] <- S.est[S.fixed]




  #ImpCov = F %*% solve(I-A2) %*% S2 %*% t(solve(I-A2)) %*% t(F)


  nncol = which(colnames(A2) == "1")
  m = A2[-nncol,"1"]
  m.pars = A[-nncol,"1"]
  #m.pars = A[-nncol,"1"]
  A.pars = A[-nncol,-nncol]
  A2 = A2[-nncol,-nncol]
  F= F[-nncol,-nncol]
  dd = SampMean
  S2 = S2[-nncol,-nncol]
  S.pars = S[-nncol,-nncol]
  I = diag(nrow(A2))
  mu = F %*% solve(I - A2) %*% m



  #I = diag(nrow(Areg))
  ImpCov = F %*% solve(I-A2) %*% S2 %*% t(solve(I-A2)) %*% t(F)

  #grad.out <- rep(0,length(par))

  B = solve(I - A2)
  C = diag(nrow(ImpCov)) - (solve(ImpCov) %*% SampCov22)
  E = B %*% S2 %*% t(B)
  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(SampCov22 %*% solve(ImpCov)) - log(det(SampCov22))  - 4


  #A.iter <- max(A)



  ret$lik <- lik
  ret$ImpCov <- ImpCov
  ret$S2 <- S2
  ret$A2 <- A2
  ret$m <- m
  ret$m.pars <- m.pars
  ret$A.pars <- A.pars
  ret$S.pars <- S.pars
  ret$F <- F
  ret$mu <- mu
  #lik;ImpCov;S2;A2
  ret
}