);
my $data = run_analysis( $tradition );
+my $c = $tradition->collation;
foreach my $row ( @{$data->{'variants'}} ) {
# Account for rows that used to be "not useful"
unless( exists $expected_genealogical{$row->{'id'}} ) {
}
is( $row->{'genealogical'}, $expected_genealogical{$row->{'id'}},
"Got correct genealogical flag for row " . $row->{'id'} );
+ # Check that we have the right row with the right groups
+ my $rank = $row->{'id'};
+ foreach my $rdghash ( @{$row->{'readings'}} ) {
+ # Skip 'readings' that aren't really
+ next unless $c->reading( $rdghash->{'readingid'} );
+ # Check the rank
+ is( $c->reading( $rdghash->{'readingid'} )->rank, $rank,
+ "Got correct reading rank" );
+ # Check the witnesses
+ my @realwits = sort $c->reading_witnesses( $rdghash->{'readingid'} );
+ my @sgrp = sort @{$rdghash->{'group'}};
+ is_deeply( \@sgrp, \@realwits, "Reading analyzed with correct groups" );
+ }
}
is( $data->{'variant_count'}, 58, "Got right total variant number" );
# TODO Make something meaningful of conflict count, maybe test other bits
# Group the variants to send to the solver
my @groups;
+ my @use_ranks;
my %lacunae;
foreach my $rank ( @ranks ) {
my $missing = [ @lacunose ];
$stemma->graph, $c->ac_label );
next unless @$rdgs;
}
+ push( @use_ranks, $rank );
push( @groups, $rankgroup );
$lacunae{$rank} = $missing;
}
- $DB::single = 1;
# Parse the answer
my $answer = solve_variants( $stemma, @groups );
# Do further analysis on the answer
my $conflict_count = 0;
- foreach my $idx ( 0 .. $#ranks ) {
+ my $aclabel = $c->ac_label;
+ foreach my $idx ( 0 .. $#use_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]};
+ $location->{'id'} = $use_ranks[$idx];
+ # Note what our lacunae are
+ my %lmiss;
+ map { $lmiss{$_} = 1 } @{$lacunae{$use_ranks[$idx]}};
+ # Run through the reading groups and add as 'lacunae' any redundant
+ # a.c. witnesses (yes, we have to do this before the analysis, thus
+ # identical loops before and after. Boo.)
+ # TODO Consider making these callbacks to analyze_location
+ foreach my $rdghash ( @{$location->{'readings'}} ) {
+ my %rwits;
+ map { $rwits{$_} = 1 } @{$rdghash->{'group'}};
+ foreach my $rw ( keys %rwits ) {
+ if( $rw =~ /^(.*)\Q$aclabel\E$/ ) {
+ if( exists $rwits{$1} ) {
+ $lmiss{$rw} = 1;
+ delete $rwits{$rw};
+ }
+ }
+ }
+ $rdghash->{'group'} = [ keys %rwits ];
+ }
+ $location->{'missing'} = [ keys %lmiss ];
+
# Run the extra analysis we need.
analyze_location( $tradition, $stemma->graph, $location );
- # Add the reading text back in
+
+ # Do the final post-analysis tidying up of the data.
foreach my $rdghash ( @{$location->{'readings'}} ) {
$conflict_count++
if exists $rdghash->{'conflict'} && $rdghash->{'conflict'};
+ # Add the reading text back in
my $rdg = $c->reading( $rdghash->{'readingid'} );
$rdghash->{'text'} = $rdg ? $rdg->text : $rdghash->{'readingid'};
+ # Remove lacunose witnesses from this reading's list now that the
+ # analysis is done
+ my @realgroup;
+ map { push( @realgroup, $_ ) unless $lmiss{$_} } @{$rdghash->{'group'}};
+ $rdghash->{'group'} = \@realgroup;
+ # TODO Record hypotheticals used to create group, if we end up
+ # needing it
}
}
$answer->{'conflict_count'} = $conflict_count;
my $groupings = [];
foreach my $ghash ( @groups ) {
my @grouping;
- foreach my $k ( keys %$ghash ) {
+ foreach my $k ( sort keys %$ghash ) {
push( @grouping, $ghash->{$k} );
}
push( @$groupings, \@grouping );
'genealogical' => $result,
'readings' => [],
};
- foreach my $k ( keys %$input_group ) {
+ foreach my $k ( sort { @{$input_group->{$b}} <=> @{$input_group->{$a}} }
+ keys %$input_group ) {
push( @{$vstruct->{'readings'}},
{ 'readingid' => $k, 'group' => $input_group->{$k}} );
}