=cut
sub parse {
- my( $graph, %opts ) = @_;
+ my( $tradition, %opts ) = @_;
my $format_mod = 'Text::Tradition::Parser::' . $opts{'format'};
load( $format_mod );
my @apparatus_entries = $format_mod->can('read')->( $opts{'data'} );
- merge_base( $graph, $opts{'base'}, @apparatus_entries );
+ merge_base( $tradition->collation, $opts{'base'}, @apparatus_entries );
}
=item B<merge_base>
=cut
sub merge_base {
- my( $graph, $base_file, @app_entries ) = @_;
- my @base_line_starts = read_base( $base_file, $graph );
+ my( $collation, $base_file, @app_entries ) = @_;
+ my @base_line_starts = read_base( $base_file, $collation );
my %all_witnesses;
foreach my $app ( @app_entries ) {
# last if $line > 2;
# DEBUG for problematic entries
my $scrutinize = "";
- my $first_line_node = $base_line_starts[ $line ];
+ my $first_line_reading = $base_line_starts[ $line ];
my $too_far = $base_line_starts[ $line+1 ];
my $lemma = $app->{rdg_0};
my @lemma_words = split( /\s+/, $lemma );
# Now search for the lemma words within this line.
- my $lemma_start = $first_line_node;
+ my $lemma_start = $first_line_reading;
my $lemma_end;
my %seen;
while( $lemma_start ne $too_far ) {
if( --$seq < 1 ) {
# Now we have to compare the rest of the words here.
if( scalar( @lemma_words ) > 1 ) {
- my $next_node = $graph->next_word( $lemma_start );
+ my $next_reading =
+ $collation->next_reading( $lemma_start );
foreach my $w ( @lemma_words[1..$#lemma_words] ) {
printf STDERR "Now matching %s against %s\n",
- cmp_str($next_node), $w
+ cmp_str($next_reading), $w
if "$line.$num" eq $scrutinize;
- if( $w ne cmp_str($next_node) ) {
+ if( $w ne cmp_str($next_reading) ) {
$unmatch = 1;
last;
} else {
- $lemma_end = $next_node;
- $next_node = $graph->next_word( $lemma_end );
+ $lemma_end = $next_reading;
+ $next_reading =
+ $collation->next_reading( $lemma_end );
}
}
} else {
}
last unless ( $unmatch || !defined( $lemma_end ) );
$lemma_end = undef;
- $lemma_start = $graph->next_word( $lemma_start );
+ $lemma_start = $collation->next_reading( $lemma_start );
}
unless( $lemma_end ) {
warn "No match found for @lemma_words at $line.$num";
next;
} else {
- # These are no longer common nodes; unmark them as such.
- my @lemma_nodes = $graph->node_sequence( $lemma_start,
+ # These are no longer common readings; unmark them as such.
+ my @lemma_readings = $collation->reading_sequence( $lemma_start,
$lemma_end );
- map { $_->set_attribute( 'class', 'lemma' ) } @lemma_nodes;
+ map { $_->set_attribute( 'class', 'lemma' ) } @lemma_readings;
}
- # Now we have our lemma nodes; we add the variant nodes to the graph.
+ # Now we have our lemma readings; we add the variant readings
+ # to the collation.
# Keep track of the start and end point of each reading for later
- # node collapse.
+ # reading collapse.
my @readings = ( $lemma_start, $lemma_end );
- # For each reading that is not rdg_0, we make a chain of nodes
+ # For each reading that is not rdg_0, we make a chain of readings
# and connect them to the anchor. Edges are named after the mss
# that are relevant.
foreach my $k ( grep { /^rdg/ } keys( %$app ) ) {
next if $k eq 'rdg_0'; # that's the lemma.
+ # TODO look at the lemma for any p.c. readings, and add
+ # them explicitly!
my @variant = split( /\s+/, $app->{$k} );
@variant = () if $app->{$k} eq '/'; # This is an omission.
my @mss = grep { $app->{$_} eq $k } keys( %$app );
next;
}
- # Determine the label name for the edges here.
- my $edge_name = join(', ', @mss );
+ # Keep track of what witnesses we have seen.
@all_witnesses{ @mss } = ( 1 ) x scalar( @mss );
- # Make the variant into a set of nodes.
+ # Make the variant into a set of readings.
my $ctr = 0;
- my $last_node = $graph->prior_word( $lemma_start );
+ my $last_reading = $collation->prior_reading( $lemma_start );
my $var_start;
foreach my $vw ( @variant ) {
my $vwname = "$k/$line.$num.$ctr"; $ctr++;
- my $vwnode = $graph->add_node( $vwname );
- $vwnode->set_attribute( 'label', $vw );
- $vwnode->set_attribute( 'class', 'variant' );
- $graph->add_edge( $last_node, $vwnode, $edge_name );
- $var_start = $vwnode unless $var_start;
- $last_node = $vwnode;
+ my $vwreading = $collation->add_reading( $vwname );
+ $vwreading->text( $vw );
+ $vwreading->make_variant();
+ foreach ( @mss ) {
+ $collation->add_path( $last_reading, $vwreading, $_ );
+ }
+ $var_start = $vwreading unless $var_start;
+ $last_reading = $vwreading;
}
# Now hook it up at the end.
- $graph->add_edge( $last_node, $graph->next_word( $lemma_end ),
- $edge_name );
+ foreach ( @mss ) {
+ $collation->add_path( $last_reading,
+ $collation->next_word( $lemma_end ),
+ $_ );
+ }
if( $var_start ) { # if it wasn't an empty reading
- push( @readings, $var_start, $last_node );
+ push( @readings, $var_start, $last_reading );
}
}
- # Now collate and collapse the identical nodes within the graph.
- collate_variants( $graph, @readings );
+ # Now collate and collapse the identical readings within the collation.
+ collate_variants( $collation, @readings );
}
- ## Now in theory I have a graph. I want to make it a little easier to
- ## read. So I collapse nodes that have only one edge in and one edge
- ## out, and I do this by looking at the edges.
-
-# foreach my $edge ( $graph->edges() ) {
-# my @out_edges = $edge->from()->outgoing();
-# my @in_edges = $edge->to()->incoming();
-
-# next if $edge->from() eq $graph->start();
-# next if $edge->to()->name() eq '#END#';
-# next unless scalar( @out_edges ) == 1;
-# next unless scalar( @in_edges ) == 1;
-# next unless $out_edges[0] eq $in_edges[0];
-# # In theory if we've got this far, we're safe, but just to
-# # double-check...
-# next unless $out_edges[0] eq $edge;
-
-# $graph->merge_nodes( $edge->from(), $edge->to(), ' ' );
-# }
-
- # Now walk the path for each witness, so that we can do the
- # position calculations.
- my $paths = {};
+ # Now make the witness objects
foreach my $w ( keys %all_witnesses ) {
- my $back = undef;
- if( $w =~ /^(.*)\s*\(p\.\s*c\.\)/ ) {
- $back = $1;
+ my $base = _is_post_corr( $w );
+ if( $base ) {
+ my $pctag = substr( $w, length( $base ) );
+ my $existing_wit = $collation->tradition->witness( $base );
+ unless( $existing_wit ) {
+ $existing_wit = $collation->tradition->add_witness( $base );
+ }
+ $existing_wit->post_correctione( $pctag );
+ } else {
+ $collation->tradition->add_witness( $w )
+ unless $collation->tradition->witness( $w );
}
- my @wit_nodes = $graph->node_sequence( $graph->start,
- $graph->node( '#END#' ),
- $w, $back );
- my @wn_names = map { $_->name() } @wit_nodes;
- $paths->{$w} = \@wn_names;
}
- $DB::single = 1;
- my @common_nodes = grep { $graph->is_common( $_ ) } $graph->nodes();
- $graph->make_positions( \@common_nodes, $paths );
+
+ # Now walk paths and calculate positions.
+ my @common_readings =
+ $collation->walk_and_expand_base( $collation->reading( '#END#' ) );
+ $collation->calculate_positions( @common_readings );
}
=item B<read_base>
-my @line_beginnings = read_base( 'reference.txt', $graph );
+my @line_beginnings = read_base( 'reference.txt', $collation );
-Takes a text file and a (presumed empty) graph object, adds the words
-as simple linear nodes to the graph, and returns a list of nodes that
-represent the beginning of lines. This graph is now the starting point
-for application of apparatus entries in merge_base, e.g. from a CSV
-file or a Classical Text Editor file.
+Takes a text file and a (presumed empty) collation object, adds the
+words as simple linear readings to the collation, and returns a
+list of readings that represent the beginning of lines. This collation
+is now the starting point for application of apparatus entries in
+merge_base, e.g. from a CSV file or a Classical Text Editor file.
=cut
sub read_base {
- my( $base_file, $graph ) = @_;
+ my( $base_file, $collation ) = @_;
- # This array gives the first node for each line. We put the
+ # This array gives the first reading for each line. We put the
# common starting point in line zero.
- my $last_node = $graph->start();
- my $lineref_array = [ $last_node ]; # There is no line zero.
+ my $last_reading = $collation->start();
+ my $lineref_array = [ $last_reading ]; # There is no line zero.
open( BASE, $base_file ) or die "Could not open file $base_file: $!";
while(<BASE>) {
- # Make the nodes, and connect them up for the base, but also
- # save the first node of each line in an array for the purpose.
+ # Make the readings, and connect them up for the base, but
+ # also save the first reading of each line in an array for the
+ # purpose.
+ # TODO use configurable reading separator
chomp;
my @words = split;
my $started = 0;
my $wordref = 0;
my $lineref = scalar @$lineref_array;
foreach my $w ( @words ) {
- my $noderef = join( ',', $lineref, ++$wordref );
- my $node = $graph->add_node( $noderef );
- $node->set_attribute( 'label', $w );
- $node->set_attribute( 'class', 'common' );
+ my $readingref = join( ',', $lineref, ++$wordref );
+ my $reading = $collation->add_reading( $readingref );
+ $reading->text( $w );
+ $reading->make_common();
unless( $started ) {
- push( @$lineref_array, $node );
+ push( @$lineref_array, $reading );
$started = 1;
}
- if( $last_node ) {
- my $edge = $graph->add_edge( $last_node, $node, "base text" );
- $edge->set_attribute( 'class', 'basetext' );
- $last_node = $node;
+ if( $last_reading ) {
+ my $path = $collation->add_path( $last_reading, $reading,
+ "base text" );
+ $path->set_attribute( 'class', 'basetext' );
+ $last_reading = $reading;
} # TODO there should be no else here...
}
}
close BASE;
# Ending point for all texts
- my $endpoint = $graph->add_node( '#END#' );
- $graph->add_edge( $last_node, $endpoint, "base text" );
+ my $endpoint = $collation->add_reading( '#END#' );
+ $collation->add_path( $last_reading, $endpoint, "base text" );
push( @$lineref_array, $endpoint );
return( @$lineref_array );
=item B<collate_variants>
-collate_variants( $graph, @readings )
+collate_variants( $collation, @readings )
Given a set of readings in the form
( lemma_start, lemma_end, rdg1_start, rdg1_end, ... )
-walks through each to identify those nodes that are identical. The
-graph is a Text::Tradition::Graph object; the elements of @readings are
-Graph::Easy::Node objects that appear on the graph.
+walks through each to identify those readings that are identical. The
+collation is a Text::Tradition::Collation object; the elements of
+@readings are Text::Tradition::Collation::Reading objects that appear
+on the collation graph.
TODO: Handle collapsed and non-collapsed transpositions.
=cut
sub collate_variants {
- my( $graph, @readings ) = @_;
+ my( $collation, @readings ) = @_;
my $lemma_start = shift @readings;
my $lemma_end = shift @readings;
my $detranspose = 0;
# We need to calculate positions at this point, which is where
# we are getting the implicit information from the apparatus.
- # Start the list of distinct nodes with those nodes in the lemma.
- my @distinct_nodes;
+ # Start the list of distinct readings with those readings in the lemma.
+ my @distinct_readings;
my $position = 0;
while( $lemma_start ne $lemma_end ) {
- push( @distinct_nodes, [ $lemma_start, 'base text', $position++ ] );
- $lemma_start = $graph->next_word( $lemma_start );
+ push( @distinct_readings, [ $lemma_start, 'base text', $position++ ] );
+ $lemma_start = $collation->next_word( $lemma_start );
}
- push( @distinct_nodes, [ $lemma_end, 'base text', $position++ ] );
+ push( @distinct_readings, [ $lemma_end, 'base text', $position++ ] );
while( scalar @readings ) {
my( $var_start, $var_end ) = splice( @readings, 0, 2 );
- # I want to look at the nodes in the variant and lemma, and
- # collapse nodes that are the same word. This is mini-collation.
+ # I want to look at the readings in the variant and lemma, and
+ # collapse readings that are the same word. This is mini-collation.
# Each word in the 'main' list can only be collapsed once with a
# word from the current reading.
my %collapsed = ();
- # Get the label. There will only be one outgoing edge to start
+ # Get the label. There will only be one outgoing path to start
# with, so this is safe.
my @out = $var_start->outgoing();
my $var_label = $out[0]->label();
- my @variant_nodes;
+ my @variant_readings;
while( $var_start ne $var_end ) {
- push( @variant_nodes, $var_start );
- $var_start = $graph->next_word( $var_start, $var_label );
+ push( @variant_readings, $var_start );
+ $var_start = $collation->next_word( $var_start, $var_label );
}
- push( @variant_nodes, $var_end );
+ push( @variant_readings, $var_end );
- # Go through the variant nodes, and if we find a lemma node that
- # hasn't yet been collapsed with a node, equate them. If we do
- # not, keep them to push onto the end of all_nodes.
- my @remaining_nodes;
+ # Go through the variant readings, and if we find a lemma reading that
+ # hasn't yet been collapsed with a reading, equate them. If we do
+ # not, keep them to push onto the end of all_readings.
+ my @remaining_readings;
my $last_index = 0;
my $curr_pos = 0;
- foreach my $w ( @variant_nodes ) {
+ foreach my $w ( @variant_readings ) {
my $word = $w->label();
my $matched = 0;
- foreach my $idx ( $last_index .. $#distinct_nodes ) {
- my( $l, $edgelabel, $pos ) = @{$distinct_nodes[$idx]};
+ foreach my $idx ( $last_index .. $#distinct_readings ) {
+ my( $l, $pathlabel, $pos ) = @{$distinct_readings[$idx]};
if( $word eq cmp_str( $l ) ) {
next if exists( $collapsed{ $l->label } )
&& $collapsed{ $l->label } eq $l;
$matched = 1;
$last_index = $idx if $detranspose;
- # Collapse the nodes.
- printf STDERR "Merging nodes %s/%s and %s/%s\n",
+ # Collapse the readings.
+ printf STDERR "Merging readings %s/%s and %s/%s\n",
$l->name, $l->label, $w->name, $w->label;
- $graph->merge_nodes( $l, $w );
+ $collation->merge_readings( $l, $w );
$collapsed{ $l->label } = $l;
- # Now collapse any multiple edges to and from the node.
- remove_duplicate_edges( $graph,
- $graph->prior_word( $l, $edgelabel ), $l );
- remove_duplicate_edges( $graph, $l,
- $graph->next_word( $l, $edgelabel ) );
+ # Now collapse any multiple paths to and from the reading.
+ remove_duplicate_paths( $collation,
+ $collation->prior_word( $l, $pathlabel ), $l );
+ remove_duplicate_paths( $collation, $l,
+ $collation->next_word( $l, $pathlabel ) );
$curr_pos = $pos;
last;
}
}
- push( @remaining_nodes, [ $w, $var_label, $curr_pos++ ] ) unless $matched;
+ push( @remaining_readings, [ $w, $var_label, $curr_pos++ ] ) unless $matched;
}
- push( @distinct_nodes, @remaining_nodes) if scalar( @remaining_nodes );
+ push( @distinct_readings, @remaining_readings) if scalar( @remaining_readings );
}
- # Now set the positions of all the nodes in this variation.
+ # Now set the positions of all the readings in this variation.
#$DB::single = 1;
- print STDERR "Nodes and their positions are:\n";
- foreach my $n ( @distinct_nodes ) {
+ print STDERR "Readings and their positions are:\n";
+ foreach my $n ( @distinct_readings ) {
printf STDERR "\t%s (position %s)\n", $n->[0]->label(), $n->[2];
}
}
-=item B<remove_duplicate_edges>
+=item B<remove_duplicate_paths>
-remove_duplicate_edges( $graph, $from, $to );
+remove_duplicate_paths( $collation, $from, $to );
-Given two nodes, reduce the number of edges between those nodes to
-one. If neither edge represents a base text, combine their labels.
+Given two readings, reduce the number of paths between those readings to
+one. If neither path represents a base text, combine their labels.
=cut
-sub remove_duplicate_edges {
- my( $graph, $from, $to ) = @_;
- my @edges = $from->edges_to( $to );
- if( scalar @edges > 1 ) {
- my @base = grep { $_->label eq 'base text' } @edges;
+sub remove_duplicate_paths {
+ my( $collation, $from, $to ) = @_;
+ my @paths = $from->paths_to( $to );
+ if( scalar @paths > 1 ) {
+ my @base = grep { $_->label eq 'base text' } @paths;
if ( scalar @base ) {
- # Remove the edges that are not base.
- foreach my $e ( @edges ) {
- $graph->del_edge( $e )
+ # Remove the paths that are not base.
+ foreach my $e ( @paths ) {
+ $collation->del_path( $e )
unless $e eq $base[0];
}
} else {
- # Combine the edges into one.
- my $new_edge_name = join( ', ', map { $_->label() } @edges );
- my $new_edge = shift @edges;
- $new_edge->set_attribute( 'label', $new_edge_name );
- foreach my $e ( @edges ) {
- $graph->del_edge( $e );
+ # Combine the paths into one.
+ my $new_path_name = join( ', ', map { $_->label() } @paths );
+ my $new_path = shift @paths;
+ $new_path->set_attribute( 'label', $new_path_name );
+ foreach my $e ( @paths ) {
+ $collation->del_path( $e );
}
}
}
}
+# Helper function. Given a witness sigil, if it is a post-correctione
+# sigil,return the base witness. If not, return a false value.
+sub _is_post_corr {
+ my( $sigil ) = @_;
+ if( $sigil =~ /^(.*?)(\s*\(p\.\s*c\.\))$/ ) {
+ return $1;
+ }
+ return undef;
+}
+
=item B<cmp_str>
Pretend you never saw this method. Really it needs to not be hardcoded.
=cut
sub cmp_str {
- my( $node ) = @_;
- my $word = $node->label();
+ my( $reading ) = @_;
+ my $word = $reading->label();
$word = lc( $word );
$word =~ s/\W//g;
$word =~ s/v/u/g;
projects / scpubgit/stemmatology.git / blobdiff