Эффективного способ преобразования набора ребер графа в дневной «напечатанный» дерево

Question

Проблемы:

Я пытаюсь взять набор ребер графа сохраняется следующим образом:

my $edges = { 
    # Parent => set_of_children 
    1 => [ 2, 6, 8 ], 
    2 => [ 6 ], 
    6 => [ 7 ], 
}; 

И преобразуйте его в полномасштабное дерево (конечный вывод JSON, но я отлично согласен с Perl-эквивалентной структурой данных, которую могу подавать на кодирование модуля JSON)

my $full_tree = { 
    node => 1, 
    children => [ 
     { 
      node => 2, 
      children => [ # Subtree expanded right here. List children 
       { 
        node => 6, 
        children => [ 
         { node => 7 }, # Leaf level, no children 
        ], 
       }, # End Node 6 
      ], 
     }, # End Node 2 
     { 
      node => 6, 
      children => [ 
       { node => 7 }, # IMPORTANT: Again expanding node #6! 
      ], 
     }, # End Node 6 
     { 
      node => 8, 
     }, # Leaf level, no children 
    ], 
}; 

Обратите внимание на важные детали:

• Если узел встречается в дереве, мы выводим ПОЛНЫЙ поддерево для него
• Если узел встречается в дереве> 1 раз, мы выводим полную копию поддерева в каждом месте (свидетельский узел 6).

То, что я пытался:

Я попробовал очевидное (рекурсивно печать - я даже не буду размещать код здесь, так как рекурсивное решение Алгоритмы и структуры данных 101 материалов).

Что мне нужно помочь с:

В Perl, вызовы подпрограмм имеют затраты. Для очень большого дерева (6 цифр # узлов, с большим количеством узлов в нескольких местах), я буду платить штраф производительности как:

1. Having пересчитывать множественные, протекающие узлы.

   Возможно, это может быть исправлено с помощью memoization.

2. Исполнение штрафов за стеки по стопкам вызовов подпрограмм.

   Как таковой, мне было интересно, существует ли хороший подход Perl для печати нужной структуры данных БЕЗ отказоустойчивого алгоритма, реализованного посредством рекурсии реальной подпрограммы. Какой-то тип DFS/BFS, полученный в виде цикла, будет моим догадком, но я не эксперт по алгоритмам дерева, поэтому не знал бы, как подойти к нему.

   Общий набор специфических для Perl алгоритмов/рекомендаций по структуре данных достаточен, мне не нужен полный рабочий код как таковой.

   Производительность несколько важна для крупногабаритных.

Answer 1

Если у вас есть только структура данных, подобная той, которая у вас есть, вы можете совершить обход дерева без рекурсии. Просто следуйте этому алгоритму, удерживая только две переменные: i (текущий узел, начиная с $i=1) и p (узел, на котором вы были ранее, начиная с $p = undef).

Если предыдущий узел был дочерним элементом текущего узла, перейдите к следующему дочернему объекту, если следующий ребенок существует, в противном случае (т.если следующий ребенок не существует) перейдите к родительскому узлу. Если предыдущий узел не был дочерним элементом текущего узла, перейдите к первому потомку.

Следуя приведенному выше алгоритму, вы перемещаете все дерево только с двумя переменными состояния.

Answer 2

Для обсуждения. Вот одно из возможных решений.

Он строит плоский хеш, который содержит ориентированный граф, показывающий только родительские узлы и уходящих детей.

Второй проход проходит по списку и создает структуру для печати.

use warnings; use strict; 
use JSON; 

my $edges = { 
    # Parent => set_of_children                       
    1 => [ 2, 6, 8 ], 
    2 => [ 6 ], 
    6 => [ 7 ], 
}; 

my %graph; 

foreach my $this_node (sort keys %$edges) { 

    my @children = @{ $edges->{$this_node} }; 

    # autovivify this node and it's children                    
    $graph{ $_ } //= { node => $_ } 
     for ($this_node, @children); 

    # link up children                          
    $graph{ $this_node }{children} = [ map { $graph{ $_ } } @children ]; 
} 

my $tree = build_tree($graph{1}); 

print to_json $tree, {pretty => 1}; 

######################################################################## 

sub build_tree { 
    my $node = shift; 
    my %tree = (node => $node->{node}); 

    if (my $children = $node->{children}) { 
     $tree{children} = [ map {build_tree($_)} @$children ]; 
    } 

    return \%tree; 
} 

Выход:

{ 
    "children" : [ 
     { 
     "children" : [ 
      { 
       "children" : [ 
        { 
        "node" : "7" 
        } 
       ], 
       "node" : "6" 
      } 
     ], 
     "node" : "2" 
     }, 
     { 
     "children" : [ 
      { 
       "node" : "7" 
      } 
     ], 
     "node" : "6" 
     }, 
     { 
     "node" : "8" 
     } 
    ], 
    "node" : "1" 
} 

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

Answer 3

Я не знаю, какую магию вы ожидаете найти здесь. Вы говорите, что рекурсивное решение - это алгоритмы 101, поэтому даже не стоит публиковать сообщения, но какое другое решение вы ожидаете найти?

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

use strict; 
use warnings; 

use JSON; 

my $edges = { 
    1 => [ 2, 6, 8 ], 
    2 => [ 6 ], 
    6 => [ 7 ], 
}; 

sub buildtree { 
    my ($edges, $cached, $current, @past) = @_; 

    die "Circular call for $current in @past" 
     if grep {$current eq $_} @past; 

    return $cached->{$current} ||= { 
     node => $current, 
     ($edges->{$current} ? (children => [ 
      map {buildtree($edges, $cached, $_, $current, @past)} @{$edges->{$current}} 
     ]) :()), 
    }; 
} 

my $tree = buildtree($edges, {}, 1); 

print to_json($tree, {pretty => 1}); 

Выходы:

{ 
    "node" : "1", 
    "children" : [ 
     { 
     "children" : [ 
      { 
       "node" : "6", 
       "children" : [ 
        { 
        "node" : "7" 
        } 
       ] 
      } 
     ], 
     "node" : "2" 
     }, 
     { 
     "node" : "6", 
     "children" : [ 
      { 
       "node" : "7" 
      } 
     ] 
     }, 
     { 
     "node" : "8" 
     } 
    ] 
} 

Если вы не хотите кэшировать результаты, то все, что нужно сделать, это измените значение ||= на простое назначение =.