Расчет коэффициента получения информации

Question

Я искал кусок кода, который делает соотношение прироста информации (IGR), в R или Python. Я нашел удобный пакет R, но он не поддерживается и был удален из CRAN. Однако я нашел какую-то старую версию и взял на себя смелость и "позаимствовал" критические функции. Я сделал некоторые изменения, а также добавил некоторые новые функции. Алгоритм ожидает матрицу 2х2 из двух сигналов / признаков и их (со) возникновения, а также общее количество событий. Он возвращает два IGR, по одному для каждой реплики / функции.

Тем не менее, я думаю, что это не очень хорошо оптимизировано, и я хотел бы узнать лучший способ реализации. В частности, я думаю, что должен быть способ сделать функции cueRE и getIGR более приятными. Ниже приведен пример и функции.

Буду признателен за любые советы и комментарии. Большое спасибо!

safelog2 <- function (x) {
    if (x <= 0) return(0)
    else return(log2(x))
}

binaryMatrix <- function(m, t) {
    return(matrix(c(m[1,2], m[1,1]-m[1,2], m[2,2]-m[1,2], t-(m[1,1]+m[2,2]-m[1,2])),
        nrow=2, byrow=TRUE, dimnames=list(c(1,0),c(1,0))))
}

H <- function (p) {
    return(-(sum(p * sapply(p, safelog2))))
}

cueH <- function(m, t) {
    p1 = c(m[1,1]/t, (t-m[1,1])/t)
    p2 = c(m[2,2]/t, (t-m[2,2])/t)
    return(c(H(p1), H(p2)))
}

cueRE <- function (tbl) {
    normalize <- function(v) {
        if (sum(v) == 0) v
        else v/sum(v)
    }
    nis <- apply(t(apply(tbl, 1, normalize)), 1, H)
    return(sum(tbl * nis) / sum(tbl))
}

getIGRs <- function(m, t) {
    ent = cueH(m, t)
    rent = cueRE(binaryMatrix(m, t))
    igr1 = (ent[2] - rent) / ent[1]
    d = diag(m)
    m[1,1] = d[2]
    m[2,2] = d[1]
    ent = cueH(m, t)
    rent = cueRE(binaryMatrix(m, t))
    igr2 = (ent[2] - rent) / ent[1]
    return(c(igr1, igr2))
}

Это будет использоваться как

M <-matrix(c(20,15,15,40), nrow=2, byrow=TRUE,
    dimnames=list(c('a','b'),c('a','b')))
total <- 120

getIGRs(M, total)