20251125

2025-11-25 00:28:51 +08:00
commit eb3f16c30e
406 changed files with 91653 additions and 0 deletions
@@ -0,0 +1,221 @@
+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