fix last bugs, make stexaminer work under new regime
Tara L Andrews [Fri, 2 Mar 2012 12:37:14 +0000 (13:37 +0100)]
Makefile.PL
lib/Text/Tradition/Analysis.pm
stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm
stemmaweb/root/src/stexaminer.tt
t/00dependencies.t
t/data/florilegium.dot
t/text_tradition_analysis.t

index 7fdbba7..4b45b4b 100644 (file)
@@ -24,7 +24,6 @@ requires( 'Moose' );
 requires( 'Moose::Util::TypeConstraints' );
 requires( 'StackTrace::Auto' );
 requires( 'Text::CSV_XS' );
-requires( 'Text::CSV::Simple' ); # TODO delete
 requires( 'Throwable::X' );
 requires( 'TryCatch' );
 requires( 'XML::LibXML' );
index 9028ed0..75897ca 100644 (file)
@@ -70,28 +70,28 @@ my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
 is( ref( $s ), 'Text::Tradition::Stemma', "Added stemma to tradition" );
 
 my %expected_genealogical = (
-       1 => '',
+       1 => 0,
        2 => 1,
-       3 =>  '',
-       5 =>  '',
-       7 =>  '',
-       8 =>  '',
-       10 => '',
+       3 =>  0,
+       5 =>  0,
+       7 =>  0,
+       8 =>  0,
+       10 => 0,
        13 => 1,
-       33 => '',
-       34 => '',
-       37 => '',
-       60 => '',
+       33 => 0,
+       34 => 0,
+       37 => 0,
+       60 => 0,
        81 => 1,
-       84 => '',
-       87 => '',
-       101 => '',
-       102 => '',
+       84 => 0,
+       87 => 0,
+       101 => 0,
+       102 => 0,
        122 => 1,
-       157 => '',
+       157 => 0,
        166 => 1,
        169 => 1,
-       200 => 1,
+       200 => 0,
        216 => 1,
        217 => 1,
        219 => 1,
@@ -102,11 +102,15 @@ my %expected_genealogical = (
 
 my $data = run_analysis( $tradition );
 foreach my $row ( @{$data->{'variants'}} ) {
+       # Account for rows that used to be "not useful"
+       unless( exists $expected_genealogical{$row->{'id'}} ) {
+               $expected_genealogical{$row->{'id'}} = 1;
+       }
        is( $row->{'genealogical'}, $expected_genealogical{$row->{'id'}}, 
                "Got correct genealogical flag for row " . $row->{'id'} );
 }
-is( $data->{'conflict_count'}, 16, "Got right conflict count" );
-is( $data->{'variant_count'}, 28, "Got right total variant number" );
+is( $data->{'conflict_count'}, 34, "Got right conflict count" );
+is( $data->{'variant_count'}, 58, "Got right total variant number" );
 
 =end testing
 
@@ -133,7 +137,7 @@ sub run_analysis {
        # explicitly specified.
        unless( @ranks ) {
                my %common_rank;
-               foreach my $rdg ( $tradition->collation->common_readings ) {
+               foreach my $rdg ( $c->common_readings ) {
                        $common_rank{$rdg->rank} = 1;
                }
                @ranks = grep { !$common_rank{$_} } ( 1 .. $c->end->rank-1 );
@@ -141,22 +145,35 @@ sub run_analysis {
        
        # Group the variants to send to the solver
        my @groups;
+       my %lacunae;
        foreach my $rank ( @ranks ) {
-               push( @groups, group_variants( $tradition, $rank, \@lacunose, \@collapse ) );
+               my $missing = [ @lacunose ];
+               push( @groups, group_variants( $tradition, $rank, $missing, \@collapse ) );
+               $lacunae{$rank} = $missing;
        }
        
        # Parse the answer
        my $answer = solve_variants( $stemma->editable( ' ' ), @groups );
-       $DB::single = 1;
 
        # Do further analysis on the answer
+       my $conflict_count = 0;
        foreach my $idx ( 0 .. $#ranks ) {
                my $location = $answer->{'variants'}->[$idx];
                # Add the rank back in
                $location->{'id'} = $ranks[$idx];
+               # Add the lacunae back in
+               $location->{'missing'} = $lacunae{$ranks[$idx]};
                # Run the extra analysis we need.
                analyze_location( $tradition, $stemma->graph, $location );
+               # Add the reading text back in
+               foreach my $rdghash ( @{$location->{'readings'}} ) {
+                       $conflict_count++ 
+                               if exists $rdghash->{'conflict'} && $rdghash->{'conflict'};
+                       my $rdg = $c->reading( $rdghash->{'readingid'} );
+                       $rdghash->{'text'} = $rdg ? $rdg->text : $rdghash->{'readingid'};
+               }
        }
+       $answer->{'conflict_count'} = $conflict_count;
        
        return $answer;
 }
@@ -340,7 +357,6 @@ sub analyze_location {
         $rdghash->{'followed'} = scalar( $part->vertices ) - scalar( @roots );
         # Find the parent readings, if any, of this reading.
         my %rdgparents;
-        $DB::single = 1;
         foreach my $wit ( @roots ) {
                # Look in the main stemma to find this witness's extant or known-reading
                # immediate ancestor(s), and look up the reading that each ancestor olds.
index 46c0359..1449ad2 100644 (file)
@@ -3,7 +3,7 @@ use Moose;
 use namespace::autoclean;
 use File::Temp;
 use JSON;
-use Text::Tradition::Analysis qw/ run_analysis /;
+use Text::Tradition::Analysis qw/ run_analysis wit_stringify /;
 
 BEGIN { extends 'Catalyst::Controller' }
 
@@ -38,6 +38,15 @@ sub index :Path :Args(1) {
                $c->stash->{template} = 'stexaminer.tt'; 
                # TODO Run the analysis as AJAX from the loaded page.
                my $t = run_analysis( $tradition );
+               # Stringify the reading groups
+               foreach my $loc ( @{$t->{'variants'}} ) {
+                       my $mst = wit_stringify( $loc->{'missing'} );
+                       $loc->{'missing'} = $mst;
+                       foreach my $rhash ( @{$loc->{'readings'}} ) {
+                               my $gst = wit_stringify( $rhash->{'group'} );
+                               $rhash->{'group'} = $gst;
+                       }
+               }
                $c->stash->{variants} = $t->{'variants'};
                $c->stash->{total} = $t->{'variant_count'};
                $c->stash->{genealogical} = $t->{'genealogical_count'};
index 2e2ad71..4298e0b 100644 (file)
@@ -29,7 +29,7 @@
 [% FOREACH reading IN row.readings -%]
 [% SET cellclass = 'clickable conflict' IF reading.conflict -%]
 [% SET cellclass = 'clickable' IF !reading.conflict -%]
-          <td class="[% cellclass %]"><span onclick="color_nodes($(this).parent().index(), [% reading.group %], [% reading.missing %]);$(this).parents('tr').addClass('active_variant_row');$(this).parent().addClass('active_variant_cell cellb'+($(this).parent().index()-1))">[% reading.text %]</span></td>
+          <td class="[% cellclass %]"><span onclick="color_nodes($(this).parent().index(), [% reading.group %], [% row.missing %]);$(this).parents('tr').addClass('active_variant_row');$(this).parent().addClass('active_variant_cell cellb'+($(this).parent().index()-1))">[% reading.text %]</span></td>
 [% END -%]
 [% FILTER repeat( row.empty ) -%]
           <td/>
index ed28fb0..c979d8e 100644 (file)
@@ -17,6 +17,16 @@ if ($@) { plan skip_all => 'Module::CoreList not installed' }
 
 plan 'no_plan';
 
+my %skipped;
+if( -f 'MANIFEST.SKIP' ) {
+       # We don't want these
+       open( SKIP, 'MANIFEST.SKIP' ) or die "Could not open manifest skip file";
+       while(<SKIP>) {
+               chomp;
+               $skipped{$_} = 1;
+       }
+       close SKIP;
+}
 my %used;
 find( \&wanted, qw/ lib t / );
 
@@ -25,6 +35,7 @@ sub wanted {
     return if $File::Find::dir  =~ m!/.git($|/)!;
     return if $File::Find::name =~ /~$/;
     return if $File::Find::name =~ /\.(pod|html)$/;
+    return if $skipped{$File::Find::name};
 
     # read in the file from disk
     my $filename = $_;
index 9419d10..7108afa 100644 (file)
@@ -12,21 +12,27 @@ digraph Stemma {
     C [ class=extant ];
     D [ class=extant ];
     E [ class=extant ];
+    E_ac [ class=extant ];
     F [ class=extant ];
     G [ class=extant ];
     H [ class=extant ];
     K [ class=extant ];
     P [ class=extant ];
+    P_ac [ class=extant ];
     Q [ class=extant ];
+    Q_ac [ class=extant ];
     S [ class=extant ];
     T [ class=extant ];
+    T_ac [ class=extant ];
     "α" -> A;
     "α" -> T;
+    T -> T_ac;
     "α" -> "δ";
     "δ" -> 2;
     2 -> C;
     2 -> B;
     B -> P;
+    P -> P_ac;
     B -> S;
     "δ" -> "γ";
     "γ" -> 3;
@@ -36,9 +42,11 @@ digraph Stemma {
     4 -> D;
     4 -> 5;
     5 -> Q;
+    Q -> Q_ac;
     5 -> K;
     5 -> 7;
     7 -> E;
+    E -> E_ac;
     7 -> G;
 }
-    
\ No newline at end of file
+    
index fe8ef2f..f13f2f3 100644 (file)
@@ -19,28 +19,28 @@ my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
 is( ref( $s ), 'Text::Tradition::Stemma', "Added stemma to tradition" );
 
 my %expected_genealogical = (
-       1 => '',
+       1 => 0,
        2 => 1,
-       3 =>  '',
-       5 =>  '',
-       7 =>  '',
-       8 =>  '',
-       10 => '',
+       3 =>  0,
+       5 =>  0,
+       7 =>  0,
+       8 =>  0,
+       10 => 0,
        13 => 1,
-       33 => '',
-       34 => '',
-       37 => '',
-       60 => '',
+       33 => 0,
+       34 => 0,
+       37 => 0,
+       60 => 0,
        81 => 1,
-       84 => '',
-       87 => '',
-       101 => '',
-       102 => '',
+       84 => 0,
+       87 => 0,
+       101 => 0,
+       102 => 0,
        122 => 1,
-       157 => '',
+       157 => 0,
        166 => 1,
        169 => 1,
-       200 => 1,
+       200 => 0,
        216 => 1,
        217 => 1,
        219 => 1,
@@ -51,11 +51,15 @@ my %expected_genealogical = (
 
 my $data = run_analysis( $tradition );
 foreach my $row ( @{$data->{'variants'}} ) {
+       # Account for rows that used to be "not useful"
+       unless( exists $expected_genealogical{$row->{'id'}} ) {
+               $expected_genealogical{$row->{'id'}} = 1;
+       }
        is( $row->{'genealogical'}, $expected_genealogical{$row->{'id'}}, 
                "Got correct genealogical flag for row " . $row->{'id'} );
 }
-is( $data->{'conflict_count'}, 16, "Got right conflict count" );
-is( $data->{'variant_count'}, 28, "Got right total variant number" );
+is( $data->{'conflict_count'}, 34, "Got right conflict count" );
+is( $data->{'variant_count'}, 58, "Got right total variant number" );
 }