R - 如何根据数据框中其他列的总和最大化

Question

所以我创建了一个数据框，代表一个梦幻球队，其中每个位置 (a,b,c) 都有一个给定的积分 (points) 和一个价格 (price)：

library(reshape2)
x<-102 #num players

replicate(x/3,paste(letters[1:3]))->l
l<-melt(l)
l<-l[,3]
l<-data.frame(l)

# pnt<- as.integer(runif(90,min=-4, max=30))
pnt<-pmax(round(as.numeric(rnorm(x,mean=6,sd=4)),digits=0),-3)
prc<-pmax(sort(round(as.numeric(rnorm(x,mean=6,sd=3)),digits=1)),4.5)

df1<-as.data.frame(pnt)
df2<-as.data.frame(prc)
df<-data.frame(df1,df2,l)
rownames(df) <- seq(from=1,to=x)
colnames(df)<-c("points","price","pos")

p<-df[rev(order(df$pos)),]
a<-p[((2*x/3)+1):x,1:3]
a<-a[rev(order(a$points)),]

我现在只使用我的数据框“a”，看起来像：

 price points pos
1   7    14     a
2   8    12     a
3   3    8      a
4   10   7      a

我正在尝试通过 4 名玩家的组合（由每行表示）来选择可能的最大点数。通常这很容易，只需按点对数据框进行排序并选择前 4 个。 但是，我想对 28 名的四名玩家施加最高价格限制。（这是显示问题的任意数字） 这可能会排除前 4 名玩家，并可能允许在该价格限制下的最大点数不连续（按点数顺序）。

您对如何解决这个问题有什么建议吗？ 我尝试了以下方法，但它只允许选择连续点。

z<-integer()
y<-integer()
for(i in 1:31){
  j<-i+2
  x<-sum(a[i:j,]$point)
  xx<-sum(a[i:j,]$price)
  y<-c(y,x)
  z<-c(z,xx)
  yz<-data.frame(y,z)
}
yz

#add points per price
yz$c<-with(yz,y/z)

yz[which(match(yz$c,max(yz$c))==TRUE),]

我感觉这是一个优化问题

Answer 1

这可能是一个解决方案。可能有更聪明的方法，但是使用优秀的包RcppAlgos 可以以相当快的方式完成任务

# Setting the framework
numOfElements <- 4
maxPrice <- 28

# Taking all combinations of prices and points
priceCombs <- RcppAlgos::comboGeneral(a$price, numOfElements)
pointCombs <- RcppAlgos::comboGeneral(a$points, numOfElements)

# Computing best choice
magicIndex <- which.max(rowSums(pointCombs[rowSums(priceCombs) <= maxPrice,])) # gives the corresponding index

# results
# points
pointCombs[magicIndex,]
[1] 15 14 13 10 # total of 52
# prices
priceCombs[magicIndex,]
[1] 11.7  6.9  4.5  4.5 # total of 27.6

我已使用问题中提供的代码来生成数据（包含的 28 个是可接受的）。为了重现性，我在生成数据之前应用了set.seed(123) - 这样可以观察到相同的数字。

---

编辑：每个位置两个元素的最佳组合

增加的约束（a;b;c 的两个元素）增加了复杂性。我写了一个 dumm 函数，它测试所有（可接受的）可能性。但是，我尝试通过子集化来有效地编写它

