迭代地和分层地循环遍历行，直到满足条件答案

【问题标题】：Iteratively and hierarchically cycle through rows till a condition is met迭代地和分层地循环遍历行，直到满足条件
【发布时间】：2016-11-16 10:07:41
【问题描述】：

我正在尝试解决 R 中的数据管理问题。

假设我的数据如下所示：

id <- c("123", "414", "606")
next.up <- c("414", "606", "119")
is.cond.met <- as.factor(c("FALSE", "FALSE", "TRUE"))
df <- data.frame(id, next.up, is.cond.met)

> df
   id next.up is.cond.met
1 123     414       FALSE
2 414     606       FALSE
3 606     119        TRUE

我想获得的是以下内容：

id <- c("123", "414", "606")
next.up <- c("414", "606", "119")
is.cond.met <- as.factor(c("FALSE", "FALSE", "TRUE"))
origin <- c("606", "606", "119")
df.result <- data.frame(id, next.up, is.cond.met, origin)

> df.result
   id next.up is.cond.met origin
1 123     414       FALSE    606
2 414     606       FALSE    606
3 606     119        TRUE    119

换句话说：当给定条件（is.met）为真时，我想将每个 ID 与其“原点”匹配。我遇到的困难是这是迭代和分层的：要找到原点，我可能必须经历多层次的分离。逻辑步骤如下所示。我真的不知道如何在 R 中解决这个问题。

更新
其中一个 cmets 提出了一种适用于已排序数据的 data.frame 解决方案，如上面的最小示例所示。事实上，我的数据并没有以这种方式排序。一个更好的例子如下：

id <- c("961980", "14788", "902460", "900748", "728912", "141726", "1041190", "692268")
next.up <- c("20090", "655036", "40375164", "40031850", "40368996", "961980", "141726", "760112")
is.cond.met <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)
df <- data.frame(id, next.up, is.cond.met, stringsAsFactors = FALSE)

glimpse(df)

Observations: 8
Variables: 3
$ id          <chr> "961980", "14788", "902460", "900748", "728912", "141726", "1041190", "692268"
$ next.up     <chr> "20090", "655036", "40375164", "40031850", "40368996", "961980", "141726", "760112"
$ is.cond.met <lgl> TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE
> df
       id  next.up is.cond.met
1  961980    20090        TRUE
2   14788   655036       FALSE
3  902460 40375164       FALSE
4  900748 40031850       FALSE
5  728912 40368996       FALSE
6  141726   961980       FALSE
7 1041190   141726       FALSE
8  692268   760112       FALSE

更新 2：最终结果应如下所示：

> df.end.result
       id  next.up is.cond.met origin
1  961980    20090        TRUE   <NA>
2   14788   655036       FALSE   <NA>
3  902460 40375164       FALSE   <NA>
4  900748 40031850       FALSE   <NA>
5  728912 40368996       FALSE   <NA>
6  141726   961980       FALSE 961980
7 1041190   141726       FALSE 961980
8  692268   760112       FALSE   <NA>

【问题讨论】：

您可以在示例中再添加几行吗？我不确定我是否遵循逻辑
您是否尝试匹配来自 2 个不同数据集的条目？这是我能尝试理解的唯一意义。如果是这种情况，明确说明可能会有所帮助。
@BryanGoggin 不，数据与 df 中的一样。 df.result 只显示我希望最终结果的样子。
如果您在更新示例中提到的数据存在差距，结果应该是什么？算法应该只在下一行还是在所有后续行中搜索 next.up？如果找不到 next.up，算法应该怎么做？
@George91 它应该搜索所有以下（和/或以前）行。如果未找到匹配项，则 origin==NA

标签： r loops dplyr data-manipulation tidyr

【解决方案1】：

我稍微扩展了您的示例数据，以显示is.cond.met 中更多TRUE 值会发生什么。使用 data.table 包，您可以：

library(data.table)
setDT(df)[, grp := shift(cumsum(is.cond.met), fill=0)
          ][, origin := ifelse(is.cond.met, next.up, id[.N]), by = grp][]

给出：

> df
    id next.up is.cond.met grp origin
