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');
my $color_common = $opts->{'color_common'} if $opts;
my $STRAIGHTENHACK = !$startrank && !$endrank && $self->end->rank
&& $self->end->rank > 100;
+ $STRAIGHTENHACK = 1 if $opts->{'straight'}; # even for subgraphs or small graphs
# Check the arguments
if( $startrank ) {
}
if( $STRAIGHTENHACK ) {
## HACK part 1
- $dot .= "\tsubgraph { rank=same \"#START#\" \"#SILENT#\" }\n";
+ my $startlabel = $startrank ? 'SUBSTART' : 'START';
+ $dot .= "\tsubgraph { rank=same \"#$startlabel#\" \"#SILENT#\" }\n";
$dot .= "\t\"#SILENT#\" [ shape=diamond,color=white,penwidth=0,label=\"\" ];"
}
my %used; # Keep track of the readings that actually appear in the graph
}
# HACK part 2
if( $STRAIGHTENHACK ) {
- $dot .= "\t\"#END#\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
+ my $endlabel = $endrank ? 'SUBEND' : 'END';
+ $dot .= "\t\"#$endlabel#\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
}
$dot .= "}\n";
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 );
}
}
-=head2 witnesses_at_rank
+=head2 readings_at_rank( $rank )
-Returns a list of witnesses that are not lacunose, for a given rank.
+Returns a list of readings at a given rank, taken from the alignment table.
=cut
-sub witnesses_at_rank {
+sub readings_at_rank {
my( $self, $rank ) = @_;
+ my $table = $self->alignment_table;
+ # Table rank is real rank - 1.
+ my @elements = map { $_->{'tokens'}->[$rank-1] } @{$table->{'alignment'}};
+ my %readings;
+ foreach my $e ( @elements ) {
+ next unless ref( $e ) eq 'HASH';
+ next unless exists $e->{'t'};
+ $readings{$e->{'t'}->id} = $e->{'t'};
+ }
+ return values %readings;
}
=head2 as_graphml
return @common;
}
-=head2 path_text( $sigil, $mainsigil [, $start, $end ] )
+=head2 path_text( $sigil, [, $start, $end ] )
Returns the text of a witness (plus its backup, if we are using a layer)
as stored in the collation. The text is returned as a string, where the
my( $self, $wit ) = @_;
my @chain = @{$wit->path};
my $sig = $wit->sigil;
+ # Add start and end if necessary
+ unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+ push( @chain, $self->end ) unless $chain[-1] eq $self->end;
foreach my $idx ( 0 .. $#chain-1 ) {
$self->add_path( $chain[$idx], $chain[$idx+1], $sig );
}
if( $wit->is_layered ) {
@chain = @{$wit->uncorrected_path};
+ unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+ push( @chain, $self->end ) unless $chain[-1] eq $self->end;
foreach my $idx( 0 .. $#chain-1 ) {
my $source = $chain[$idx];
my $target = $chain[$idx+1];
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
sub flatten_ranks {
my $self = shift;
my %unique_rank_rdg;
+ my $changed;
foreach my $rdg ( $self->readings ) {
next unless $rdg->has_rank;
my $key = $rdg->rank . "||" . $rdg->text;
if( exists $unique_rank_rdg{$key} ) {
# Combine!
# print STDERR "Combining readings at same rank: $key\n";
+ $changed = 1;
$self->merge_readings( $unique_rank_rdg{$key}, $rdg );
# TODO see if this now makes a common point.
} else {
$unique_rank_rdg{$key} = $rdg;
}
}
+ # If we merged readings, the ranks are still fine but the alignment
+ # table is wrong. Wipe it.
+ $self->wipe_table() if $changed;
}
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
sub text_from_paths {
my $self = shift;
foreach my $wit ( $self->tradition->witnesses ) {
- my @text = split( /\s+/,
- $self->reading_sequence( $self->start, $self->end, $wit->sigil ) );
+ my @readings = $self->reading_sequence( $self->start, $self->end, $wit->sigil );
+ my @text;
+ foreach my $r ( @readings ) {
+ next if $r->is_meta;
+ push( @text, $r->text );
+ }
$wit->text( \@text );
if( $wit->is_layered ) {
- my @uctext = split( /\s+/,
- $self->reading_sequence( $self->start, $self->end,
- $wit->sigil.$self->ac_label ) );
- $wit->text( \@uctext );
+ my @ucrdgs = $self->reading_sequence( $self->start, $self->end,
+ $wit->sigil.$self->ac_label );
+ my @uctext;
+ foreach my $r ( @ucrdgs ) {
+ next if $r->is_meta;
+ push( @uctext, $r->text );
+ }
+ $wit->layertext( \@uctext );
}
}
}
);
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