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;
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];
return $substitutions;
}
-sub collate_nonlinearly {
+sub _collate_nonlinearly {
my( $collation, $lemma_set, @variant_sets ) = @_;
my @unique;
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;
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} ) {
}
}
-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