排列 R 中向量的所有唯一枚举

发布于 2024-11-01 23:39:58 字数 596 浏览 1 评论 0原文

我试图找到一个函数来排列向量的所有唯一排列，同时不计算相同元素类型子集中的并置。例如：

dat <- c(1,0,3,4,1,0,0,3,0,4)

具有

factorial(10)
> 3628800

只有 10!/(2!*2!*4!*2!)

factorial(10)/(factorial(2)*factorial(2)*factorial(2)*factorial(4))
> 18900

可能的排列，但当忽略相同元素类型子集中的并置时，

唯一排列。我可以通过使用 unique() 和 combinat 包中的 permn() 函数来得到这个，

unique( permn(dat) )

但这在计算上非常昂贵，因为它涉及到枚举 n!，这可能比我需要的排列多一个数量级。有没有办法在不先计算 n! 的情况下做到这一点？

原文

I'm trying to find a function that will permute all the unique permutations of a vector, while not counting juxtapositions within subsets of the same element type. For example:

dat <- c(1,0,3,4,1,0,0,3,0,4)

has

factorial(10)
> 3628800

possible permutations, but only 10!/(2!*2!*4!*2!)

factorial(10)/(factorial(2)*factorial(2)*factorial(2)*factorial(4))
> 18900

unique permutations when ignoring juxtapositions within subsets of the same element type.

I can get this by using unique() and the permn() function from the package combinat

unique( permn(dat) )

but this is computationally very expensive, since it involves enumerating n!, which can be an order of magnitude more permutations than I need. Is there a way to do this without first computing n!?

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

酒儿 2024-11-08 23:39:58

编辑：这是一个更快的答案；再次基于 Louisa Gray 和 Bryce Wagner 的想法，但由于更好地使用矩阵索引，R 代码更快。它比我原来的要快很多：

> ddd <- c(1,0,3,4,1,0,0,3,0,4)
> system.time(up1 <- uniqueperm(d))
   user  system elapsed 
  0.183   0.000   0.186 
> system.time(up2 <- uniqueperm2(d))
   user  system elapsed 
  0.037   0.000   0.038

代码：

uniqueperm2 <- function(d) {
  dat <- factor(d)
  N <- length(dat)
  n <- tabulate(dat)
  ng <- length(n)
  if(ng==1) return(d)
  a <- N-c(0,cumsum(n))[-(ng+1)]
  foo <- lapply(1:ng, function(i) matrix(combn(a[i],n[i]),nrow=n[i]))
  out <- matrix(NA, nrow=N, ncol=prod(sapply(foo, ncol)))
  xxx <- c(0,cumsum(sapply(foo, nrow)))
  xxx <- cbind(xxx[-length(xxx)]+1, xxx[-1])
  miss <- matrix(1:N,ncol=1)
  for(i in seq_len(length(foo)-1)) {
    l1 <- foo[[i]]
    nn <- ncol(miss)
    miss <- matrix(rep(miss, ncol(l1)), nrow=nrow(miss))
    k <- (rep(0:(ncol(miss)-1), each=nrow(l1)))*nrow(miss) + 
               l1[,rep(1:ncol(l1), each=nn)]
    out[xxx[i,1]:xxx[i,2],] <- matrix(miss[k], ncol=ncol(miss))
    miss <- matrix(miss[-k], ncol=ncol(miss))
  }
  k <- length(foo)
  out[xxx[k,1]:xxx[k,2],] <- miss
  out <- out[rank(as.numeric(dat), ties="first"),]
  foo <- cbind(as.vector(out), as.vector(col(out)))
  out[foo] <- d
  t(out)
}

它不会返回相同的顺序，但排序后，结果是相同的。

up1a <- up1[do.call(order, as.data.frame(up1)),]
up2a <- up2[do.call(order, as.data.frame(up2)),]
identical(up1a, up2a)

对于我的第一次尝试，请参阅编辑历史记录。

EDIT: Here's a faster answer; again based on the ideas of Louisa Grey and Bryce Wagner, but with faster R code thanks to better use of matrix indexing. It's quite a bit faster than my original:

