R - 优化(最大)

Question

我正在尝试将解决方案从 Excel 求解器复制到 R 中，但不知道从哪里开始。

问题:
每小时选择 5 个选项(5 行)，以最大化“分数”的总和，而无需在多个小时内选择同一组 2 次。

换句话说:
最大化分数，条件是:
1. 同一组内的行最多只能被选取 2 次。
2.同一小时内的行最多被选取5次。

我认为通过向大家展示 Excel 中的结果来解释这一点会更容易:

数据:组别,小时,成绩
a,1,1000
a,2,1231
b,1,12312
b,2,6438
c,1,3033
c,2,6535
d,1,4283
d,2,4957
e,1,9507
e,2,5115
f ,1,1914
f,2,9278
g,1,5362
g,2,8408
h,1,4640
h,2,4296< br/> j,1,8115
j,2,1143
aa,1,3242
aa,2,3695
bb,1,3908
bb, 2,2540
cc,1,6438
cc,2,2170
dd,1,6497
dd,2,3327
ee,1,5067
/> ee,2,6614
ff,1,5140
ff,2,9858
gg,1,8061
gg,2,2316
hh,1 ,7848
hh,2,3525
jj,1,8259
jj,2,9014
a,3,31100
b,3,111100
c,3,87200
d,3,60700
e,3,50600
f,3,74300
g,3,97400
h,3, 28900
j,3,25900
aa,3,55600
bb,3,38200
cc,3,58500
dd,3,51300
ee,3,84000
ff,3,83700
gg,3,74200
hh,3,19700
jj,3,62800

dput 格式的数据。

df1 <-
structure(list(group = structure(c(1L, 1L, 3L, 3L, 
5L, 5L, 7L, 7L, 9L, 9L, 11L, 11L, 13L, 13L, 15L, 
15L, 17L, 17L, 2L, 2L, 4L, 4L, 6L, 6L, 8L, 8L, 
10L, 10L, 12L, 12L, 14L, 14L, 16L, 16L, 18L, 
18L, 1L, 3L, 5L, 7L, 9L, 11L, 13L, 15L, 17L, 
2L, 4L, 6L, 8L, 10L, 12L, 14L, 16L, 18L), 
.Label = c("a", "aa", "b", "bb", "c", "cc", 
"d", "dd", "e", "ee", "f", "ff", "g", "gg", 
"h", "hh", "j", "jj"), class = "factor"), 
hour = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 
2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 
1L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), Score = c(1000L, 
1231L, 12312L, 6438L, 3033L, 6535L, 4283L, 4957L, 
9507L, 5115L, 1914L, 9278L, 5362L, 8408L, 4640L, 
4296L, 8115L, 1143L, 3242L, 3695L, 3908L, 2540L, 
6438L, 2170L, 6497L, 3327L, 5067L, 6614L, 5140L, 
9858L, 8061L, 2316L, 7848L, 3525L, 8259L, 9014L, 
31100L, 111100L, 87200L, 60700L, 50600L, 74300L, 
97400L, 28900L, 25900L, 55600L, 38200L, 58500L, 
51300L, 84000L, 83700L, 74200L, 19700L, 62800L)), 
class = "data.frame", row.names = c(NA, -54L))

Answer 1

使用 lpSolve 包解决具有二元变量和线性约束的优化问题，

library(lpSolve)
library(data.table) #for pivoting data and shifting coef of constraints
d <- dcast(df1, group ~ hour, value.var="Score")
nr <- nrow(d)
nc <- ncol(d) - 1L

m1 <- matrix(c(1,1,1,rep(0, nr*nc-3L)), ncol=nc, byrow=TRUE)
max2constr <- do.call(rbind, shift(m1, 0L:(nr-1), fill=0))

m2 <- matrix(c(rep(1, nr), rep(0, (nc-1)*nr)), ncol=nc)
choose5constr <- do.call(rbind, shift(m2, seq(0, by=nr, length.out=nc), fill=0))

ans <- lp("max",
    unlist(d[, 2:4]),
    rbind(max2constr, choose5constr),
    c(rep("<=", nrow(max2constr)), rep("=", nrow(choose5constr))),
    c(rep(2, nrow(max2constr)), rep(5, nrow(choose5constr))),
    all.bin=TRUE)
ans$objval

soln <- matrix(ans$solution, nrow=nr, dimnames=list(d$group, names(d)[-1L]))

目标值 = 552826

soln 输出:

   1 2 3
a  0 0 0
aa 0 0 0
b  1 0 1
bb 0 0 0
c  0 0 1
cc 0 0 0
d  0 0 0
dd 0 0 0
e  1 0 0
ee 0 1 1
f  0 1 0
ff 0 1 1
g  0 1 1
gg 1 0 0
h  0 0 0
hh 0 0 0
j  1 0 0
jj 1 1 0