R - 如何根据数据框中其他列的总和进行最大化
R - How to maximise based of sum of other column from data frame
所以我创建了一个数据框，代表一支梦幻球队，其中每个位置 (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
我正在尝试 select 通过组合 4 名玩家（由每一行表示）可能获得的最大分数。通常这很容易，只需按点排序数据框，select 前 4 个。
但是我想对 28 位的四位玩家施加最高价格限制。（这是一个任意数字来显示问题）
这可能会排除前 4 名玩家，并可能允许该价格限制下的最高点数不连续（按点数顺序）。
你对如何处理这件事有什么建议吗？
我尝试了以下但它只允许连续点 selected.
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),]
我感觉这是一个优化问题
这可能是一个解决方案。可能有更聪明的方法，但是使用优秀的包 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 和 c 的两倍的
- 对
b 和 c 进行类似的操作
- 存储并记住最佳分配
所以我创建了一个数据框，代表一支梦幻球队，其中每个位置 (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
我正在尝试 select 通过组合 4 名玩家（由每一行表示）可能获得的最大分数。通常这很容易，只需按点排序数据框，select 前 4 个。 但是我想对 28 位的四位玩家施加最高价格限制。（这是一个任意数字来显示问题） 这可能会排除前 4 名玩家，并可能允许该价格限制下的最高点数不连续（按点数顺序）。
你对如何处理这件事有什么建议吗？ 我尝试了以下但它只允许连续点 selected.
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),]
我感觉这是一个优化问题
这可能是一个解决方案。可能有更聪明的方法，但是使用优秀的包 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和c的两倍的 - 对
b和c 进行类似的操作
- 存储并记住最佳分配