> ddd <- c(1,0,3,4,1,0,0,3,0,4)
> system.time(up1 <- uniqueperm(d))
   user  system elapsed 
  0.183   0.000   0.186 
> system.time(up2 <- uniqueperm2(d))
   user  system elapsed 
  0.037   0.000   0.038

And the code:

uniqueperm2 <- function(d) {
  dat <- factor(d)
  N <- length(dat)
  n <- tabulate(dat)
  ng <- length(n)
  if(ng==1) return(d)
  a <- N-c(0,cumsum(n))[-(ng+1)]
  foo <- lapply(1:ng, function(i) matrix(combn(a[i],n[i]),nrow=n[i]))
  out <- matrix(NA, nrow=N, ncol=prod(sapply(foo, ncol)))
  xxx <- c(0,cumsum(sapply(foo, nrow)))
  xxx <- cbind(xxx[-length(xxx)]+1, xxx[-1])
  miss <- matrix(1:N,ncol=1)
  for(i in seq_len(length(foo)-1)) {
    l1 <- foo[[i]]
    nn <- ncol(miss)
    miss <- matrix(rep(miss, ncol(l1)), nrow=nrow(miss))
    k <- (rep(0:(ncol(miss)-1), each=nrow(l1)))*nrow(miss) + 
               l1[,rep(1:ncol(l1), each=nn)]
    out[xxx[i,1]:xxx[i,2],] <- matrix(miss[k], ncol=ncol(miss))
    miss <- matrix(miss[-k], ncol=ncol(miss))
  }
  k <- length(foo)
  out[xxx[k,1]:xxx[k,2],] <- miss
  out <- out[rank(as.numeric(dat), ties="first"),]
  foo <- cbind(as.vector(out), as.vector(col(out)))
  out[foo] <- d
  t(out)
}

It doesn't return the same order, but after sorting, the results are identical.

up1a <- up1[do.call(order, as.data.frame(up1)),]
up2a <- up2[do.call(order, as.data.frame(up2)),]
identical(up1a, up2a)

For my first attempt, see the edit history.

回复收藏 0 原文

东风软 2024-11-08 23:39:58

以下函数（它实现了重复排列的经典公式，就像您在问题中手动执行的那样）对我来说似乎相当快：

upermn <- function(x) {
    n <- length(x)
    duplicates <- as.numeric(table(x))
    factorial(n) / prod(factorial(duplicates))
}

它确实计算 n! 但不像 permn首先生成所有排列的函数。

查看实际操作：

> dat <- c(1,0,3,4,1,0,0,3,0,4)
> upermn(dat)
[1] 18900
> system.time(uperm(dat))
   user  system elapsed 
  0.000   0.000   0.001

更新：我刚刚意识到问题是关于生成所有唯一的排列，而不仅仅是指定它们的数量 - 对此感到抱歉！

您可以通过为少一个元素指定唯一排列来改进 unique(perm(...)) 部分，然后在它们前面添加 uniqe 元素。好吧，我的解释可能会失败，所以让消息来源说：

uperm <- function(x) {
u <- unique(x)                    # unique values of the vector
result <- x                       # let's start the result matrix with the vector
for (i in 1:length(u)) {
    v <- x[-which(x==u[i])[1]]    # leave the first occurance of duplicated values
    result <- rbind(result, cbind(u[i], do.call(rbind, unique(permn(v)))))
}
return(result)
}

这样你可以获得一些速度。我懒得在您提供的向量上运行代码（花了很多时间），这是对较小向量的一个小比较：

> dat <- c(1,0,3,4,1,0,0)
> system.time(unique(permn(dat)))
   user  system elapsed 
  0.264   0.000   0.268 
> system.time(uperm(dat))
   user  system elapsed 
  0.147   0.000   0.150

我认为通过将此函数重写为递归，您可以获得更多收益！

更新（再次）：我尝试用我有限的知识编写一个递归函数：

