开发者

Finding Nodes With Only Incoming Edges and Only Outgoing Edges in a Graph Via Perl

开发者 https://www.devze.com 2023-01-23 08:47 出处:网络
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]);

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];

Finding Nodes With Only Incoming Edges and Only Outgoing Edges in a Graph Via Perl

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";
0

精彩评论

暂无评论...
验证码 换一张
取 消