強力運算拍賣算法

Question

我與各種auction algorithms工作評估ň項目分配 到ň代理通過競價機制，使得每個代理被分配到恰好一個項目，並且每個項目只能分配給一個代理。我想通過將它們與暴力方法進行比較來評估我正在測試的算法的性能。比較是 通過價值分配的總和，我試圖最大化。

set.seed(1) 

#Assume: 
n <- 3 
agents <- 1:3 # agent IDs 
items <-1:3 # item IDs 

# each agent has a preference score for each item 
# create agent x item matrix w/ cells containing pref score 
(m <- matrix(data = round(runif(9, 0, 1),3), nrow = n, ncol = n)) 

##  [,1] [,2] [,3] 
## [1,] 0.266 0.908 0.945 
## [2,] 0.372 0.202 0.661 
## [3,] 0.573 0.898 0.629 

# Given these sample data, here is one possible assignment 
s <- data.frame(agent = agents, item = NA, score = NA) 

# assign item & corresponding score to agent 
s[1,"item"] <- 1; s[1,"score"] <- m[1,1] 
s[2,"item"] <- 2; s[2,"score"] <- m[2,2] 
s[3,"item"] <- 1; s[3,"score"] <- m[3,3] 
s 
## agent item score 
## 1  1 1 0.266 
## 2  2 2 0.202 
## 3  3 1 0.629 


# The value/score of this particular assignment s 
(total_score <- sum(s$score)) 
## [1] 1.097 

我想要做的是，給我的代理和項目載體是創建包含成員項任務的每一個可能的組合的數據結構。根據我的計算，應該有階乘（n）可能的組合。因此在例子中，最終結構應該有6行。

這是我想要的符號表示。每一行對應一個特定的全面分配，其中代理是列及其相應的項目將單元格的值：

#  a1 a2 a3 <- cols are agents 
#  ______________ 
# s1 | 1  2  3 <- corresponds to assignment s above 
# s2 | 1  3  2 
# s3 | 2  1  3 
# s4 | 2  3  1 
# s5 | 3  2  1 
# s6 | 3  1  2 

我不清楚爲ň任何正值一般實現這一目標的最佳途徑。我嘗試過expand.grid()，但似乎不符合我想要實現的 。有沒有我可以使用的功能呢，還是有人對我可以實現的算法有任何建議？

Answer 1

展開網格在這裏不起作用，因爲它創建了代理和項目的所有可能組合，因此它會產生一個組合，例如所有代理都獲得第一個項目。 我建議使用排列。對物品進行排列就足夠了，讓代理人留在同一個地點。我使用combinat包生成排列：

library(combinat) permn(1:3)

[[1]] 
[1] 1 2 3 

[[2]] 
[1] 1 3 2 

[[3]] 
[1] 3 1 2 

[[4]] 
[1] 3 2 1 

[[5]] 
[1] 2 3 1 

[[6]] 
[1] 2 1 3 

列表中的每個元素對應於一個項目可能的排列。因此，2 1 3表示第一個代理獲取第二個項目，第二個代理獲取第一個項目，第三個代理獲取第三個項目。 要找出相應的分數，我們可以子集我們的得分矩陣，布爾矩陣的排列：

#creating scores matrix  
n=3 
m <- matrix(data = round(runif(9, 0, 1),3), nrow = n, ncol = n)  
#creating boolean identity matrix 
E=matrix(as.logical(diag(1,n,n)),nrow=n,ncol=n) 
m[E[,c(1,3,2)]] #this shows the scores of 1 3 2 item combination 

#[1] 0.472 0.039 0.223 

最後，我們計算所有排列個人得分和總分，並把結果保存在一個整潔data.table：

library(data.table) 
dt=data.table(items=permn(1:n)) 
dt[,scores:=lapply(items,function(x) m[E[,x]])] 
dt[,totalScore:=lapply(scores,sum)] 
dt 
#  items   scores totalScore 
#1: 1,2,3 0.472,0.239,0.517  1.228 
#2: 1,3,2 0.472,0.039,0.223  0.734 
#3: 3,1,2 0.658,0.064,0.223  0.945 
#4: 3,2,1 0.658,0.239,0.994  1.891 
#5: 2,3,1 0.326,0.039,0.994  1.359 
#6: 2,1,3 0.326,0.064,0.517  0.907