Graph::ChainBuilder - build directed 2-regular cyclic graphs

Graph-ChainBuilder documentation Contained in the Graph-ChainBuilder distribution.

Index

Code Index:

NAME

Top

Graph::ChainBuilder - build directed 2-regular cyclic graphs

SYNOPSIS

Top

This object collects data into a set of ordered chains, allowing you to organize e.g. edges AB,CD,AD,CB into the circular sequence AB,BC,CD,DA while keeping track of the directionality of the input data.

  my $graph = Graph::ChainBuilder->new;

  while(whatever) {
    ...
    $graph->add($p0, $p1, $data);
  }

An edge is defined by the strings $p0 and $p1. The $data is whatever you want to associate with an edge.

  foreach my $loop ($graph->loops) {
    foreach my $edge (@$loop) {
      ...
      $edge->data;
    }
  }

Limitations

Top

This code will identify multiple independent loops in an arbitrary set of unordered edges, but assumes that all loops are closed and that no stray edges exist. The result is undefined if your input contains duplicate or dangling edges.

new

  my $graph = Graph::ChainBuilder->new;

add

Adds an edge to the graph. The nodes $p0 and $p1 will be connected (if possible) to the existing loops.

  $graph->add($p0, $p1, $data);

Attempting to add an edge with a point which has already been connected will throw an error.

new

  my $e = Graph::ChainBuilder::edge->new($p0, $p1, $rev, $data);

AUTHOR

Top

Eric Wilhelm @ <ewilhelm at cpan dot org>

http://scratchcomputing.com/

BUGS

Top

If you found this module on CPAN, please report any bugs or feature requests through the web interface at http://rt.cpan.org. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

If you pulled this development version from my /svn/, please contact me directly.

COPYRIGHT

Top

Copyright (C) 2009 Eric L. Wilhelm, All Rights Reserved.

NO WARRANTY

Top

Absolutely, positively NO WARRANTY, neither express or implied, is offered with this software. You use this software at your own risk. In case of loss, no person or entity owes you anything whatsoever. You have been warned.

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Graph-ChainBuilder documentation Contained in the Graph-ChainBuilder distribution. 
package Graph::ChainBuilder;
$VERSION = v0.0.2;

use warnings;
use strict;
use Carp;


use Class::Accessor::Classy;
with 'new';
lo 'loops';
no  Class::Accessor::Classy;


sub new {
  my $self = shift->SUPER::new();
  $self->{ep}    = {};
  $self->{loops} = [];
  return($self);
} # end subroutine new definition
########################################################################


sub add {
  my $self = shift;
  my ($p0, $p1, $data) = @_;

  my $edge = Graph::ChainBuilder::edge->new($p0, $p1, 0, $data);

  my $ep = $self->{ep};
  if(my $where = delete($ep->{$p0})) {
    my ($chain, $end) = @$where;
    # warn "insert $p0|$p1 on $chain $end";
    $edge->reverse unless($end);
    splice(@$chain, $end ? scalar(@$chain) : 0, 0, $edge);
    if(my $and = delete($ep->{$p1})) {
      # warn "unravelling needed at $p1";
      # {local $ep->{$p1} = $and; warn join("\n", $self->stringify, '');}
      if($and->[0] eq $chain) { # closed!
        push(@{$self->{loops}}, $chain);
      }
      else {
        $self->_unravel([$chain, $end], $and);
      }
    }
    else {
      $ep->{$p1} = [$chain, $end];
    }
  }
  elsif($where = delete($ep->{$p1})) {
    my ($chain, $end) = @$where;
    # warn "insert $p1|$p0 on $chain $end";
    $edge->reverse if($end);
    splice(@$chain, $end ? scalar(@$chain) : 0, 0, $edge);
    $ep->{$p0} = [$chain, $end];
  }
  else {
    # start a new chain
    my $chain = [$edge];
    $ep->{$p0} = [$chain, 0];
    $ep->{$p1} = [$chain, 1];
  }
} # end subroutine add definition
########################################################################


sub open_ends {
  my $self = shift;

  my %once = map({$_ => $_} map {$_->[0]} values %{$self->{ep}});
  return(values %once);
}
sub stringify {
  my $self = shift;

  return map({join(" ", map({join("|", $_->p0, $_->p1)} @$_))} 
    $self->open_ends);
}

# recursively check/close connected subchains
sub _unravel {
  my $self = shift;
  my ($where, $and) = @_;

  my $ep = $self->{ep};

  my $chain = $where->[0];
  my $end   = $where->[1];

  my $subchain = $and->[0];

  if($end == $and->[1]) { # reverse direction
    @$subchain = reverse(@$subchain);
    $_->reverse for(@$subchain);
  }

  splice(@$chain, $end ? scalar(@$chain) : 0, 0, @$subchain);

  # the opposite end of that chain is now this end of this chain
  my $which_node = 'p' . $end;
  my $last = $subchain->[$end ? $#$subchain : 0]->$which_node;
  $ep->{$last} or die "that's unexpected";
  $ep->{$last} = $where;
} # end subroutine _unravel definition
########################################################################

{
package Graph::ChainBuilder::edge;


sub new { my $class = shift; bless([@_], $class); }
sub p0       {shift->[0]};
sub p1       {shift->[1]};
sub reversed {shift->[2]};
sub data     {shift->[3]};

sub reverse { my $e = shift; $e->[2] ^= 1; @$e[0,1] = @$e[1,0]; }
}
########################################################################



# vi:ts=2:sw=2:et:sta
1;