222 lines
3.7 KiB
Perl
222 lines
3.7 KiB
Perl
package GenericGraph;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
sub new {
|
|
my $packagename = shift;
|
|
|
|
my $self = {
|
|
_nodes => {}, # node_name => node_reference
|
|
_edge_counter => {}, # prev_node -> after_node = count
|
|
};
|
|
|
|
bless ($self, $packagename);
|
|
|
|
return($self);
|
|
}
|
|
|
|
|
|
sub get_or_create_node {
|
|
my $self = shift;
|
|
my $node_name = shift;
|
|
|
|
if ($self->node_exists($node_name)) {
|
|
return($self->get_node($node_name));
|
|
}
|
|
else {
|
|
# instantiate it, add it to the graph
|
|
return($self->create_node($node_name));
|
|
}
|
|
}
|
|
|
|
|
|
sub node_exists {
|
|
my $self = shift;
|
|
my $node_name = shift;
|
|
|
|
unless ($node_name =~ /\w/) {
|
|
confess "Error, node_name required";
|
|
}
|
|
|
|
if (exists $self->{_nodes}->{$node_name}) {
|
|
return(1);
|
|
}
|
|
else {
|
|
return(0);
|
|
}
|
|
}
|
|
|
|
sub get_node {
|
|
my $self = shift;
|
|
my $node_name = shift;
|
|
|
|
if (! $self->node_exists($node_name)) {
|
|
confess "Error, $node_name doesn't exist in graph";
|
|
}
|
|
|
|
my $node = $self->{_nodes}->{$node_name};
|
|
|
|
return($node);
|
|
}
|
|
|
|
sub get_all_nodes {
|
|
my $self = shift;
|
|
|
|
return(values %{$self->{_nodes}});
|
|
}
|
|
|
|
|
|
sub create_node {
|
|
my $self = shift;
|
|
|
|
my $node_name = shift;
|
|
|
|
if ($self->node_exists($node_name)) {
|
|
confess "Error, node $node_name already exists in the graph";
|
|
}
|
|
|
|
my $node = new GenericNode($node_name);
|
|
|
|
$self->{_nodes}->{$node_name} = $node;
|
|
|
|
return($node);
|
|
}
|
|
|
|
|
|
sub link_adjacent_nodes {
|
|
my $self = shift;
|
|
my ($before_node, $after_node, $edge_increment) = @_;
|
|
|
|
unless (ref $before_node && ref $after_node) {
|
|
confess "Error, need both before and after nodes for linking";
|
|
}
|
|
|
|
$before_node->add_next_node($after_node);
|
|
$after_node->add_prev_node($before_node);
|
|
|
|
if (defined($edge_increment)) {
|
|
if ($edge_increment =~ /^\d+/ && $edge_increment > 0) {
|
|
$self->{_edge_counter}->{$before_node}->{$after_node} += $edge_increment;
|
|
}
|
|
}
|
|
else {
|
|
$self->{_edge_counter}->{$before_node}->{$after_node}++;
|
|
}
|
|
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
sub get_edge_count {
|
|
my $self = shift;
|
|
my ($prev_node, $next_node) = @_;
|
|
|
|
my $edge_count = $self->{_edge_counter}->{$prev_node}->{$next_node} || 0;
|
|
|
|
return($edge_count);
|
|
}
|
|
|
|
|
|
####
|
|
sub prune_nodes_from_graph {
|
|
my $self = shift;
|
|
my @nodes = @_;
|
|
|
|
my $graph_nodes_href = $self->{_nodes};
|
|
|
|
foreach my $node (@nodes) {
|
|
|
|
delete ($self->{_edge_counter}->{$node}); # remove edge counts starting at current node.
|
|
|
|
my $node_name = $node->get_value();
|
|
delete $graph_nodes_href->{$node_name};
|
|
|
|
my @next_nodes = $node->get_all_next_nodes();
|
|
my @prev_nodes = $node->get_all_prev_nodes();
|
|
|
|
foreach my $prev_node (@prev_nodes) {
|
|
$prev_node->delete_next_node($node);
|
|
$node->delete_prev_node($prev_node);
|
|
|
|
delete ($self->{_edge_counter}->{$prev_node}->{$node}); # remove edge counts for prev nodes linking to current node.
|
|
|
|
}
|
|
|
|
foreach my $next_node (@next_nodes) {
|
|
|
|
$next_node->delete_prev_node($node);
|
|
$node->delete_next_node($next_node);
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
return;
|
|
}
|
|
|
|
####
|
|
sub prune_edge {
|
|
my $self = shift;
|
|
my ($prev_node, $node) = @_;
|
|
|
|
# Sever connection between nodes.
|
|
|
|
$prev_node->delete_next_node($node);
|
|
$node->delete_prev_node($prev_node);
|
|
|
|
delete ($self->{_edge_counter}->{$prev_node}->{$node});
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
####
|
|
sub print_path {
|
|
my @nodes = @_;
|
|
|
|
my $counter = 0;
|
|
foreach my $node (@nodes) {
|
|
$counter++;
|
|
printf("%4s", $counter);
|
|
print " " . $node->get_value() . "\n";
|
|
}
|
|
print "\n";
|
|
|
|
return;
|
|
}
|
|
|
|
####
|
|
sub toString {
|
|
my $self = shift;
|
|
|
|
my @nodes = $self->get_all_nodes();
|
|
|
|
my $text = "";
|
|
foreach my $node (@nodes) {
|
|
$text .= $node->toString() . "\n";
|
|
}
|
|
|
|
return($text);
|
|
}
|
|
|
|
####
|
|
sub get_root_nodes {
|
|
my $self = shift;
|
|
|
|
my @roots;
|
|
foreach my $node ($self->get_all_nodes()) {
|
|
unless ($node->get_all_prev_nodes()) {
|
|
push (@roots, $node);
|
|
}
|
|
}
|
|
|
|
return(@roots);
|
|
}
|
|
|
|
|
|
1; #EOM
|