用 lapply 矢量化嵌套循环

Question

我正在尝试对拓扑排序进行矢量化以加快运行速度
其中一部分是带有嵌套for 的while。我在矢量化时遇到问题。 这个函数的思想是对相互依赖的任务进行排序

这是我目前的代码：

tsort <- function(deps) {
  nm <- names(deps)
  libs <- union(as.vector(unlist(deps)), nm)
  s <- c()
  s <- unlist(lapply(libs,function(x){
    if(!(x %in% nm)) {
      s <- c(s, x)
    }
  }))
  k <- 1
  while(k > 0) {
    k <- 0
    for(x in setdiff(nm, s)) {
      r <- c(s, x)
      if(length(setdiff(deps[[x]], r)) == 0) {
        s <- r
        k <- 1
      }
    }
  }
  if(length(s) < length(libs)) {
    v <- setdiff(libs, s)
    stop(sprintf("Unorderable items :\n%s", paste("", v, sep="", collapse="\n")))
  }
  s
}

这里是一个可以用函数排序的相互依赖的任务列表：

tasks <- list(
"seven" = c("eight", "nine", "ten", "seven", "five", "one", "eleven", "two"),
"one" = c("two", "one", "three", "four"),
"five" = c("two", "five", "three"),
"six" = c("eight", "nine", "three", "six", "five", "one", "two", "four"),
"twelve" = c("twelve", "two", "one", "three", "four"),
"thirteen" = c("thirteen", "two", "three"),
"fourteen" = c("fourteen", "two", "three"),
"fifteen" = c("two", "three"),
"three" = c("two", "three"),
"four" = c("two", "four"),
"eleven" = c("eight", "two"),
"ten" = c("two", "ten"),
"nine" = c())

我要矢量化的部分是：

k <- 1
while(k > 0) {
  k <- 0
  for(x in setdiff(nm, s)) {
    r <- c(s, x)
    if(length(setdiff(deps[[x]], r)) == 0) {
      s <- r
      k <- 1
    }
  }
}

我发现很难对函数的主要部分进行矢量化，其中我有一个 for 和一个 while 一起

Answer 1

首先，看一下包igraph，它有一个函数topological.sort()。它提供了更多处理图的功能，并且每个需要拓扑排序的问题通常都可以用图重新表述。

我不完全确定您的代码是否正确排序。您有两个级别的循环：内部循环遍历所有在 nm 中但不在 s 中的 x。外部循环是一个 while 循环，并再次启动该过程。

每次通过内部循环时，您都会考虑之前通过的结果。这导致了一个有趣的结果：虽然“十三”、“十四”和“十五”不包含与“五”或“一”和“六”的连接，但“六”仍然在拓扑上排序在任何一个之前其他。那是因为在“一”和“五”之后添加了“六”，但在同一个循环中。

这种行为——如果正确的话——不能以任何方式向量化。但是，据我了解，“十三”、“十四”和“十五”应该排在“六”之前而不是之后。

也就是说，您在感兴趣的部分上方有一个非常简单的矢量化：

   s <- unlist(lapply(libs,function(x){
     if(!(x %in% nm)) {
       s <- c(s, x)
     }
  }))

实际上只不过是s <- setdiff(libs,nm)。另外，您在那里所做的分配没有意义，因为来自s <- c(s,x) 的s 是在lapply 的本地环境中创建的，并且对外部s 没有任何影响。它所做的一切，与invisible(x) 完全相同。

如果您想以如下方式进行矢量化：

• 遍历解决方案中尚未包含的所有名称，并检查它们的集合是否涵盖解决方案中的所有内容
• 将正确的名称添加到解决方案中
• 重复直到所有名称都在解决方案中

您可以使用下面的代码。请注意我如何预先分配内存空间来保存解决方案。这种预分配节省了相当多的内存操作。就像在代码中一样，在 R 中增加对象是在浪费资源。

另外请注意，由于上述原因，我的代码将给出与您的代码不同的顺序。

tsort2 <- function(deps) {
  nm <- names(deps)
  libs <- union(as.vector(unlist(deps)), nm)
  s <- setdiff(libs,nm) 

  #Preallocation
  out <- vector(mode(libs),length(libs))
  out[seq_along(s)] <- s

  x <- setdiff(nm,s)
  lpos <- length(s)

  # go over all x and check which ones contain all names in the 
  # current solution.
  # Add these names to the solution
  # remove these names from x
  # repeat until x is empty
  while(length(x) > 0){
    tmp <- out[seq_len(lpos)]
    id <- sapply(x, function(i){
       length(setdiff(deps[[i]],c(i,tmp))) == 0
    } )
    id <- which(id)
    lid <- length(id)
    idout <- seq(lpos+1,length.out=lid)
    out[idout] <- x[id]
    x <- x[-id]
    lpos <- lpos + lid
  }

  if(length(out) < length(libs)) {
    v <- setdiff(libs, out)
    stop(sprintf("Unorderable items :\n%s", paste("", v, sep="", collapse="\n")))
  }
  out
}