# Also return the reading objects in the table, rather than just the words.
my $wits = {};
map { $wits->{$_} = 1 } $stemma->witnesses;
- my $all_wits_table = $tradition->collation->make_alignment_table( 'refs', $wits );
-
# For each column in the alignment table, we want to see if the existing
- # groupings of witnesses match our stemma hypothesis. We also want, at the
- # end, to produce an HTML table with all the variants.
- my $html_columns = 0;
+ # 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 );
- # Strip the list of sigla and save it for correlation to the readings.
- my $col_wits = shift @$all_wits_table;
- # Any witness in the stemma that has no row should be noted.
- foreach ( @$col_wits ) {
- $wits->{$_}++; # Witnesses present in table and stemma now have value 2.
- }
- my @not_collated = grep { $wits->{$_} == 1 } keys %$wits;
-
- # We will return a data structure, an array for each row that looks like:
- # { id = X, genealogical = Y, readings = [ text = X, group = Y], empty = N }
- my $rank = 0;
my $t0 = Benchmark->new();
- foreach my $i ( 0 .. $#$all_wits_table ) {
- # For each column in the table, group the readings by witness.
- my $rdg_wits = {};
- my $col_rdgs = shift @$all_wits_table;
- # my $rank;
- my $lacunose = [ @not_collated ];
- 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 ) {
- $rdg_text = undef; # Don't count lacunae
- push( @$lacunose, $col_wits->[$j] );
- } else {
- $rdg_text = $rdg->text;
- # Get the rank from any real reading; they should be identical.
- # $rank = $rdg->rank;
- }
- }
- 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],
- $tradition->collation->ac_label );
- }
- }
-
- # See if this column has any potentially genealogical variants.
- # If not, skip to the next.
- $total++ unless scalar keys %$rdg_wits == 1;
- my( $groups, $readings ) = useful_variant( $rdg_wits );
- next unless $groups && $readings;
- $rank++;
+ my $variant_groups = group_variants( $tradition->collation, $wits );
+ foreach my $rank ( 0 .. $#{$variant_groups} ) {
+ my $groups = $variant_groups->[$rank]->{'groups'};
+ my $readings = $variant_groups->[$rank]->{'readings'};
+ my $lacunose = $variant_groups->[$rank]->{'lacunose'};
- # Keep track of our widest row
- $html_columns = scalar @$groups if scalar @$groups > $html_columns;
+ $max_variants = scalar @$groups if scalar @$groups > $max_variants;
# We can already look up witnesses for a reading; we also want to look
# up readings for a given witness.
# For all the groups with more than one member, collect the list of all
# contiguous vertices needed to connect them.
- my $variant_row = analyze_variant_location( $group_readings, $groups,
+ my $variant_loc = analyze_variant_location( $group_readings, $groups,
$stemma->graph, $lacunose );
- $variant_row->{'id'} = $rank;
- $genealogical++ if $variant_row->{'genealogical'};
- $conflicts += grep { $_->{'conflict'} } @{$variant_row->{'readings'}};
+ $variant_loc->{'id'} = $rank;
+ $genealogical++ if $variant_loc->{'genealogical'};
+ $conflicts += grep { $_->{'conflict'} } @{$variant_loc->{'readings'}};
# Now run the same analysis given the calculated distance tree(s).
# my @trees = @{$stemma->distance_trees};
# }
# Record that we used this variant in an analysis
- push( @$variants, $variant_row );
+ 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 rows, after we have seen all of them once,
+ # 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 ) {
- my $empty = $html_columns - scalar @{$row->{'readings'}};
+ my $empty = $max_variants - scalar @{$row->{'readings'}};
$row->{'empty'} = $empty;
}
my( $c, $wits ) = @_;
my $variant_groups = [];
+ # 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 $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;
foreach ( @$col_wits ) {
$wits->{$_}++; # Witnesses present in table and stemma now have value 2.
}
- my @not_collated = grep { $wits->{$_} == 1 } keys %$wits;
+ my @not_collated = grep { $wits->{$_} == 1 } keys %$wits;
foreach my $i ( 0 .. $#$all_wits_table ) {
# For each column in the table, group the readings by witness.
my $rdg_wits = {};
my $col_rdgs = shift @$all_wits_table;
- my $rank;
my $lacunose = [ @not_collated ];
foreach my $j ( 0 .. $#{$col_rdgs} ) {
my $rdg = $col_rdgs->[$j];
push( @$lacunose, $col_wits->[$j] );
} else {
$rdg_text = $rdg->text;
- # Get the rank from any real reading; they should be identical.
- $rank = $rdg->rank;
}
}
if( defined $rdg_text ) {
my( $groups, $readings ) = useful_variant( $rdg_wits );
next unless $groups && $readings;
- push( @$variant_groups, $groups );
+ push( @$variant_groups,
+ { 'groups' => $groups, 'readings' => $readings, 'lacunose' => $lacunose } );
}
return $variant_groups;
}
+
+
# variant_row -> genealogical
# -> readings [ { text, group, conflict, missing } ]
projects / scpubgit/stemmatology.git / commitdiff