From: tla <tla@mit.edu>
Date: Tue, 20 May 2014 13:01:04 +0000 (+0200)
Subject: keep merging readings by rel type until no more exist. Fixes #22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=751ee528fadccad251e6214908bf95b5147a2671;p=scpubgit%2Fstemmatology.git

keep merging readings by rel type until no more exist. Fixes #22
---

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index 1573eb1..db06e24 100644
--- a/base/lib/Text/Tradition/Collation.pm
+++ b/base/lib/Text/Tradition/Collation.pm
@@ -445,9 +445,9 @@ my $c = $t->collation;
 my %rdg_ids;
 map { $rdg_ids{$_} = 1 } $c->readings;
 $c->merge_related( 'orthographic' );
-is( scalar( $c->readings ), keys( %rdg_ids ) - 8, 
+is( scalar( $c->readings ), keys( %rdg_ids ) - 9, 
 	"Successfully collapsed orthographic variation" );
-map { $rdg_ids{$_} = undef } qw/ r13.3 r11.4 r8.5 r8.2 r7.7 r7.5 r7.4 r7.1 /;
+map { $rdg_ids{$_} = undef } qw/ r13.3 r11.4 r8.5 r8.2 r7.7 r7.5 r7.4 r7.3 r7.1 /;
 foreach my $rid ( keys %rdg_ids ) {
 	my $exp = $rdg_ids{$rid};
 	is( !$c->reading( $rid ), !$exp, "Reading $rid correctly " . 
@@ -464,7 +464,7 @@ try {
 # Now add some transpositions
 $c->add_relationship( 'r8.4', 'r10.4', { type => 'transposition' } );
 $c->merge_related( 'transposition' );
-is( scalar( $c->readings ), keys( %rdg_ids ) - 9, 
+is( scalar( $c->readings ), keys( %rdg_ids ) - 10, 
 	"Transposed relationship is merged away" );
 ok( !$c->reading('r8.4'), "Correct transposed reading removed" );
 ok( !$c->linear, "Graph is no longer linear" );
@@ -495,8 +495,7 @@ sub merge_related {
 	# Go through all readings looking for related ones
 	foreach my $r ( $self->readings ) {
 		next unless $self->reading( "$r" ); # might have been deleted meanwhile
-		my @related = $self->related_readings( $r, $filter );
-		if( @related ) {
+		while( my @related = $self->related_readings( $r, $filter ) ) {
 			push( @related, $r );
 			@related = sort { 
 					scalar $b->witnesses <=> scalar $a->witnesses
diff --git a/base/t/text_tradition_collation.t b/base/t/text_tradition_collation.t
index a70ff9e..bee39e0 100644
--- a/base/t/text_tradition_collation.t
+++ b/base/t/text_tradition_collation.t
@@ -81,9 +81,9 @@ my $c = $t->collation;
 my %rdg_ids;
 map { $rdg_ids{$_} = 1 } $c->readings;
 $c->merge_related( 'orthographic' );
-is( scalar( $c->readings ), keys( %rdg_ids ) - 8, 
+is( scalar( $c->readings ), keys( %rdg_ids ) - 9, 
 	"Successfully collapsed orthographic variation" );
-map { $rdg_ids{$_} = undef } qw/ r13.3 r11.4 r8.5 r8.2 r7.7 r7.5 r7.4 r7.1 /;
+map { $rdg_ids{$_} = undef } qw/ r13.3 r11.4 r8.5 r8.2 r7.7 r7.5 r7.4 r7.3 r7.1 /;
 foreach my $rid ( keys %rdg_ids ) {
 	my $exp = $rdg_ids{$rid};
 	is( !$c->reading( $rid ), !$exp, "Reading $rid correctly " . 
@@ -100,7 +100,7 @@ try {
 # Now add some transpositions
 $c->add_relationship( 'r8.4', 'r10.4', { type => 'transposition' } );
 $c->merge_related( 'transposition' );
-is( scalar( $c->readings ), keys( %rdg_ids ) - 9, 
+is( scalar( $c->readings ), keys( %rdg_ids ) - 10, 
 	"Transposed relationship is merged away" );
 ok( !$c->reading('r8.4'), "Correct transposed reading removed" );
 ok( !$c->linear, "Graph is no longer linear" );