data frame ggplot2

Iterativa y jerárquicamente ciclo a través de filas hasta que se cumpla una condición

Question

Estoy tratando de resolver un problema de administración de datos en R.

Supongamos que mi información se ve de la siguiente manera:

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

Y me gustaría obtener es lo siguiente:

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

En otras palabras: quiero hacer coincidir cada ID con su "origen" cuando una condición dada (is.met) es verdadera. La dificultad que tengo es que esto es iterativo y jerárquico: para encontrar el origen puedo tener que atravesar múltiples grados de separaciones. los pasos lógicos se ilustran a continuación. Realmente no estoy seguro de cómo abordar esto en R.

ACTUALIZAR
Uno de los comentarios propone una solución de data.frame que funciona para datos ordenados, como en el ejemplo mínimo anterior. En verdad, mis datos no están ordenados de esa manera. Un mejor ejemplo es el siguiente:

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

ACTUALIZACIÓN 2 : el resultado final debería verse así:

> 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>

Answer 1

Entonces, imho, creo que no puedes resolverlo sin una actualización interactiva.

Similar a @ procrastinatus-maximus aquí hay una solución iterativa con 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))

editar : condición de inicio añadida; reemplazado dplyr::if_else por dplyr::if_else

Explicación : actualizamos iterativamente el dfIterated para incluir todos los nodos next.up como ya se sugirió. Aquí lo hacemos para cada id en paralelo.

1. Cambiamos cond.origin.node y lo reemplazamos por id si cond.is.met == TRUE y con next.up "de lo contrario" - los valores de NA en cond.is.met devolverán los valores de NA sí mismos, lo cual es muy práctico en nuestro caso.
   • Luego calculamos el índice parental correspondiente
2. Actualizamos el cond.update donde hacemos coincidir el padre en la columna id . (Los valores que devolverán NA, es decir, no hay coincidencias en la id , serán reemplazados por NA .) Y usamos | (o) operador que fortunetaley devolverá TRUE == (TRUE | NA) si hay entrada TRUE anterior en cond.update
3. Entonces necesitamos calcular el nodo de origen para la condición TRUE .
4. Y luego upde la condición en is.cond.met
5. Repite todo hasta que nuestro is.cond.met consista únicamente en TRUE s o NA s. El orgin contendrá nodos para los que el cond.is.met == TRUE

El resultado del ejemplo anterior se ve así:

> 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

¡Espero que esto ayude! Una búsqueda hacia adelante funcionaría de manera similar. Las mejoras adicionales dependen del tipo de resultados que desee conservar (por ejemplo, ¿realmente desea sobrescribir is.cond.met ?)

Answer 2

Espero haber entendido tu problema correctamente y aquí sigue mi punto de vista. Parece que intentas resolver un problema de red en términos de tablas de datos. Sugiero la siguiente formulación.

Tenemos una red, definida como un conjunto de bordes (las columnas id y next.up corresponden a vertex_from y vertex_to ). La red es un conjunto de árboles. La columna is.cond.met mapea vértices que son puntos finales o las raíces de los árboles. Los árboles con raíz no asignada no se tienen en cuenta.

He modificado ligeramente tu MRE para hacerlo más demostrativo.

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)

Ahora permitamos traducir todo al lenguaje de los gráficos.

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")

Tenemos el siguiente gráfico.

Los vértices verdes son raíces mapeadas, llamémoslos treeroots. Sus vecinos del orden fisrt son las raíces de las grandes ramas principales de cada árbol, déjalos ser branchroots. El problema es que para cada columna de vértices en id de los datos iniciales, averigüe la raíz branchroot correspondiente.

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

Podemos encontrar todos los vértices descendiendo a cada branchroot con la ayuda de la función ego del paquete igraph .

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

Después de eso, podemos crear la columna de 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

Por conveniencia, arreglé el código resultante en una función.

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[]
}

Para su MRE produce la salida deseada.

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

El enfoque descrito debería ser significativamente más rápido que la actualización iterativa de un data.frame dentro de un bucle.

Answer 3

He ampliado un poco los datos de ejemplo para mostrar lo que sucede con más valores TRUE en is.cond.met . Usando el paquete data.table , podrías hacer:

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

lo que da:

> 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

Explicación:

1. shift(cumsum(is.cond.met), fill=0) una variable de agrupación con shift(cumsum(is.cond.met), fill=0) .
2. Con ifelse(is.cond.met, next.up, id[.N]) asigna los valores correctos al origin .

Nota: Las columnas id y next.up deberían ser de carácter de clase para que funcione lo anterior (por esa razón utilicé stringsAsFactors = FALSE en la construcción de los datos de ejemplo extendidos). Si son factores, as.character primero con as.character . Si is.cond.met no es ya una lógica, as.logical con as.logical .

En los datos de ejemplo actualizados, el código anterior ofrece:

        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

Datos usados:

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)