Question

我有一个项目，我需要能够在R中计算不同的投票权力指数。作为第一次尝试，我写了一个小函数来计算banzhaf指数。它需要两个参数，一个数据框有两列，必须标记为成员和投票，以及多数票（配额）需要多少票：

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（）函数（我认为）。有谁知道如何才能更快地运行？

最好，托马斯

P.S：如果你想测试它，请使用以下数据，但要注意它可能会永远运行！

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

Answer 1

您的示例数据框有27行，您正在查看每个集合（空集除外），因此至少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是否适合遵循这样的结构。

Answer 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]))
  }))
}

使用R的名称传播而不是data.frame，尽可能避免循环，并在可能的情况下使用整数而不是数字。我的盒子仍然需要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'）
用二进制表示数字给每位玩家投票。
使用模数和除法将比特提取到投票矩阵（比较'm'），代替按位运算（最近我只相信加入R）。

之后我认为它的演奏方式与David的演奏方式相同。唯一的复杂因素是确保使用整数来提高效率，并添加批处理，因为它不可能创建一个27：2 ^ 27的矩阵！

计算R中的投票权指数

2 个答案: