From: Tara L Andrews Date: Fri, 2 Mar 2012 12:37:14 +0000 (+0100) Subject: fix last bugs, make stexaminer work under new regime X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a44aaf2a3c6e12fd2329a85718f2fc1fa077f9a4;p=scpubgit%2Fstemmatology.git fix last bugs, make stexaminer work under new regime --- diff --git a/Makefile.PL b/Makefile.PL index 7fdbba7..4b45b4b 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -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' ); diff --git a/lib/Text/Tradition/Analysis.pm b/lib/Text/Tradition/Analysis.pm index 9028ed0..75897ca 100644 --- a/lib/Text/Tradition/Analysis.pm +++ b/lib/Text/Tradition/Analysis.pm @@ -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. diff --git a/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm b/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm index 46c0359..1449ad2 100644 --- a/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm +++ b/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm @@ -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'}; diff --git a/stemmaweb/root/src/stexaminer.tt b/stemmaweb/root/src/stexaminer.tt index 2e2ad71..4298e0b 100644 --- a/stemmaweb/root/src/stexaminer.tt +++ b/stemmaweb/root/src/stexaminer.tt @@ -29,7 +29,7 @@ [% FOREACH reading IN row.readings -%] [% SET cellclass = 'clickable conflict' IF reading.conflict -%] [% SET cellclass = 'clickable' IF !reading.conflict -%] - [% reading.text %] + [% reading.text %] [% END -%] [% FILTER repeat( row.empty ) -%] diff --git a/t/00dependencies.t b/t/00dependencies.t index ed28fb0..c979d8e 100644 --- a/t/00dependencies.t +++ b/t/00dependencies.t @@ -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() { + 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 = $_; diff --git a/t/data/florilegium.dot b/t/data/florilegium.dot index 9419d10..7108afa 100644 --- a/t/data/florilegium.dot +++ b/t/data/florilegium.dot @@ -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 + diff --git a/t/text_tradition_analysis.t b/t/text_tradition_analysis.t index fe8ef2f..f13f2f3 100644 --- a/t/text_tradition_analysis.t +++ b/t/text_tradition_analysis.t @@ -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" ); }