在 R 中查找感染链的方法比“while”循环更快

Question

我正在分析存储由疾病模拟模型输出的数据的大表（300 000 - 500 000 行）。在模型中，景观中的动物会感染其他动物。例如，在下图中的示例中，动物a1感染了景观中的每只动物，并且感染从动物移动到动物，分支为感染“链”。

在下面的示例中，我想获取存储有关每只动物的信息的表（在下面的示例中， table = allanimals）并仅切出有关 Animald2感染链的信息（我已将d2's 链突出显示为绿色）这样我就可以计算出该感染链的平均栖息地价值。

虽然我的 while 循环有效，但当表存储数十万行并且链有 40-100 个成员时，它就像糖蜜一样缓慢。

关于如何加快速度的任何想法？希望得到tidyverse解决。我知道我的示例数据集“看起来足够快”，但我的数据确实很慢......

示意图：

以下示例数据的所需输出：

   AnimalID InfectingAnimal habitat
1        d2              d1       1
2        d1              c3       1
3        c3              c2       3
4        c2              c1       2
5        c1              b3       3
6        b3              b2       6
7        b2              b1       5
8        b1              a2       4
9        a2              a1       2
10       a1               x       1

示例代码：

library(tidyverse)

# make some data
allanimals <- structure(list(AnimalID = c("a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8",
"b1", "b2", "b3", "b4", "b5", "c1", "c2", "c3", "c4", "d1", "d2", "e1", "e2",
"e3", "e4", "e5", "e6", "f1", "f2", "f3", "f4", "f5", "f6", "f7"),
InfectingAnimal = c("x", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a2", "b1",
"b2", "b3", "b4", "b3", "c1", "c2", "c3", "c3", "d1", "b1", "e1", "e2", "e3",
"e4", "e5", "e1", "f1", "f2", "f3", "f4", "f5", "f6"), habitat = c(1L, 2L, 1L,
2L, 2L, 1L, 3L, 2L, 4L, 5L, 6L, 1L, 2L, 3L, 2L, 3L, 2L, 1L, 1L, 2L, 5L, 4L,
1L, 1L, 1L, 1L, 4L, 5L, 4L, 5L, 4L, 3L)), .Names = c("AnimalID",
"InfectingAnimal", "habitat"), class = "data.frame", row.names = c(NA, -32L))

# check it out
head(allanimals)

# Start with animal I'm interested in - say, d2
Focal.Animal <- "d2"

# Make a 1-row data.frame with d2's information
Focal.Animal <- allanimals %>% 
  filter(AnimalID == Focal.Animal)

# This is the animal we start with
Focal.Animal

# Make a new data.frame to store our results of the while loop in
Chain <- Focal.Animal

# make a condition to help while loop
InfectingAnimalInTable <- TRUE

# time it 
ptm <- proc.time()

# Run loop until you find an animal that isn't in the table, then stop
while(InfectingAnimalInTable == TRUE){
    # Who is the next infecting animal?
    NextAnimal <- Chain %>% 
      slice(n()) %>% 
      select(InfectingAnimal) %>% 
      unlist()

    NextRow <- allanimals %>% 
      filter(AnimalID == NextAnimal)


    # If there is an infecting animal in the table, 
    if (nrow(NextRow) > 0) {
      # Add this to the Chain table
      Chain[(nrow(Chain)+1),] <- NextRow
      #Otherwise, if there is no infecting animal in the  table, 
      # define the Infecting animal follows, this will stop the loop.
    } else {InfectingAnimalInTable <- FALSE}
  }

proc.time() - ptm

# did it work? Check out the Chain data.frame
Chain

Answer 1

所以这里的问题在于你的数据结构。您将需要一个向量来存储谁被谁感染（将谁保留为整数）：

allanimals_ID <- unique(c(allanimals$AnimalID, allanimals$InfectingAnimal))

infected <- rep(NA_integer_, length(allanimals_ID))
infected[match(allanimals$AnimalID, allanimals_ID)] <-
  match(allanimals$InfectingAnimal, allanimals_ID)

path <- rep(NA_integer_, length(allanimals_ID))
curOne <- match("d2", allanimals_ID)
i <- 1
while (!is.na(nextOne <- infected[curOne])) {
  path[i] <- curOne
  i <- i + 1
  curOne <- nextOne
}

allanimals[path[seq_len(i - 1)], ]

为了获得额外的性能提升，请使用 Rcpp 重新编码此循环:')