uperm <- function(x) {
    u <- sort(unique(x))
    l <- length(u)
    if (l == length(x)) {
        return(do.call(rbind,permn(x)))
    }
    if (l == 1) return(x)
    result <- matrix(NA, upermn(x), length(x))
    index <- 1
    for (i in 1:l) {
        v <- x[-which(x==u[i])[1]]
        newindex <- upermn(v)
        if (table(x)[i] == 1) {
            result[index:(index+newindex-1),] <- cbind(u[i], do.call(rbind, unique(permn(v))))
            } else {
                result[index:(index+newindex-1),] <- cbind(u[i], uperm(v))
            }
        index <- index+newindex
    }
    return(result)
}

这有很大的收获：

> system.time(unique(permn(c(1,0,3,4,1,0,0,3,0))))
   user  system elapsed 
 22.808   0.103  23.241 

> system.time(uperm(c(1,0,3,4,1,0,0,3,0)))
   user  system elapsed 
  4.613   0.003   4.645

请报告这是否适合您！

The following function (which implements the classic formula for repeated permutations just like you did manually in your question) seems quite fast to me:

upermn <- function(x) {
    n <- length(x)
    duplicates <- as.numeric(table(x))
    factorial(n) / prod(factorial(duplicates))
}

It does compute n! but not like permn function which generates all permutations first.

See it in action:

> dat <- c(1,0,3,4,1,0,0,3,0,4)
> upermn(dat)
[1] 18900
> system.time(uperm(dat))
   user  system elapsed 
  0.000   0.000   0.001

UPDATE: I have just realized that the question was about generating all unique permutations not just specifying the number of them - sorry for that!

You could improve the unique(perm(...)) part with specifying unique permutations for one less element and later adding the uniqe elements in front of them. Well, my explanation may fail, so let the source speak:

uperm <- function(x) {
u <- unique(x)                    # unique values of the vector
result <- x                       # let's start the result matrix with the vector
for (i in 1:length(u)) {
    v <- x[-which(x==u[i])[1]]    # leave the first occurance of duplicated values
    result <- rbind(result, cbind(u[i], do.call(rbind, unique(permn(v)))))
}
return(result)
}

This way you could gain some speed. I was lazy to run the code on the vector you provided (took so much time), here is a small comparison on a smaller vector:

> dat <- c(1,0,3,4,1,0,0)
> system.time(unique(permn(dat)))
   user  system elapsed 
  0.264   0.000   0.268 
> system.time(uperm(dat))
   user  system elapsed 
  0.147   0.000   0.150

I think you could gain a lot more by rewriting this function to be recursive!

UPDATE (again): I have tried to make up a recursive function with my limited knowledge:

uperm <- function(x) {
    u <- sort(unique(x))
    l <- length(u)
    if (l == length(x)) {
        return(do.call(rbind,permn(x)))
    }
    if (l == 1) return(x)
    result <- matrix(NA, upermn(x), length(x))
    index <- 1
    for (i in 1:l) {
        v <- x[-which(x==u[i])[1]]
        newindex <- upermn(v)
        if (table(x)[i] == 1) {
            result[index:(index+newindex-1),] <- cbind(u[i], do.call(rbind, unique(permn(v))))
            } else {
                result[index:(index+newindex-1),] <- cbind(u[i], uperm(v))
            }
        index <- index+newindex
    }
    return(result)
}

Which has a great gain:

> system.time(unique(permn(c(1,0,3,4,1,0,0,3,0))))
   user  system elapsed 
 22.808   0.103  23.241 

> system.time(uperm(c(1,0,3,4,1,0,0,3,0)))
   user  system elapsed 
  4.613   0.003   4.645

Please report back if this would work for you!

回复收藏 0 原文

孤者何惧 2024-11-08 23:39:58

这里没有提到的一个选项是 multicool 包中的 allPerm 函数。它可以很容易地用来获得所有独特的排列：

