muck about with serialization of lexeme wordforms; allow individual lexeme addressing

[scpubgit/stemmatology.git] / lib / Text / Tradition / Parser / Util.pm

diff --git a/lib/Text/Tradition/Parser/Util.pm b/lib/Text/Tradition/Parser/Util.pm
index fbeac3f..de18a6f 100644 (file)
--- a/lib/Text/Tradition/Parser/Util.pm
+++ b/lib/Text/Tradition/Parser/Util.pm
@@ -31,16 +31,24 @@ on the collation graph.
 
 sub collate_variants {
     my( $collation, @reading_sets ) = @_;
+    
+    # Make sure the reading sets are unique, but retain their ordering.
+    my %unique_sets;
+    my @sets;
+    foreach( @reading_sets ) {
+       push( @sets, $_ ) unless $unique_sets{$_};
+       $unique_sets{$_} = $_;
+    }
 
     # Two different ways to do this, depending on whether we want
     # transposed reading nodes to be merged into one (producing a
     # nonlinear, bidirectional graph) or not (producing a relatively
     # linear, unidirectional graph.)
-    return $collation->linear ? collate_linearly( @_ )
-        : collate_nonlinearly( @_ );
+    return $collation->linear ? _collate_linearly( $collation, @sets )
+        : _collate_nonlinearly( $collation, @sets );
 }
 
-sub collate_linearly {
+sub _collate_linearly {
     my( $collation, $lemma_set, @variant_sets ) = @_;
 
     my @unique;
@@ -61,9 +69,9 @@ sub collate_linearly {
                 foreach my $i ( 0 .. $#l ) {
                     if( !$merged{$l[$i]->id} ) {
                         next if $v[$i] eq $l[$i];
-                        print STDERR sprintf( "Merging %s into %s\n", 
-                                             $v[$i]->id,
-                                             $l[$i]->id );
+#                         print STDERR sprintf( "Merging %s into %s\n", 
+#                                              $v[$i]->id,
+#                                              $l[$i]->id );
                         $collation->merge_readings( $l[$i], $v[$i] );
                         $merged{$l[$i]->id} = 1;
                         $substitutions->{$v[$i]->id} = $l[$i];
@@ -87,7 +95,7 @@ sub collate_linearly {
     return $substitutions;
 }
 
-sub collate_nonlinearly {
+sub _collate_nonlinearly {
     my( $collation, $lemma_set, @variant_sets ) = @_;
     
     my @unique;
@@ -132,9 +140,16 @@ sub _collation_hash {
     return cmp_str( $node );
 }
 
+=head2 B<cmp_str>
+
+Don't use this. Really.
+
+=cut
+
 sub cmp_str {
     my( $reading ) = @_;
     my $word = $reading->text();
+    return $word unless $reading->collation->tradition->name =~ /158/;
     $word = lc( $word );
     $word =~ s/\W//g;
     $word =~ s/v/u/g;
@@ -166,6 +181,12 @@ sub check_for_repeated {
     return @repeated;
 }
 
+=head2 B<add_hash_entry>( $hash, $key, $entry )
+
+Very simple utility for adding $entry to the list at $hash->{$key}.
+
+=cut
+
 sub add_hash_entry {
     my( $hash, $key, $entry ) = @_;
     if( exists $hash->{$key} ) {
@@ -175,24 +196,6 @@ sub add_hash_entry {
     }
 }
 
-sub is_monotonic {
-    my( @readings ) = @_;
-    my( $common, $min, $max ) = ( -1, -1, -1 );
-    foreach my $rdg ( @readings ) {
-#         print STDERR "Checking reading " . $rdg->id . "/" . $rdg->text . " - " 
-#         . $rdg->position->reference ."\n";
-        return 0 if $rdg->position->common < $common;
-        if( $rdg->position->common == $common ) {
-            return 0 if $rdg->position->min <= $min;
-            return 0 if $rdg->position->max <= $max;
-        }
-        $common = $rdg->position->common;
-        $min = $rdg->position->min;
-        $max = $rdg->position->max;
-    }
-    return 1;
-}
-
 1;
 
 =head1 BUGS / TODO