r - 比 "while"循环更快的方法来找到R中的感染链

我正在分析存储疾病模拟模型输出的数据的大型表(30万至50万行)。在模型中，景观动物会感染其他动物。例如，在下图所示的示例中，动物 a1 感染了景观上的每只动物，并且感染在动物之间转移，并分支成感染的“链”。

在下面的示例中，我想要获取存储有关每种动物的信息的表(在下面的示例中，table = allanimals)，并仅切出有关动物 d2 的感染链的信息(我突出显示了 d2 的链为绿色)，这样我就可以计算出该感染链的平均栖息地值(value)。

尽管我的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

最佳答案

因此，这里的问题在于您的数据结构。您将需要一个向量来存储谁感染了谁(将who保持为整数):

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重新编码此循环:')

关于r - 比 "while"循环更快的方法来找到R中的感染链，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/45865242/