对于GTR模型，L-BFGS-B需要'fn'的有限值

Question

我正在尝试估计广义时间可逆模型的参数。我的GTR模型的对数似然函数如下所示：

GTRLL <- function(pars){
    Cij <- countsMatrix()
    BL <- pars[1]
    piA <- pars[2]
    piC <- pars[3]
    piG <- pars[4]
    A <- pars[5]
    B <- pars[6]
    C <- pars[7]
    D <- pars[8]
    E <- pars[9]
    F <- 1
    piT <- 1 - (piA+piC+piG)
    matSum <- 0

    TT <- (piC * A) + (piA*B) + (piG*C) * -1
    CC <- (piT * A) + (piA*D) + (piG*E) * -1
    AA <- (piT * B) + (piC*D) + (piG*F) * -1
    GG <- (piT * C) + (piC*E) + (piA*F) * -1

    sigma <- ((piA * AA) + (piT * TT) + (piC * CC) + (piG * GG)) * -1

    qMat = matrix(c((TT * sigma), (piT * A), (piT*B), (piT*C),(piC*A),(CC* sigma),(piC*D),(piC*E),(piA*B),(piA*D),(AA*sigma),(piA*F),(piG*C),(piG*E),(piG*F), (GG*sigma)),nrow = 4, ncol =4)

    Pij<-expm(qMat*BL)

    for(j in 1:4){
        for(i in 1:4){
            matSum <- matSum + (Cij[i,j] * log(Pij[i,j]))
        }
    }
    return(-matSum)
}

然后我尝试使用以下函数对此函数运行optim：

optim(c(1,0.2,0.2,0.2,2,2,2,2,2), GTRLL, method = "L-BFGS-B", upper = c(Inf,0.25,0.25,0.25,Inf,Inf,Inf,Inf,Inf), lower = c(1,0.0001,0.0001,0.0001,1,1,1,1,1), control = list(trace = 5)

然而，回报是：

Error in optim(c(1, 0.2, 0.2, 0.2, 2, 2, 2, 2, 2), GTRLL, method = "L-BFGS-B",  : 
  L-BFGS-B needs finite values of 'fn'

我一直在试图找到一种方法来使这个函数收敛，但它似乎并没有实现。我试图使用上限和下限，但这似乎也不起作用。

修改 countsMatrix（）根据序列返回计数矩阵。在我的例子中，返回的矩阵如下所示：

     [,1] [,2] [,3] [,4]
[1,]    3    1    1    1
[2,]    1    4    1    2
[3,]    1    1    4    0
[4,]    1    2    0    2

countsMatrix（）看起来像这样：

countsMatrix <- function(){
    S1 <- "TTCAGTCACCTCTGAGTAA"
    S2 <- "TACAGGCACGTCTCAGCAC"
    S1mat <- strsplit(S1, "")[[1]]
    S2mat <- strsplit(S2, "")[[1]]
    aa <- 0
    at <- 0
    ac <- 0
    ag <- 0
    ta <- 0
    tt <- 0
    tc <- 0
    tg <- 0
    ca <- 0
    ct <- 0
    cc <- 0
    cg <- 0
    ga <- 0
    gt <- 0
    GC <- 0
    gg <- 0

    for (i in 1:length(S1mat)){ 
        x <- S1mat[i]
        y <- S2mat[i]
        if (x == "A" & y == "A"){
            aa <- aa + 1
        }
        if (x == "A" & y == "T"){
            at <- at + 1
        }
        if (x == "A" & y == "C"){
            ac <- ac + 1
        }
        if (x == "A" & y == "G"){
            ag <- ag + 1
        }
        if (x == "T" & y == "A"){
            ta <- ta + 1
        }
        if (x == "T" & y == "T"){
            tt <- tt + 1
        }
        if (x == "T" & y == "C"){
            tc <- tc + 1
        }
        if (x == "T" & y == "G"){
            tg <- tg + 1
        }
        if (x == "C" & y == "A"){
            ca <- ca + 1
        }
        if (x == "C" & y == "T"){
            ct <- ct + 1
        }
        if (x == "C" & y == "C"){
            cc <- cc + 1
        }
        if (x == "C" & y == "G"){
            cg <- cg + 1
        }
        if (x == "G" & y == "A"){
            ga <- ga + 1
        }
        if (x == "G" & y == "T"){
            gt <- gt + 1
        }
        if (x == "G" & y == "C"){
            GC <- GC + 1
        }
        if (x == "G" & y == "G"){
            gg <- gg + 1
        }
    }


    Cij = matrix( c(tt, ct+ tc, at + ta, ct + tc , tc + ct, cc, ca + ac, cg + GC, ta + at, ac + ca, aa, ag+ga, tg+gt,GC+cg,ga+ag,gg), nrow = 4, ncol = 4)

    return(Cij)
}