X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=fcdd1ff78959c66662fc5ac00a9481fba6afdf90;hb=2a8127263ef278f3f14b480a12b84f9aa4f92fdc;hp=5f94dfb2eaad1356eafda00eecf3fd3ab26cd10b;hpb=1f7aa795ef1c5a8567cf241e59c496ea56576ede;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 5f94dfb..fcdd1ff 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -2,61 +2,60 @@ package Text::Tradition::Collation;
 
 use Encode qw( decode_utf8 );
 use File::Temp;
+use File::Which;
 use Graph;
-use Graph::Easy;
 use IPC::Run qw( run binary );
-use Text::CSV_XS;
-use Text::Tradition::Collation::Path;
+use Text::CSV;
 use Text::Tradition::Collation::Reading;
-use Text::Tradition::Collation::Relationship;
+use Text::Tradition::Collation::RelationshipStore;
+use Text::Tradition::Error;
+use XML::Easy::Syntax qw( $xml10_namestartchar_rx $xml10_namechar_rx );
 use XML::LibXML;
+use XML::LibXML::XPathContext;
 use Moose;
 
-has 'graph' => (
+has 'sequence' => (
     is => 'ro',
-    isa => 'Graph::Easy',
+    isa => 'Graph',
+    default => sub { Graph->new() },
     handles => {
-        add_reading => 'add_node',
-        add_lacuna => 'add_node',
-        del_reading => 'del_node',
-        add_path => 'add_edge',
-        del_path => 'del_edge',
-        reading => 'node',
-        path => 'edge',
-        readings => 'nodes',
-        paths => 'edges',
-        relationships => 'edges',
+    	paths => 'edges',
     },
-    default => sub { Graph::Easy->new( undirected => 0 ) },
     );
-                
-
-has 'tradition' => (  # TODO should this not be ro?
-    is => 'rw',
+    
+has 'relations' => (
+	is => 'ro',
+	isa => 'Text::Tradition::Collation::RelationshipStore',
+	handles => {
+		relationships => 'relationships',
+		related_readings => 'related_readings',
+		get_relationship => 'get_relationship',
+		del_relationship => 'del_relationship',
+		equivalence => 'equivalence',
+		equivalence_graph => 'equivalence_graph',
+	},
+	writer => '_set_relations',
+	);
+
+has 'tradition' => (
+    is => 'ro',
     isa => 'Text::Tradition',
+    writer => '_set_tradition',
     weak_ref => 1,
     );
 
-has 'svg' => (
-    is => 'ro',
-    isa => 'Str',
-    writer => '_save_svg',
-    predicate => 'has_svg',
-    );
-
-has 'graphml' => (
-    is => 'ro',
-    isa => 'Str',
-    writer => '_save_graphml',
-    predicate => 'has_graphml',
-    );
-
-has 'csv' => (
-    is => 'ro',
-    isa => 'Str',
-    writer => '_save_csv',
-    predicate => 'has_csv',
-    );
+has 'readings' => (
+	isa => 'HashRef[Text::Tradition::Collation::Reading]',
+	traits => ['Hash'],
+    handles => {
+        reading     => 'get',
+        _add_reading => 'set',
+        del_reading => 'delete',
+        has_reading => 'exists',
+        readings   => 'values',
+    },
+    default => sub { {} },
+	);
 
 has 'wit_list_separator' => (
     is => 'rw',
@@ -70,286 +69,855 @@ has 'baselabel' => (
     default => 'base text',
     );
 
-has 'collapsed' => (
-    is => 'rw',
-    isa => 'Bool',
-    );
-
 has 'linear' => (
     is => 'rw',
     isa => 'Bool',
     default => 1,
     );
-
+    
 has 'ac_label' => (
     is => 'rw',
     isa => 'Str',
     default => ' (a.c.)',
     );
+    
+has 'wordsep' => (
+	is => 'rw',
+	isa => 'Str',
+	default => ' ',
+	);
+    
+has 'start' => (
+	is => 'ro',
+	isa => 'Text::Tradition::Collation::Reading',
+	writer => '_set_start',
+	weak_ref => 1,
+	);
+
+has 'end' => (
+	is => 'ro',
+	isa => 'Text::Tradition::Collation::Reading',
+	writer => '_set_end',
+	weak_ref => 1,
+	);
+	
+has 'cached_svg' => (
+	is => 'rw',
+	isa => 'Str',
+	predicate => 'has_cached_svg',
+	clearer => 'wipe_svg',
+	);
+	
+has 'cached_table' => (
+	is => 'rw',
+	isa => 'HashRef',
+	predicate => 'has_cached_table',
+	clearer => 'wipe_table',
+	);
+	
+has '_graphcalc_done' => (
+	is => 'rw',
+	isa => 'Bool',
+	default => undef,
+	); 
+
+=head1 NAME
+
+Text::Tradition::Collation - a software model for a text collation
+
+=head1 SYNOPSIS
+
+  use Text::Tradition;
+  my $t = Text::Tradition->new( 
+    'name' => 'this is a text',
+    'input' => 'TEI',
+    'file' => '/path/to/tei_parallel_seg_file.xml' );
+
+  my $c = $t->collation;
+  my @readings = $c->readings;
+  my @paths = $c->paths;
+  my @relationships = $c->relationships;
+  
+  my $svg_variant_graph = $t->collation->as_svg();
+    
+=head1 DESCRIPTION
 
+Text::Tradition is a library for representation and analysis of collated
+texts, particularly medieval ones.  The Collation is the central feature of
+a Tradition, where the text, its sequence of readings, and its relationships
+between readings are actually kept.
 
-# The collation can be created two ways:
-# 1. Collate a set of witnesses (with CollateX I guess) and process
-#    the results as in 2.
-# 2. Read a pre-prepared collation in one of a variety of formats,
-#    and make the graph from that.
+=head1 CONSTRUCTOR
 
-# The graph itself will (for now) be immutable, and the positions
-# within the graph will also be immutable.  We need to calculate those
-# positions upon graph construction.  The equivalences between graph
-# nodes will be mutable, entirely determined by the user (or possibly
-# by some semantic pre-processing provided by the user.)  So the
-# constructor should just make an empty equivalences object.  The
-# constructor will also need to make the witness objects, if we didn't
-# come through option 1.
+=head2 new
 
-sub BUILD {
-    my( $self, $args ) = @_;
-    $self->graph->use_class('node', 'Text::Tradition::Collation::Reading');
-    $self->graph->use_class('edge', 'Text::Tradition::Collation::Path');
+The constructor.  Takes a hash or hashref of the following arguments:
 
-    # Pass through any graph-specific options.
-    my $shape = exists( $args->{'shape'} ) ? $args->{'shape'} : 'ellipse';
-    $self->graph->set_attribute( 'node', 'shape', $shape );
-    
-	# Start and end points for all texts
-	$self->start( 'INIT' );
-	$self->end( 'INIT' );
-}
+=over
 
-around add_lacuna => sub {
-    my $orig = shift;
-    my $self = shift;
-    my $id = shift @_;
-    my $l = $self->$orig( '#LACUNA_' . $id . '#' );
-    $l->is_lacuna( 1 );
-    return $l;
-};
+=item * tradition - The Text::Tradition object to which the collation 
+belongs. Required.
 
-# Wrapper around add_path 
+=item * linear - Whether the collation should be linear; that is, whether 
+transposed readings should be treated as two linked readings rather than one, 
+and therefore whether the collation graph is acyclic.  Defaults to true.
 
-around add_path => sub {
-    my $orig = shift;
-    my $self = shift;
+=item * baselabel - The default label for the path taken by a base text 
+(if any). Defaults to 'base text'.
 
-    # Make sure there are three arguments
-    unless( @_ == 3 ) {
-        warn "Call add_path with args source, target, witness";
-        return;
-    }
-    # Make sure the proposed path does not yet exist
-    # NOTE 'reading' will currently return readings and segments
-    my( $source, $target, $wit ) = @_;
-    $source = $self->reading( $source )
-        unless ref( $source ) eq 'Text::Tradition::Collation::Reading';
-    $target = $self->reading( $target )
-        unless ref( $target ) eq 'Text::Tradition::Collation::Reading';
-    foreach my $path ( $source->edges_to( $target ) ) {
-        if( $path->label eq $wit && $path->class eq 'edge.path' ) {
-            return;
-        }
-    }
-    # Do the deed
-    $self->$orig( @_ );
-};
+=item * wit_list_separator - The string to join a list of witnesses for 
+purposes of making labels in display graphs.  Defaults to ', '.
+
+=item * ac_label - The extra label to tack onto a witness sigil when 
+representing another layer of path for the given witness - that is, when
+a text has more than one possible reading due to scribal corrections or
+the like.  Defaults to ' (a.c.)'.
+
+=item * wordsep - The string used to separate words in the original text.
+Defaults to ' '.
+
+=back
+
+=head1 ACCESSORS
+
+=head2 tradition
+
+=head2 linear
+
+=head2 wit_list_separator
+
+=head2 baselabel
+
+=head2 ac_label
+
+=head2 wordsep
+
+Simple accessors for collation attributes.
 
-# Wrapper around paths
-around paths => sub {
-    my $orig = shift;
+=head2 start
+
+The meta-reading at the start of every witness path.
+
+=head2 end
+
+The meta-reading at the end of every witness path.
+
+=head2 readings
+
+Returns all Reading objects in the graph.
+
+=head2 reading( $id )
+
+Returns the Reading object corresponding to the given ID.
+
+=head2 add_reading( $reading_args )
+
+Adds a new reading object to the collation. 
+See L<Text::Tradition::Collation::Reading> for the available arguments.
+
+=head2 del_reading( $object_or_id )
+
+Removes the given reading from the collation, implicitly removing its
+paths and relationships.
+
+=head2 merge_readings( $main, $second, $concatenate, $with_str )
+
+Merges the $second reading into the $main one. If $concatenate is true, then
+the merged node will carry the text of both readings, concatenated with either
+$with_str (if specified) or a sensible default (the empty string if the
+appropriate 'join_*' flag is set on either reading, or else $self->wordsep.)
+
+The first two arguments may be either readings or reading IDs.
+
+=head2 has_reading( $id )
+
+Predicate to see whether a given reading ID is in the graph.
+
+=head2 reading_witnesses( $object_or_id )
+
+Returns a list of sigils whose witnesses contain the reading.
+
+=head2 paths
+
+Returns all reading paths within the document - that is, all edges in the 
+collation graph.  Each path is an arrayref of [ $source, $target ] reading IDs.
+
+=head2 add_path( $source, $target, $sigil )
+
+Links the given readings in the collation in sequence, under the given witness
+sigil.  The readings may be specified by object or ID.
+
+=head2 del_path( $source, $target, $sigil )
+
+Links the given readings in the collation in sequence, under the given witness
+sigil.  The readings may be specified by object or ID.
+
+=head2 has_path( $source, $target );
+
+Returns true if the two readings are linked in sequence in any witness.  
+The readings may be specified by object or ID.
+
+=head2 relationships
+
+Returns all Relationship objects in the collation.
+
+=head2 add_relationship( $reading, $other_reading, $options )
+
+Adds a new relationship of the type given in $options between the two readings,
+which may be specified by object or ID.  Returns a value of ( $status, @vectors)
+where $status is true on success, and @vectors is a list of relationship edges
+that were ultimately added.
+See L<Text::Tradition::Collation::Relationship> for the available options.
+
+=cut 
+
+sub BUILD {
     my $self = shift;
+    $self->_set_relations( Text::Tradition::Collation::RelationshipStore->new( 'collation' => $self ) );
+    $self->_set_start( $self->add_reading( { 'collation' => $self, 'is_start' => 1 } ) );
+    $self->_set_end( $self->add_reading( { 'collation' => $self, 'is_end' => 1 } ) );
+}
 
-    my @result = grep { $_->sub_class eq 'path' } $self->$orig( @_ );
-    return @result;
+### Reading construct/destruct functions
+
+sub add_reading {
+	my( $self, $reading ) = @_;
+	unless( ref( $reading ) eq 'Text::Tradition::Collation::Reading' ) {
+		my %args = %$reading;
+		if( $self->tradition->has_language && !exists $args{'language'} ) {
+			$args{'language'} = $self->tradition->language;
+		}
+		$reading = Text::Tradition::Collation::Reading->new( 
+			'collation' => $self,
+			%args );
+	}
+	# First check to see if a reading with this ID exists.
+	if( $self->reading( $reading->id ) ) {
+		throw( "Collation already has a reading with id " . $reading->id );
+	}
+	$self->_graphcalc_done(0);
+	$self->_add_reading( $reading->id => $reading );
+	# Once the reading has been added, put it in both graphs.
+	$self->sequence->add_vertex( $reading->id );
+	$self->relations->add_reading( $reading->id );
+	return $reading;
 };
 
-around relationships => sub {
-    my $orig = shift;
-    my $self = shift;
-    my @result = grep { $_->sub_class eq 'relationship' } $self->$orig( @_ );
-    return @result;
+around del_reading => sub {
+	my $orig = shift;
+	my $self = shift;
+	my $arg = shift;
+	
+	if( ref( $arg ) eq 'Text::Tradition::Collation::Reading' ) {
+		$arg = $arg->id;
+	}
+	# Remove the reading from the graphs.
+	$self->_graphcalc_done(0);
+	$self->_clear_cache; # Explicitly clear caches to GC the reading
+	$self->sequence->delete_vertex( $arg );
+	$self->relations->delete_reading( $arg );
+	
+	# Carry on.
+	$self->$orig( $arg );
 };
 
-# Wrapper around merge_nodes
+=begin testing
+
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+my $rno = scalar $c->readings;
+# Split n21 for testing purposes
+my $new_r = $c->add_reading( { 'id' => 'n21p0', 'text' => 'un', 'join_next' => 1 } );
+my $old_r = $c->reading( 'n21' );
+$old_r->alter_text( 'to' );
+$c->del_path( 'n20', 'n21', 'A' );
+$c->add_path( 'n20', 'n21p0', 'A' );
+$c->add_path( 'n21p0', 'n21', 'A' );
+$c->flatten_ranks();
+ok( $c->reading( 'n21p0' ), "New reading exists" );
+is( scalar $c->readings, $rno, "Reading add offset by flatten_ranks" );
+
+# Combine n3 and n4 ( with his )
+$c->merge_readings( 'n3', 'n4', 1 );
+ok( !$c->reading('n4'), "Reading n4 is gone" );
+is( $c->reading('n3')->text, 'with his', "Reading n3 has both words" );
+
+# Collapse n9 and n10 ( rood / root )
+$c->merge_readings( 'n9', 'n10' );
+ok( !$c->reading('n10'), "Reading n10 is gone" );
+is( $c->reading('n9')->text, 'rood', "Reading n9 has an unchanged word" );
+
+# Combine n21 and n21p0
+my $remaining = $c->reading('n21');
+$remaining ||= $c->reading('n22');  # one of these should still exist
+$c->merge_readings( 'n21p0', $remaining, 1 );
+ok( !$c->reading('n21'), "Reading $remaining is gone" );
+is( $c->reading('n21p0')->text, 'unto', "Reading n21p0 merged correctly" );
+
+=end testing
+
+=cut
+
 sub merge_readings {
-    my $self = shift;
-    my $first_node = shift;
-    my $second_node = shift;
-    $first_node->merge_from( $second_node );
-    unshift( @_, $first_node, $second_node );
-    return $self->graph->merge_nodes( @_ );
+	my $self = shift;
+
+	# We only need the IDs for adding paths to the graph, not the reading
+	# objects themselves.
+    my( $kept, $deleted, $combine, $combine_char ) = $self->_stringify_args( @_ );
+	$self->_graphcalc_done(0);
+
+    # The kept reading should inherit the paths and the relationships
+    # of the deleted reading.
+	foreach my $path ( $self->sequence->edges_at( $deleted ) ) {
+		my @vector = ( $kept );
+		push( @vector, $path->[1] ) if $path->[0] eq $deleted;
+		unshift( @vector, $path->[0] ) if $path->[1] eq $deleted;
+		next if $vector[0] eq $vector[1]; # Don't add a self loop
+		my %wits = %{$self->sequence->get_edge_attributes( @$path )};
+		$self->sequence->add_edge( @vector );
+		my $fwits = $self->sequence->get_edge_attributes( @vector );
+		@wits{keys %$fwits} = values %$fwits;
+		$self->sequence->set_edge_attributes( @vector, \%wits );
+	}
+	$self->relations->merge_readings( $kept, $deleted, $combine_char );
+	
+	# Do the deletion deed.
+	if( $combine ) {
+		my $kept_obj = $self->reading( $kept );
+		my $del_obj = $self->reading( $deleted );
+		my $joinstr = $combine_char;
+		unless( defined $joinstr ) {
+			$joinstr = '' if $kept_obj->join_next || $del_obj->join_prior;
+			$joinstr = $self->wordsep unless defined $joinstr;
+		}
+		$kept_obj->alter_text( join( $joinstr, $kept_obj->text, $del_obj->text ) );
+	}
+	$self->del_reading( $deleted );
 }
 
+
+# Helper function for manipulating the graph.
+sub _stringify_args {
+	my( $self, $first, $second, @args ) = @_;
+    $first = $first->id
+        if ref( $first ) eq 'Text::Tradition::Collation::Reading';
+    $second = $second->id
+        if ref( $second ) eq 'Text::Tradition::Collation::Reading';        
+    return( $first, $second, @args );
+}
+
+# Helper function for manipulating the graph.
+sub _objectify_args {
+	my( $self, $first, $second, $arg ) = @_;
+    $first = $self->reading( $first )
+        unless ref( $first ) eq 'Text::Tradition::Collation::Reading';
+    $second = $self->reading( $second )
+        unless ref( $second ) eq 'Text::Tradition::Collation::Reading';        
+    return( $first, $second, $arg );
+}
+### Path logic
+
+sub add_path {
+	my $self = shift;
+
+	# We only need the IDs for adding paths to the graph, not the reading
+	# objects themselves.
+    my( $source, $target, $wit ) = $self->_stringify_args( @_ );
+
+	$self->_graphcalc_done(0);
+	# Connect the readings
+	unless( $self->sequence->has_edge( $source, $target ) ) {
+	    $self->sequence->add_edge( $source, $target );
+	    $self->relations->add_equivalence_edge( $source, $target );
+	}
+    # Note the witness in question
+    $self->sequence->set_edge_attribute( $source, $target, $wit, 1 );
+}
+
+sub del_path {
+	my $self = shift;
+	my @args;
+	if( ref( $_[0] ) eq 'ARRAY' ) {
+		my $e = shift @_;
+		@args = ( @$e, @_ );
+	} else {
+		@args = @_;
+	}
+
+	# We only need the IDs for adding paths to the graph, not the reading
+	# objects themselves.
+    my( $source, $target, $wit ) = $self->_stringify_args( @args );
+
+	$self->_graphcalc_done(0);
+	if( $self->sequence->has_edge_attribute( $source, $target, $wit ) ) {
+		$self->sequence->delete_edge_attribute( $source, $target, $wit );
+	}
+	unless( keys %{$self->sequence->get_edge_attributes( $source, $target )} ) {
+		$self->sequence->delete_edge( $source, $target );
+		$self->relations->delete_equivalence_edge( $source, $target );
+	}
+}
+
+
 # Extra graph-alike utility
 sub has_path {
-    my( $self, $source, $target, $label ) = @_;
-    my @paths = $source->edges_to( $target );
-    my @relevant = grep { $_->label eq $label } @paths;
-    return scalar @relevant;
+	my $self = shift;
+    my( $source, $target, $wit ) = $self->_stringify_args( @_ );
+	return undef unless $self->sequence->has_edge( $source, $target );
+	return $self->sequence->has_edge_attribute( $source, $target, $wit );
 }
 
-## Dealing with relationships between readings.  This is a different
-## sort of graph edge.  Return a success/failure value and a list of
-## node pairs that have been linked.
+=head2 clear_witness( @sigil_list )
 
-sub add_relationship {
-    my( $self, $source, $target, $options ) = @_;
-
-    # Make sure there is not another relationship between these two
-    # readings already
-    $source = $self->reading( $source )
-        unless ref( $source ) && $source->isa( 'Graph::Easy::Node' );
-    $target = $self->reading( $target )
-        unless ref( $target ) && $target->isa( 'Graph::Easy::Node' );
-    foreach my $rel ( $source->edges_to( $target ), $target->edges_to( $source ) ) {
-        if( $rel->class eq 'edge.relationship' ) {
-            return ( undef, "Relationship already exists between these readings" );
-        }
-    }
-    if( $options->{'equal_rank'} && !relationship_valid( $source, $target ) ) {
-        return ( undef, 'Relationship creates witness loop' );
-    }
+Clear the given witnesses out of the collation entirely, removing references
+to them in paths, and removing readings that belong only to them.  Should only
+be called via $tradition->del_witness.
 
-    # TODO Think about positional hilarity if relationships are added after positions
-    # are assigned.
-    
-    my @joined = ( [ $source->name, $target->name ] );  # Keep track of the nodes we join.
-    
-    $options->{'this_relation'} = [ $source, $target ];
-    my $rel;
-    eval { $rel = Text::Tradition::Collation::Relationship->new( %$options ) };
-    if( $@ ) {
-       return ( undef, $@ );
-    }
-    $self->graph->add_edge( $source, $target, $rel );
-    
-    # TODO Handle global relationship setting
+=cut
 
-    return( 1, @joined );
+sub clear_witness {
+	my( $self, @sigils ) = @_;
+
+	$self->_graphcalc_done(0);
+	# Clear the witness(es) out of the paths
+	foreach my $e ( $self->paths ) {
+		foreach my $sig ( @sigils ) {
+			$self->del_path( $e, $sig );
+		}
+	}
+	
+	# Clear out the newly unused readings
+	foreach my $r ( $self->readings ) {
+		unless( $self->reading_witnesses( $r ) ) {
+			$self->del_reading( $r );
+		}
+	}
 }
 
-sub relationship_valid {
-    my( $source, $target ) = @_;
-    # Check that linking the source and target in a relationship won't lead
-    # to a path loop for any witness.
-    my @proposed_related = ( $source, $target );
-    push( @proposed_related, $source->related_readings );
-    push( @proposed_related, $target->related_readings );
-    my %pr_ids;
-    map { $pr_ids{ $_->name } = 1 } @proposed_related;
-    # The lists of 'in' and 'out' should not have any element that appears
-    # in 'proposed_related'.
-    foreach my $pr ( @proposed_related ) {
-        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->incoming ) {
-            if( exists $pr_ids{ $e->from->name } ) {
-                return 0;
-            }
-        }
-        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->outgoing ) {
-            if( exists $pr_ids{ $e->to->name } ) {
-                return 0;
-            }
-        }
-    }
-    return 1;
+sub add_relationship {
+	my $self = shift;
+    my( $source, $target, $opts ) = $self->_stringify_args( @_ );
+    my( @vectors ) = $self->relations->add_relationship( $source, $target, $opts );
+	$self->_graphcalc_done(0);
+    return @vectors;
 }
 
-=head2 Output method(s)
+around qw/ get_relationship del_relationship / => sub {
+	my $orig = shift;
+	my $self = shift;
+	my @args = @_;
+	if( @args == 1 && ref( $args[0] ) eq 'ARRAY' ) {
+		@args = @{$_[0]};
+	}
+	my( $source, $target ) = $self->_stringify_args( @args );
+	$self->$orig( $source, $target );
+};
 
-=over
+=head2 reading_witnesses( $reading )
 
-=item B<as_svg>
+Return a list of sigils corresponding to the witnesses in which the reading appears.
 
-print $graph->as_svg( $recalculate );
+=cut
+
+sub reading_witnesses {
+	my( $self, $reading ) = @_;
+	# We need only check either the incoming or the outgoing edges; I have
+	# arbitrarily chosen "incoming".  Thus, special-case the start node.
+	if( $reading eq $self->start ) {
+		return map { $_->sigil } $self->tradition->witnesses;
+	}
+	my %all_witnesses;
+	foreach my $e ( $self->sequence->edges_to( $reading ) ) {
+		my $wits = $self->sequence->get_edge_attributes( @$e );
+		@all_witnesses{ keys %$wits } = 1;
+	}
+	my $acstr = $self->ac_label;
+	foreach my $acwit ( grep { $_ =~ s/^(.*)\Q$acstr\E$/$1/ } keys %all_witnesses ) {
+		delete $all_witnesses{$acwit.$acstr} if exists $all_witnesses{$acwit};
+	}
+	return keys %all_witnesses;
+}
 
-Returns an SVG string that represents the graph.  Uses GraphViz to do
-this, because Graph::Easy doesn\'t cope well with long graphs. Unless
-$recalculate is passed (and is a true value), the method will return a
-cached copy of the SVG after the first call to the method.
+=head1 OUTPUT METHODS
+
+=head2 as_svg( \%options )
+
+Returns an SVG string that represents the graph, via as_dot and graphviz.
+See as_dot for a list of options.  Must have GraphViz (dot) installed to run.
 
 =cut
 
 sub as_svg {
-    my( $self, $recalc ) = @_;
-    return $self->svg if $self->has_svg;
-    
-    $self->collapse_graph_paths();
-    
-    my @cmd = qw/dot -Tsvg/;
-    my( $svg, $err );
-    my $dotfile = File::Temp->new();
-    ## TODO REMOVE
-    # $dotfile->unlink_on_destroy(0);
-    binmode $dotfile, ':utf8';
-    print $dotfile $self->as_dot();
-    push( @cmd, $dotfile->filename );
-    run( \@cmd, ">", binary(), \$svg );
-    $svg = decode_utf8( $svg );
-    $self->_save_svg( $svg );
-    $self->expand_graph_paths();
-    return $svg;
+    my( $self, $opts ) = @_;
+    throw( "Need GraphViz installed to output SVG" )
+    	unless File::Which::which( 'dot' );
+    my $want_subgraph = exists $opts->{'from'} || exists $opts->{'to'};
+    $self->calculate_ranks() unless( $self->_graphcalc_done || $opts->{'nocalc'} );
+    if( !$self->has_cached_svg || $opts->{'recalc'}	|| $want_subgraph ) {        
+		my @cmd = qw/dot -Tsvg/;
+		my( $svg, $err );
+		my $dotfile = File::Temp->new();
+		## USE FOR DEBUGGING
+		# $dotfile->unlink_on_destroy(0);
+		binmode $dotfile, ':utf8';
+		print $dotfile $self->as_dot( $opts );
+		push( @cmd, $dotfile->filename );
+		run( \@cmd, ">", binary(), \$svg );
+		$svg = decode_utf8( $svg );
+		$self->cached_svg( $svg ) unless $want_subgraph;
+		return $svg;
+	} else {
+		return $self->cached_svg;
+	}
 }
 
-=item B<as_dot>
 
-print $graph->as_dot( $view, $recalculate );
+=head2 as_dot( \%options )
 
 Returns a string that is the collation graph expressed in dot
-(i.e. GraphViz) format.  The 'view' argument determines what kind of
-graph is produced.
-    * 'path': a graph of witness paths through the collation (DEFAULT)
-    * 'relationship': a graph of how collation readings relate to 
-      each other
+(i.e. GraphViz) format.  Options include:
+
+=over 4
+
+=item * from
+
+=item * to
+
+=item * color_common
+
+=back
 
 =cut
 
 sub as_dot {
-    my( $self, $view ) = @_;
-    $view = 'path' unless $view;
-    # TODO consider making some of these things configurable
+    my( $self, $opts ) = @_;
+    my $startrank = $opts->{'from'} if $opts;
+    my $endrank = $opts->{'to'} if $opts;
+    my $color_common = $opts->{'color_common'} if $opts;
+    my $STRAIGHTENHACK = !$startrank && !$endrank && $self->end->rank 
+       && $self->end->rank > 100;
+    $STRAIGHTENHACK = 1 if $opts->{'straight'}; # even for subgraphs or small graphs
+
+    # Check the arguments
+    if( $startrank ) {
+    	return if $endrank && $startrank > $endrank;
+    	return if $startrank > $self->end->rank;
+	}
+	if( defined $endrank ) {
+		return if $endrank < 0;
+		$endrank = undef if $endrank == $self->end->rank;
+	}
+	
     my $graph_name = $self->tradition->name;
     $graph_name =~ s/[^\w\s]//g;
     $graph_name = join( '_', split( /\s+/, $graph_name ) );
+
+    my %graph_attrs = (
+    	'rankdir' => 'LR',
+    	'bgcolor' => 'none',
+    	);
+    my %node_attrs = (
+    	'fontsize' => 14,
+    	'fillcolor' => 'white',
+    	'style' => 'filled',
+    	'shape' => 'ellipse'
+    	);
+    my %edge_attrs = ( 
+    	'arrowhead' => 'open',
+    	'color' => '#000000',
+    	'fontcolor' => '#000000',
+    	);
+
     my $dot = sprintf( "digraph %s {\n", $graph_name );
-    $dot .= "\tedge [ arrowhead=open ];\n";
-    $dot .= "\tgraph [ rankdir=LR ];\n";
-    $dot .= sprintf( "\tnode [ fontsize=%d, fillcolor=%s, style=%s, shape=%s ];\n",
-                     11, "white", "filled", $self->graph->get_attribute( 'node', 'shape' ) );
+    $dot .= "\tgraph " . _dot_attr_string( \%graph_attrs ) . ";\n";
+    $dot .= "\tnode " . _dot_attr_string( \%node_attrs ) . ";\n";
 
-    foreach my $reading ( $self->readings ) {
+	# Output substitute start/end readings if necessary
+	if( $startrank ) {
+		$dot .= "\t\"__SUBSTART__\" [ label=\"...\",id=\"__START__\" ];\n";
+	}
+	if( $endrank ) {
+		$dot .= "\t\"__SUBEND__\" [ label=\"...\",id=\"__END__\" ];\n";	
+	}
+	if( $STRAIGHTENHACK ) {
+		## HACK part 1
+		my $startlabel = $startrank ? '__SUBSTART__' : '__START__';
+		$dot .= "\tsubgraph { rank=same \"$startlabel\" \"#SILENT#\" }\n";  
+		$dot .= "\t\"#SILENT#\" [ shape=diamond,color=white,penwidth=0,label=\"\" ];"
+	}
+	my %used;  # Keep track of the readings that actually appear in the graph
+	# Sort the readings by rank if we have ranks; this speeds layout.
+	my @all_readings = $self->end->has_rank 
+		? sort { $a->rank <=> $b->rank } $self->readings
+		: $self->readings;
+	# TODO Refrain from outputting lacuna nodes - just grey out the edges.
+    foreach my $reading ( @all_readings ) {
+    	# Only output readings within our rank range.
+    	next if $startrank && $reading->rank < $startrank;
+    	next if $endrank && $reading->rank > $endrank;
+        $used{$reading->id} = 1;
         # Need not output nodes without separate labels
-        next if $reading->name eq $reading->label;
-        $dot .= sprintf( "\t\"%s\" [ label=\"%s\" ];\n", $reading->name, $reading->label );
+        next if $reading->id eq $reading->text;
+        my $rattrs;
+        my $label = $reading->text;
+        $label .= '-' if $reading->join_next;
+        $label = "-$label" if $reading->join_prior;
+        $label =~ s/\"/\\\"/g;
+		$rattrs->{'label'} = $label;
+		$rattrs->{'id'} = $reading->id;
+		$rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
+        $dot .= sprintf( "\t\"%s\" %s;\n", $reading->id, _dot_attr_string( $rattrs ) );
     }
-
-    my @edges = $view eq 'relationship' ? $self->relationships : $self->paths;
+    
+	# Add the real edges. Need to weight one edge per rank jump, in a
+	# continuous line.
+	# my $weighted = $self->_add_edge_weights;
+    my @edges = $self->paths;
+	my( %substart, %subend );
     foreach my $edge ( @edges ) {
-        my %variables = ( 'color' => '#000000',
-                          'fontcolor' => '#000000',
-                          'label' => $edge->label,
-            );
-        my $varopts = join( ', ', map { $_.'="'.$variables{$_}.'"' } sort keys %variables );
-        $dot .= sprintf( "\t\"%s\" -> \"%s\" [ %s ];\n",
-                         $edge->from->name, $edge->to->name, $varopts );
+    	# Do we need to output this edge?
+    	if( $used{$edge->[0]} && $used{$edge->[1]} ) {
+    		my $label = $self->_path_display_label( $self->path_witnesses( $edge ) );
+			my $variables = { %edge_attrs, 'label' => $label };
+			
+			# Account for the rank gap if necessary
+			my $rank0 = $self->reading( $edge->[0] )->rank
+				if $self->reading( $edge->[0] )->has_rank;
+			my $rank1 = $self->reading( $edge->[1] )->rank
+				if $self->reading( $edge->[1] )->has_rank;
+			if( defined $rank0 && defined $rank1 && $rank1 - $rank0 > 1 ) {
+				$variables->{'minlen'} = $rank1 - $rank0;
+			}
+			
+			# Add the calculated edge weights
+			# if( exists $weighted->{$edge->[0]} 
+			# 	&& $weighted->{$edge->[0]} eq $edge->[1] ) {
+			# 	# $variables->{'color'} = 'red';
+			# 	$variables->{'weight'} = 3.0;
+			# }
+
+			# EXPERIMENTAL: make edge width reflect no. of witnesses
+			my $extrawidth = scalar( $self->path_witnesses( $edge ) ) * 0.2;
+			$variables->{'penwidth'} = $extrawidth + 0.8; # gives 1 for a single wit
+
+			my $varopts = _dot_attr_string( $variables );
+			$dot .= sprintf( "\t\"%s\" -> \"%s\" %s;\n", 
+				$edge->[0], $edge->[1], $varopts );
+        } elsif( $used{$edge->[0]} ) {
+        	$subend{$edge->[0]} = 1;
+        } elsif( $used{$edge->[1]} ) {
+        	$substart{$edge->[1]} = 1;
+        }
     }
+    # Add substitute start and end edges if necessary
+    foreach my $node ( keys %substart ) {
+    	my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+    	my $variables = { %edge_attrs, 'label' => $witstr };
+        my $varopts = _dot_attr_string( $variables );
+        $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;";
+	}
+    foreach my $node ( keys %subend ) {
+    	my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+    	my $variables = { %edge_attrs, 'label' => $witstr };
+        my $varopts = _dot_attr_string( $variables );
+        $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;";
+	}
+	# HACK part 2
+	if( $STRAIGHTENHACK ) {
+		my $endlabel = $endrank ? '__SUBEND__' : '__END__';
+		$dot .= "\t\"$endlabel\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
+	}       
+
     $dot .= "}\n";
     return $dot;
 }
 
-=item B<as_graphml>
+sub _dot_attr_string {
+	my( $hash ) = @_;
+	my @attrs;
+	foreach my $k ( sort keys %$hash ) {
+		my $v = $hash->{$k};
+		push( @attrs, $k.'="'.$v.'"' );
+	}
+	return( '[ ' . join( ', ', @attrs ) . ' ]' );
+}
+
+sub _add_edge_weights {
+	my $self = shift;
+	# Walk the graph from START to END, choosing the successor node with
+	# the largest number of witness paths each time.
+	my $weighted = {};
+	my $curr = $self->start->id;
+	my $ranked = $self->end->has_rank;
+	while( $curr ne $self->end->id ) {
+		my $rank = $ranked ? $self->reading( $curr )->rank : 0;
+		my @succ = sort { $self->path_witnesses( $curr, $a )
+							<=> $self->path_witnesses( $curr, $b ) } 
+			$self->sequence->successors( $curr );
+		my $next = pop @succ;
+		my $nextrank = $ranked ? $self->reading( $next )->rank : 0;
+		# Try to avoid lacunae in the weighted path.
+		while( @succ && 
+			   ( $self->reading( $next )->is_lacuna ||
+			   	 $nextrank - $rank > 1 ) ){
+			$next = pop @succ;
+		}
+		$weighted->{$curr} = $next;
+		$curr = $next;
+	}
+	return $weighted;	
+}
 
-print $graph->as_graphml( $recalculate )
+=head2 path_witnesses( $edge )
 
-Returns a GraphML representation of the collation graph, with
-transposition information and position information. Unless
-$recalculate is passed (and is a true value), the method will return a
-cached copy of the SVG after the first call to the method.
+Returns the list of sigils whose witnesses are associated with the given edge.
+The edge can be passed as either an array or an arrayref of ( $source, $target ).
 
 =cut
 
-sub as_graphml {
-    my( $self, $recalc ) = @_;
-    return $self->graphml if $self->has_graphml;
+sub path_witnesses {
+	my( $self, @edge ) = @_;
+	# If edge is an arrayref, cope.
+	if( @edge == 1 && ref( $edge[0] ) eq 'ARRAY' ) {
+		my $e = shift @edge;
+		@edge = @$e;
+	}
+	my @wits = keys %{$self->sequence->get_edge_attributes( @edge )};
+	return @wits;
+}
+
+# Helper function. Make a display label for the given witnesses, showing a.c.
+# witnesses only where the main witness is not also in the list.
+sub _path_display_label {
+	my $self = shift;
+	my %wits;
+	map { $wits{$_} = 1 } @_;
+
+	# If an a.c. wit is listed, remove it if the main wit is also listed.
+	# Otherwise keep it for explicit listing.
+	my $aclabel = $self->ac_label;
+	my @disp_ac;
+	foreach my $w ( sort keys %wits ) {
+		if( $w =~ /^(.*)\Q$aclabel\E$/ ) {
+			if( exists $wits{$1} ) {
+				delete $wits{$w};
+			} else {
+				push( @disp_ac, $w );
+			}
+		}
+	}
+	
+	# See if we are in a majority situation.
+	my $maj = scalar( $self->tradition->witnesses ) * 0.6;
+	if( scalar keys %wits > $maj ) {
+		unshift( @disp_ac, 'majority' );
+		return join( ', ', @disp_ac );
+	} else {
+		return join( ', ', sort keys %wits );
+	}
+}
+
+=head2 readings_at_rank( $rank )
+
+Returns a list of readings at a given rank, taken from the alignment table.
+
+=cut
+
+sub readings_at_rank {
+	my( $self, $rank ) = @_;
+	my $table = $self->alignment_table;
+	# Table rank is real rank - 1.
+	my @elements = map { $_->{'tokens'}->[$rank-1] } @{$table->{'alignment'}};
+	my %readings;
+	foreach my $e ( @elements ) {
+		next unless ref( $e ) eq 'HASH';
+		next unless exists $e->{'t'};
+		$readings{$e->{'t'}->id} = $e->{'t'};
+	}
+	return values %readings;
+}		
+
+=head2 as_graphml
+
+Returns a GraphML representation of the collation.  The GraphML will contain 
+two graphs. The first expresses the attributes of the readings and the witness 
+paths that link them; the second expresses the relationships that link the 
+readings.  This is the native transfer format for a tradition.
+
+=begin testing
+
+use Text::Tradition;
+
+my $READINGS = 311;
+my $PATHS = 361;
+
+my $datafile = 't/data/florilegium_tei_ps.xml';
+my $tradition = Text::Tradition->new( 'input' => 'TEI',
+                                      'name' => 'test0',
+                                      'file' => $datafile,
+                                      'linear' => 1 );
+
+ok( $tradition, "Got a tradition object" );
+is( scalar $tradition->witnesses, 13, "Found all witnesses" );
+ok( $tradition->collation, "Tradition has a collation" );
+
+my $c = $tradition->collation;
+is( scalar $c->readings, $READINGS, "Collation has all readings" );
+is( scalar $c->paths, $PATHS, "Collation has all paths" );
+is( scalar $c->relationships, 0, "Collation has all relationships" );
+
+# Add a few relationships
+$c->add_relationship( 'w123', 'w125', { 'type' => 'collated' } );
+$c->add_relationship( 'w193', 'w196', { 'type' => 'collated' } );
+$c->add_relationship( 'w257', 'w262', { 'type' => 'transposition' } );
+
+# Now write it to GraphML and parse it again.
+
+my $graphml = $c->as_graphml;
+my $st = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml );
+is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all readings" );
+is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
+is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
+
+# Now add a stemma, write to GraphML, and parse again.
+my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
+is( $tradition->stemmata, 1, "Tradition now has the stemma" );
+$graphml = $c->as_graphml;
+like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
 
+=end testing
+
+=cut
+
+sub as_graphml {
+    my( $self, $options ) = @_;
+	$self->calculate_ranks unless $self->_graphcalc_done;
+	
+	my $start = $options->{'from'} 
+		? $self->reading( $options->{'from'} ) : $self->start;
+	my $end = $options->{'to'} 
+		? $self->reading( $options->{'to'} ) : $self->end;
+	if( $start->has_rank && $end->has_rank && $end->rank < $start->rank ) {
+		throw( 'Start node must be before end node' );
+	}
+	# The readings need to be ranked for this to work.
+	$start = $self->start unless $start->has_rank;
+	$end = $self->end unless $end->has_rank;
+	my $rankoffset = 0;
+	unless( $start eq $self->start ) {
+		$rankoffset = $start->rank - 1;
+	}
+	my %use_readings;
+	
     # Some namespaces
     my $graphml_ns = 'http://graphml.graphdrawing.org/xmlns';
     my $xsi_ns = 'http://www.w3.org/2001/XMLSchema-instance';
@@ -362,126 +930,209 @@ sub as_graphml {
     $graphml->setDocumentElement( $root );
     $root->setNamespace( $xsi_ns, 'xsi', 0 );
     $root->setAttributeNS( $xsi_ns, 'schemaLocation', $graphml_schema );
+    
+    # List of attribute types to save on our objects and their corresponding
+    # GraphML types
+    my %save_types = (
+    	'Str' => 'string',
+    	'Int' => 'int',
+    	'Bool' => 'boolean',
+    	'ReadingID' => 'string',
+    	'RelationshipType' => 'string',
+    	'RelationshipScope' => 'string',
+    );
+    
+    # List of attribute names *not* to save on our objects.
+    # We will also not save any attribute beginning with _.
+    my %skipsave;
+    map { $skipsave{$_} = 1 } qw/ cached_svg /;
 
-    # Add the data keys for the graph
+    # Add the data keys for the graph. Include an extra key 'version' for the
+    # GraphML output version.
     my %graph_data_keys;
     my $gdi = 0;
-    my @graph_attributes = qw/ wit_list_separator baselabel linear ac_label /;
-    foreach my $datum ( @graph_attributes ) {
+    my %graph_attributes = ( 'version' => 'string' );
+	# Graph attributes include those of Tradition and those of Collation.
+	my %gattr_from;
+	my $tmeta = $self->tradition->meta;
+	my $cmeta = $self->meta;
+	map { $gattr_from{$_->name} = 'Tradition' } $tmeta->get_all_attributes;
+	map { $gattr_from{$_->name} = 'Collation' } $cmeta->get_all_attributes;
+	foreach my $attr ( ( $tmeta->get_all_attributes, $cmeta->get_all_attributes ) ) {
+		next if $attr->name =~ /^_/;
+		next if $skipsave{$attr->name};
+		next unless $save_types{$attr->type_constraint->name};
+		$graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
+	}
+    # Extra custom key for the tradition stemma(ta)
+    $graph_attributes{'stemmata'} = 'string';
+	
+    foreach my $datum ( sort keys %graph_attributes ) {
     	$graph_data_keys{$datum} = 'dg'.$gdi++;
         my $key = $root->addNewChild( $graphml_ns, 'key' );
         $key->setAttribute( 'attr.name', $datum );
-        $key->setAttribute( 'attr.type', $key eq 'linear' ? 'boolean' : 'string' );
+        $key->setAttribute( 'attr.type', $graph_attributes{$datum} );
         $key->setAttribute( 'for', 'graph' );
         $key->setAttribute( 'id', $graph_data_keys{$datum} );    	
     }
 
-    # Add the data keys for nodes
+    # Add the data keys for reading nodes
+    my %reading_attributes;
+    my $rmeta = Text::Tradition::Collation::Reading->meta;
+    foreach my $attr( $rmeta->get_all_attributes ) {
+		next if $attr->name =~ /^_/;
+		next if $skipsave{$attr->name};
+		next unless $save_types{$attr->type_constraint->name};
+		$reading_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
+	}
+	# Extra custom key for the reading morphology
+	$reading_attributes{'lexemes'} = 'string';
+	
     my %node_data_keys;
     my $ndi = 0;
-    foreach my $datum ( qw/ name reading identical rank class / ) {
+    foreach my $datum ( sort keys %reading_attributes ) {
         $node_data_keys{$datum} = 'dn'.$ndi++;
         my $key = $root->addNewChild( $graphml_ns, 'key' );
         $key->setAttribute( 'attr.name', $datum );
-        $key->setAttribute( 'attr.type', 'string' );
+        $key->setAttribute( 'attr.type', $reading_attributes{$datum} );
         $key->setAttribute( 'for', 'node' );
         $key->setAttribute( 'id', $node_data_keys{$datum} );
     }
 
-    # Add the data keys for edges, i.e. witnesses
+    # Add the data keys for edges, that is, paths and relationships. Path
+    # data does not come from a Moose class so is here manually.
     my $edi = 0;
     my %edge_data_keys;
-    my @string_keys = qw/ class witness relationship /;
-    my @bool_keys = qw/ extra equal_rank non_correctable non_independent /;
-    foreach my $edge_key( @string_keys ) {
-        $edge_data_keys{$edge_key} = 'de'.$edi++;
+    my %edge_attributes = (
+    	witness => 'string',			# ID/label for a path
+    	extra => 'boolean',				# Path key
+    	);
+    my @path_attributes = keys %edge_attributes; # track our manual additions
+    my $pmeta = Text::Tradition::Collation::Relationship->meta;
+    foreach my $attr( $pmeta->get_all_attributes ) {
+		next if $attr->name =~ /^_/;
+		next if $skipsave{$attr->name};
+		next unless $save_types{$attr->type_constraint->name};
+		$edge_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
+	}
+    foreach my $datum ( sort keys %edge_attributes ) {
+        $edge_data_keys{$datum} = 'de'.$edi++;
         my $key = $root->addNewChild( $graphml_ns, 'key' );
-        $key->setAttribute( 'attr.name', $edge_key );
-        $key->setAttribute( 'attr.type', 'string' );
+        $key->setAttribute( 'attr.name', $datum );
+        $key->setAttribute( 'attr.type', $edge_attributes{$datum} );
         $key->setAttribute( 'for', 'edge' );
-        $key->setAttribute( 'id', $edge_data_keys{$edge_key} );
+        $key->setAttribute( 'id', $edge_data_keys{$datum} );
     }
-    foreach my $edge_key( @bool_keys ) {
-        $edge_data_keys{$edge_key} = 'de'.$edi++;
-        my $key = $root->addNewChild( $graphml_ns, 'key' );
-        $key->setAttribute( 'attr.name', $edge_key );
-        $key->setAttribute( 'attr.type', 'boolean' );
-        $key->setAttribute( 'for', 'edge' );
-        $key->setAttribute( 'id', $edge_data_keys{$edge_key} );
+
+    # Add the collation graph itself. First, sanitize the name to a valid XML ID.
+    my $xmlidname = $self->tradition->name;
+    $xmlidname =~ s/(?!$xml10_namechar_rx)./_/g;
+    if( $xmlidname !~ /^$xml10_namestartchar_rx/ ) {
+    	$xmlidname = '_'.$xmlidname;
     }
-    
-    # Add the graph, its nodes, and its edges
-    my $graph = $root->addNewChild( $graphml_ns, 'graph' );
-    $graph->setAttribute( 'edgedefault', 'directed' );
-    $graph->setAttribute( 'id', $self->tradition->name );
-    $graph->setAttribute( 'parse.edgeids', 'canonical' );
-    $graph->setAttribute( 'parse.edges', scalar($self->paths) );
-    $graph->setAttribute( 'parse.nodeids', 'canonical' );
-    $graph->setAttribute( 'parse.nodes', scalar($self->readings) );
-    $graph->setAttribute( 'parse.order', 'nodesfirst' );
-    
-    # Collation attribute data
-    foreach my $datum ( @graph_attributes ) {
-		_add_graphml_data( $graph, $graph_data_keys{$datum}, $self->$datum );
+    my $sgraph = $root->addNewChild( $graphml_ns, 'graph' );
+    $sgraph->setAttribute( 'edgedefault', 'directed' );
+    $sgraph->setAttribute( 'id', $xmlidname );
+    $sgraph->setAttribute( 'parse.edgeids', 'canonical' );
+    $sgraph->setAttribute( 'parse.edges', 0 ); # fill in later
+    $sgraph->setAttribute( 'parse.nodeids', 'canonical' );
+    $sgraph->setAttribute( 'parse.nodes', 0 ); # fill in later
+    $sgraph->setAttribute( 'parse.order', 'nodesfirst' );
+    	    
+    # Tradition/collation attribute data
+    foreach my $datum ( keys %graph_attributes ) {
+    	my $value;
+    	if( $datum eq 'version' ) {
+    		$value = '3.2';
+    	} elsif( $datum eq 'stemmata' ) {
+    		my @stemstrs;
+    		map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
+    			$self->tradition->stemmata;
+    		$value = join( "\n", @stemstrs );
+    	} elsif( $gattr_from{$datum} eq 'Tradition' ) {
+    		$value = $self->tradition->$datum;
+    	} else {
+    		$value = $self->$datum;
+    	}
+		_add_graphml_data( $sgraph, $graph_data_keys{$datum}, $value );
 	}
 
     my $node_ctr = 0;
     my %node_hash;
     # Add our readings to the graph
-    foreach my $n ( sort { $a->name cmp $b->name } $self->readings ) {
-        my $node_el = $graph->addNewChild( $graphml_ns, 'node' );
+    foreach my $n ( sort { $a->id cmp $b->id } $self->readings ) {
+    	next if $n->has_rank && $n ne $self->start && $n ne $self->end &&
+    		( $n->rank < $start->rank || $n->rank > $end->rank );
+    	$use_readings{$n->id} = 1;
+    	# Add to the main graph
+        my $node_el = $sgraph->addNewChild( $graphml_ns, 'node' );
         my $node_xmlid = 'n' . $node_ctr++;
-        $node_hash{ $n->name } = $node_xmlid;
+        $node_hash{ $n->id } = $node_xmlid;
         $node_el->setAttribute( 'id', $node_xmlid );
-        _add_graphml_data( $node_el, $node_data_keys{'name'}, $n->name );
-        _add_graphml_data( $node_el, $node_data_keys{'reading'}, $n->label );
-        _add_graphml_data( $node_el, $node_data_keys{'rank'}, $n->rank )
-            if $n->has_rank;
-        _add_graphml_data( $node_el, $node_data_keys{'class'}, $n->sub_class );
-        $DB::single = 1 if $n->has_primary && $n->primary ne $n;
-        _add_graphml_data( $node_el, $node_data_keys{'identical'}, $n->primary->name )
-            if $n->has_primary && $n->primary ne $n;
+        foreach my $d ( keys %reading_attributes ) {
+        	my $nval = $n->$d;
+        	# Custom serialization
+        	if( $d eq 'lexemes' ) {
+				# If nval is a true value, we have lexemes so we need to
+				# serialize them. Otherwise set nval to undef so that the
+				# key is excluded from this reading.
+        		$nval = $nval ? $n->_serialize_lexemes : undef;
+        	}
+        	if( $rankoffset && $d eq 'rank' && $n ne $self->start ) {
+        		# Adjust the ranks within the subgraph.
+        		$nval = $n eq $self->end ? $end->rank - $rankoffset + 1 
+        			: $nval - $rankoffset;
+        	}
+        	_add_graphml_data( $node_el, $node_data_keys{$d}, $nval )
+        		if defined $nval;
+        }
     }
 
-    # Add the path and relationship edges
+    # Add the path edges to the sequence graph
     my $edge_ctr = 0;
-    foreach my $e ( sort { $a->from->name cmp $b->from->name } $self->graph->edges() ) {
-        my( $name, $from, $to ) = ( 'e'.$edge_ctr++,
-                                    $node_hash{ $e->from->name() },
-                                    $node_hash{ $e->to->name() } );
-        my $edge_el = $graph->addNewChild( $graphml_ns, 'edge' );
-        $edge_el->setAttribute( 'source', $from );
-        $edge_el->setAttribute( 'target', $to );
-        $edge_el->setAttribute( 'id', $name );
-        # Add the edge class
-        _add_graphml_data( $edge_el, $edge_data_keys{'class'}, $e->sub_class );
-        
-        # For some classes we have extra information to save.
-        if( $e->sub_class eq 'path' ) {
-            # It's a witness path, so add the witness
-            my $base = $e->label;
-            my $key = $edge_data_keys{'witness_main'};
-            # Is this an ante-corr witness?
-            my $aclabel = $self->ac_label;
-            if( $e->label =~ /^(.*)\Q$aclabel\E$/ ) {
-            	# Keep the base witness
-                $base = $1;
-                # ...and record that this is an 'extra' reading path
-                _add_graphml_data( $edge_el, $edge_data_keys{'extra'}, 'true' );
-            }
-            _add_graphml_data( $edge_el, $edge_data_keys{'witness'}, $base );
-        } elsif( $e->sub_class eq 'relationship' ) {
-            # It's a relationship, so save the relationship data
-            _add_graphml_data( $edge_el, $edge_data_keys{'relationship'}, $e->label );
-            _add_graphml_data( $edge_el, $edge_data_keys{'equal_rank'}, $e->equal_rank );
-            _add_graphml_data( $edge_el, $edge_data_keys{'non_correctable'}, $e->non_correctable );
-            _add_graphml_data( $edge_el, $edge_data_keys{'non_independent'}, $e->non_independent );
-        } 
-    }
+    foreach my $e ( sort { $a->[0] cmp $b->[0] } $self->sequence->edges() ) {
+    	# We add an edge in the graphml for every witness in $e.
+    	next unless( $use_readings{$e->[0]} || $use_readings{$e->[1]} );
+    	my @edge_wits = sort $self->path_witnesses( $e );
+    	$e->[0] = $self->start->id unless $use_readings{$e->[0]};
+    	$e->[1] = $self->end->id unless $use_readings{$e->[1]};
+    	# Skip any path from start to end; that witness is not in the subgraph.
+    	next if ( $e->[0] eq $self->start->id && $e->[1] eq $self->end->id );
+    	foreach my $wit ( @edge_wits ) {
+			my( $id, $from, $to ) = ( 'e'.$edge_ctr++,
+										$node_hash{ $e->[0] },
+										$node_hash{ $e->[1] } );
+			my $edge_el = $sgraph->addNewChild( $graphml_ns, 'edge' );
+			$edge_el->setAttribute( 'source', $from );
+			$edge_el->setAttribute( 'target', $to );
+			$edge_el->setAttribute( 'id', $id );
+			
+			# It's a witness path, so add the witness
+			my $base = $wit;
+			my $key = $edge_data_keys{'witness'};
+			# Is this an ante-corr witness?
+			my $aclabel = $self->ac_label;
+			if( $wit =~ /^(.*)\Q$aclabel\E$/ ) {
+				# Keep the base witness
+				$base = $1;
+				# ...and record that this is an 'extra' reading path
+				_add_graphml_data( $edge_el, $edge_data_keys{'extra'}, $aclabel );
+			}
+			_add_graphml_data( $edge_el, $edge_data_keys{'witness'}, $base );
+		}
+	}
+	
+	# Report the actual number of nodes and edges that went in
+	$sgraph->setAttribute( 'parse.edges', $edge_ctr );
+	$sgraph->setAttribute( 'parse.nodes', $node_ctr );
+		
+	# Add the relationship graph to the XML
+	map { delete $edge_data_keys{$_} } @path_attributes;
+	$self->relations->_as_graphml( $graphml_ns, $root, \%node_hash, 
+		$node_data_keys{'id'}, \%edge_data_keys );
 
     # Save and return the thing
     my $result = decode_utf8( $graphml->toString(1) );
-    $self->_save_graphml( $result );
     return $result;
 }
 
@@ -493,82 +1144,92 @@ sub _add_graphml_data {
     $data_el->appendText( $value );
 }
 
-=item B<as_csv>
-
-print $graph->as_csv( $recalculate )
+=head2 as_csv
 
 Returns a CSV alignment table representation of the collation graph, one
-row per witness (or witness uncorrected.) Unless $recalculate is passed
-(and is a true value), the method will return a cached copy of the CSV
-after the first call to the method.
+row per witness (or witness uncorrected.) 
 
 =cut
 
 sub as_csv {
-    my( $self, $recalc ) = @_;
-    return $self->csv if $self->has_csv;
-    my $table = $self->make_alignment_table;
-    my $csv = Text::CSV_XS->new( { binary => 1, quote_null => 0 } );    
+    my( $self ) = @_;
+    my $table = $self->alignment_table;
+    my $csv = Text::CSV->new( { binary => 1, quote_null => 0 } );    
     my @result;
-    foreach my $row ( @$table ) {
-        $csv->combine( @$row );
+    # Make the header row
+    $csv->combine( map { $_->{'witness'} } @{$table->{'alignment'}} );
+	push( @result, decode_utf8( $csv->string ) );
+    # Make the rest of the rows
+    foreach my $idx ( 0 .. $table->{'length'} - 1 ) {
+    	my @rowobjs = map { $_->{'tokens'}->[$idx] } @{$table->{'alignment'}};
+    	my @row = map { $_ ? $_->{'t'}->text : $_ } @rowobjs;
+        $csv->combine( @row );
         push( @result, decode_utf8( $csv->string ) );
     }
-    $self->_save_csv( join( "\n", @result ) );
-    return $self->csv;
+    return join( "\n", @result );
 }
 
-# Make an alignment table - $noderefs controls whether the objects
-# in the table are the nodes or simply their readings.
+=head2 alignment_table( $use_refs, $include_witnesses )
 
-sub make_alignment_table {
-    my( $self, $noderefs, $include ) = @_;
-    unless( $self->linear ) {
-        warn "Need a linear graph in order to make an alignment table";
-        return;
-    }
-    my $table;
-    my @all_pos = ( 0 .. $self->end->rank - 1 );
-    foreach my $wit ( $self->tradition->witnesses ) {
+Return a reference to an alignment table, in a slightly enhanced CollateX
+format which looks like this:
+
+ $table = { alignment => [ { witness => "SIGIL", 
+                             tokens => [ { t => "TEXT" }, ... ] },
+                           { witness => "SIG2", 
+                             tokens => [ { t => "TEXT" }, ... ] },
+                           ... ],
+            length => TEXTLEN };
+
+If $use_refs is set to 1, the reading object is returned in the table 
+instead of READINGTEXT; if not, the text of the reading is returned.
+
+If $include_witnesses is set to a hashref, only the witnesses whose sigil
+keys have a true hash value will be included.
+
+=cut
+
+sub alignment_table {
+    my( $self ) = @_;
+    $self->calculate_ranks() unless $self->_graphcalc_done;
+    return $self->cached_table if $self->has_cached_table;
+    
+    # Make sure we can do this
+	throw( "Need a linear graph in order to make an alignment table" )
+		unless $self->linear;
+	$self->calculate_ranks unless $self->end->has_rank;
+	
+    my $table = { 'alignment' => [], 'length' => $self->end->rank - 1 };
+    my @all_pos = ( 1 .. $self->end->rank - 1 );
+    foreach my $wit ( sort { $a->sigil cmp $b->sigil } $self->tradition->witnesses ) {
         # print STDERR "Making witness row(s) for " . $wit->sigil . "\n";
         my @wit_path = $self->reading_sequence( $self->start, $self->end, $wit->sigil );
-        my @row = _make_witness_row( \@wit_path, \@all_pos, $noderefs );
-        unshift( @row, $wit->sigil );
-        push( @$table, \@row );
+        my @row = _make_witness_row( \@wit_path, \@all_pos );
+        push( @{$table->{'alignment'}}, 
+        	{ 'witness' => $wit->sigil, 'tokens' => \@row } );
         if( $wit->is_layered ) {
         	my @wit_ac_path = $self->reading_sequence( $self->start, $self->end, 
-        		$wit->sigil.$self->ac_label, $wit->sigil );
-            my @ac_row = _make_witness_row( \@wit_ac_path, \@all_pos, $noderefs );
-            unshift( @ac_row, $wit->sigil . $self->ac_label );
-            push( @$table, \@ac_row );
+        		$wit->sigil.$self->ac_label );
+            my @ac_row = _make_witness_row( \@wit_ac_path, \@all_pos );
+			push( @{$table->{'alignment'}},
+				{ 'witness' => $wit->sigil.$self->ac_label, 'tokens' => \@ac_row } );
         }           
     }
-
-    if( $include ) {
-        my $winnowed = [];
-        # Winnow out the rows for any witness not included.
-        foreach my $row ( @$table ) {
-            next unless $include->{$row->[0]};
-            push( @$winnowed, $row );
-        }
-        $table = $winnowed;
-    }
-
-    # Return a table where the witnesses read in columns rather than rows.
-    my $turned = _turn_table( $table );
-    # TODO We should really go through and delete empty rows.
-    return $turned;
+    $self->cached_table( $table );
+    return $table;
 }
 
 sub _make_witness_row {
-    my( $path, $positions, $noderefs ) = @_;
+    my( $path, $positions ) = @_;
     my %char_hash;
     map { $char_hash{$_} = undef } @$positions;
+    my $debug = 0;
     foreach my $rdg ( @$path ) {
         my $rtext = $rdg->text;
         $rtext = '#LACUNA#' if $rdg->is_lacuna;
-        # print STDERR "No rank for " . $rdg->name . "\n" unless defined $rdg->rank;
-        $char_hash{$rdg->rank} = $noderefs ? $rdg : $rtext;
+        print STDERR "rank " . $rdg->rank . "\n" if $debug;
+        # print STDERR "No rank for " . $rdg->id . "\n" unless defined $rdg->rank;
+        $char_hash{$rdg->rank} = { 't' => $rdg };
     }
     my @row = map { $char_hash{$_} } @$positions;
     # Fill in lacuna markers for undef spots in the row
@@ -577,8 +1238,8 @@ sub _make_witness_row {
     foreach my $el ( @row ) {
         # If we are using node reference, make the lacuna node appear many times
         # in the table.  If not, use the lacuna tag.
-        if( $last_el && _el_is_lacuna( $last_el ) && !defined $el ) {
-            $el = $noderefs ? $last_el : '#LACUNA#';
+        if( $last_el && $last_el->{'t'}->is_lacuna && !defined $el ) {
+            $el = $last_el;
         }
         push( @filled_row, $el );
         $last_el = $el;
@@ -586,206 +1247,51 @@ sub _make_witness_row {
     return @filled_row;
 }
 
-# Tiny utility function to say if a table element is a lacuna
-sub _el_is_lacuna {
-    my $el = shift;
-    return 1 if $el eq '#LACUNA#';
-    return 1 if ref( $el ) eq 'Text::Tradition::Collation::Reading'
-        && $el->is_lacuna;
-    return 0;
-}
-
-# Helper to turn the witnesses along columns rather than rows.  Assumes
-# equal-sized rows.
-sub _turn_table {
-    my( $table ) = @_;
-    my $result = [];
-    return $result unless scalar @$table;
-    my $nrows = scalar @{$table->[0]};
-    foreach my $idx ( 0 .. $nrows - 1 ) {
-        foreach my $wit ( 0 .. $#{$table} ) {
-            $result->[$idx]->[$wit] = $table->[$wit]->[$idx];
-        }
-    }
-    return $result;        
-}
-
+=head1 NAVIGATION METHODS
 
-sub collapse_graph_paths {
-    my $self = shift;
-    # Our collation graph has an path per witness.  This is great for
-    # calculation purposes, but terrible for display.  Thus we want to
-    # display only one path between any two nodes.
-
-    return if $self->collapsed;
-
-    print STDERR "Collapsing witness paths in graph...\n";
-
-    # Don't list out every witness if we have more than half to list.
-    my $majority = int( scalar( $self->tradition->witnesses ) / 2 ) + 1;
-    # But don't compress if there are only a few witnesses.
-    $majority = 4 if $majority < 4;
-    foreach my $node ( $self->readings ) {
-        my $newlabels = {};
-        # We will visit each node, so we only look ahead.
-        foreach my $edge ( $node->outgoing() ) {
-            next unless $edge->class eq 'edge.path';
-            add_hash_entry( $newlabels, $edge->to->name, $edge->name );
-            $self->del_path( $edge );
-        }
-
-        foreach my $newdest ( keys %$newlabels ) {
-            my $label;
-            my @compressed_wits = @{$newlabels->{$newdest}};
-            if( @compressed_wits < $majority ) {
-                $label = join( ', ', sort( @{$newlabels->{$newdest}} ) );
-            } else {
-                ## TODO FIX THIS HACK
-                my @aclabels;
-                foreach my $wit ( @compressed_wits ) {
-                    push( @aclabels, $wit ) if( $wit =~ /^(.*?)(\s*\(?a\.\s*c\.\)?)$/ );
-                }
-                $label = join( ', ', 'majority', sort( @aclabels ) );
-            }
-            
-            my $newpath = $self->add_path( $node, $self->reading( $newdest ), $label );
-            $newpath->hidden_witnesses( \@compressed_wits );
-        }
-    }
-
-    $self->collapsed( 1 );
-}
-
-sub expand_graph_paths {
-    my $self = shift;
-    # Our collation graph has only one path between any two nodes.
-    # This is great for display, but not so great for analysis.
-    # Expand this so that each witness has its own path between any
-    # two reading nodes.
-    return unless $self->collapsed;
-    
-    print STDERR "Expanding witness paths in graph...\n";
-    foreach my $path( $self->paths ) {
-        my $from = $path->from;
-        my $to = $path->to;
-        warn sprintf( "No hidden witnesses on %s -> %s ?", $from->name, $to->name )
-            unless $path->has_hidden_witnesses;
-        my @wits = @{$path->hidden_witnesses};
-        $self->del_path( $path );
-        foreach ( @wits ) {
-            $self->add_path( $from, $to, $_ );
-        }
-    }
-    $self->collapsed( 0 );
-}
-
-=back
-
-=head2 Navigation methods
-
-=over
-
-=item B<start>
-
-my $beginning = $collation->start();
-
-Returns the beginning of the collation, a meta-reading with label '#START#'.
-
-=cut
-
-sub start {
-    # Return the beginning reading of the graph.
-    my( $self, $new_start ) = @_;
-    my $start = $self->reading( '#START#' );
-    if( ref( $new_start ) eq 'Text::Tradition::Collation::Reading' ) {
-    	# Replace the existing start node.
-        $self->del_reading( '#START#' );
-        $self->graph->rename_node( $new_start, '#START#' );
-        $start = $new_start;
-    } elsif ( $new_start && $new_start eq 'INIT' ) {
-    	# Make a new start node.
-    	$start = $self->add_reading( '#START#' );
-    }
-    # Make sure the start node is a meta node
-    $start->is_meta( 1 );
-    # Make sure the start node has a start position.
-    unless( $start->has_rank ) {
-        $start->rank( '0' );
-    }
-    return $start;
-}
-
-=item B<end>
-
-my $end = $collation->end();
-
-Returns the end of the collation, a meta-reading with label '#END#'.
-
-=cut
-
-sub end {
-    my $self = shift;
-    my( $new_end ) = @_;
-    my $end = $self->reading( '#END#' );
-    if( ref( $new_end ) eq 'Text::Tradition::Collation::Reading' ) {
-        $self->del_reading( '#END#' );
-        $self->graph->rename_node( $new_end, '#END#' );
-        $end = $new_end
-    } elsif ( $new_end && $new_end eq 'INIT' ) {
-    	# Make a new start node.
-    	$end = $self->add_reading( '#END#' );
-    }
-    # Make sure the start node is a meta node
-    $end->is_meta( 1 );
-    return $end;
-}
-
-=item B<reading_sequence>
-
-my @readings = $graph->reading_sequence( $first, $last, $path[, $alt_path] );
+=head2 reading_sequence( $first, $last, $sigil, $backup )
 
 Returns the ordered list of readings, starting with $first and ending
-with $last, along the given witness path.  If no path is specified,
-assume that the path is that of the base text (if any.)
+with $last, for the witness given in $sigil. If a $backup sigil is 
+specified (e.g. when walking a layered witness), it will be used wherever
+no $sigil path exists.  If there is a base text reading, that will be
+used wherever no path exists for $sigil or $backup.
 
 =cut
 
 # TODO Think about returning some lazy-eval iterator.
+# TODO Get rid of backup; we should know from what witness is whether we need it.
 
 sub reading_sequence {
-    my( $self, $start, $end, $witness, $backup ) = @_;
+    my( $self, $start, $end, $witness ) = @_;
 
     $witness = $self->baselabel unless $witness;
     my @readings = ( $start );
     my %seen;
     my $n = $start;
-    while( $n && $n ne $end ) {
-        if( exists( $seen{$n->name()} ) ) {
-            warn "Detected loop at " . $n->name();
-            last;
+    while( $n && $n->id ne $end->id ) {
+        if( exists( $seen{$n->id} ) ) {
+            throw( "Detected loop for $witness at " . $n->id );
         }
-        $seen{$n->name()} = 1;
+        $seen{$n->id} = 1;
         
-        my $next = $self->next_reading( $n, $witness, $backup );
+        my $next = $self->next_reading( $n, $witness );
         unless( $next ) {
-            warn "Did not find any path for $witness from reading " . $n->name;
-            last;
+            throw( "Did not find any path for $witness from reading " . $n->id );
         }
         push( @readings, $next );
         $n = $next;
     }
     # Check that the last reading is our end reading.
     my $last = $readings[$#readings];
-    warn "Last reading found from " . $start->label() .
-        " for witness $witness is not the end!"
-        unless $last eq $end;
+    throw( "Last reading found from " . $start->text .
+        " for witness $witness is not the end!" ) # TODO do we get this far?
+        unless $last->id eq $end->id;
     
     return @readings;
 }
 
-=item B<next_reading>
-
-my $next_reading = $graph->next_reading( $reading, $witpath );
+=head2 next_reading( $reading, $sigil );
 
 Returns the reading that follows the given reading along the given witness
 path.  
@@ -795,12 +1301,12 @@ path.
 sub next_reading {
     # Return the successor via the corresponding path.
     my $self = shift;
-    return $self->_find_linked_reading( 'next', @_ );
+    my $answer = $self->_find_linked_reading( 'next', @_ );
+	return undef unless $answer;
+    return $self->reading( $answer );
 }
 
-=item B<prior_reading>
-
-my $prior_reading = $graph->prior_reading( $reading, $witpath );
+=head2 prior_reading( $reading, $sigil )
 
 Returns the reading that precedes the given reading along the given witness
 path.  
@@ -810,45 +1316,54 @@ path.
 sub prior_reading {
     # Return the predecessor via the corresponding path.
     my $self = shift;
-    return $self->_find_linked_reading( 'prior', @_ );
+    my $answer = $self->_find_linked_reading( 'prior', @_ );
+    return $self->reading( $answer );
 }
 
 sub _find_linked_reading {
-    my( $self, $direction, $node, $path, $alt_path ) = @_;
+    my( $self, $direction, $node, $path ) = @_;
+    
+    # Get a backup if we are dealing with a layered witness
+    my $alt_path;
+    my $aclabel = $self->ac_label;
+    if( $path && $path =~ /^(.*)\Q$aclabel\E$/ ) {
+    	$alt_path = $1;
+    }
+    
     my @linked_paths = $direction eq 'next' 
-        ? $node->outgoing() : $node->incoming();
+        ? $self->sequence->edges_from( $node ) 
+        : $self->sequence->edges_to( $node );
     return undef unless scalar( @linked_paths );
     
     # We have to find the linked path that contains all of the
     # witnesses supplied in $path.
     my( @path_wits, @alt_path_wits );
-    @path_wits = $self->witnesses_of_label( $path ) if $path;
-    @alt_path_wits = $self->witnesses_of_label( $alt_path ) if $alt_path;
+    @path_wits = sort( $self->_witnesses_of_label( $path ) ) if $path;
+    @alt_path_wits = sort( $self->_witnesses_of_label( $alt_path ) ) if $alt_path;
     my $base_le;
     my $alt_le;
     foreach my $le ( @linked_paths ) {
-        if( $le->name eq $self->baselabel ) {
+        if( $self->sequence->has_edge_attribute( @$le, $self->baselabel ) ) {
             $base_le = $le;
-        } else {
-            my @le_wits = $self->witnesses_of_label( $le->name );
-            if( _is_within( \@path_wits, \@le_wits ) ) {
-                # This is the right path.
-                return $direction eq 'next' ? $le->to() : $le->from();
-            } elsif( _is_within( \@alt_path_wits, \@le_wits ) ) {
-                $alt_le = $le;
-            }
         }
+		my @le_wits = sort $self->path_witnesses( $le );
+		if( _is_within( \@path_wits, \@le_wits ) ) {
+			# This is the right path.
+			return $direction eq 'next' ? $le->[1] : $le->[0];
+		} elsif( _is_within( \@alt_path_wits, \@le_wits ) ) {
+			$alt_le = $le;
+		}
     }
     # Got this far? Return the alternate path if it exists.
-    return $direction eq 'next' ? $alt_le->to() : $alt_le->from()
+    return $direction eq 'next' ? $alt_le->[1] : $alt_le->[0]
         if $alt_le;
 
     # Got this far? Return the base path if it exists.
-    return $direction eq 'next' ? $base_le->to() : $base_le->from()
+    return $direction eq 'next' ? $base_le->[1] : $base_le->[0]
         if $base_le;
 
     # Got this far? We have no appropriate path.
-    warn "Could not find $direction node from " . $node->label 
+    warn "Could not find $direction node from " . $node->id 
         . " along path $path";
     return undef;
 }
@@ -863,8 +1378,70 @@ sub _is_within {
     return $ret;
 }
 
+# Return the string that joins together a list of witnesses for
+# display on a single path.
+sub _witnesses_of_label {
+    my( $self, $label ) = @_;
+    my $regex = $self->wit_list_separator;
+    my @answer = split( /\Q$regex\E/, $label );
+    return @answer;
+}
+
+=head2 common_readings
+
+Returns the list of common readings in the graph (i.e. those readings that are
+shared by all non-lacunose witnesses.)
 
-## INITIALIZATION METHODS - for use by parsers
+=cut
+
+sub common_readings {
+	my $self = shift;
+	my @common = grep { $_->is_common } $self->readings;
+	return @common;
+}
+
+=head2 path_text( $sigil, [, $start, $end ] )
+
+Returns the text of a witness (plus its backup, if we are using a layer)
+as stored in the collation.  The text is returned as a string, where the
+individual readings are joined with spaces and the meta-readings (e.g.
+lacunae) are omitted.  Optional specification of $start and $end allows
+the generation of a subset of the witness text.
+
+=cut
+
+sub path_text {
+	my( $self, $wit, $start, $end ) = @_;
+	$start = $self->start unless $start;
+	$end = $self->end unless $end;
+	my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit );
+	my $pathtext = '';
+	my $last;
+	foreach my $r ( @path ) {
+		unless ( $r->join_prior || !$last || $last->join_next ) {
+			$pathtext .= ' ';
+		} 
+		$pathtext .= $r->text;
+		$last = $r;
+	}
+	return $pathtext;
+}
+
+=head1 INITIALIZATION METHODS
+
+These are mostly for use by parsers.
+
+=head2 make_witness_path( $witness )
+
+Link the array of readings contained in $witness->path (and in 
+$witness->uncorrected_path if it exists) into collation paths.
+Clear out the arrays when finished.
+
+=head2 make_witness_paths
+
+Call make_witness_path for all witnesses in the tradition.
+
+=cut
 
 # For use when a collation is constructed from a base text and an apparatus.
 # We have the sequences of readings and just need to add path edges.
@@ -875,7 +1452,7 @@ sub _is_within {
 sub make_witness_paths {
     my( $self ) = @_;
     foreach my $wit ( $self->tradition->witnesses ) {
-        print STDERR "Making path for " . $wit->sigil . "\n";
+        # print STDERR "Making path for " . $wit->sigil . "\n";
         $self->make_witness_path( $wit );
     }
 }
@@ -884,11 +1461,16 @@ sub make_witness_path {
     my( $self, $wit ) = @_;
     my @chain = @{$wit->path};
     my $sig = $wit->sigil;
+    # Add start and end if necessary
+    unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+    push( @chain, $self->end ) unless $chain[-1] eq $self->end;
     foreach my $idx ( 0 .. $#chain-1 ) {
         $self->add_path( $chain[$idx], $chain[$idx+1], $sig );
     }
     if( $wit->is_layered ) {
         @chain = @{$wit->uncorrected_path};
+		unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+		push( @chain, $self->end ) unless $chain[-1] eq $self->end;
         foreach my $idx( 0 .. $#chain-1 ) {
             my $source = $chain[$idx];
             my $target = $chain[$idx+1];
@@ -900,61 +1482,79 @@ sub make_witness_path {
     $wit->clear_uncorrected_path;
 }
 
+=head2 calculate_ranks
+
+Calculate the reading ranks (that is, their aligned positions relative
+to each other) for the graph.  This can only be called on linear collations.
+
+=begin testing
+
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+# Make an svg
+my $table = $c->alignment_table;
+ok( $c->has_cached_table, "Alignment table was cached" );
+is( $c->alignment_table, $table, "Cached table returned upon second call" );
+$c->calculate_ranks;
+is( $c->alignment_table, $table, "Cached table retained with no rank change" );
+$c->add_relationship( 'n24', 'n23', { 'type' => 'spelling' } );
+isnt( $c->alignment_table, $table, "Alignment table changed after relationship add" );
+
+=end testing
+
+=cut
+
 sub calculate_ranks {
     my $self = shift;
-    # Walk a version of the graph where every node linked by a relationship 
-    # edge is fundamentally the same node, and do a topological ranking on
-    # the nodes in this graph.
-    my $topo_graph = Graph->new();
-    my %rel_containers;
-    my $rel_ctr = 0;
-    # Add the nodes
-    foreach my $r ( $self->readings ) {
-        next if exists $rel_containers{$r->name};
-        my @rels = $r->related_readings( 'colocated' );
-        if( @rels ) {
-            # Make a relationship container.
-            push( @rels, $r );
-            my $rn = 'rel_container_' . $rel_ctr++;
-            $topo_graph->add_vertex( $rn );
-            foreach( @rels ) {
-                $rel_containers{$_->name} = $rn;
-            }
-        } else {
-            # Add a new node to mirror the old node.
-            $rel_containers{$r->name} = $r->name;
-            $topo_graph->add_vertex( $r->name );
-        }
-    }
+    # Save the existing ranks, in case we need to invalidate the cached SVG.
+    my %existing_ranks;
+    map { $existing_ranks{$_} = $_->rank } $self->readings;
 
-    # Add the edges. Need only one edge between any pair of nodes.
-    foreach my $r ( $self->readings ) {
-        foreach my $n ( $r->neighbor_readings( 'forward' ) ) {
-        	my( $tfrom, $tto ) = ( $rel_containers{$r->name},
-        		$rel_containers{$n->name} );
-            $topo_graph->add_edge( $tfrom, $tto )
-            	unless $topo_graph->has_edge( $tfrom, $tto );
-        }
-    }
-    
-    # Now do the rankings, starting with the start node.
-    my $topo_start = $rel_containers{$self->start->name};
+    # Do the rankings based on the relationship equivalence graph, starting 
+    # with the start node.
+    my $topo_start = $self->equivalence( $self->start->id );
     my $node_ranks = { $topo_start => 0 };
     my @curr_origin = ( $topo_start );
     # A little iterative function.
     while( @curr_origin ) {
-        @curr_origin = _assign_rank( $topo_graph, $node_ranks, @curr_origin );
+        @curr_origin = _assign_rank( $self->equivalence_graph, 
+        	$node_ranks, @curr_origin );
     }
     # Transfer our rankings from the topological graph to the real one.
     foreach my $r ( $self->readings ) {
-        if( defined $node_ranks->{$rel_containers{$r->name}} ) {
-            $r->rank( $node_ranks->{$rel_containers{$r->name}} );
+        if( defined $node_ranks->{$self->equivalence( $r->id )} ) {
+            $r->rank( $node_ranks->{$self->equivalence( $r->id )} );
         } else {
-            $DB::single = 1;
-            die "No rank calculated for node " . $r->name 
-                . " - do you have a cycle in the graph?";
+        	# Die. Find the last rank we calculated.
+        	my @all_defined = sort { ( $node_ranks->{$self->equivalence( $a->id )}||-1 )
+        			 <=> ( $node_ranks->{$self->equivalence( $b->id )}||-1 ) }
+        		$self->readings;
+        	my $last = pop @all_defined;
+            throw( "Ranks not calculated after $last - do you have a cycle in the graph?" );
         }
     }
+    # Do we need to invalidate the cached data?
+    if( $self->has_cached_svg || $self->has_cached_table ) {
+    	foreach my $r ( $self->readings ) {
+    		next if defined( $existing_ranks{$r} ) 
+    			&& $existing_ranks{$r} == $r->rank;
+    		# Something has changed, so clear the cache
+    		$self->_clear_cache;
+			# ...and recalculate the common readings.
+			$self->calculate_common_readings();
+    		last;
+    	}
+    }
+	# The graph calculation information is now up to date.
+	$self->_graphcalc_done(1);
 }
 
 sub _assign_rank {
@@ -992,59 +1592,241 @@ sub _assign_rank {
     return @next_nodes;
 }
 
-# Another method to make up for rough collation methods.  If the same reading
-# appears multiple times at the same rank, collapse the nodes.
+sub _clear_cache {
+	my $self = shift;
+	$self->wipe_svg if $self->has_cached_svg;
+	$self->wipe_table if $self->has_cached_table;
+}	
+
+
+=head2 flatten_ranks
+
+A convenience method for parsing collation data.  Searches the graph for readings
+with the same text at the same rank, and merges any that are found.
+
+=cut
+
 sub flatten_ranks {
     my $self = shift;
     my %unique_rank_rdg;
+    my $changed;
     foreach my $rdg ( $self->readings ) {
         next unless $rdg->has_rank;
         my $key = $rdg->rank . "||" . $rdg->text;
         if( exists $unique_rank_rdg{$key} ) {
             # Combine!
-            print STDERR "Combining readings at same rank: $key\n";
+        	# print STDERR "Combining readings at same rank: $key\n";
+        	$changed = 1;
             $self->merge_readings( $unique_rank_rdg{$key}, $rdg );
+            # TODO see if this now makes a common point.
         } else {
             $unique_rank_rdg{$key} = $rdg;
         }
     }
+    # If we merged readings, the ranks are still fine but the alignment
+    # table is wrong. Wipe it.
+    $self->wipe_table() if $changed;
 }
+	
+
+=head2 calculate_common_readings
 
+Goes through the graph identifying the readings that appear in every witness 
+(apart from those with lacunae at that spot.) Marks them as common and returns
+the list.
 
-## Utility functions
+=begin testing
+
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+my @common = $c->calculate_common_readings();
+is( scalar @common, 8, "Found correct number of common readings" );
+my @marked = sort $c->common_readings();
+is( scalar @common, 8, "All common readings got marked as such" );
+my @expected = qw/ n1 n11 n16 n19 n20 n5 n6 n7 /;
+is_deeply( \@marked, \@expected, "Found correct list of common readings" );
+
+=end testing
+
+=cut
+
+sub calculate_common_readings {
+	my $self = shift;
+	my @common;
+	map { $_->is_common( 0 ) } $self->readings;
+	# Implicitly calls calculate_ranks
+	my $table = $self->alignment_table;
+	foreach my $idx ( 0 .. $table->{'length'} - 1 ) {
+		my @row = map { $_->{'tokens'}->[$idx] 
+							? $_->{'tokens'}->[$idx]->{'t'} : '' } 
+					@{$table->{'alignment'}};
+		my %hash;
+		foreach my $r ( @row ) {
+			if( $r ) {
+				$hash{$r->id} = $r unless $r->is_meta;
+			} else {
+				$hash{'UNDEF'} = $r;
+			}
+		}
+		if( keys %hash == 1 && !exists $hash{'UNDEF'} ) {
+			my( $r ) = values %hash;
+			$r->is_common( 1 );
+			push( @common, $r );
+		}
+	}
+	return @common;
+}
+
+=head2 text_from_paths
+
+Calculate the text array for all witnesses from the path, for later consistency
+checking.  Only to be used if there is no non-graph-based way to know the
+original texts.
+
+=cut
+
+sub text_from_paths {
+	my $self = shift;
+    foreach my $wit ( $self->tradition->witnesses ) {
+    	my @readings = $self->reading_sequence( $self->start, $self->end, $wit->sigil );
+    	my @text;
+    	foreach my $r ( @readings ) {
+    		next if $r->is_meta;
+    		push( @text, $r->text );
+    	}
+    	$wit->text( \@text );
+    	if( $wit->is_layered ) {
+			my @ucrdgs = $self->reading_sequence( $self->start, $self->end, 
+												  $wit->sigil.$self->ac_label );
+			my @uctext;
+			foreach my $r ( @ucrdgs ) {
+				next if $r->is_meta;
+				push( @uctext, $r->text );
+			}
+			$wit->layertext( \@uctext );
+    	}
+    }    
+}
+
+=head1 UTILITY FUNCTIONS
+
+=head2 common_predecessor( $reading_a, $reading_b )
+
+Find the last reading that occurs in sequence before both the given readings.
+At the very least this should be $self->start.
+
+=head2 common_successor( $reading_a, $reading_b )
+
+Find the first reading that occurs in sequence after both the given readings.
+At the very least this should be $self->end.
     
-# Return the string that joins together a list of witnesses for
-# display on a single path.
-sub path_label {
-    my $self = shift;
-    return join( $self->wit_list_separator, @_ );
+=begin testing
+
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+is( $c->common_predecessor( 'n24', 'n23' )->id, 
+    'n20', "Found correct common predecessor" );
+is( $c->common_successor( 'n24', 'n23' )->id, 
+    '__END__', "Found correct common successor" );
+
+is( $c->common_predecessor( 'n19', 'n17' )->id, 
+    'n16', "Found correct common predecessor for readings on same path" );
+is( $c->common_successor( 'n21', 'n10' )->id, 
+    '__END__', "Found correct common successor for readings on same path" );
+
+=end testing
+
+=cut
+
+## Return the closest reading that is a predecessor of both the given readings.
+sub common_predecessor {
+	my $self = shift;
+	my( $r1, $r2 ) = $self->_objectify_args( @_ );
+	return $self->_common_in_path( $r1, $r2, 'predecessors' );
 }
 
-sub witnesses_of_label {
-    my( $self, $label ) = @_;
-    my $regex = $self->wit_list_separator;
-    my @answer = split( /\Q$regex\E/, $label );
-    return @answer;
-}    
-
-sub add_hash_entry {
-    my( $hash, $key, $entry ) = @_;
-    if( exists $hash->{$key} ) {
-        push( @{$hash->{$key}}, $entry );
-    } else {
-        $hash->{$key} = [ $entry ];
-    }
+sub common_successor {
+	my $self = shift;
+	my( $r1, $r2 ) = $self->_objectify_args( @_ );
+	return $self->_common_in_path( $r1, $r2, 'successors' );
+}
+
+
+# TODO think about how to do this without ranks...
+sub _common_in_path {
+	my( $self, $r1, $r2, $dir ) = @_;
+	my $iter = $self->end->rank;
+	my @candidates;
+	my @last_r1 = ( $r1 );
+	my @last_r2 = ( $r2 );
+	# my %all_seen = ( $r1 => 'r1', $r2 => 'r2' );
+	my %all_seen;
+	# print STDERR "Finding common $dir for $r1, $r2\n";
+	while( !@candidates ) {
+		last unless $iter--;  # Avoid looping infinitely
+		# Iterate separately down the graph from r1 and r2
+		my( @new_lc1, @new_lc2 );
+		foreach my $lc ( @last_r1 ) {
+			foreach my $p ( $lc->$dir ) {
+				if( $all_seen{$p->id} && $all_seen{$p->id} ne 'r1' ) {
+					# print STDERR "Path candidate $p from $lc\n";
+					push( @candidates, $p );
+				} elsif( !$all_seen{$p->id} ) {
+					$all_seen{$p->id} = 'r1';
+					push( @new_lc1, $p );
+				}
+			}
+		}
+		foreach my $lc ( @last_r2 ) {
+			foreach my $p ( $lc->$dir ) {
+				if( $all_seen{$p->id} && $all_seen{$p->id} ne 'r2' ) {
+					# print STDERR "Path candidate $p from $lc\n";
+					push( @candidates, $p );
+				} elsif( !$all_seen{$p->id} ) {
+					$all_seen{$p->id} = 'r2';
+					push( @new_lc2, $p );
+				}
+			}
+		}
+		@last_r1 = @new_lc1;
+		@last_r2 = @new_lc2;
+	}
+	my @answer = sort { $a->rank <=> $b->rank } @candidates;
+	return $dir eq 'predecessors' ? pop( @answer ) : shift ( @answer );
+}
+
+sub throw {
+	Text::Tradition::Error->throw( 
+		'ident' => 'Collation error',
+		'message' => $_[0],
+		);
 }
 
 no Moose;
 __PACKAGE__->meta->make_immutable;
 
-=head1 BUGS / TODO
+=head1 LICENSE
 
-=over
-
-=item * Rationalize edge classes
+This package is free software and is provided "as is" without express
+or implied warranty.  You can redistribute it and/or modify it under
+the same terms as Perl itself.
 
-=item * Port the internal graph from Graph::Easy to Graph
+=head1 AUTHOR
 
-=back
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>