X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=6357a6f4697dfb19e07515e87e556688f018a9a9;hb=335a62ef9e58093170ab3e2da0945fc545e9f982;hp=7c22786ae1820ff359d68bdaf65c385e6dfd015b;hpb=6648ee3de96b0a0647a59b22782261c2e4c71138;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 7c22786..6357a6f 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -338,15 +338,15 @@ $c->flatten_ranks(); ok( $c->reading( 'n21p0' ), "New reading exists" ); is( scalar $c->readings, $rno, "Reading add offset by flatten_ranks" ); -# Combine n3 and n4 +# Combine n3 and n4 ( with his ) $c->merge_readings( 'n3', 'n4', 1 ); ok( !$c->reading('n4'), "Reading n4 is gone" ); is( $c->reading('n3')->text, 'with his', "Reading n3 has both words" ); -# Collapse n25 and n26 -$c->merge_readings( 'n25', 'n26' ); -ok( !$c->reading('n26'), "Reading n26 is gone" ); -is( $c->reading('n25')->text, 'rood', "Reading n25 has an unchanged word" ); +# Collapse n9 and n10 ( rood / root ) +$c->merge_readings( 'n9', 'n10' ); +ok( !$c->reading('n10'), "Reading n10 is gone" ); +is( $c->reading('n9')->text, 'rood', "Reading n9 has an unchanged word" ); # Combine n21 and n21p0 my $remaining = $c->reading('n21'); @@ -783,15 +783,34 @@ sub path_witnesses { return @wits; } +# Helper function. Make a display label for the given witnesses, showing a.c. +# witnesses only where the main witness is not also in the list. sub _path_display_label { my $self = shift; - my @wits = sort @_; + my %wits; + map { $wits{$_} = 1 } @_; + + # If an a.c. wit is listed, remove it if the main wit is also listed. + # Otherwise keep it for explicit listing. + my $aclabel = $self->ac_label; + my @disp_ac; + foreach my $w ( sort keys %wits ) { + if( $w =~ /^(.*)\Q$aclabel\E$/ ) { + if( exists $wits{$1} ) { + delete $wits{$w}; + } else { + push( @disp_ac, $w ); + } + } + } + + # See if we are in a majority situation. my $maj = scalar( $self->tradition->witnesses ) * 0.6; - if( scalar @wits > $maj ) { - # TODO break out a.c. wits - return 'majority'; + if( scalar keys %wits > $maj ) { + unshift( @disp_ac, 'majority' ); + return join( ', ', @disp_ac ); } else { - return join( ', ', @wits ); + return join( ', ', sort keys %wits ); } } @@ -1407,7 +1426,7 @@ ok( $c->has_cached_table, "Alignment table was cached" ); is( $c->alignment_table, $table, "Cached table returned upon second call" ); $c->calculate_ranks; is( $c->alignment_table, $table, "Cached table retained with no rank change" ); -$c->add_relationship( 'n9', 'n23', { 'type' => 'spelling' } ); +$c->add_relationship( 'n24', 'n23', { 'type' => 'spelling' } ); isnt( $c->alignment_table, $table, "Alignment table changed after relationship add" ); =end testing @@ -1585,7 +1604,7 @@ my @common = $c->calculate_common_readings(); is( scalar @common, 8, "Found correct number of common readings" ); my @marked = sort $c->common_readings(); is( scalar @common, 8, "All common readings got marked as such" ); -my @expected = qw/ n1 n12 n16 n19 n20 n5 n6 n7 /; +my @expected = qw/ n1 n11 n16 n19 n20 n5 n6 n7 /; is_deeply( \@marked, \@expected, "Found correct list of common readings" ); =end testing @@ -1672,14 +1691,14 @@ my $t = Text::Tradition->new( ); my $c = $t->collation; -is( $c->common_predecessor( 'n9', 'n23' )->id, +is( $c->common_predecessor( 'n24', 'n23' )->id, 'n20', "Found correct common predecessor" ); -is( $c->common_successor( 'n9', 'n23' )->id, +is( $c->common_successor( 'n24', 'n23' )->id, '#END#', "Found correct common successor" ); is( $c->common_predecessor( 'n19', 'n17' )->id, 'n16', "Found correct common predecessor for readings on same path" ); -is( $c->common_successor( 'n21', 'n26' )->id, +is( $c->common_successor( 'n21', 'n10' )->id, '#END#', "Found correct common successor for readings on same path" ); =end testing