1: 123     414       FALSE   0    606
2: 414     606       FALSE   0    606
3: 606     119        TRUE   0    119
4: 119     321       FALSE   1    321
5: 321     507        TRUE   1    507
6: 507     185        TRUE   2    185

解释：

首先使用shift(cumsum(is.cond.met), fill=0) 创建一个分组变量。
使用ifelse(is.cond.met, next.up, id[.N])，您可以将正确的值分配给origin。

注意：id 和 next.up 列应该是类字符才能使上述内容起作用（因此，我在构造扩展示例数据时使用了 stringsAsFactors = FALSE）。如果它们是因子，请先用as.character 转换它们。如果is.cond.met 还不是逻辑的，请将其转换为as.logical。

在更新的示例数据上，上面的代码给出：

        id  next.up is.cond.met grp origin
1:  961980    20090        TRUE   0  20090
2:   14788   655036       FALSE   1 692268
3:  902460 40375164       FALSE   1 692268
4:  900748 40031850       FALSE   1 692268
5:  728912 40368996       FALSE   1 692268
6:  141726   961980       FALSE   1 692268
7: 1041190   141726       FALSE   1 692268
8:  692268   760112       FALSE   1 692268

使用过的数据：

id <- c("123", "414", "606", "119", "321", "507")
next.up <- c("414", "606", "119", "321", "507", "185")
is.cond.met <- c(FALSE, FALSE, TRUE, FALSE, TRUE, TRUE)

df <- data.frame(id, next.up, is.cond.met, stringsAsFactors = FALSE)

【讨论】：

谢谢。在将代码调整为真实数据时，出现以下错误：Type of RHS ('character') must match LHS ('integer'). To check and coerce would impact performance too much for the fastest cases. Either change the type of the target column, or coerce the RHS of := yourself (e.g. by using 1L instead of 1)
@ThomasSpeidel 您是否按照我在 note 中所说的那样转换了列？
@ThomasSpeidel sapply(df, class) 的结果是什么？
我做到了。 > sapply(df.test, class) id next.up is.cond.met grp origin "character" "character" "logical" "integer" "integer"
@ThomasSpeidel 由于您呈现示例数据的方式，顺序在我上面给出的方法中确实很重要。如果您无法共享（部分）您的真实数据，您能否构建一个示例数据集以更好地模拟您的真实数据和问题？如果没有重现问题的示例，很难说出如何解决这个问题。

【解决方案2】：

所以，恕我直言，我认为如果没有交互式更新，您将无法解决它。

与@procrastinatus-maximus 类似，这里是dplyr 的迭代解决方案

library(dplyr)
dfIterated <- data.frame(df, cond.origin.node = id, 
                         cond.update = is.cond.met, stringsAsFactors = F)
initial.cond <- dfIterated$is.cond.met
while(!all(dfIterated$is.cond.met %in% c(TRUE, NA))) {
  dfIterated <- dfIterated %>% 
    mutate(cond.origin.node = if_else(is.cond.met,
                                      cond.origin.node, 
                                      next.up),
           parent.match = match(next.up, id),
           cond.update = (cond.update[parent.match] | cond.update),
           cond.origin.node = if_else(!is.cond.met & cond.update,
                                      next.up[parent.match],
                                      next.up),
           is.cond.met = cond.update)
}
# here we use ifelse instead of if_else since it is less type strict
dfIterated %>%
  mutate(cond.origin.node = ifelse(initial.cond,  
                                   yes = NA, 
                                   no  = cond.origin.node))

edit：添加起始条件；将ifelse 替换为dplyr::if_else

说明：我们反复更新dfIterated 以包含所有next.up 节点，如已建议的那样。在这里，我们对每个 id 并行执行此操作。

