1

Rでさまざまな投票力指数を計算できるようにする必要があるプロジェクトがあります。これの最初の試みとして、banzhaf指数を計算する小さな関数を書きました。メンバーと投票のラベルを付ける必要がある 2 つの列を持つデータフレームと、過半数 (割り当て) に必要な投票数の 2 つの引数を取ります。

library(combinat)
banzhaf <- function(data,quota){
 f <- vector()
 m <- vector()
 score <- vector()
 name <- vector()
 pivot <- vector()
 for (n in 1:nrow(data)){
  y <- as.matrix(combn(data$member,n))
  for (i in 1:ncol(y)){
   for ( j in 1:n){
    f[j] <- data[data$member == y[j,i],]$vote
    m[j] <- as.character(data[data$member == y[j,i],]$member)
    o <- data.frame(member = m, vote = f)
    }

   if (sum(o$vote) >= quota){
    for (k in 1:length(o$member)){
     t <- o[-k,]
    if (sum(t$vote) < quota){
     pivot[length(pivot) + 1] <- as.character(o$member[k])
     }
    }
   }
  }
 }

 for (l in unique(pivot)){
  score[length(score) + 1] <- sum(pivot == l)
  name[length(name) + 1] <- l
  }
 out <- data.frame(name = name, score = score/length(pivot))
 return(out)
}

この関数の問題は、データフレームに 8 つを超えるメンバーがあると、非常に遅くなることです。これは、最も外側のループで使用されている combn() 関数によるものです (と思います)。これをより高速に実行する方法を知っている人はいますか?

ベスト、トーマス

PS: テストしたい場合は、次のデータを使用してください。ただし、永久に実行される可能性があることに注意してください。

x <- c("Germany","France","UK","Italy","Spain","Poland","Romania","Netherlands","Greece","Portugal","Belgium","Czech Rep.","Hungary","Sweden","Austria","Bulgaria","Denmark","Slovakia","Finland","Ireland","Lithuania","Latvia","Slovenia","Estonia","Cyprus","Luxembourg","Malta")
z <- c(29,29,29,29,27,27,14,13,12,12,12,12,12,10,10,10,7,7,7,7,7,4,4,4,4,4,3)

dat <- data.frame(member = as.character(x),vote = z)

oi <- banzhaf(dat, 255)
oi
4

2 に答える 2

2

私のアプローチは、サイズを処理するためにバッチ化された行列演算を使用して、David のアプローチに似ていました。

banzhaf = function(votes, pass=sum(votes) %/% 2 + 1, batch.size=500000, quiet=batches == 1) {
  n = length(votes)
  batches = ceiling((2^n / batch.size))
  if (!quiet)
    cat('calculating...\n')
  Reduce(`+`, lapply(1:batches, function(b) {
    if (!quiet)
      cat('-', b, '/', batches, '\n')
    i = ((b - 1) * batch.size + 1):min(2^n, b * batch.size)
    m = do.call(cbind, lapply(as.integer(2^((1:n) - 1L)), function(j, k) (k %/% j) %% 2L, i))
    x = drop(m %*% votes)
    passed = x >= pass
    colSums((outer(x[passed] - pass, votes, `<`) * m[passed, , drop=F]))
  }))
}

data.frame の代わりに R の名前伝播を使用し、可能な場合はループを回避し、可能であれば数値の代わりに整数を使用します。私のボックスで実行するのにまだ6分以上かかりました：

# wikipedia examples
banzhaf(c(A=4, B=3, C=2, D=1), 6)
banzhaf(c('Hempstead #1'=9, 'Hempstead #2'=9, 'North Hempstead'=7, 'Oyster Bay'=3, 'Glen Cove'=1, 'Long Beach'=1), 16)

# stackoverflow data
system.time(banzhaf(setNames(as.integer(z), x), 255))

考えは次のようになりました。

  • 2^n の可能な結果 (プレーヤーごとに 2 つの結果、n 人の独立したプレーヤー)
  • 1:2^n の数字で表される (cf 'i')
  • 数値を 2 進数で表すと、各プレイヤーの投票になります。
  • ビットごとの演算の代わりに、モジュラスと除算を使用してビットを投票行列に抽出します（「m」を参照）（最近Rに追加されたと思います）。

その後はデビッドと同じように展開すると思います。唯一の複雑な点は、効率のために整数を使用することと、27:2^27 の行列を作成するのは現実的ではないため、バッチ処理を追加することでした。

于 2010-09-17T19:00:29.077 に答える
2

サンプル データ フレームには 27 行があり、すべてのセット (null セットを除く) を見ているので、少なくとも 2^27 - 1 = 134 217 727 操作です...これには時間がかかります。とはいえ、これがあなたのコードのより効率的なバージョンであると私が信じているものです。少なくともウィキペディアの記事と一致しているようです: http://en.wikipedia.org/wiki/Banzhaf_power_index

banzhaf1 <- function(data, quota) {
  n <- nrow(data)
  vote <- data$vote
  swingsPerIndex <- numeric(n)
  for (setSize in 1:n) {
    sets <- utils::combn(n, setSize)
    numSets <- ncol(sets)
    flatSets <- as.vector(sets)
    voteMatrix <- matrix(vote[flatSets], nrow=setSize, ncol=numSets)
    totals <- colSums(voteMatrix)
    aboveQuota <- totals >= quota
    totalsMatrix <- matrix(rep(totals, each=setSize), nrow=setSize, ncol=numSets)
    winDiffs <- totalsMatrix[, aboveQuota] - voteMatrix[, aboveQuota]
    winSets <- sets[, aboveQuota]
    swingers <- as.vector(winSets[winDiffs < quota])
    swingsPerIndex <- swingsPerIndex + tabulate(swingers, n)
  }
  return(data.frame(name=data$member, score=swingsPerIndex / sum(swingsPerIndex)))
}

（これを完全なデータセットで実行しようとしたことはありません。）

この問題に効率的に取り組むには、問題の構造を利用する必要があると思います。たとえば、セット X の投票合計がクォータを上回っていることがわかったら、X ユニオン Y もクォータを上回っていることがわかります。Rがそのような構造に従うのに適しているかどうかはわかりません。

于 2010-09-17T18:30:27.750 に答える