r - 情報利得率の計算

Question

R または Python で Information Gain Ratio (IGR) を実行するコードを探していました。便利な R パッケージを見つけましたが、メンテナンスされておらず、CRAN から削除されました。ただし、古いバージョンを見つけたので、重要な機能を自由に「借用」しました。いくつかの変更を行い、また、いくつかの新しい機能を追加しました。アルゴリズムは、2 つのキュー/機能の 2x2 行列と、それらの (共) 発生とイベントの総数を想定しています。キュー/機能ごとに 1 つずつ、合計 2 つの 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)