From: Tara L Andrews <tla@mit.edu>
Date: Sat, 29 Sep 2012 19:52:23 +0000 (+0200)
Subject: add relationship tests; move filter_collations to the parser where it's used
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98a665078819c542a061f2317e9d9a1649362c9e;p=scpubgit%2Fstemmatology.git

add relationship tests; move filter_collations to the parser where it's used
---

diff --git a/base/lib/Text/Tradition/Collation/RelationshipStore.pm b/base/lib/Text/Tradition/Collation/RelationshipStore.pm
index 923214a..4801152 100644
--- a/base/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/base/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -445,7 +445,20 @@ try {
 # TODO Test 4: make a global relationship that involves re-ranking a node first, when 
 # the prior rank has a potential match too
 my $t4 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/globalrel_test.xml' );
-
+my $c4 = $t4->collation;
+# Can we even add the relationship?
+try {
+	$c4->add_relationship( 'r463.2', 'r463.4', 
+		{ type => 'orthographic', scope => 'global' } );
+	ok( 1, "Added global relationship without error" );
+} catch ( Text::Tradition::Error $e ) {
+	ok( 0, "Failed to add global relationship when same-rank alternative exists: "
+		. $e->message );
+}
+$c4->calculate_ranks();
+# Do our readings now share a rank?
+is( $c4->reading('r463.2')->rank, $c4->reading('r463.4')->rank, 
+	"Expected readings now at same rank" );
 
 =end testing
 
@@ -463,7 +476,6 @@ sub add_relationship {
 	my $reltype;
 	my $thispaironly = delete $options->{thispaironly};
 	my $droppedcolls = [];
-	$DB::single = 1 if $source eq 'r796.3' && $target eq 'r796.4';
 	if( ref( $options ) eq 'Text::Tradition::Collation::Relationship' ) {
 		$relationship = $options;
 		$reltype = $self->type( $relationship->type );
@@ -581,7 +593,7 @@ sub add_global_relationship {
 		    } catch {
 		    	my $reldesc = sprintf( "%s %s -> %s", $relationship->type,
 		    		$relationship->reading_a, $relationship->reading_b );
-		    	print STDERR "Global relationship $reldesc not applicable at @$v\n";
+		    	# print STDERR "Global relationship $reldesc not applicable at @$v\n";
 		    }
     		push( @pairs_set, @added ) if @added;
     	}
@@ -760,42 +772,6 @@ sub _restore_weak {
 	}
 }
 
-=head2 filter_collations()
-
-Utility function. Removes any redundant weak relationships from the graph.
-A weak relationship is redundant if the readings in question would occupy
-the same rank regardless of the existence of the relationship.
-
-=cut
-
-#TODO change name
-sub filter_collations {
-	my $self = shift;
-	my $c = $self->collation;
-	foreach my $r ( 1 .. $c->end->rank - 1 ) {
-		my $anchor;
-		my @need_weak;
-		foreach my $rdg ( $c->readings_at_rank( $r ) ) {
-			next if $rdg->is_meta;
-			my $ip = 0;
-			foreach my $pred ( $rdg->predecessors ) {
-				if( $pred->rank == $r - 1 ) {
-					$ip = 1;
-					$anchor = $rdg unless( $anchor );
-					last;
-				}
-			}
-			push( @need_weak, $rdg ) unless $ip;
-			$self->_drop_weak( $rdg->id );
-		}
-		$anchor
-			# TODO FIX HACK of adding explicit collation type
-			? map { $c->add_relationship( $anchor, $_, { 'type' => 'collated' } )
-						unless $c->get_relationship( $anchor, $_ ) } @need_weak
-			: print STDERR "No anchor found at $r\n";
-	}
-}
-
 =head2 related_readings( $reading, $filter )
 
 Returns a list of readings that are connected via relationship links to $reading.
diff --git a/base/lib/Text/Tradition/Parser/Tabular.pm b/base/lib/Text/Tradition/Parser/Tabular.pm
index ab91eb3..2e56320 100644
--- a/base/lib/Text/Tradition/Parser/Tabular.pm
+++ b/base/lib/Text/Tradition/Parser/Tabular.pm
@@ -287,8 +287,7 @@ sub parse {
 	
 	# Note that our ranks and common readings are set.
 	$c->_graphcalc_done(1);
-	# Remove redundant collation relationships.
-	$c->relations->filter_collations() unless $nocollate;
+	_add_collations( $c ) unless $nocollate;
 }
 
 sub _table_from_input {
@@ -428,27 +427,44 @@ sub _make_nodes {
         $unique{$w} = $r;
         $ctr++;
     }
-    # Collate this sequence of readings via a single 'collation' relationship.
-    unless( $nocollate ) {
-		my @rankrdgs = values %unique;
-		my $collation_rel;
-		while( @rankrdgs ) {
-			my $r = shift @rankrdgs;
-			next if $r->is_meta;
-			foreach my $nr ( @rankrdgs ) {
-				next if $nr->is_meta;
-				if( $collation_rel ) {
-					$collation->add_relationship( $r, $nr, $collation_rel );
-				} else {
-					$collation->add_relationship( $r, $nr, 
-						{ 'type' => 'collated', 
-						  'annotation' => "Parsed together for rank $index" } );
-					$collation_rel = $collation->get_relationship( $r, $nr );
+    return \%unique;
+}
+
+sub _add_collations {
+	my( $collation ) = shift;
+	# For each reading that needs to be held in place, add a 'collated' 
+	# relationship to whatever anchor we can find. An anchor is a reading
+	# that would occupy its rank by virtue of being subsequent to a
+	# reading at $rank-1.
+	my @collate_pairs;
+	foreach my $r ( 1 .. $collation->end->rank - 1 ) {
+		$DB::single = 1 if $r == 82 || $r == 104 || $r == 167;
+		my $anchor;
+		my @need_weak;
+		my @here = grep { !$_->is_meta } $collation->readings_at_rank( $r );
+		next unless @here > 1;
+		foreach my $rdg ( @here ) {
+			my $ip = 0;
+			foreach my $pred ( $rdg->predecessors ) {
+				if( $pred->rank == $r - 1 ) {
+					$ip = 1;
+					$anchor = $rdg unless( $anchor );
+					last;
 				}
 			}
+			push( @need_weak, $rdg ) unless $ip;
 		}
-	}    
-    return \%unique;
+		$anchor
+			? map { push( @collate_pairs, [ $r, $anchor, $_ ] ) } @need_weak
+			: print STDERR "No anchor found at $r\n";
+	}
+	foreach my $p ( @collate_pairs ) {
+		my $r = shift @$p;
+		$collation->add_relationship( @$p, 
+			{ 'type' => 'collated', 
+			  'annotation' => "Collated together for rank $r" } )
+			unless $collation->get_relationship( @$p )
+	}
 }
 
 sub throw {
diff --git a/base/t/text_tradition_collation_relationshipstore.t b/base/t/text_tradition_collation_relationshipstore.t
index 6fe65da..65a2de8 100644
--- a/base/t/text_tradition_collation_relationshipstore.t
+++ b/base/t/text_tradition_collation_relationshipstore.t
@@ -171,6 +171,24 @@ try {
 } catch ( Text::Tradition::Error $e ) {
 	ok( 0, "Failed to add normal transposition complement: " . $e->message );
 }
+
+# TODO Test 4: make a global relationship that involves re-ranking a node first, when 
+# the prior rank has a potential match too
+my $t4 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/globalrel_test.xml' );
+my $c4 = $t4->collation;
+# Can we even add the relationship?
+try {
+	$c4->add_relationship( 'r463.2', 'r463.4', 
+		{ type => 'orthographic', scope => 'global' } );
+	ok( 1, "Added global relationship without error" );
+} catch ( Text::Tradition::Error $e ) {
+	ok( 0, "Failed to add global relationship when same-rank alternative exists: "
+		. $e->message );
+}
+$c4->calculate_ranks();
+# Do our readings now share a rank?
+is( $c4->reading('r463.2')->rank, $c4->reading('r463.4')->rank, 
+	"Expected readings now at same rank" );
 }