From: Tara L Andrews <tla@mit.edu>
Date: Fri, 3 Feb 2012 21:18:36 +0000 (+0100)
Subject: add facilities for removing 'collated' relationship, and for annotation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4633f9e4c01ef98b3bf0a2851886c3e301071b27;p=scpubgit%2Fstemmatology.git

add facilities for removing 'collated' relationship, and for annotation
---

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 85d09bf..746504b 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -488,7 +488,6 @@ sub as_dot {
 		$endrank = undef if $endrank == $self->end->rank;
 	}
 	
-    # TODO consider making some of these things configurable
     my $graph_name = $self->tradition->name;
     $graph_name =~ s/[^\w\s]//g;
     $graph_name = join( '_', split( /\s+/, $graph_name ) );
@@ -526,6 +525,7 @@ sub as_dot {
 	my @all_readings = $self->end->has_rank 
 		? sort { $a->rank <=> $b->rank } $self->readings
 		: $self->readings;
+	# TODO Refrain from outputting lacuna nodes - just grey out the edges.
     foreach my $reading ( @all_readings ) {
     	# Only output readings within our rank range.
     	next if $startrank && $reading->rank < $startrank;
@@ -1329,6 +1329,45 @@ sub flatten_ranks {
     }
 }
 
+=head2 remove_collations
+
+Another convenience method for parsing. Removes all 'collation' relationships
+that were defined in order to get the reading ranks to be correct.
+
+=begin testing
+
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+isnt( $c->reading('n23')->rank, $c->reading('n9')->rank, "Rank skew exists" );
+$c->add_relationship( 'n23', 'n9', { 'type' => 'collated', 'scope' => 'local' } );
+is( scalar $c->relationships, 4, "Found all expected relationships" );
+$c->remove_collations;
+is( scalar $c->relationships, 3, "Collated relationships now gone" );
+is( $c->reading('n23')->rank, $c->reading('n9')->rank, "Aligned ranks were preserved" );
+
+=end testing
+
+=cut
+
+sub remove_collations {
+	my $self = shift;
+	foreach my $reledge ( $self->relationships ) {
+		my $relobj = $self->relations->get_relationship( $reledge );
+		if( $relobj && $relobj->type eq 'collated' ) {
+			$self->relations->delete_relationship( $reledge );
+		}
+	}
+}
+	
+
 =head2 calculate_common_readings
 
 Goes through the graph identifying the readings that appear in every witness 
diff --git a/lib/Text/Tradition/Collation/Relationship.pm b/lib/Text/Tradition/Collation/Relationship.pm
index 07c6293..e08fb3c 100644
--- a/lib/Text/Tradition/Collation/Relationship.pm
+++ b/lib/Text/Tradition/Collation/Relationship.pm
@@ -6,7 +6,7 @@ use Moose::Util::TypeConstraints;
 enum 'RelationshipType' => qw( spelling orthographic grammatical meaning lexical
 							   collated repetition transposition );
 
-enum 'RelationshipScope' => qw( local tradition global );
+enum 'RelationshipScope' => qw( local document global );
 
 no Moose::Util::TypeConstraints;
 
@@ -35,12 +35,14 @@ Options include:
 
 =item * displayform - (Optional) The reading that should be displayed if the related nodes are treated as one.
 
+=item * scope - (Optional) A meta-attribute.  Can be one of 'local', 'document', or 'global'. Denotes whether the relationship between the two readings holds always, independent of context, either within this tradition or across all traditions.
+
+=item * anotation - (Optional) A freeform note to attach to the relationship.
+
 =item * non_correctable - (Optional) True if the reading would not have been corrected independently.
 
 =item * non_independent - (Optional) True if the variant is unlikely to have occurred independently in unrelated witnesses.
 
-=item * scope - (Optional) A meta-attribute.  Can be one of 'local', 'tradition', or 'global'. Denotes whether the relationship between the two readings holds always, independent of context, either within this tradition or across all traditions.
-
 =back
 
 =head1 ACCESSORS
@@ -51,6 +53,8 @@ Options include:
 
 =head2 scope
 
+=head2 annotation
+
 =head2 non_correctable
 
 =head2 non_independent
@@ -88,6 +92,11 @@ has 'scope' => (
 	isa => 'RelationshipScope', 
 	default => 'local',
 	);
+	
+has 'annotation' => (
+	is => 'ro',
+	isa => 'Str',
+	);
 
 has 'non_correctable' => (
 	is => 'ro',
diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index a74c890..367cbf8 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -57,9 +57,24 @@ has 'graph' => (
     	relationships => 'edges',
     	add_reading => 'add_vertex',
     	delete_reading => 'delete_vertex',
+    	delete_relationship => 'delete_edge',
     },
 	);
 	
+around 'delete_relationship' => sub {
+	my $orig = shift;
+	my $self = shift;
+	my @vector;
+	if( @_ == 1 && ref( $_[0] ) eq 'ARRAY' ) {
+		# Dereference the edge arrayref that was passed.
+		my $edge = shift;
+		@vector = @$edge;
+	} else {
+		@vector = @_;
+	}
+	return $self->$orig( @vector );
+};
+	
 =head2 get_relationship
 
 Return the relationship object, if any, that exists between two readings.
@@ -67,7 +82,15 @@ Return the relationship object, if any, that exists between two readings.
 =cut
 
 sub get_relationship {
-	my( $self, @vector ) = @_;
+	my $self = shift;
+	my @vector;
+	if( @_ == 1 && ref( $_[0] ) eq 'ARRAY' ) {
+		# Dereference the edge arrayref that was passed.
+		my $edge = shift;
+		@vector = @$edge;
+	} else {
+		@vector = @_;
+	}
 	my $relationship;
 	if( $self->graph->has_edge_attribute( @vector, 'object' ) ) {
 		$relationship = $self->graph->get_edge_attribute( @vector, 'object' );
diff --git a/t/text_tradition_collation.t b/t/text_tradition_collation.t
index 38b698b..099f612 100644
--- a/t/text_tradition_collation.t
+++ b/t/text_tradition_collation.t
@@ -56,6 +56,28 @@ my $t = Text::Tradition->new(
     );
 my $c = $t->collation;
 
+isnt( $c->reading('n23')->rank, $c->reading('n9')->rank, "Rank skew exists" );
+$c->add_relationship( 'n23', 'n9', { 'type' => 'collated', 'scope' => 'local' } );
+is( scalar $c->relationships, 4, "Found all expected relationships" );
+$c->remove_collations;
+is( scalar $c->relationships, 3, "Collated relationships now gone" );
+is( $c->reading('n23')->rank, $c->reading('n9')->rank, "Aligned ranks were preserved" );
+}
+
+
+
+# =begin testing
+{
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
 my @common = $c->calculate_common_readings();
 is( scalar @common, 8, "Found correct number of common readings" );
 my @marked = sort $c->common_readings();