我将N=6元素和q=3元素标识为0，1，2。
我想创建N=6个元素的所有向量，2元素等于0，2元素等于1和{{1} }元素在所有可能的位置都等于2。
这些向量的数量等于2。
以下是在矩阵combn(6,2)*combn(4,2)*combn(2,2)=90中构建这些90向量的代码：
F还有其他不太复杂的方法吗？
答案 0 :(得分：3)
这是来自包RcppAlgos的开发版本的超快单行内容。
devtools::install_github("jwood000/RcppAlgos")
library(RcppAlgos)
myPerms <– permuteGeneral(3,6,TRUE,"prod","==",36) - 1L
myPerms
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 2 2
[2,] 0 0 1 2 1 2
[3,] 0 0 1 2 2 1
[4,] 0 0 2 1 1 2
[5,] 0 0 2 1 2 1
[6,] 0 0 2 2 1 1
.
.
.
[,1] [,2] [,3] [,4] [,5] [,6]
[85,] 2 2 0 0 1 1
[86,] 2 2 0 1 0 1
[87,] 2 2 0 1 1 0
[88,] 2 2 1 0 0 1
[89,] 2 2 1 0 1 0
[90,] 2 2 1 1 0 0
以下是一些基准测试，其中rcppAlgo，r2eOne，r2eTwo和OPFun是每种方法的代码的函数包装。
microbenchmark(rcppAlgo(),r2eOne(),r2eTwo(),OPFun(N=6) unit = "relative")
Unit: relative
expr min lq mean median uq max neval
rcppAlgo() 1.00000 1.00000 1.00000 1.0000 1.00000 1.000000 100
r2eOne() 471.56007 473.26487 194.01669 267.9402 274.46604 8.373630 100
r2eTwo() 50.71091 48.84173 24.01617 27.8441 34.02326 2.044374 100
OPFun(N=6) 37.35899 24.38966 22.38029 19.7059 19.51935 31.18059 100
由于OP正在寻找具有特定频率的特定数字组合，我们可以使用Fundamental theorem of arithmetic，其中指出每个数字都可以写为素数的唯一组合的乘积。我们获得了集合0, 1, 2，并且添加1给出了集合1, 2, 3。我们这样做是为了避免在我们购买产品时获得很多零。
现在，我们的任务是找到所有组合，使每个元素恰好出现两次。这意味着在我们将产品应用于目标组合后，我们得到1*1*2*2*3*3 = 36（N.B。1不是素数，但可以忽略1*n = n for all n）。现在问题很简单。
我们只是找到所有组合，使产品等于36，然后减去1以回到我们原来的数字和Voila！
下面，我们有一个通用的解决方案，可用于查找给定向量的所有排列，并重复每个元素特定次数。
library(RcppAlgos) ## for primeSieve and permuteGeneral
MakePerms <- function(v, numReps, myCap = NULL) {
m <- sum(numReps)
n <- length(v)
## Generate some primes using prime
## number theorem; fudging a bit to
## ensure we get n-1 prime numbers
myPs <- primeSieve(2*n*log(n))[1:(n-1)]
## Set up vector that will be tested
myV <- c(1L, myPs)
target <- prod(myV^numReps)
ps <- permuteGeneral(myV, m, TRUE, "prod", "==", target, myCap)
for (j in 1:n) {ps[ps == myV[j]] <- v[j]}
ps
}
它很大程度上依赖于算术基本定理和一个小索引的素数因子分解的唯一性（不像上面那么简单，但仍然只有7行，但仍然超快）。
我们首先创建第一个n-1素数的向量，并在1上添加以完成myV。然后，我们将myV的每个元素提升为numReps给出的每个元素所需的重复次数，并获取产品以获取target值。以下是一些例子：
v = c(10,13,267,1)和numReps = c(3,1,2,5) - ＆gt;＆gt; myV = c(1,2,3,5) - ＆gt;＆gt; target = 1^3 * 2^1 * 3^2 * 5^5 = 56250 v = 0:5和numReps = c(1,2,1,2,2,2) - ＆gt;＆gt; myV = c(1,2,3,5,7,11) - ＆gt;＆gt; target = 1^1 * 2^2 * 3^1 * 5^2 * 7^2 * 11^2 = 1778700 v = c(0,1,2)和numReps = c(2,2,2) - ＆gt;＆gt; myV = c(1,2,3) - ＆gt;＆gt; target = 1^2 * 2^2 * 3^2 = 36 在我们找到产品等于target值的所有排列后，我们只需使用索引将原始向量v的内容映射到生成的矩阵。
例如，如果您在OP的示例中设置了N = 8，那么c(0,1,2)的所有排列都会0完全重复4次，1和2重复了两次。
t1 <- OPFun(N=8)
t2 <- MakePerms(0:2, c(4,2,2))
all.equal(t1[do.call(order, as.data.frame(t1)), ],
t2[do.call(order, as.data.frame(t2)), ])
[1] TRUE
microbenchmark(fun2(8), MakePerms(0:2, c(4,2,2)), unit = "relative")
Unit: relative
expr min lq mean median uq max neval
OPFun(8) 23.25099 22.56178 18.64762 19.52436 18.37387 10.90934 100
MakePerms(0:2, c(4, 2, 2)) 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 100
应该注意的是，可能的排列数量会迅速增长，因此MakePerms(0:5, rep(2, 6))这样的尝试会失败，因为0:5 12 times的排列总数为12^6 = 2,985,984 > 2^31 - 1（即最大值） Rcpp中矩阵的行数。但是，我们并不期望所有这些都符合我们的标准，所以如果我们设置一个上限，比如说10^7，我们就会取得成功。观察：
a <- MakePerms(0:5, rep(2, 6), 10^7)
nrow(a)
7484400
set.seed(17)
a[sample(nrow(a), 10), ]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 0 5 3 3 1 2 4 4 5 1 0 2
[2,] 5 4 2 1 1 0 3 4 5 2 3 0
[3,] 2 4 5 3 5 1 3 0 1 0 4 2
[4,] 4 3 3 1 2 5 0 5 4 1 0 2
[5,] 2 2 5 3 4 1 0 3 5 1 0 4
[6,] 3 1 1 5 0 3 2 0 2 4 4 5
[7,] 1 1 4 2 0 5 4 0 3 5 3 2
[8,] 1 0 4 2 4 2 5 1 3 0 5 3
[9,] 4 3 4 1 5 0 0 2 2 1 3 5
[10,] 1 0 5 3 2 0 1 4 3 4 2 5
使用myCap也可以大大提高效率。
microbenchmark(withOutCap = MakePerms(0:5, c(1,2,1,2,1,2)),
withCap = MakePerms(0:5, c(1,2,1,2,1,2), 10^5),
times = 15)
Unit: milliseconds
expr min lq mean median uq max neval
withOutCap 219.64847 246.4718 275.04672 282.52829 299.33816 311.2031 15
withCap 22.56437 30.6904 33.30469 31.70443 37.50858 41.6095 15
identical(MakePerms(0:5, c(1,2,1,2,1,2)), MakePerms(0:5, c(1,2,1,2,1,2), 10^5))
[1] TRUE
iterpc解决方案似乎提供给这一点的答案完全是学术性的，因为@StéphaneLaurent提供的答案远非优越。超级一般，一线，超快!!
microbenchmark(iter = getall(iterpc(c(2,2,2), labels=c(0,1,2), ordered=TRUE)),
rcppAlg = MakePerms(0:2, c(2,2,2)))
Unit: microseconds
expr min lq mean median uq max neval
iter 428.885 453.2975 592.53164 540.154 683.9585 1165.772 100
rcppAlg 62.418 74.5205 93.44926 81.749 108.4660 216.454 100
故事随着排列数量的增加而变化。观察：
microbenchmark(iter = getall(iterpc(c(2,2,2,2), labels=c(0,1,2,3), ordered=TRUE)),
rcppAlg = MakePerms(0:3, c(2,2,2,2)),
rcppAlgCap = MakePerms(0:3, c(2,2,2,2), 5000))
Unit: microseconds
expr min lq mean median uq max neval
iter 877.246 1052.7060 1394.636 1150.0895 1265.088 8914.980 100
rcppAlg 964.446 1449.7115 2084.944 1787.9350 1906.242 10921.156 100
如果您使用myCap，MakePerms会更快一些。这并不重要，因为使用iterpc解决方案，您甚至不必考虑将获得多少结果。非常好!!
新版本的RcppAlgos（我是其作者）刚刚在CRAN上发布。现在还有一个名为permuteGeneral freqs的额外参数允许多重集合的排列，这正是OP正在寻找的。
microbenchmark(iter = getall(iterpc(c(2,2,2,2), labels=0:3, ordered=TRUE)),
newRcppAlgos = permuteGeneral(0:3, freqs = c(2,2,2,2)))
Unit: microseconds
expr min lq mean median uq max neval
iter 457.442 482.8365 609.98678 508.6150 572.581 4037.048 100
newRcppAlgos 33.159 43.3975 56.40026 48.5665 58.194 625.691 100
microbenchmark(iter = getall(iterpc(c(5,4,3,2), labels=0:3, ordered=TRUE)),
newRcppAlgos = permuteGeneral(0:3, freqs = c(5,4,3,2)))
Unit: milliseconds
expr min lq mean median uq max neval
iter 480.25976 552.54343 567.9155 565.23066 579.0258 751.8556 100
newRcppAlgos 83.41194 87.03957 104.6279 95.67596 107.3572 181.1119 100
identical(getall(iterpc(c(5,4,3,2), labels=0:3, ordered=TRUE)),
permuteGeneral(0:3, freqs = c(5,4,3,2)))
[1] TRUE
nrow(permuteGeneral(0:3, freqs = c(5,4,3,2)))
[1] 2522520
正如@StéphaneLaurent所指出的那样，包arrangements已被释放，以替代iterpc（请参阅@RandyLai的评论）。它更有效并且能够处理更广泛的组合问题（例如分区）。以下是更大范例的基准：
microbenchmark(arrangements = permutations(x = 0:3, freq = c(5,4,3,2)),
RcppAlgos = permuteGeneral(0:3, freqs = c(5,4,3,2)))
Unit: milliseconds
expr min lq mean median uq max neval
arrangements 97.10078 98.67154 113.5953 100.56261 131.3244 163.8912 100
RcppAlgos 92.13122 93.84818 108.1845 95.72691 101.2647 165.7248 100
......几乎相同的结果。
arrangements的一大好处是能够通过getnext逐个（或以块为单位）获取排列。这样，用户就可以生成超过2^31 - 1个结果，并提供更多灵活性。
有关R中有关此类问题的详细信息，我在问题extensive overview上写了R: Permutations and combinations with/without replacement and for distinct/non-distinct items/multiset。
答案 1 :(得分：2)
提出了两种方法：效率低，效率高但费力的方法。 （在这种情况下，我将“效率”等同于缩放，而不是等待执行它的代码量或执行时间。也就是说，只要你只创建90行，那么你就没事了。如果这是简化的话。问题，你真的需要扩展到更大的矩阵，然后permutations可能超过内存和/或R的容量。）
两种解决方案都比您的代码短一些。第一个是相对清晰的阅读，只有4行代码;第二个被认为有点模糊（似乎进入索引间接“开始”），但实际上仍然只有13行所需的代码。第二种可能会有所减少，但我没有“玩”时间： - ）
一种方法是创建所有排列并过滤掉重复。只要您的“N”不会太大，这就有效。
library(gtools)
v <- rep(0:2, 2)
p <- permutations(6, 6)
p[] <- v[p]
p <- p[!duplicated(p),]
head(p)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 0 1 2 0 1 2
# [2,] 0 1 2 0 2 1
# [3,] 0 1 2 1 0 2
# [4,] 0 1 2 1 2 0
# [5,] 0 1 2 2 0 1
# [6,] 0 1 2 2 1 0
tail(p)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [85,] 2 2 0 1 0 1
# [86,] 2 2 0 1 1 0
# [87,] 2 2 0 0 1 1
# [88,] 2 2 1 0 0 1
# [89,] 2 2 1 0 1 0
# [90,] 2 2 1 1 0 0
验证每行中是否有两个元素：
all(apply(p, 1, table) == 2)
# [1] TRUE
效率较低（因此更省力）的方法：使用combn(6,2)和combn(4,2)创建列索引矩阵，然后适当地分配“因子”。 （这一刻会更有意义。）
（注意：我经常根据转置矩阵更好地考虑这些问题;您可以轻松地进行此转换，只需调整代码以交换列/行。）
我们需要的是expand.grid类似于一次两列的内容。所以我们将从较小的问题开始：
left2 <- t(combn(6, 2))
mid2 <- t(combn(4, 2))
left2
# [,1] [,2]
# [1,] 1 2
# [2,] 1 3
# [3,] 1 4
# [4,] 1 5
# [5,] 1 6
# [6,] 2 3
# [7,] 2 4
# [8,] 2 5
# [9,] 2 6
# [10,] 3 4
# [11,] 3 5
# [12,] 3 6
# [13,] 4 5
# [14,] 4 6
# [15,] 5 6
mid2
# [,1] [,2]
# [1,] 1 2
# [2,] 1 3
# [3,] 1 4
# [4,] 2 3
# [5,] 2 4
# [6,] 3 4
现在，网格将扩展这两个矩阵的行索引。
eg <- expand.grid(a = 1:15, b = 1:6)
head(eg)
# a b
# 1 1 1
# 2 2 1
# 3 3 1
# 4 4 1
# 5 5 1
# 6 6 1
inds <- cbind(left2[eg$a,], mid2[eg$b,])
head(inds)
# [,1] [,2] [,3] [,4]
# [1,] 1 2 1 2
# [2,] 1 3 1 2
# [3,] 1 4 1 2
# [4,] 1 5 1 2
# [5,] 1 6 1 2
# [6,] 2 3 1 2
inds[25,,drop=FALSE]
# [,1] [,2] [,3] [,4]
# [1,] 3 4 1 3
这意味着，对于第25行，我们应该用第一个因子（比如0）替换第3列和第4列。然后，剩下的列（1,2,5,6），我们应该将第1列和第3列替换为第二个因子（比如1）。再说一遍，c(1,2,5,6)[c(1,3)]等同于第1列和第5列被替换为第二个值（1）。 （第三个值2将进入所有剩余的广告位。）
因此，要想出上面的c(1,2,5,6)，我们可以使用setdiff(1:6,...)：
afterleft2 <- t(apply(left2[eg$a,], 1, function(a) setdiff(1:6, a)))
head( afterleft2 )
# [,1] [,2] [,3] [,4]
# [1,] 3 4 5 6
# [2,] 2 4 5 6
# [3,] 2 3 5 6
# [4,] 2 3 4 6
# [5,] 2 3 4 5
# [6,] 1 4 5 6
afterleft2[25,,drop=FALSE]
# [,1] [,2] [,3] [,4]
# [1,] 1 2 5 6
让我们来修复inds第三和第四列。
inds[,3] <- afterleft2[ cbind(1:90, mid2[eg$b,1]) ]
inds[,4] <- afterleft2[ cbind(1:90, mid2[eg$b,2]) ]
head(inds)
# [,1] [,2] [,3] [,4]
# [1,] 1 2 3 4
# [2,] 1 3 2 4
# [3,] 1 4 2 3
# [4,] 1 5 2 3
# [5,] 1 6 2 3
# [6,] 2 3 1 4
inds[25,,drop=FALSE]
# [,1] [,2] [,3] [,4]
# [1,] 3 4 1 5
我们从中看到第25行有我们期望的“1”和“5”。
现在结束：
nr <- nrow(inds)
out <- matrix(nrow = nr, ncol = 6L)
out[cbind(1:nr,inds[,1])] <- 0L
out[cbind(1:nr,inds[,2])] <- 0L
out[cbind(1:nr,inds[,3])] <- 1L
out[cbind(1:nr,inds[,4])] <- 1L
head(out)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 0 0 1 1 NA NA
# [2,] 0 1 0 1 NA NA
# [3,] 0 1 1 0 NA NA
# [4,] 0 1 1 NA 0 NA
# [5,] 0 1 1 NA NA 0
# [6,] 1 0 0 1 NA NA
out[25,,drop=FALSE]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 NA 0 0 1 NA
我在上面提到的“剩余时段”（第三个值）都是NA，设计符合。
out[is.na(out)] <- 2L
head(out)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 0 0 1 1 2 2
# [2,] 0 1 0 1 2 2
# [3,] 0 1 1 0 2 2
# [4,] 0 1 1 2 0 2
# [5,] 0 1 1 2 2 0
# [6,] 1 0 0 1 2 2
out[25,,drop=FALSE]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 2 0 0 1 2
现在进行快速健全性检查，以确保我们的out变量在每一行中只包含两个元素。
all(apply(out, 1, table) == 2)
# [1] TRUE
答案 2 :(得分：2)
您可以使用iterpc包：
> library(iterpc)
> I <- iterpc(c(2,2,2), labels=c(0,1,2), ordered=TRUE)
> getall(I)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 2 2
[2,] 0 0 1 2 1 2
[3,] 0 0 1 2 2 1
[4,] 0 0 2 1 1 2
[5,] 0 0 2 1 2 1
[6,] 0 0 2 2 1 1
[7,] 0 1 0 1 2 2
[8,] 0 1 0 2 1 2
[9,] 0 1 0 2 2 1
[10,] 0 1 1 0 2 2
[11,] 0 1 1 2 0 2
[12,] 0 1 1 2 2 0
[13,] 0 1 2 0 1 2
[14,] 0 1 2 0 2 1
[15,] 0 1 2 1 0 2
[16,] 0 1 2 1 2 0
[17,] 0 1 2 2 0 1
[18,] 0 1 2 2 1 0
[19,] 0 2 0 1 1 2
[20,] 0 2 0 1 2 1
[21,] 0 2 0 2 1 1
[22,] 0 2 1 0 1 2
[23,] 0 2 1 0 2 1
[24,] 0 2 1 1 0 2
[25,] 0 2 1 1 2 0
[26,] 0 2 1 2 0 1
[27,] 0 2 1 2 1 0
[28,] 0 2 2 0 1 1
[29,] 0 2 2 1 0 1
[30,] 0 2 2 1 1 0
[31,] 1 0 0 1 2 2
[32,] 1 0 0 2 1 2
[33,] 1 0 0 2 2 1
[34,] 1 0 1 0 2 2
[35,] 1 0 1 2 0 2
[36,] 1 0 1 2 2 0
[37,] 1 0 2 0 1 2
[38,] 1 0 2 0 2 1
[39,] 1 0 2 1 0 2
[40,] 1 0 2 1 2 0
[41,] 1 0 2 2 0 1
[42,] 1 0 2 2 1 0
[43,] 1 1 0 0 2 2
[44,] 1 1 0 2 0 2
[45,] 1 1 0 2 2 0
[46,] 1 1 2 0 0 2
[47,] 1 1 2 0 2 0
[48,] 1 1 2 2 0 0
[49,] 1 2 0 0 1 2
[50,] 1 2 0 0 2 1
[51,] 1 2 0 1 0 2
[52,] 1 2 0 1 2 0
[53,] 1 2 0 2 0 1
[54,] 1 2 0 2 1 0
[55,] 1 2 1 0 0 2
[56,] 1 2 1 0 2 0
[57,] 1 2 1 2 0 0
[58,] 1 2 2 0 0 1
[59,] 1 2 2 0 1 0
[60,] 1 2 2 1 0 0
[61,] 2 0 0 1 1 2
[62,] 2 0 0 1 2 1
[63,] 2 0 0 2 1 1
[64,] 2 0 1 0 1 2
[65,] 2 0 1 0 2 1
[66,] 2 0 1 1 0 2
[67,] 2 0 1 1 2 0
[68,] 2 0 1 2 0 1
[69,] 2 0 1 2 1 0
[70,] 2 0 2 0 1 1
[71,] 2 0 2 1 0 1
[72,] 2 0 2 1 1 0
[73,] 2 1 0 0 1 2
[74,] 2 1 0 0 2 1
[75,] 2 1 0 1 0 2
[76,] 2 1 0 1 2 0
[77,] 2 1 0 2 0 1
[78,] 2 1 0 2 1 0
[79,] 2 1 1 0 0 2
[80,] 2 1 1 0 2 0
[81,] 2 1 1 2 0 0
[82,] 2 1 2 0 0 1
[83,] 2 1 2 0 1 0
[84,] 2 1 2 1 0 0
[85,] 2 2 0 0 1 1
[86,] 2 2 0 1 0 1
[87,] 2 2 0 1 1 0
[88,] 2 2 1 0 0 1
[89,] 2 2 1 0 1 0
[90,] 2 2 1 1 0 0
iterpc现已弃用，以支持arrangements。