library(multicool)
perms <- allPerm(initMC(dat))
dim(perms)
# [1] 18900    10
head(perms)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,]    4    4    3    3    1    1    0    0    0     0
# [2,]    0    4    4    3    3    1    1    0    0     0
# [3,]    4    0    4    3    3    1    1    0    0     0
# [4,]    4    4    0    3    3    1    1    0    0     0
# [5,]    3    4    4    0    3    1    1    0    0     0
# [6,]    4    3    4    0    3    1    1    0    0     0

在基准测试中，我发现它在 dat 上比 OP 和 daroczig 的解决方案更快，但比 Aaron 的解决方案慢。

One option that hasn't been mentioned here is the allPerm function from the multicool package. It can be used pretty easily to get all the unique permutations:

library(multicool)
perms <- allPerm(initMC(dat))
dim(perms)
# [1] 18900    10
head(perms)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,]    4    4    3    3    1    1    0    0    0     0
# [2,]    0    4    4    3    3    1    1    0    0     0
# [3,]    4    0    4    3    3    1    1    0    0     0
# [4,]    4    4    0    3    3    1    1    0    0     0
# [5,]    3    4    4    0    3    1    1    0    0     0
# [6,]    4    3    4    0    3    1    1    0    0     0

In benchmarking I found it to be faster on dat than the solutions from the OP and daroczig but slower than the solution from Aaron.

回复收藏 0 原文

鲜肉鲜肉永远不皱 2024-11-08 23:39:58

我实际上并不了解 R，但这是我解决问题的方法：

查找每种元素类型的数量，即

按频率排序（上面已经是）。

从出现频率最高的值开始，该值占据 10 个位置中的 4 个。确定 10 个可用点内 4 个值的唯一组合。
(0,1,2,3),(0,1,2,4),(0,1,2,5),(0,1,2,6)
... (0,1,2,9),(0,1,3,4),(0,1,3,5)
... (6,7,8,9)

转到第二个最常见的值，它占据 6 个可用位置中的 2 个，并确定它的 6 个中的 2 个的唯一组合。
(0,1),(0,2),(0,3),(0,4),(0,5),(1,2),(1,3) ... (4,6), (5,6)

然后 4 中的 2：
(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)

其余值，2 of 2：
(0,1)

然后你需要将它们组合成每种可能的组合。这是一些伪代码（我相信有一个更有效的算法，但这应该不会太糟糕）：

lookup = (0,1,3,4)
For each of the above sets of combinations, example: input = ((0,2,4,6),(0,2),(2,3),(0,1))
newPermutation = (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1)
for i = 0 to 3
  index = 0
  for j = 0 to 9
    if newPermutation(j) = -1
      if index = input(i)(j)
        newPermutation(j) = lookup(i)
        break
      else
        index = index + 1

I don't actually know R, but here's how I'd approach the problem:

Find how many of each element type, i.e.

Sort by frequency (which the above already is).

Start with the most frequent value, which takes up 4 of the 10 spots. Determine the unique combinations of 4 values within the 10 available spots.
(0,1,2,3),(0,1,2,4),(0,1,2,5),(0,1,2,6)
... (0,1,2,9),(0,1,3,4),(0,1,3,5)
... (6,7,8,9)

Go to the second most frequent value, it takes up 2 of 6 available spots, and determine it's unique combinations of 2 of 6.
(0,1),(0,2),(0,3),(0,4),(0,5),(1,2),(1,3) ... (4,6),(5,6)

Then 2 of 4:
(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)

And the remaining values, 2 of 2:
(0,1)

Then you need to combine them into each possible combination. Here's some pseudocode (I'm convinced there's a more efficient algorithm for this, but this shouldn't be too bad):

lookup = (0,1,3,4)
For each of the above sets of combinations, example: input = ((0,2,4,6),(0,2),(2,3),(0,1))
newPermutation = (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1)
for i = 0 to 3
  index = 0
  for j = 0 to 9
    if newPermutation(j) = -1
      if index = input(i)(j)
        newPermutation(j) = lookup(i)
        break
      else
        index = index + 1

回复收藏 0 原文

蓬勃野心 2024-11-08 23:39:58

