r - R在向量上分配权重
问题描述
假设我在 R 中有一个向量
0 1 0 0 1 0 0 0 0 1 0
向量中的任何位置都不能有超过 6 个“1”。所有其他元素为 0。
我试图获得所有可能的值,其中我将“1”分布在每个值必须为 <= 0.5的1 个位置上。
例如:
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 是我的向量。
因此,现在对于 temp 中的每个人,我想将其放在 1 所在的位置
0 1 0 0 1 0 0 0 0 1 0
解决方案
编辑:正如@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
对于置换部分,这些实际上被称为受限整数组合。我们可以调用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
推荐阅读
- python - Keras 中时间一维卷积的输入形状错误
- twitter-bootstrap - 如何通过单击视口中的任意位置来关闭 Bootstrap/Lightbox 模式?
- java - 如何在另一个类中调用“写入文件”方法?
- php - 如何防止子查询返回超过 1 行
- php - 警告:mysqli_connect(): (HY000/1045): Access denied for user 'usr'@'localhost' (使用密码: YES)
- python-3.x - 如何从spacy vocab中获取所有单词?
- c# - 优化字符串操作
- swift - 如何在 SceneKit 中检测 GKComponent 中两个 GKEntities(SCNNodes)之间的 SCNPhysics 交集
- azure-functions - 我们可以在 Azure 函数 v2 中的 Entry 函数中使用 HttpRequestMessage 代替 HttpRequest 类吗?
- azure - 在 Azure DevOps 上运行 DockerFile 构建命令时找不到项目