r在向量上分布权重

编辑:正如@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

快速思考
有人可能会把这个问题当作一个可加整数分区问题来攻击。有一个映射来自 顺序(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

这里有一个可能的选择。 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)
})

我相信我们只需要替换给定向量中的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