Поиск узлов с только входящими кромками и только исходящими кромками в графике с помощью Perl

Question

У меня есть следующий график

my %connections=(36=>[31,22],31=>[30],30=>[20],22=>[20,8],20=>[1],8=>[5],5=>[2],2=>[1,20]);

Существует ли какой-либо существующий алгоритм, который позволяет нам находить узлы только с исходящими ребрами и только с входящими ребрами.Следовательно, с учетом приведенного выше графика, он даст:

$node_only_incoming_edge = [36];
$node_only_outgoing_edge = [1];

график, созданный с использованием graph.gafol.net

Обновление: Исправлена ​​ошибка ввода %connection в соответствии с предложением RF.

Answer 1

В ответе Ричарда Фирна описан алгоритм вычисления результатов самостоятельно.Альтернативный подход заключается в использовании модуля Graph .Например:

use strict;
use warnings;
use Graph;

my $g = Graph->new;

my %connections = (
    36 => [31,22],
    31 => [22,30],  # Your data omitted 22.
    30 => [20],
    22 => [20,8],
    20 => [1,99],   # Added 99 for testing.
     8 => [5],
     5 => [2],
     2 => [1,20],
    88 => [31],     # Added 88 for testing.
);

for my $n (keys %connections){
    $g->add_edge($n, $_) for @{$connections{$n}};
}

my @outgoing_only = $g->source_vertices;        # 36 and 88
my @incoming_only = $g->successorless_vertices; #  1 and 99

Answer 2

Узел, имеющий только исходящие ребра, будет иметь запись в словаре connections (что указывает на то, что существует ребро от этого узла к одному или нескольким другим узлам), но узел не будет отображаться в значении ни для одной из статей словаря.(что указывает на то, что у этого узла есть ребро от какого-то другого узла).

Узел с только входящими ребрами не будет иметь запись в словаре connections (имеется в видунет ребер от этого узла до любого другого узла).Однако будет появляться в значении для одной или нескольких записей словаря (то есть есть ребро до этого узла от какого-либо другого узла).

Answer 3

Хотя я думаю, что мне больше нравится FM, для собственного удовольствия я реализовал Ричарда:

#!/usr/bin/perl

use strict;
use warnings;

my %connections=(36=>[31,22],31=>[30],30=>[20],22=>[20,8],20=>[1],8=>[5],5=>[2],2=>[1,20]);

my @left = keys %connections;
my @only_incoming;
my @arrives;
my @only_outgoing;
my @all_nodes = @left;

foreach my $left (@left) {
  foreach my $arrives (@{ $connections{$left} }) {
    unless ($arrives ~~ @arrives) {
      push(@arrives, $arrives);
      push(@all_nodes, $arrives) unless $arrives ~~ @all_nodes;
    }
  }
}

foreach my $node (@all_nodes) {
  if ($node ~~ @left and !($node ~~ @arrives)) {
    push(@only_incoming, $node);
  } elsif (!($node ~~ @left) and $node ~~ @arrives) {
    push(@only_outgoing, $node);
  }
}
print "Only incoming: " . join(" ", @only_incoming) . "\n";
print "Only outgoing: " . join(" ", @only_outgoing) . "\n";