From: Tara L Andrews <tla@mit.edu>
Date: Sun, 5 Jun 2011 22:53:44 +0000 (+0200)
Subject: new positioning system, works great for graph, needs work for CSV
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=45456358649b557f9addf7193f8359f20ede6d07;p=scpubgit%2Fstemmatology.git

new positioning system, works great for graph, needs work for CSV
---

diff --git a/lib/Text/Tradition/Collation/Position.pm b/lib/Text/Tradition/Collation/Position.pm
new file mode 100644
index 0000000..f180046
--- /dev/null
+++ b/lib/Text/Tradition/Collation/Position.pm
@@ -0,0 +1,134 @@
+package Text::Tradition::Collation::Position;
+
+use Moose;
+
+has 'common' => (
+    is => 'rw',
+    isa => 'Int',
+    required => 1,
+    );
+
+has 'min' => (
+    is => 'rw',
+    isa => 'Int',
+    required => 1,
+    );
+
+has 'max' => (
+    is => 'rw',
+    isa => 'Int',
+    required => 1,
+    );
+
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $class = shift;
+
+    # Two ways we can be called - with the arguments we expect, or with a
+    # single argument to be parsed out into a position.
+    my %args;
+    if( @_ == 1 ) {
+	my( $common, $min, $max ) = parse_reference( $_[0] );
+	%args = ( 'common' => $common,
+		  'min' => $min,
+		  'max' => $max );
+    } elsif ( 2 <= @_ && @_ <= 3 ) {
+	my( $common, $min, $max ) = @_;
+	$max = $min unless $max;
+	%args = ( 'common' => $common,
+		  'min' => $min,
+		  'max' => $max );
+    } else {
+	%args = @_;
+    }
+
+    return $class->$orig( %args );
+};
+
+sub BUILD {
+    my $self = shift;
+    if( $self->min > $self->max ) {
+	die "Position minimum cannot be higher than maximum";
+    }
+}
+
+sub parse_reference {
+    my( $ref ) = @_;
+    if( $ref =~ /^(\d+),(\d+)(\-(\d+))?$/ ) {
+	my( $common, $min, $max ) = ( $1, $2, $4 );
+	$max = $min unless defined $max;
+	return( $common, $min, $max );
+    } else {
+	warn "Bad argument $ref passed to Position constructor";
+	return undef;
+    }
+}
+
+# Instance method
+sub cmp_with {
+    my( $self, $other ) = @_;
+    return _cmp_bits( [ $self->common, $self->min, $self->max ],
+		      [ $other->common, $other->min, $other->max ] );
+}
+
+# Class method
+sub str_cmp {
+    my( $a, $b ) = @_;
+    my @abits = parse_reference( $a );
+    my @bbits = parse_reference( $b );
+    return _cmp_bits( \@abits, \@bbits );
+}
+
+sub _cmp_bits {
+    my( $a, $b ) = @_;
+    return $a->[0] <=> $b->[0]
+	unless $a->[0] == $b->[0];
+    return $a->[1] <=> $b->[1]
+	unless $a->[1] == $b->[1];
+    return $a->[2] <=> $b->[2];
+}
+
+sub minref {
+    my $self = shift;
+    return join(',', $self->common, $self->min );
+}
+
+sub maxref {
+    my $self = shift;
+    return join(',', $self->common, $self->max );
+}
+
+sub reference {
+    my $self = shift;
+    my $answer = join( ',', $self->common, $self->min );
+    $answer .= '-'. $self->max unless $self->min == $self->max;
+    return $answer;
+}
+
+sub fixed {
+    my $self = shift;
+    return $self->min == $self->max;
+}
+
+sub is_colocated {
+    my( $self, $other, $strict ) = @_;
+    if( $strict ) {
+	return $self->common == $other->common
+	    && $self->min == $other->min
+	    && $self->max == $other->max;
+    } else {
+	return $self->common == $other->common 
+	    && $self->min <= $other->max
+	    && $self->max >= $other->min;
+    }
+}
+
+# Return all the possible fixed position refs.
+sub possible_positions {
+    my $self = shift;
+    my @possible = map { join( ',', $self->common, $_ ) } ( $self->min .. $self->max );
+    return @possible;
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;