Question

我正在尝试在R中探索optim以解决方案但我无法限制函数按预期工作。我阅读了帮助页面，但由于我是这个领域的新手，因此无法取得很大进展。

让我向您解释一个较小框架中的问题。我有一个包含数十名学生的数据框

scoreDf <- data.frame(Name = c("A", "B", "C"), Score = c(10, 15, 25))

目标：选择学生（或学生群体）并按顺序排序，以便我们最小化他们的分数和他们在序列中的位置的总和 - 如下所述：

最小化SUM（得分*位置）; 受制于：得分之和> = 30， position = 0：n（序列中的不同整数，0可以重复）并返回职位向量

例如：

在给定的数据中，所需的解是序列2,0,1 for A，B，C这意味着只考虑A和C，因为它们的得分总和 = 10 + 25 = 35> = 30目标函数的值是10 * 2 + 25 * 1 = 45，这是最小值。我很想知道这个结果 CA就是那个顺序的组。

我尝试使用优化，但我可以取得很大进展。请帮忙。感谢

Answer 1

optim用于持续优化，但这个问题是整数编程。

1）lpSolve 如果学生j在位置i，则让X [i，j] = 1，否则为零。然后使用lpSolve包中的lp优化X的9个元素。约束X使得每行的总和和X的每列的总和不能超过1，并且得分的总和是＆gt; ; = 30.目标系数是位置乘以得分。指定X变量都是二进制，即0/1。

library(lpSolve)
scoreDf <- data.frame(Name = c("A", "B", "C"), Score = c(10, 15, 25)) 
n <- nrow(scoreDf)

obj <- c(outer(1:n, scoreDf$Score)) # obj fun coef of X[i,j] is position[i] * score[j]
cons <- rbind( outer(1:n, c(col(diag(n))), "==") + 0,  # lhs of col sum constraints on X
               outer(1:n, c(row(diag(n))), "==") + 0,  # lhs of row sum constraints on X
               rep(scoreDf$Score, each = n)) # lhs of sum of scores constraint on X
# col and row sums <= 1; sum of scores >= 30
dir <- c(rep("<=", 2 * n), ">=")
rhs <- c(rep(1, 2 * n), 30)  
ans <- lp("min", obj, cons, dir, rhs, all.bin = TRUE)

ans$objval
## [1] 45

# reshape ans$solution vector into a 0/1 matrix whose rows are positions and cols are names
X <- matrix(ans$solution, n, n, dimnames = list(pos = 1:n, Name = scoreDf$Name))
X
##    Name
## pos A B C
##   1 0 0 1
##   2 1 0 0
##   3 0 0 0

1:n %*% X # solution sequence
##     Name
##      A B C
## [1,] 2 0 1

# rework X into a data frame showing the Name for each pos
s <- subset(as.data.frame.table(X), Freq == 1, select = -Freq)
s[order(s$pos), ]
##   pos Name
## 7   1    C
## 2   2    A

2）组合另一种方法是对所有排列进行强力搜索并挑选出具有最小目标的那种排列。对于大输入，这可能需要过多的时间和内存，但对于小输入，这似乎是实用的，并且对于交叉检查具有独立的替代方案可能是有用的。我们使用combinat包中的permn来生成排列。对于每个排列，找到分数总和超过29（no）的前导名称的最小数量，然后计算目标（给予其余0）产生DF。 DF的每一行都列出了排列no和目标值obj。然后使用which.min找到具有最小目标的DF行。

library(combinat)
sc <- setNames(scoreDf$Score, as.character(scoreDf$Name))
DF <- do.call(rbind, permn(names(sc), function(x) {
  no <- findInterval(29, cumsum(sc[x])) + 1  # only need first no
  data.frame(t(x), no, obj = sum(head(sc[x], no) * 1:no))
}))
ix <- which.min(DF$obj)
cbind(DF[ix, 1:DF[ix, "no"]], obj = DF$obj[ix])
##   X1 X2 obj
## 3  C  A  45

Answer 2

让我试试。第一步是开发一个描述问题的数学模型。我的想法是使用二进制变量 x（i，j）将学生 i 分配到 j 位置。这样的模型看起来像：

这是一个具有线性目标和线性约束以及二元变量的模型。这是一个混合整数规划（MIP）模型，因此需要一个MIP求解器。 R的优点不符合要求。合适的开源求解器可以是glpk，lpsolve和COIN CBC（参见here列表）。

注意：如果问题非常大，有一些可能会简化模型并使其更有效，但对于小数据集，这个公式应该没问题。

在R中使用optim [将参数限制为不同的自然数]

2 个答案: