use new stemma interface

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

diff --git a/lib/Text/Tradition/Analysis.pm b/lib/Text/Tradition/Analysis.pm
index 399dbab..910f994 100644 (file)
--- a/lib/Text/Tradition/Analysis.pm
+++ b/lib/Text/Tradition/Analysis.pm
@@ -8,42 +8,21 @@ use Text::Tradition;
 use Text::Tradition::Stemma;
 
 use vars qw/ @EXPORT_OK /;
-@EXPORT_OK = qw/ run_analysis group_variants wit_stringify /;
-
-sub new {
-       my( $class, $args ) = @_;
-       my $self = {};
-       bless( $self, $class ); 
-       $self->{'data'} = [];
-       foreach my $t ( @{$args->{'traditions'}} ) {
-           $self->run_analysis( $t->{'file'}, $t->{'stemmadot'} );
-       }
-       return $self;
-}
+@EXPORT_OK = qw/ run_analysis group_variants analyze_variant_location wit_stringify /;
 
 sub run_analysis {
-       my( $self, $file, $stemmadot ) = @_;
+       my( $tradition ) = @_;
        # What we will return
-       my $svg;
        my $variants = [];
        my $data = {};
        
-       # Read in the file and stemma   
-       my $tradition = Text::Tradition->new( 
-               'input'  => 'Self',
-               'file'   => $file,
-               'linear' => 1,
-               );
-       $data->{'title'} = $tradition->name;
-       
-       my $stemma = Text::Tradition::Stemma->new(
-               'collation' => $tradition->collation,
-               'dot' => $stemmadot,
-               );
-       # We will return the stemma picture
-       $svg = $stemma->as_svg( { size => "8,7.5" } );;
-       $data->{'svg'} = $svg;
-       
+       # We need a stemma in order to run this...
+       unless( $tradition->stemma_count ) {
+               warn "Tradition '" . $tradition->name . "' has no stemma to analyze";
+               return undef;
+       }
+       my $stemma = $tradition->stemma(0); # TODO allow multiple
+               
        # We have the collation, so get the alignment table with witnesses in rows.
        # Also return the reading objects in the table, rather than just the words.
        my $wits = {};
@@ -52,9 +31,8 @@ sub run_analysis {
        # groupings of witnesses match our stemma hypothesis. We also need to keep
        # track of the maximum number of variants at any one location.
        my $max_variants = 0;
-       my ( $total, $genealogical, $conflicts ) = ( 0, 0, 0 );
+       my ( $genealogical, $conflicts ) = ( 0, 0, 0 );
        
-    my $t0 = Benchmark->new();
     my $variant_groups = group_variants( $tradition->collation, $wits );
     foreach my $rank ( 0 .. $#{$variant_groups} ) {
         my $groups = $variant_groups->[$rank]->{'groups'};
@@ -93,10 +71,7 @@ sub run_analysis {
                # Record that we used this variant in an analysis
                push( @$variants, $variant_loc );
        }
-    my $t1 = Benchmark->new();
-    print STDERR "Analysis of graph for " . $tradition->name . " took " 
-        . timestr( timediff( $t1, $t0 ) ) . "seconds\n";
-       
+
        # Go through our variant locations, after we have seen all of them once,
        # and add the number of empty columns needed by each.
        foreach my $row ( @$variants ) {
@@ -104,12 +79,11 @@ sub run_analysis {
                $row->{'empty'} = $empty;
        }
        
-       # Populate self with our analysis data.
        $data->{'variants'} = $variants;
-       $data->{'variant_count'} = $total;
+       $data->{'variant_count'} = $tradition->collation->end->rank - 1;
        $data->{'conflict_count'} = $conflicts;
        $data->{'genealogical_count'} = $genealogical;
-       push( @{$self->{'data'}}, $data );
+       return $data;
 }
 
 sub group_variants {
@@ -120,33 +94,33 @@ sub group_variants {
        # Also return the reading objects in the table, rather than just the words.
        my $all_wits_table = $c->make_alignment_table( 'refs', $wits );
        # Strip the list of sigla and save it for correlation to the readings.
-       my $col_wits = shift @$all_wits_table;
+       my @table_wits = map { $_->{'witness'} } @{$all_wits_table->{'alignment'}};
        # Any witness in the stemma that has no row should be noted.
-    foreach ( @$col_wits ) {
+    foreach ( @table_wits ) {
         $wits->{$_}++; # Witnesses present in table and stemma now have value 2.
     }
     my @not_collated = grep { $wits->{$_} == 1 } keys %$wits;
-       foreach my $i ( 0 .. $#$all_wits_table ) {
+       foreach my $i ( 0 .. $all_wits_table->{'length'} - 1 ) {
                # For each column in the table, group the readings by witness.
                my $rdg_wits = {};
-               my $col_rdgs = shift @$all_wits_table;
+               my @col_rdgs = map { $_->{tokens}->[$i] } @{$all_wits_table->{'alignment'}};
                my $lacunose = [ @not_collated ];
-               foreach my $j ( 0 .. $#{$col_rdgs} ) {
-                       my $rdg = $col_rdgs->[$j];
+               foreach my $j ( 0 .. $#col_rdgs ) {
+                       my $rdg = $col_rdgs[$j];
                        my $rdg_text = '(omitted)';  # Initialize in case of empty reading
                        if( $rdg ) {
-                           if( $rdg->is_lacuna ) {
+                           if( $rdg->{'t'}->is_lacuna ) {
                                $rdg_text = undef;   # Don't count lacunae
-                               push( @$lacunose, $col_wits->[$j] );
+                               push( @$lacunose, $table_wits[$j] );
                            } else {
-                               $rdg_text = $rdg->text; 
+                               $rdg_text = $rdg->{'t'}->text; 
                                }
                        }
                        if( defined $rdg_text ) {
                                # Initialize the witness array if we haven't got one yet
                                $rdg_wits->{$rdg_text} = [] unless $rdg_wits->{$rdg_text};
                                # Add the relevant witness, subject to a.c. logic
-                               add_variant_wit( $rdg_wits->{$rdg_text}, $col_wits->[$j],
+                               add_variant_wit( $rdg_wits->{$rdg_text}, $table_wits[$j],
                                        $c->ac_label );
                        }
                }