另一个选择是 iterpc 包，我相信它是现有方法中最快的。更重要的是，结果是按字典顺序排列的（这可能在某种程度上更可取）。

dat <- c(1, 0, 3, 4, 1, 0, 0, 3, 0, 4)
library(iterpc)
getall(iterpc(table(dat), order=TRUE))

基准测试表明 iterpc 比此处描述的所有其他方法要快得多

library(multicool)
library(microbenchmark)
microbenchmark(uniqueperm2(dat), 
               allPerm(initMC(dat)), 
               getall(iterpc(table(dat), order=TRUE))
              )

Unit: milliseconds
                                     expr         min         lq        mean      median
                         uniqueperm2(dat)   23.011864   25.33241   40.141907   27.143952
                     allPerm(initMC(dat)) 1713.549069 1771.83972 1814.434743 1810.331342
 getall(iterpc(table(dat), order = TRUE))    4.332674    5.18348    7.656063    5.989448
          uq        max neval
   64.147399   74.66312   100
 1855.869670 1937.48088   100
    6.705741   49.98038   100

Another option is the iterpc package, I believe it is the fastest of the existing method. More importantly, the result is in dictionary order (which may be somehow preferable).

dat <- c(1, 0, 3, 4, 1, 0, 0, 3, 0, 4)
library(iterpc)
getall(iterpc(table(dat), order=TRUE))

The benchmark indicates that iterpc is significant faster than all other methods described here

library(multicool)
library(microbenchmark)
microbenchmark(uniqueperm2(dat), 
               allPerm(initMC(dat)), 
               getall(iterpc(table(dat), order=TRUE))
              )

Unit: milliseconds
                                     expr         min         lq        mean      median
                         uniqueperm2(dat)   23.011864   25.33241   40.141907   27.143952
                     allPerm(initMC(dat)) 1713.549069 1771.83972 1814.434743 1810.331342
 getall(iterpc(table(dat), order = TRUE))    4.332674    5.18348    7.656063    5.989448
          uq        max neval
   64.147399   74.66312   100
 1855.869670 1937.48088   100
    6.705741   49.98038   100

回复收藏 0 原文

且行且努力 2024-11-08 23:39:58

由于这个问题很老，并且继续吸引许多观点，所以这篇文章只是为了告知 R 用户该语言在执行 OP 概述的流行任务方面的当前状态。正如 @RandyLai 提到的，有一些开发包是为了完成此任务而开发的。它们是：安排和RcppAlgos^*。

效率

它们非常高效并且非常容易用于生成多重集的排列。

dat <- c(1, 0, 3, 4, 1, 0, 0, 3, 0, 4)
dim(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
[1] 18900    10

microbenchmark(algos = RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)),
               arngmnt = arrangements::permutations(sort(unique(dat)), freq = table(dat)),
               curaccptd = uniqueperm2(dat), unit = "relative")
Unit: relative
     expr       min        lq       mean    median        uq       max neval
    algos  1.000000  1.000000  1.0000000  1.000000  1.000000 1.0000000   100
  arngmnt  1.501262  1.093072  0.8783185  1.089927  1.133112 0.3238829   100
curaccptd 19.847457 12.573657 10.2272080 11.705090 11.872955 3.9007364   100

借助 RcppAlgos，我们可以利用并行处理在更大的示例上获得更高的效率。

hugeDat <- rep(dat, 2)[-(1:5)]
RcppAlgos::permuteCount(sort(unique(hugeDat)), freqs = table(hugeDat))
[1] 3603600

microbenchmark(algospar = RcppAlgos::permuteGeneral(sort(unique(hugeDat)),
                                                    freqs = table(hugeDat), nThreads = 4),
               arngmnt = arrangements::permutations(sort(unique(hugeDat)), freq = table(hugeDat)),
               curaccptd = uniqueperm2(hugeDat), unit = "relative", times = 10)