我们改变 cond.origin.node 并将其替换为 id if cond.is.met == TRUE 和 next.up “否则” - cond.is.met 中的 NA 值将返回 NA 值自己，这在我们的案例中非常实用.
- 然后我们计算匹配的父索引
我们更新了cond.update，我们在id 列中匹配父项。（将返回 NA 的值，即在 id 中没有匹配项，将被 NA 替换。）我们使用 |（或）运算符，如果有以前的 @987654340，fortunetaley 将返回 TRUE == (TRUE | NA) @进入cond.update
然后我们需要计算 TRUE 条件的原始节点。
然后更新is.cond.met中的条件
重复所有操作，直到我们的 is.cond.met 仅包含 TRUEs 或 NAs。 orgin 将包含具有cond.is.met == TRUE 的节点

以上示例的输出如下所示：

> dfIterated
       id  next.up is.cond.met cond.origin.node cond.update
1  961980    20090        TRUE             <NA>        TRUE
2   14788   655036          NA             <NA>          NA
3  902460 40375164          NA             <NA>          NA
4  900748 40031850          NA             <NA>          NA
5  728912 40368996          NA             <NA>          NA
6  141726   961980        TRUE           961980        TRUE
7 1041190   141726        TRUE           961980        TRUE
8  692268   760112          NA             <NA>          NA

希望这会有所帮助！正向查找将以类似的方式工作。进一步的改进取决于您想要保留什么样的结果（例如，您真的要覆盖is.cond.met 吗？）

【讨论】：

这几乎是我想要的，除了第 1 行应该评估为缺失，因为一旦满足条件，origin 不应该评估为 next.up。看我的更新。这应该很容易解决。我的数据很大，所以我希望这种方法很快！我会根据真实数据进行测试并报告。
有趣的是，修复并不是那么微不足道 :-) 因为它会破坏算法的假设——但幸运的是我们可以将它存储在开头并替换原点最后相应地。（在代码中进行的编辑）。额外的存储复杂度在 O(2n) 中，因为我们只需要 3+3 个额外的列 - 这意味着如果您加载 dplyr::if_else而不是ifelse进行更快的处理。算法应该在到达最深节点后停止。
顺便说一句，如果您的数据超过 10 GB，您可以切换到 data.table。它肯定会更快 - 原理将保持不变，但语法会有所不同。
更新：我仍然对建议的代码有问题。它在示例中运行良好。但是，它在实际数据上并没有按预期工作。我很难理解为什么。
由于赏金即将到期，我将把它奖励给@Drey，因为他的解决方案让我最接近我想要实现的目标。

【解决方案3】：

我希望我正确理解了您的问题，并在此遵循我的观点。您似乎试图根据数据表解决网络问题。我建议以下公式。

我们有一个网络，定义为一组边（列id 和next.up 对应于vertex_from 和vertex_to）。网络是一组树。列is.cond.met 映射作为端点或树根的顶点。不考虑具有未映射根的树。

我稍微修改了您的 MRE 以使其更具示范性。

id <- c("961980", "14788", "902460", "900748", "728912", "141726", "1041190", "692268", "40368996", "555555", "777777")
next.up <- c("20090", "655036", "40375164", "40031850", "40368996", "961980", "141726", "760112", "692268", "760112", "555555")
is.cond.met <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE)
dt <- data.table(id, next.up, is.cond.met, stringsAsFactors = FALSE)

现在让我们将所有内容翻译成图形语言。

library(data.table)
library(magrittr)
library(igraph)

graph_from_edgelist(as.matrix(dt[, 1:2, with = F])) -> dt_graph
V(dt_graph)$color <- ifelse(V(dt_graph)$name %in% dt[is.cond.met == T]$next.up, "green", "yellow")
E(dt_graph)$arrow.size <- .7
E(dt_graph)$width <- 2
plot(dt_graph, edge.color = "grey50")

我们有以下图表。

绿色顶点是映射的根——让我们将它们命名为树根。它们的第一阶邻居是每棵树的大主枝的根——让它们成为枝根。问题是对于初始数据id列中的每个顶点找出对应的分支根。

treeroots <- dt[is.cond.met == T]$next.up %>% unique
lapply(V(dt_graph)[names(V(dt_graph)) %in% treeroots], 
       function(vrtx) neighbors(dt_graph, vrtx, mode = "in")) -> branchroots

借助igraph 包中的ego 函数，我们可以找到下放到每个分支根的所有顶点。

