view release on metacpan or  search on metacpan

lib/Graph/Undirected/Undirected/Hamiltonicity/Transforms.pm  view on Meta::CPAN

package Graph::Undirected::Hamiltonicity::Transforms;

use Modern::Perl;
use Carp;

use Graph::Undirected;
use Graph::Undirected::Hamiltonicity::Output qw(:all);

use Exporter qw(import);

our @EXPORT_OK = qw(
    &add_random_edges
    &delete_cycle_closing_edges
    &delete_non_required_neighbors
    &get_common_neighbors
    &get_required_graph
    &get_random_isomorph
    &string_to_graph
    &swap_vertices
);

our %EXPORT_TAGS = ( all => \@EXPORT_OK );

##########################################################################

# The "required graph" contains the same vertices as the original graph,
# but with only the edges incident on vertices of degree == 2.

sub get_required_graph {
    my ($g) = @_;

    output(   "Beginning a sweep to mark all edges adjacent to degree 2 "
            . "vertices as required:<BR/>" );

    my $g1 = $g->deep_copy_graph();
    output($g1);

    my @vertices = $g1->vertices();
    my $required_graph = Graph::Undirected->new( vertices => \@vertices );

    foreach my $vertex (@vertices) {
        my $degree = $g1->degree($vertex);
        if ( $degree != 2 ) {
            output("Vertex $vertex : Degree=[$degree] ...skipping.<BR/>");
            next;
        }

        output("Vertex $vertex : Degree=[$degree] ");
        output("<UL>");
        foreach my $neighbor_vertex ( $g1->neighbors($vertex) ) {
            $required_graph->add_edge( $vertex, $neighbor_vertex );

            if ( $g1->get_edge_attribute( $vertex, $neighbor_vertex,
                                          'required') ) {
                output( "<LI>$vertex=$neighbor_vertex is already "
                        . "marked required</LI>" );
                next;
            }

            $g1->set_edge_attribute($vertex, $neighbor_vertex,
                                    'required', 1);
            output( "<LI>Marking $vertex=$neighbor_vertex "
                    . "as required</LI>" );