Unit: relative
     expr      min        lq      mean    median       uq      max neval
 algospar  1.00000  1.000000  1.000000  1.000000  1.00000  1.00000    10
  arngmnt  3.23193  3.109092  2.427836  2.598058  2.15965  1.79889    10
curaccptd 49.46989 45.910901 34.533521 39.399481 28.87192 22.95247    10

字典顺序

这些包的一个很好的好处是输出按照字典顺序：

head(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    0    0    0    0    1    1    3    3    4     4
[2,]    0    0    0    0    1    1    3    4    3     4
[3,]    0    0    0    0    1    1    3    4    4     3
[4,]    0    0    0    0    1    1    4    3    3     4
[5,]    0    0    0    0    1    1    4    3    4     3
[6,]    0    0    0    0    1    1    4    4    3     3

tail(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
         [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[18895,]    4    4    3    3    0    1    1    0    0     0
[18896,]    4    4    3    3    1    0    0    0    0     1
[18897,]    4    4    3    3    1    0    0    0    1     0
[18898,]    4    4    3    3    1    0    0    1    0     0
[18899,]    4    4    3    3    1    0    1    0    0     0
[18900,]    4    4    3    3    1    1    0    0    0     0

identical(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)),
      arrangements::permutations(sort(unique(dat)), freq = table(dat)))
[1] TRUE

迭代器

此外，这两个包都提供迭代器，允许逐一高效地生成排列：

algosIter <- RcppAlgos::permuteIter(sort(unique(dat)), freqs = table(dat))

algosIter$nextIter()
[1] 0 0 0 0 1 1 3 3 4 4

algosIter$nextNIter(5)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    0    0    0    0    1    1    3    4    3     4
[2,]    0    0    0    0    1    1    3    4    4     3
[3,]    0    0    0    0    1    1    4    3    3     4
[4,]    0    0    0    0    1    1    4    3    4     3
[5,]    0    0    0    0    1    1    4    4    3     3

## last permutation
algosIter$back()
[1] 4 4 3 3 1 1 0 0 0 0

## use reverse iterator methods
algosIter$prevNIter(5)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    4    4    3    3    1    0    1    0    0     0
[2,]    4    4    3    3    1    0    0    1    0     0
[3,]    4    4    3    3    1    0    0    0    1     0
[4,]    4    4    3    3    1    0    0    0    0     1
[5,]    4    4    3    3    0    1    1    0    0     0

^* 我是 RcppAlgos 的作者

As this question is old and continues to attract many views, this post is solely meant to inform R users of the current state of the language with regards to performing the popular task outlined by the OP. As @RandyLai alludes to, there are packages developed with this task in mind. They are: arrangements and RcppAlgos^*.

Efficiency

They are very efficient and quite easy to use for generating permutations of a multiset.

dat <- c(1, 0, 3, 4, 1, 0, 0, 3, 0, 4)
dim(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
[1] 18900    10

microbenchmark(algos = RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)),
               arngmnt = arrangements::permutations(sort(unique(dat)), freq = table(dat)),
               curaccptd = uniqueperm2(dat), unit = "relative")
Unit: relative
     expr       min        lq       mean    median        uq       max neval
    algos  1.000000  1.000000  1.0000000  1.000000  1.000000 1.0000000   100
  arngmnt  1.501262  1.093072  0.8783185  1.089927  1.133112 0.3238829   100
curaccptd 19.847457 12.573657 10.2272080 11.705090 11.872955 3.9007364   100

With RcppAlgos we can utilize parallel processing for even better efficiency on larger examples.

hugeDat <- rep(dat, 2)[-(1:5)]
RcppAlgos::permuteCount(sort(unique(hugeDat)), freqs = table(hugeDat))
[1] 3603600

microbenchmark(algospar = RcppAlgos::permuteGeneral(sort(unique(hugeDat)),
                                                    freqs = table(hugeDat), nThreads = 4),
               arngmnt = arrangements::permutations(sort(unique(hugeDat)), freq = table(hugeDat)),
               curaccptd = uniqueperm2(hugeDat), unit = "relative", times = 10)