bestAllocation <- function (p, maxPrice) {

  # Prelims
  # Create frames per position
  myList <- list(a = p[p$pos == "a",], b = p[p$pos == "b",], c = p[p$pos == "c",])
  # Determining max prices per position
  minPriceA <- min(myList$a$price)
  minPriceB <- min(myList$b$price)
  minPriceC <- min(myList$c$price)
  maxAllowedPriceA <- maxPrice - minPriceB - minPriceC
  maxAllowedPriceB <- maxPrice - minPriceA - minPriceC
  maxAllowedPriceC <- maxPrice - minPriceB - minPriceA
  # Subsetting for efficiency
  myList$a <- myList$a[myList$a$price < maxAllowedPriceA,]
  myList$b <- myList$b[myList$b$price < maxAllowedPriceB,]
  myList$c <- myList$c[myList$c$price < maxAllowedPriceC,]
  # Recode position variables as integers
  myList$a$pos <- 0L
  myList$b$pos <- 1L
  myList$c$pos <- 2L

  # Variables used for the loops
  remainingPrice1 <- remainingPrice2 <- numeric(1)
  indA1 <- indA2 <- indB1 <- indB2 <- indC1 <- indC2 <- logical(nrow(myList$b))
  bestPointsC <- numeric(1)
  resultDF <- data.frame(matrix(0, ncol = 2*3, nrow = 2*3))
  currentMax <- numeric(1)

  # To the loops
  indA1 <- .subset2(myList$a,2L) < maxPrice - minPriceA - 2*minPriceB - 2*minPriceC # keep a's such that we can afford  1a & 2b & 2c 
  indA2 <- .subset2(myList$a,2L) %in% unique(RcppAlgos::comboGeneral(.subset2(myList$a,2L)[indA1], 
                                                                 2L, 
                                                                 constraintFun = "sum", 
                                                                 comparisonFun = "<=", 
                                                                 limitConstraints = maxPrice - 2*minPriceA - 2*minPriceC))

  if (!any(indA1 & indA2)) stop("\nAll combinations of a's exceed the admissible price.") # no admissible tuple of a's

  for (k in 1:nrow(RcppAlgos::comboGeneral(which(indA1 & indA2), 2L)) )
  {
    k1 <- RcppAlgos::comboGeneral(which(indA1 & indA2), 2L)[k,1L]
    k2 <- RcppAlgos::comboGeneral(which(indA1 & indA2), 2L)[k,2L]

    if (sum(.subset2(myList$a,2)[c(k1,k2)]) >= maxPrice - 2*minPriceB - 2*minPriceC) next # not enough money for 2b & 2c

    remainingPrice1 <- maxPrice - sum(.subset2(myList$a,2)[c(k1,k2)])  

    if (all(.subset2(myList$b,2) >= remainingPrice1 - minPriceB - 2*minPriceC )) next # not enough money for 1b & 2c
    indB1 <- .subset2(myList$b,2) < remainingPrice1 - minPriceB - 2*minPriceC 
    indB2 <- .subset2(myList$b,2) %in% unique(RcppAlgos::comboGeneral(.subset2(myList$b,2)[indB1], 
                                                                  2L, 
                                                                  constraintFun = "sum", 
                                                                  comparisonFun = "<=", 
                                                                  limitConstraints = 2*minPriceC))
    if (!any(indB1 & indB2)) next # no admissible tuple of b's

    for (s in 1:nrow(RcppAlgos::comboGeneral(which(indB1 & indB2), 2L))) 
    {
      s1 <- RcppAlgos::comboGeneral(which(indB1 & indB2), 2L)[s,1L]
      s2 <- RcppAlgos::comboGeneral(which(indB1 & indB2), 2L)[s,2L]
      remainingPrice2 <- maxPrice - sum(.subset2(myList$a,2)[c(k1,k2)]) - sum(.subset2(myList$b,2L)[c(s1,s2)])

      if (all(.subset2(myList$c, 2) >= remainingPrice2 - minPriceC)) next # not enough money for 2c

      indC1 <- .subset2(myList$c,2L) < remainingPrice2 - minPriceC
      indC2 <- .subset2(myList$c,2L) %in% unique(RcppAlgos::comboGeneral(.subset2(myList$c,2L)[indC1],
                                                                     2L, 
                                                                     constraintFun = "sum", 
                                                                     comparisonFun = "<=", 
                                                                     limitConstraints = remainingPrice2))
      if (!any(indC1 & indC2)) next # no admissible tuple of c's

      bestPointsC <- sort(.subset2(myList$c,1L)[indC1 & indC2], partial = (sum(indC1 & indC2) - 1L):sum(indC1 & indC2))[(sum(indC1 & indC2) - 1L):sum(indC1 & indC2)]

      if (sum(.subset2(myList$a,1L)[c(k1,k2)]) + sum(.subset2(myList$b,1L)[c(s1,s2)]) + sum(bestPointsC) <= currentMax) next # points value in this iteration lower than the current max 

      currentMax <- sum(.subset2(myList$a,1L)[c(k1,k2)]) + sum(.subset2(myList$b,1L)[c(k1,k2)]) + sum(bestPointsC)
      resultDF <- rbind(myList$a[c(k1,k2),], 
                        myList$b[c(s1,s2),], 
                        myList$c[(.subset2(myList$c,1L) %in% bestPointsC) & indC1 & indC2,]) # maybe add a safety measure (e.g order myList$c[...] by pts, price and keep only first two)
      cat(paste0("\n\nUpdated result",
                 "\nPoints:\t", sum(resultDF$points),
                 "\nPrice :\t", sum(resultDF$price)))  
    }
  }
  return(resultDF)
} 

这是函数的作用

> ans <- bestAllocation(p, maxPrice = 28)


Updated result
Points :    55
Price  :    27.9

Updated result
Points :    58
Price  :    27.9

Updated result
Points :    61
Price  :    27.9

Updated result
Points :    64
Price  :    27.9

Updated result
Points :    67
Price  :    27.8

Updated result
Points :    68
Price  :    27

我相信这可以在这里和那里得到增强，或者有更好的方法来解决它。此外，此函数适用于任何maxPrice，但仅适用于每个位置选择两个元素的情况。

简短说明

1. 算出a;b;c 中最便宜的元素是多少
2. 考虑两个a 的所有组合，这样组合的价格就足够了，也就是说，一个人至少可以买得起最便宜的b 和c 的两倍
3. 对b 和c 进行类似操作
4. 存储并记住最佳分配