migrate lexemes and normal forms when readings are combined; script to merge readings...

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

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index fb1b7cb..d4395a7 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -409,12 +409,19 @@ sub merge_readings {
        
        # Do the deletion deed.
        if( $combine ) {
+               # Combine the text of the readings
                my $joinstr = $combine_char;
                unless( defined $joinstr ) {
                        $joinstr = '' if $kept_obj->join_next || $del_obj->join_prior;
                        $joinstr = $self->wordsep unless defined $joinstr;
                }
                $kept_obj->alter_text( join( $joinstr, $kept_obj->text, $del_obj->text ) );
+               $kept_obj->normal_form( 
+                       join( $joinstr, $kept_obj->normal_form, $del_obj->normal_form ) );
+               # Combine the lexemes present in the readings
+               if( $kept_obj->has_lexemes && $del_obj->has_lexemes ) {
+                       $kept_obj->add_lexeme( $del_obj->lexemes );
+               }
        }
        $self->del_reading( $deleted );
 }
@@ -729,23 +736,28 @@ sub as_dot {
                        $dot .= sprintf( "\t\"%s\" -> \"%s\" %s;\n", 
                                $edge->[0], $edge->[1], $varopts );
         } elsif( $used{$edge->[0]} ) {
-               $subend{$edge->[0]} = 1;
+               $subend{$edge->[0]} = $edge->[1];
         } elsif( $used{$edge->[1]} ) {
-               $substart{$edge->[1]} = 1;
+               $substart{$edge->[1]} = $edge->[0];
         }
     }
     # Add substitute start and end edges if necessary
     foreach my $node ( keys %substart ) {
-       my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+       my $witstr = $self->_path_display_label ( $self->path_witnesses( $substart{$node}, $node ) );
        my $variables = { %edge_attrs, 'label' => $witstr };
+       my $nrdg = $self->reading( $node );
+       if( $nrdg->has_rank && $nrdg->rank > $startrank ) {
+               # Substart is actually one lower than $startrank
+               $variables->{'minlen'} = $nrdg->rank - ( $startrank - 1 );
+       }       
         my $varopts = _dot_attr_string( $variables );
-        $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;";
+        $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;\n";
        }
     foreach my $node ( keys %subend ) {
-       my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+       my $witstr = $self->_path_display_label ( $self->path_witnesses( $node, $subend{$node} ) );
        my $variables = { %edge_attrs, 'label' => $witstr };
         my $varopts = _dot_attr_string( $variables );
-        $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;";
+        $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;\n";
        }
        # HACK part 2
        if( $STRAIGHTENHACK ) {