Unit: relative
     expr      min        lq      mean    median       uq      max neval
 algospar  1.00000  1.000000  1.000000  1.000000  1.00000  1.00000    10
  arngmnt  3.23193  3.109092  2.427836  2.598058  2.15965  1.79889    10
curaccptd 49.46989 45.910901 34.533521 39.399481 28.87192 22.95247    10

Lexicographical Order

A nice benefit of these packages is that the output is in lexicographical order:

head(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    0    0    0    0    1    1    3    3    4     4
[2,]    0    0    0    0    1    1    3    4    3     4
[3,]    0    0    0    0    1    1    3    4    4     3
[4,]    0    0    0    0    1    1    4    3    3     4
[5,]    0    0    0    0    1    1    4    3    4     3
[6,]    0    0    0    0    1    1    4    4    3     3

tail(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)))
         [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[18895,]    4    4    3    3    0    1    1    0    0     0
[18896,]    4    4    3    3    1    0    0    0    0     1
[18897,]    4    4    3    3    1    0    0    0    1     0
[18898,]    4    4    3    3    1    0    0    1    0     0
[18899,]    4    4    3    3    1    0    1    0    0     0
[18900,]    4    4    3    3    1    1    0    0    0     0

identical(RcppAlgos::permuteGeneral(sort(unique(dat)), freqs = table(dat)),
      arrangements::permutations(sort(unique(dat)), freq = table(dat)))
[1] TRUE

Iterators

Additionally, both packages offer iterators that allow for memory efficient generation of permutation, one by one:

algosIter <- RcppAlgos::permuteIter(sort(unique(dat)), freqs = table(dat))

algosIter$nextIter()
[1] 0 0 0 0 1 1 3 3 4 4

algosIter$nextNIter(5)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    0    0    0    0    1    1    3    4    3     4
[2,]    0    0    0    0    1    1    3    4    4     3
[3,]    0    0    0    0    1    1    4    3    3     4
[4,]    0    0    0    0    1    1    4    3    4     3
[5,]    0    0    0    0    1    1    4    4    3     3

## last permutation
algosIter$back()
[1] 4 4 3 3 1 1 0 0 0 0

## use reverse iterator methods
algosIter$prevNIter(5)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    4    4    3    3    1    0    1    0    0     0
[2,]    4    4    3    3    1    0    0    1    0     0
[3,]    4    4    3    3    1    0    0    0    1     0
[4,]    4    4    3    3    1    0    0    0    0     1
[5,]    4    4    3    3    0    1    1    0    0     0

^* I am the author of RcppAlgos

回复收藏 0 原文

〆凄凉。 2024-11-08 23:39:58

另一种选择是使用 Rcpp 包。不同之处在于它返回一个列表。

//[[Rcpp::export]]
std::vector<std::vector< int > > UniqueP(std::vector<int> v){
std::vector< std::vector<int> > out;
std::sort (v.begin(),v.end());
do {
    out.push_back(v);
} while ( std::next_permutation(v.begin(),v.end()));
return out;
}
 Unit: milliseconds
         expr       min      lq     mean    median       uq      max neval cld
 uniqueperm2(dat) 10.753426 13.5283 15.61438 13.751179 16.16061 34.03334   100   b
 UniqueP(dat)      9.090222  9.6371 10.30185  9.838324 10.20819 24.50451   100   a

Another option is by using the Rcpp package. The difference is that it returns a list.

//[[Rcpp::export]]
std::vector<std::vector< int > > UniqueP(std::vector<int> v){
std::vector< std::vector<int> > out;
std::sort (v.begin(),v.end());
do {
    out.push_back(v);
} while ( std::next_permutation(v.begin(),v.end()));
return out;
}
 Unit: milliseconds
         expr       min      lq     mean    median       uq      max neval cld
 uniqueperm2(dat) 10.753426 13.5283 15.61438 13.751179 16.16061 34.03334   100   b
 UniqueP(dat)      9.090222  9.6371 10.30185  9.838324 10.20819 24.50451   100   a

回复收藏 0 原文

~没有更多了~