=item * merge_types - Specify a list of relationship types, where related readings
should be treated as identical for the purposes of analysis.
+=item * exclude_type1 - Exclude those ranks whose groupings have only type-1 variants.
+
=back
=begin testing
);
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 ];
- push( @groups, group_variants( $tradition, $rank, $missing, \@collapse ) );
+ my $rankgroup = group_variants( $tradition, $rank, $missing, \@collapse );
+ if( $opts{'exclude_type1'} ) {
+ # Check to see whether this is a "useful" group.
+ my( $rdgs, $grps ) = _useful_variant( $rankgroup,
+ $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;
be a reference to an array, to which the sigla of lacunose witnesses at this
rank will be appended.
-Returns two ordered lists $readings, $groups, where $readings->[$n] is attested
-by the witnesses listed in $groups->[$n].
+Returns a hash $group_readings where $rdg is attested by the witnesses listed
+in $group_readings->{$rdg}.
=cut
my $aclabel = $c->ac_label;
# Get the alignment table readings
my %readings_at_rank;
+ my %is_lacunose; # lookup table for $lacunose
+ map { $is_lacunose{$_} = 1 } @$lacunose;
my @gap_wits;
foreach my $tablewit ( @{$c->alignment_table->{'alignment'}} ) {
my $rdg = $tablewit->{'tokens'}->[$rank-1];
my $wit = $tablewit->{'witness'};
+ # Exclude the witness if it is "lacunose" which if we got here
+ # means "not in the stemma".
+ next if $is_lacunose{$wit};
if( $rdg && $rdg->{'t'}->is_lacuna ) {
_add_to_witlist( $wit, $lacunose, $aclabel );
} elsif( $rdg ) {
$grouped_readings{$other->id} = 0;
}
}
- $grouped_readings{$rdg->id} = \@wits;
+ my @use_wits = grep { !$is_lacunose{$_} } @wits;
+ $grouped_readings{$rdg->id} = \@use_wits;
}
$grouped_readings{'(omitted)'} = \@gap_wits if @gap_wits;
# Get rid of our collapsed readings
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}} );
}
projects / scpubgit/stemmatology.git / blobdiff