From: Tara L Andrews <tla\@mit.edu>
Date: Fri, 20 Apr 2012 08:20:44 +0000 (+0200)
Subject: add some more transposition logic
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=abadc99755945b57efb1268ab54d99642ae4786c;p=scpubgit%2Fstemmatology.git

add some more transposition logic
---

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index ddad4db..b6e71cb 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -461,9 +461,30 @@ sub relationship_valid {
 				return ( 1, "ok" ) if $rel eq 'repetition';
 			}
 		}
-		return $rel eq 'transposition' ? ( 1, "ok" )
-			: ( 0, "Readings occur only in distinct witnesses" );
-	} else {
+		return ( 0, "Readings occur only in distinct witnesses" )
+			if $rel eq 'repetition';
+	} 
+	if ( $rel eq 'transposition' ) {
+		# We also need to check both that the readings occur in distinct
+		# witnesses, and that they are not in the same place. That is,
+		# proposing to link them should cause a witness loop.
+		my $map = {};
+		my( $startrank, $endrank );
+		if( $c->end->has_rank ) {
+			my $cpred = $c->common_predecessor( $source, $target );
+			my $csucc = $c->common_successor( $source, $target );
+			$startrank = $cpred->rank;
+			$endrank = $csucc->rank;
+		}
+		my $eqgraph = $c->equivalence_graph( $map, $startrank, $endrank, 
+			$source, $target );
+		if( $eqgraph->has_a_cycle ) {
+			return ( 1, "ok" );
+		} else {
+			return ( 0, "Readings appear to be colocated, not transposed" );
+		}
+		
+	} elsif( $rel ne 'repetition' ) {
 		# Check that linking the source and target in a relationship won't lead
 		# to a path loop for any witness. 
 		# First, drop/stash any collations that might interfere