Finding Nodes With Only Incoming Edges and Only Outgoing Edges in a Graph Via Perl
I have the following graph
my %connections=(36=>[31,22],31=>[30],30=>[20],22=>[20,8],20=>[1],8=>[5],5=>[2],2=>[1,20]);
Is there any existing algorithm that let us find node with only outgoing edges and only incoming edges. Hence given the above graph, it would yield:
$node_only_incoming_edge = [36];
$node_only_outgoing_edge = [1];
graph created using graph.gafol.net
Update: Fixed the %connection
entry error according to RF suggest开发者_C百科ion.
Richard Fearn's answer describes the algorithm to compute the results yourself. An alternative approach is to use the Graph module. For example:
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
A node with only outgoing edges will have an entry in the connections
dictionary (indicating there's an edge from that node to one or more other nodes), but the node will not appear in the value for any of the dictionary's entries (which would indicate that there is an edge to that node from some other node).
A node with only incoming edges will not have an entry in the connections
dictionary (meaning there are no edges from that node to any other node). However it will appear in the value for one or more of the dictionary's entries (meaning there's an edge to that node from some other node).
While I think I like FM's better, for my own amusement I implemented Richard's:
#!/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";
精彩评论