Tidygraph: подсчитать итоги ребенка на родительском уровне

Question

Используя пакет tidygraph в R, учитывая дерево, я хотел бы вычислить среднее значение, сумму, дисперсию... значения для каждого из прямых потомков каждого узла в дереве.

Моя интуиция заключается в использовании map_bfs_back_dbl или связанные и пытались изменить пример справки, но я застрял

library(tidygraph)

# Collect values from children
create_tree(40, children = 3, directed = TRUE) %>%
  mutate(value = round(runif(40)*100)) %>%
  mutate(child_acc = map_bfs_back_dbl(node_is_root(), .f = function(node, path, ...) {
    if (nrow(path) == 0) .N()$value[node]
    else {
      sum(unlist(path$result[path$parent == node]))
    }
  }))

За выше, я хотел бы среднее value для всех прямых, первого уровня, потомков каждого родителя в дереве.

Обновление:: Я попробовал этот подход (который вычисляет дисперсию дочернего атрибута):

library(tidygraph)
create_tree(40, children = 3, directed = TRUE) %>%
  mutate(parent = bfs_parent(),
         value = round(runif(40)*100)) %>% 
  group_by(parent) %>%
  mutate(var = var(value))

Что чертовски близко:

# Node Data: 40 x 3 (active)
# Groups:    parent [14]
  parent value   var
*  <int> <dbl> <dbl>
1     NA  2.00    NA
2      1 13.0   1393
3      1 63.0   1393
4      1 86.0   1393
5      2 27.0    890
6      2 76.0    890
# ... with 34 more rows

То, что я хотел бы видеть, это что-то вроде:

# Node Data: 40 x 3 (active)
# Groups:    parent [14]
  parent value   var  child_var
*  <int> <dbl> <dbl>      <dbl>
1     NA  2.00    NA       1393
2      1 13.0   1393        890 
3      1 63.0   1393       (etc)
4      1 86.0   1393
5      2 27.0    890
6      2 76.0    890
# ... with 34 more rows

Который перемещает (первое) значение "var" вверх к узлу, идентифицированному значением "parent". Помогите? Предложения?

Изменить: это то, что я сделал в конечном итоге:

tree <- create_tree(40, children = 3, directed = TRUE) %>%
  mutate(parent = bfs_parent(),
         value = round(runif(40) * 100),
         name = row_number()) %>%
  activate(nodes) %>%
  left_join(
    tree %>%
      group_by(parent) %>%
      mutate(var = var(value)) %>% activate(nodes) %>% as_tibble() %>%
      group_by(parent) %>% summarize(child_stat = first(var)),
    by=c("name" = "parent")
  )

Чувствуется не очень-тидограф, но, кажется, работает. Открыт для оптимизации.

Answer 1

Я попробовал "тидиографический" способ делать вещи здесь. Основная функция для вычисления дисперсии value колонка:

calc_child_stats <- function(neighborhood, ...){
  ## By default the neighborhood includes the parent and all of it's children
  ## First remove the parent, then run analysis
  neighborhood %>% activate(nodes) %>% 
    slice(-1) %>% 
    select(value) %>% 
    pull %>% 
    var
}

Если у вас есть эта функция, то это простой вызов map_local вместо map_bfs как вы пытались:

tree <- create_tree(40, children = 3, directed = TRUE) %>%
  mutate(value = round(runif(40)*100))

tree %>% mutate(var = map_local_dbl(order = 1, mode="out", .f = calc_child_stats))
#> # A tbl_graph: 40 nodes and 39 edges
#> #
#> # A rooted tree
#> #
#> # Node Data: 40 x 2 (active)
#>   value   var
#>   <dbl> <dbl>
#> 1    29  34.3
#> 2    45 433  
#> 3    56 225. 
#> 4    47 868  
#> 5    78 604. 
#> 6    43 283  
#> # ... with 34 more rows
#> #
#> # Edge Data: 39 x 2
#>    from    to
#>   <int> <int>
#> 1     1     2
#> 2     1     3
#> 3     1     4
#> # ... with 36 more rows

В то время как моя версия тидиграфа более "графическая", она не выглядит очень быстрой, поэтому я создал быстрый тест микробенчмаркинга между двумя методами:

library(microbenchmark)
microbenchmark(tree %>% mutate(var = map_local_dbl(order = 1, mode="out", .f = calc_child_stats)))
#> Unit: milliseconds
#>                                                                                       expr
#>  tree %>% mutate(var = map_local_dbl(order = 1, mode = "out",      .f = calc_child_stats))
#>       min       lq     mean   median      uq      max neval
#>  115.3325 123.0303 127.7889 126.6683 130.057 191.6065   100
microbenchmark(calc_child_stats_dplyr(tree))
#> Unit: milliseconds
#>                          expr      min       lq     mean   median       uq
#>  calc_child_stats_dplyr(tree) 4.915917 5.213939 6.292579 5.573978 6.717745
#>       max neval
#>  16.72846   100

Создано в 2018-06-15 пакетом представлением (v0.2.0).

Конечно, путь dplyr намного быстрее, поэтому я бы придерживался этого пока. Они оба дали одинаковые значения в моем тесте.

Для полноты, это был fxn, который я использовал, копируя метод op:

calc_child_stats_dplyr <- function(tree){
  tree <- tree %>%
    mutate(parent = bfs_parent(),
           name = row_number())

  tree %>% activate(nodes) %>%
    left_join(
      tree %>%
        group_by(parent) %>%
        mutate(var = var(value)) %>% 
        activate(nodes) %>% 
        as_tibble() %>%
        group_by(parent) %>% 
        summarize(child_stat = first(var)),
      by=c("name" = "parent")
    )
}