r - 排列 : Speed up, 预测和/或多线程

Question

我正在研究一种算法，它需要连续暴力破解 N 次测试。测试的排列对结果很重要。

问题:当某些规则适用时，我需要能够限制组合搜索空间。例如:

排列“1,2,3”使后续测试无用。所以我不再需要像“1,2,3,4”或“1,2,3,5”等排列。所以我写了一些代码，自己做排列，但我并不慢。

我该怎么做才能使这段代码更快？或者有没有我错过的包裹？我应该自己用 C 实现吗？有没有简单的多线程方法？有没有一种简单的方法可以预测第 N 个排列？ (这会很巧妙，以简单的方式实现并行计算；)

非常感谢!马克

# Example of permu.with.check.
# 02.05.2014; Marc Giesmann

# Set if needed Recursion limit
# options(expressions=1e5)

permu.with.check <- function(perm = c(1,2,3), current = NULL, fun){

  #Optional: Calculate all variants
  #if(is.null(current)){
  #  all.permutations <- 2* (sum(gamma(perm + 1)) - 1)
  #}

  for(i in 1: length(perm)){

    fix  <- perm[i]   # calculated elements; fix at this point
    rest <- perm[-i]  # elements yet to permutate

    #If this is a recursive call, use
    #"current" to complement current fix value
    if(!is.null(current)){
      fix <- c(current,fix)
    }

    #Call callback.
    #If callback returns "FALSE" don't calculate 
    #further permutations with this "fix". Skip i.
    if(fun(x=fix)){

      #if this is the call with the last
      #value (the deepest,recursive call), stop recursion
      if(length(rest) > 0){
        permu.with.check( rest, fix,fun ) #recursive. 
      }
    }
  }

}

# Callback for permu.with.check
# Ignores 3
perm.callback <- function(x){

  #CALCULATE STUFF HERE
  #cat(counter, ". permutation: ",x, "\n")
  counter <<- counter + 1

  #TEST - EXAMPLE:
  # if new number equals 3, we don't need further testing
  if(x[length(x)] == 3){
    return(FALSE)
  }else{
    return(TRUE)
  }

} 

########## MAIN ################

counter <- 0
permu.with.check(perm=1:8, fun=perm.callback)

#Compare with permutations from package Combinations
# counter (from permu.with.check) == 27399
# nrow(permutations(8))           == 40320

#OPTIONAL: Try out Combinations package
#if(!require(Combinations)){
#  install.packages("Combinations", repos = "http://www.omegahat.org/R")
#  require(Combinations)
#}

#nrow(permutations(8))

Answer 1

Marc，根据你最近的评论，这里有一个建议的实现。

这是一个非常迭代的解决方案，就目前而言效率不高产生排列。它假设计算在testfunc 比置换生成要昂贵得多。

基本设置:

set.seed(123)
opts <- 1:5
library(combinat)
## a little inefficient but functional
permn.lim <- function(x, m=length(x)) {
    tmp <- permn(x)
    if (m >= length(x)) tmp
    else unique(lapply(tmp, `[`, 1:m))
}
testfunc <- function(...) list(results=list(), continue=(runif(1) < 0.3))

运行三元组的第一次迭代。

doe3 <- permn.lim(opts, 3)
length(doe3)
## [1] 60
str(head(doe3, n=2))
## List of 2
##  $ : int [1:3] 1 2 3
##  $ : int [1:3] 1 2 5
tmp3 <- lapply(doe3, testfunc)
str(head(tmp3, n=2))
## List of 2
##  $ :List of 2
##   ..$ results : list()
##   ..$ continue: logi TRUE
##  $ :List of 2
##   ..$ results : list()
##   ..$ continue: logi FALSE
results3 <- sapply(tmp3, function(zz) zz$results)
continue3 <- sapply(tmp3, function(zz) zz$continue)
head(continue3, n=2)
## [1]  TRUE FALSE
length(doe3.continue <- doe3[continue3])
## [1] 19

results3 是每个实际测试结果的列表(据称是在testfunc), continue3 是一个 bool 向量，表示是否继续使用相应的 3 元组是合理的。用于查找目的，然后我们将 doe3 过滤为 doe3.continue。

然后我们生成下一系列实验(在本例中为 4 个)，并且根据先前存储的成功测试过滤在 doe3.continue 中。

doe4.all <- permn.lim(opts, 4)
length(doe4.all)
## [1] 120
doe4.filtered <- Filter(function(zz) list(zz[1:3]) %in% doe3.continue, doe4.all)
length(doe4.filtered)
## [1] 38
tmp4 <- lapply(doe4.filtered, testfunc)
results4 <- sapply(tmp4, function(zz) zz$results)
continue4 <- sapply(tmp4, function(zz) zz$continue)
doe4.continue <- doe4[continue4]
length(doe4.continue)
## [1] 35

可以对 opts 中的元素重复此过程。如果这是针对固定数量的级别，那么不难维护在目前的形式。如果你要用不同的方式重复这个级别的数量，那么将它变成一个就不会太难了尾递归函数，可能更精致一些。