Здесь может быть решение.Могут быть и более разумные способы, однако, используя превосходный пакет 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, но построена только для случая выбора двух элементов на позицию.
Краткое объяснение
- Узнайте, какНаиболее наименее дорогие элементы
a;b;c равны - . Рассмотрим все комбинации двух
a, такие, что достаточно объединенной цены, то есть так, чтобы можно было, по крайней мере, в два раза дешевле b 's и c s - Выполните аналогичные действия для
b и c - Сохраните и запомните лучшее распределение