File: gmQO.R

package info (click to toggle)
r-cran-ctmcd 1.4.1-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 1,384 kB
  • sloc: cpp: 183; ansic: 19; makefile: 2
file content (31 lines) | stat: -rw-r--r-- 840 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
gmQO <-
function (tmrel, te, logmethod = "Eigen") 
{
    n = nrow(tmrel)
    gmest = logm(tmrel, method = logmethod)/te
    for (i in 1:n) {
        a = gmest[i, ]
        lambda = mean(a)
        aorder = order(a + lambda)
        aest = a[aorder]
        for (m in 2:n) {
            if ((n - m + 1) * aest[m + 1] - (aest[1] + sum(aest[(m + 
                1):n])) >= 0) {
                mstar = m
                break
            }
        }
        zstar = NULL
        for (j in 1:n) {
            if (j %in% 2:mstar) {
                zstar = c(zstar, 0)
            }
            else {
                zstar = c(zstar, aest[j] - 1/(n - mstar + 1) * 
                  (aest[1] + sum(aest[(mstar + 1):n])))
            }
        }
        gmest[i, ] = zstar[order(aorder)]
    }
    return(gmest)
}