假设我在R中有一个向量
0 1 0 0 1 0 0 0 0 1 0
向量中的任何地方都不能超过6个“ 1”。所有其他元素均为0。
我试图获取所有可能的值，这些值是我在 1 位置上分配“ 1”的位置，其中每个值必须<= 0.5。
例如：
0 .2 0 0 .3 0 0 0 0 .5 0 . <- OK
0 .35 0 0 .4 0 0 0 0 .25 0 <- OK
但是
0 .2 0 0 .2 0 0 0 0 .6 0 <- not ok
增量可以增加0.05。
因此，在一个具有3个“ 1”的向量中，最多存在20 ^ 3个组合，其中许多组合将是不好的，因为它们的总和大于1或值大于0.5。有没有比暴力破解更快的方法了？
编辑： 我意识到我可以使用以下方法快速得出所有可能的权重：
temp <- expand.grid(replicate(sum(x),seq(0.05,.5,0.05), simplify=FALSE))
其中x是我的向量。
所以现在对于每个临时人员，我想将其放在1的位置
0 1 0 0 1 0 0 0 0 1 0
答案 0 :(得分：4)
编辑：正如@www在注释中指出的那样，如果您依靠浮点运算，则会错过一些组合/排列。为了解决这个问题，我们需要以整数精度工作（即，我们需要seq(0, 0.5, 0.05)来代替seq(0L, 50L, 5L)），然后将结果除以100。
我编写了RcppAlgos软件包，该软件包正是用于解决以下问题：
library(RcppAlgos)
myCombs <- comboGeneral(seq(0L,50L,5L), 6, TRUE,
constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 100L) / 100
head(myCombs, n = 10)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0.00 0.50 0.50
[2,] 0 0 0 0.05 0.45 0.50
[3,] 0 0 0 0.10 0.40 0.50
[4,] 0 0 0 0.10 0.45 0.45
[5,] 0 0 0 0.15 0.35 0.50
[6,] 0 0 0 0.15 0.40 0.45
[7,] 0 0 0 0.20 0.30 0.50
[8,] 0 0 0 0.20 0.35 0.45
[9,] 0 0 0 0.20 0.40 0.40
[10,] 0 0 0 0.25 0.25 0.50
tail(myCombs, n = 10)
[,1] [,2] [,3] [,4] [,5] [,6]
[190,] 0.10 0.10 0.15 0.15 0.15 0.35
[191,] 0.10 0.10 0.15 0.15 0.20 0.30
[192,] 0.10 0.10 0.15 0.15 0.25 0.25
[193,] 0.10 0.10 0.15 0.20 0.20 0.25
[194,] 0.10 0.10 0.20 0.20 0.20 0.20
[195,] 0.10 0.15 0.15 0.15 0.15 0.30
[196,] 0.10 0.15 0.15 0.15 0.20 0.25
[197,] 0.10 0.15 0.15 0.20 0.20 0.20
[198,] 0.15 0.15 0.15 0.15 0.15 0.25
[199,] 0.15 0.15 0.15 0.15 0.20 0.20
如果您对排列感兴趣，没问题：
myPerms <- permuteGeneral(seq(0L,50L,5L), 6, TRUE,
constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 100L) / 100
head(myPerms, n = 10)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0.0 0.0 0.0 0.5 0.5
[2,] 0 0.0 0.0 0.5 0.0 0.5
[3,] 0 0.0 0.0 0.5 0.5 0.0
[4,] 0 0.0 0.5 0.0 0.0 0.5
[5,] 0 0.0 0.5 0.0 0.5 0.0
[6,] 0 0.0 0.5 0.5 0.0 0.0
[7,] 0 0.5 0.0 0.0 0.0 0.5
[8,] 0 0.5 0.0 0.0 0.5 0.0
[9,] 0 0.5 0.0 0.5 0.0 0.0
[10,] 0 0.5 0.5 0.0 0.0 0.0
tail(myPerms, n = 10)
[,1] [,2] [,3] [,4] [,5] [,6]
[41109,] 0.15 0.15 0.20 0.20 0.15 0.15
[41110,] 0.15 0.20 0.15 0.15 0.15 0.20
[41111,] 0.15 0.20 0.15 0.15 0.20 0.15
[41112,] 0.15 0.20 0.15 0.20 0.15 0.15
[41113,] 0.15 0.20 0.20 0.15 0.15 0.15
[41114,] 0.20 0.15 0.15 0.15 0.15 0.20
[41115,] 0.20 0.15 0.15 0.15 0.20 0.15
[41116,] 0.20 0.15 0.15 0.20 0.15 0.15
[41117,] 0.20 0.15 0.20 0.15 0.15 0.15
[41118,] 0.20 0.20 0.15 0.15 0.15 0.15
结果立即生效：
system.time(permuteGeneral(seq(0L,50L,5L), 6, TRUE,
constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 100L) / 100)
user system elapsed
0.005 0.001 0.006
快速思考
人们可能会试图将这一问题作为加法整数分区问题来解决。从seq(0, 0.5, 0.05)到0:11的映射以及从seq(0, 1, 0.05)到0:20的映射。关于它为什么有用，后者可能并不明显，但实际上是有用的。有一个非常不错的软件包partitions，它带有一个用于生成受限分区（即给定长度的分区）的功能。
library(partitions)
myParts <- t(as.matrix(restrictedparts(20, 6))) / 20
head(myParts)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1.00 0.00 0 0 0 0
[2,] 0.95 0.05 0 0 0 0
[3,] 0.90 0.10 0 0 0 0
[4,] 0.85 0.15 0 0 0 0
[5,] 0.80 0.20 0 0 0 0
[6,] 0.75 0.25 0 0 0 0
如您所见，我们已经违反了数字大于0.5的要求。因此，我们需要做一些额外的工作才能获得最终结果：
myMax <- apply(myParts, 1, max)
myFinalParts <- myParts[-which(myMax > 0.5), ]
head(myFinalParts)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.50 0.50 0.00 0 0 0
[2,] 0.50 0.45 0.05 0 0 0
[3,] 0.50 0.40 0.10 0 0 0
[4,] 0.45 0.45 0.10 0 0 0
[5,] 0.50 0.35 0.15 0 0 0
[6,] 0.45 0.40 0.15 0 0 0
tail(myFinalParts, n = 10)
[,1] [,2] [,3] [,4] [,5] [,6]
[190,] 0.35 0.15 0.15 0.15 0.10 0.10
[191,] 0.30 0.20 0.15 0.15 0.10 0.10
[192,] 0.25 0.25 0.15 0.15 0.10 0.10
[193,] 0.25 0.20 0.20 0.15 0.10 0.10
[194,] 0.20 0.20 0.20 0.20 0.10 0.10
[195,] 0.30 0.15 0.15 0.15 0.15 0.10
[196,] 0.25 0.20 0.15 0.15 0.15 0.10
[197,] 0.20 0.20 0.20 0.15 0.15 0.10
[198,] 0.25 0.15 0.15 0.15 0.15 0.15
[199,] 0.20 0.20 0.15 0.15 0.15 0.15
如您所见，只有列的顺序不同，我们上面的解决方案完全相同（请参见myCombs。
all.equal(myCombs, myFinalParts[,6:1])
[1] TRUE
对于置换部分，这些实际上称为受限整数compositions。我们可以调用partitions::compositions并按照与上述类似的方式进行操作，在此我们需要清除那些违反规则的行（即，丢弃包含最大值大于0.5的行）。利用分区可能会获得理想的结果，其中涉及一些额外的步骤。
myComps <- t(as.matrix(compositions(20, 6))) / 20
myMax <- apply(myComps, 1, max)
temp <- myComps[-which(myMax > 0.5), ]
myFinalComps <- temp[do.call(order, as.data.frame(temp)), ]
all.equal(myPerms[do.call(order, as.data.frame(myPerms)), ], myFinalComps)
[1] TRUE
答案 1 :(得分：1)
这里是一种可能的选择。 dat5是最终输出。
# Create all possible combination from 1 to 19
dat1 <- expand.grid(L1 = 1:19,
L2 = 1:19,
L3 = 1:19)
# Filter for the rows with sum = 20
dat2 <- dat1[rowSums(dat1) == 20L, ]
# Filter for the rows with no any numbers larger than 10
dat3 <- dat2[rowSums(dat2 > 10) == 0L, ]
# Convert the values by multiplied 0.05
dat4 <- dat3 * 0.05
# Convert the data frame to a list of vectors
dat4$ID <- 1:nrow(dat4)
dat5 <- lapply(split(dat4, f = dat4$ID), function(x){
c(0, x$L1, 0, 0, x$L2, 0, 0, 0, 0, x$L3, 0)
})
答案 2 :(得分：1)
我确实相信我们只需要替换给定向量中的1。在这种情况下，零将保持不变：
s = c(0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0)
m = expand.grid(replicate(sum(s==1),seq(0,0.5,0.05),F))
indx = replace(replace(s,s==1,1:ncol(m)),s==0,ncol(m)+1)
dat = unname(cbind(m[rowSums(m)==1,],0)[indx])
head(dat)
121 0 0.50 0 0 0.50 0 0 0 0 0.00 0
231 0 0.50 0 0 0.45 0 0 0 0 0.05 0
241 0 0.45 0 0 0.50 0 0 0 0 0.05 0
341 0 0.50 0 0 0.40 0 0 0 0 0.10 0
351 0 0.45 0 0 0.45 0 0 0 0 0.10 0
361 0 0.40 0 0 0.50 0 0 0 0 0.10 0
tail(dat)
1271 0 0.25 0 0 0.25 0 0 0 0 0.5 0
1281 0 0.20 0 0 0.30 0 0 0 0 0.5 0
1291 0 0.15 0 0 0.35 0 0 0 0 0.5 0
1301 0 0.10 0 0 0.40 0 0 0 0 0.5 0
1311 0 0.05 0 0 0.45 0 0 0 0 0.5 0
1321 0 0.00 0 0 0.50 0 0 0 0 0.5 0