我正在寻找优化数据的平方（最高分数），其中每一行都是在没有替换的情况下选择的。这是一个小例子，但我想要一个允许 30x30 表格的算法。
opt_table = data.frame(player = c('A', 'B', 'C'),
first = c(0.5, 0.4, 0.4),
second = c(0.4, 0.7, 0.2),
third = c(0.2, 0.4, 0.3))
按列添加所选分数时，最高分数将是最高总分。在这里，它将是 0.5 (A) + 0.7 (B) + 0.3 (C) = 1.5。你不能通过总是取给定列的最大行来通过算法解决它，因为它没有替换。
【问题讨论】：
标签： r optimization
这是一个assignment problem，如果你使用包lpSolve中的lp.assign可以解决，即，
library(lpSolve)
z <- lp.assign(-as.matrix(opt_table[-1]))
maxscore <- -z$objval
assignment <- colnames(opt_table[-1])[which(t(z$solution != 0), arr.ind = TRUE)[, "row"]]
你会看到
> maxscore
[1] 1.5
> assignment
[1] "first" "second" "third"
【讨论】：
lp.assign 几乎瞬间得到了 61.03。
我不知道这是否接近最佳；可能有一些聪明的方法可以将其简化为一类已知的优化问题。与此同时，暴力蒙特卡洛交换 + optim(..., method="SANN") 似乎可行。
首先，定义目标函数和更新函数（随机交换两个位置）。
swap <- function(x,...) {
s <- sample(length(x), 2, replace=FALSE)
x[s] <- x[rev(s)]
return(x)
}
objfun <- function(x,M) {
sum(M[cbind(x,seq(ncol(M)))])
}
我检查了这对微不足道的问题有效，现在让我们在 30x30 矩阵上尝试一下。
set.seed(101)
M2 <- matrix(abs(rnorm(900)),30)
start <- sample(30)
optim(par=start, fn=objfun, gr=swap, control=list(fnscale=-1,
trace=TRUE, maxit=1e6),
method="SANN", M=M2)
（我将fnscale设置为-1，因为optim喜欢最小化。跟踪时，打印目标函数的负数 ...）
它从 22.1 开始到 53.06。最后一次改进（从 52.31 到 53.06）在步骤 796000 中找到。
一百万次随机抽奖 (r <- replicate(1e6, objfun(sample(30), M=M2))) 中的最好成绩是 39.5。
调整模拟退火参数可能会提高性能。或者您可以尝试其他一些随机全局优化方法（例如遗传算法）。
【讨论】：
取每列的最大值（不包括“玩家”列）并将它们相加。
library(dplyr)
data.frame(player = c('A', 'B', 'C'),
first = c(0.5, 0.4, 0.4),
second = c(0.4, 0.7, 0.2),
third = c(0.2, 0.4, 0.3)) %>%
summarise_at(vars(-player), funs(max)) %>%
rowSums()
请注意，0.5 (A) + 0.7 (B) + 0.3 (C) = 1.5 实际上应该是：0.5 (A) + 0.7 (B) + 0.4 (C) = 1.6
【讨论】：