У меня есть DAG, выраженная в виде узлов и их преемников. Реализовать его как вложенную структуру данных можно с помощью простой рекурсивной функции.
#tree1.pl
#!/usr/bin/env perl
use 5.028; use strictures; use Moops; use Kavorka qw(fun); use List::AllUtils qw(first);
class Node :ro {
has label => isa => Str;
has children => isa => ArrayRef[Str];
}
fun N($label, $children) {
return Node->new(label => $label, children => $children);
}
# list is really flat, but
# indentation outlines desired tree structure
our @dag = (
N(N0 => ['N1']),
N(N1 => ['N2']),
N(N2 => ['N3']),
N(N3 => ['N4', 'N5']),
N(N4 => []),
N(N5 => []),
);
fun tree(Node $n) {
return bless [
map {
my $c = $_;
tree(first {
$_->label eq $c
} @dag)
} $n->children->@*
] => $n->label;
}
tree($dag[0]);
# bless([ #N0
# bless([ #N1
# bless([ #N2
# bless([ #N3
# bless([] => 'N4'),
# bless([] => 'N5'),
# ] => 'N3')
# ] => 'N2')
# ] => 'N1')
# ] => 'N0')
Это был тривиальный случай.
В моем приложении возникает сложность, заключающаяся в том, что группа обеспечения доступности баз данных содержит несколько узлов с одинаковой меткой.
our @dag = (
N(N0 => ['N1']),
N(N1 => ['N2']),
︙
N(N1 => ['N6', 'N5']),
︙
Обратите внимание, что это не означает, что в собственном смысле существует многоугольник.
Это неправильно, потому что теперь N1 имеет трех равных детей.
Узлы N1 не должны быть объединены в один узел для целей обхода графа, только для маркировки выходного дерева; другими словами, эти узлы должны иметь различную идентичность. Давайте представим это с помощью цветов.
our @dag = (
N(N0 => ['N1']),
N([N1 => 'red'] => ['N2']),
︙
N([N1 => 'blue'] => ['N6', 'N5']),
︙
Цель состоит в том, чтобы преобразовать этот DAG в два дерева. Следуйте за каждым пунктирным краем преемника в отдельных проходах. Я достигаю этого, запоминая номер индекса одного цвета на узле, когда я прохожу его, и во время построения следующего дерева я выбираю следующий цвет по порядку.
#tree2.pl
#!/usr/bin/env perl
use 5.028; use strictures; use Moops; use Kavorka qw(fun); use List::AllUtils qw(first);
class Node :ro {
has label => isa => Str;
has col => isa => Maybe[Str];
has children => isa => ArrayRef[Str];
has col_seen => is => 'rw', isa => Int;
}
fun N($c_l, $children) {
return ref $c_l
? Node->new(label => $c_l->[0], col => $c_l->[1], children => $children)
: Node->new(label => $c_l, children => $children);
}
# indentation outlines desired tree structure
our @dag = (
### start 1st tree
N(N0 => ['N1']),
N([N1 => 'red'] => ['N2']),
N(N2 => ['N3']),
N(N3 => ['N4', 'N5']),
N(N4 => []),
N(N5 => []),
### end 1st tree
### start 2nd tree
# N0
N([N1 => 'blue'] => ['N6', 'N5']),
N(N6 => ['N7']),
N(N7 => ['N4']),
# N4
# N5
### end 2nd tree
);
fun tree(Node $n) {
return bless [
map {
my $c = $_;
my @col = map { $_->col } grep { $_->label eq $c } @dag;
if (@col > 1) {
$n->col_seen($n->col_seen + 1);
die 'exhausted' if $n->col_seen > @col;
tree(first {
$_->label eq $c && $_->col eq $col[$n->col_seen - 1]
} @dag);
} else {
tree(first { $_->label eq $c } @dag);
}
} $n->children->@*
] => $n->label;
}
tree($dag[0]);
# bless([ #N0
# bless([ #N1
# bless([ #N2
# bless([ #N3
# bless([] => 'N4'),
# bless([] => 'N5')
# ] => 'N3')
# ] => 'N2')
# ] => 'N1')
# ] => 'N0')
tree($dag[0]);
# bless([ #N0
# bless([ #N1
# bless([ #N6
# bless([ #N7
# bless([] => 'N4')
# ] => 'N7')
# ] => 'N6'),
# bless([] => 'N5')
# ] => 'N1')
# ] => 'N0')
tree($dag[0]);
# exhausted
Этот код работает, я получаю два дерева.
Тем не менее, существует проблема с моим кодом, когда у меня есть несколько таких узлов с цветными преемниками. Тот же код, что и выше, только ввод отличается:
#tree3.pl
︙
our @dag = (
N(N0 => ['N1']),
N([N1 => 'red'] => ['N2']),
N(N2 => ['N3']),
N(N3 => ['N4', 'N5']),
N(N4 => []),
N(N5 => []),
# N0
N([N1 => 'blue'] => ['N6', 'N5']),
N(N6 => ['N7']),
N(N7 => ['N8', 'N4']),
N([N8 => 'purple'] => ['N5']),
# N5
N([N8 => 'orange'] => []),
N([N8 => 'cyan'] => ['N5', 'N5']),
# N5
# N5
# N4
# N5
);
︙
tree($dag[0]);
# bless([ #N0
# bless([ #N1
# bless([ #N2
# bless([ #N3
# bless([] => 'N4'),
# bless([] => 'N5')
# ] => 'N3')
# ] => 'N2')
# ] => 'N1')
# ] => 'N0')
tree($dag[0]);
# bless([ #N0
# bless([ #N1
# bless([ #N6
# bless([ #N7
# bless([ #N8
# bless([] => 'N5')
# ] => 'N8'),
# bless([] => 'N4')
# ] => 'N7')
# ] => 'N6'),
# bless([] => 'N5')
# ] => 'N1')
# ] => 'N0')
tree($dag[0]);
# exhausted
Проблема в том, что поиск исчерпывает только два дерева, хотя я должен получить четыре:
- путь через красный
- путь через синий, затем фиолетовый
- путь через синий, затем оранжевый
- путь через синий, затем голубой
Вы можете ответить на любом языке программирования.