lapply(seq_along(branchroots), function(i) {
  data.table(tree_root = names(branchroots[i]), branch_root = branchroots[[i]]$name)
}) %>% rbindlist() -> branch_dt

branch_dt[, trg_vertices := ego(dt_graph, order = 1e9, 
                                V(dt_graph)[names(V(dt_graph)) %in% branch_dt$branch_root], 
                                mode = "in", mindist = 1) %>% lapply(names)]

branch_dt
#    tree_root branch_root    trg_vertices
# 1:     20090      961980  141726,1041190
# 2:    760112      692268 40368996,728912
# 3:    760112      555555          777777

之后我们可以创建origin 列。

sapply(seq_along(branch_dt$branch_root), 
       function(i) rep(branch_dt$branch_root[i], 
                       length(branch_dt$trg_vertices[[i]]))) %>% unlist -> map_vertices
branch_dt$trg_vertices %>% unlist() -> map_names
names(map_vertices) <- map_names

dt[, origin := NA_character_]
dt[id %in% map_names, origin := map_vertices[id]]
dt
#           id  next.up is.cond.met origin
#  1:   961980    20090        TRUE     NA
#  2:    14788   655036       FALSE     NA
#  3:   902460 40375164       FALSE     NA
#  4:   900748 40031850       FALSE     NA
#  5:   728912 40368996       FALSE 692268
#  6:   141726   961980       FALSE 961980
#  7:  1041190   141726       FALSE 961980
#  8:   692268   760112        TRUE     NA
#  9: 40368996   692268       FALSE 692268
# 10:   555555   760112       FALSE     NA
# 11:   777777   555555       FALSE 555555

为方便起见，我将生成的代码整理成一个函数。

add_origin <- function(dt) {
  require(data.table)
  require(magrittr)
  require(igraph)

  setDT(dt)
  graph_from_edgelist(as.matrix(dt[, .(id, next.up)])) -> dt_graph

  treeroots <- dt[is.cond.met == T]$next.up %>% unique

  lapply(V(dt_graph)[names(V(dt_graph)) %in% treeroots], 
         function(vrtx) neighbors(dt_graph, vrtx, mode = "in")) -> branchroots

  lapply(seq_along(branchroots), function(i) {
    data.table(tree_root = names(branchroots[i]), branch_root = branchroots[[i]]$name)
  }) %>% rbindlist() -> branch_dt

  branch_dt[, trg_vertices := rep(list(NA), nrow(branch_dt))][]
  vertices_on_branch <- ego(dt_graph, order = 1e9, 
                            V(dt_graph)[names(V(dt_graph)) %in% branch_dt$branch_root], 
                            mode = "in", mindist = 1) %>% lapply(names)
  set(branch_dt, j = "trg_vertices", value = list(vertices_on_branch))

  sapply(seq_along(branch_dt$branch_root),
         function(i) rep(branch_dt$branch_root[i], 
                         length(branch_dt$trg_vertices[[i]]))) %>% unlist -> map_vertices
  branch_dt$trg_vertices %>% unlist() -> map_names
  names(map_vertices) <- map_names

  dt[, origin := NA_character_]
  dt[id %in% map_names, origin := map_vertices[id]]
  dt[]
}

对于您的 MRE，它会产生所需的输出。

df0 <- data.frame(id = c("961980", "14788", "902460", "900748", "728912", "141726", "1041190", "692268"),
                  next.up = c("20090", "655036", "40375164", "40031850", "40368996", "961980", "141726", "760112"),
                  is.cond.met = c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE), stringsAsFactors = FALSE)

df0 %>% add_origin

#         id  next.up is.cond.met origin
# 1:  961980    20090        TRUE     NA
# 2:   14788   655036       FALSE     NA
# 3:  902460 40375164       FALSE     NA
# 4:  900748 40031850       FALSE     NA
# 5:  728912 40368996       FALSE     NA
# 6:  141726   961980       FALSE 961980
# 7: 1041190   141726       FALSE 961980
# 8:  692268   760112       FALSE     NA

所描述的方法应该比循环内data.frame 的迭代更新快得多。

【讨论】：