From: Tara L Andrews Date: Fri, 13 Jan 2012 14:11:11 +0000 (+0100) Subject: fix a.c. paths for parallel segmentation input X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2Fstemmatology.git;a=commitdiff_plain;h=96dc90ecf08a45d43fd2d54b9017036ab5209dfa fix a.c. paths for parallel segmentation input --- diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index bf84fce..c5bb6a1 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -339,7 +339,10 @@ sub relationship_valid { sub reading_witnesses { my( $self, $reading ) = @_; # We need only check either the incoming or the outgoing edges; I have - # arbitrarily chosen "incoming". + # arbitrarily chosen "incoming". Thus, special-case the start node. + if( $reading eq $self->start ) { + return map { $_->sigil } $self->tradition->witnesses; + } my %all_witnesses; foreach my $e ( $self->sequence->edges_to( $reading ) ) { my $wits = $self->sequence->get_edge_attributes( @$e ); diff --git a/lib/Text/Tradition/Parser/TEI.pm b/lib/Text/Tradition/Parser/TEI.pm index 9b9088e..6b9734f 100644 --- a/lib/Text/Tradition/Parser/TEI.pm +++ b/lib/Text/Tradition/Parser/TEI.pm @@ -160,6 +160,7 @@ sub parse { } # See if we need to make an a.c. version of the witness. if( exists $app_ac->{$sig} ) { + $DB::single = 1; my @uncorrected; push( @uncorrected, @real_sequence ); foreach my $app ( keys %{$app_ac->{$sig}} ) { @@ -168,10 +169,12 @@ sub parse { my @new = map { _return_rdg( $_ ) } @{$app_ac->{$sig}->{$app}}; _replace_sequence( \@uncorrected, $start, $end, @new ); } - my $source = $c->start; + my $source = shift @uncorrected; # the start node + warn "Something weird!" unless $source eq $c->start; foreach my $rdg ( @uncorrected ) { - my $has_base = grep { $_ eq $sig } $c->reading_witnesses( $rdg ); - if( $rdg ne $c->start && !$has_base ) { + my $source_base = grep { $_ eq $sig } $c->reading_witnesses( $source ); + my $target_base = grep { $_ eq $sig } $c->reading_witnesses( $rdg ); + unless( $source_base && $target_base ) { # print STDERR sprintf( "Adding path %s from %s -> %s\n", # $sig.$c->ac_label, $source->id, $rdg->id ); $c->add_path( $source, $rdg, $sig.$c->ac_label );