remove redundant a.c. witnesses from list

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation.pm

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 6297295..3a9b056 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -27,6 +27,7 @@ has 'relations' => (
        handles => {
                relationships => 'relationships',
                related_readings => 'related_readings',
+               del_relationship => 'del_relationship',
        },
        writer => '_set_relations',
        );
@@ -454,6 +455,10 @@ sub reading_witnesses {
                my $wits = $self->sequence->get_edge_attributes( @$e );
                @all_witnesses{ keys %$wits } = 1;
        }
+       my $acstr = $self->ac_label;
+       foreach my $acwit ( grep { $_ =~ s/^(.*)\Q$acstr\E$/$1/ } keys %all_witnesses ) {
+               delete $all_witnesses{$acwit.$acstr} if exists $all_witnesses{$acwit};
+       }
        return keys %all_witnesses;
 }
 
@@ -1473,7 +1478,9 @@ sub calculate_common_readings {
        my @common;
        my $table = $self->alignment_table;
        foreach my $idx ( 0 .. $table->{'length'} - 1 ) {
-               my @row = map { $_->{'tokens'}->[$idx]->{'t'} } @{$table->{'alignment'}};
+               my @row = map { $_->{'tokens'}->[$idx] 
+                                                       ? $_->{'tokens'}->[$idx]->{'t'} : '' } 
+                                       @{$table->{'alignment'}};
                my %hash;
                foreach my $r ( @row ) {
                        if( $r ) {