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 (file)
--- 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 (file)
--- 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 (file)
--- 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" );
 }