0

我正在寻找一段在 R 或 Python 中执行信息增益比 (IGR) 的代码。我找到了一个方便的 R 包，但它没有得到维护，并且已从 CRAN 中删除。但是，我找到了一些旧版本，我冒昧地“借用”了关键功能。我做了一些更改，还添加了一些新功能。算法期望两个线索/特征及其（共）出现和事件总数的 2x2 矩阵。它返回两个 IGR，每个提示/特征一个。

但是，我认为它没有得到很好的优化，我想学习更好的实现方式。特别是，我认为必须有一种方法可以使函数 cueRE 和 getIGRs 更好。下面，是一个例子和功能。

我将不胜感激任何建议和评论。非常感谢！

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)
4

0 回答 0