From: Tara L Andrews <tla\@mit.edu>
Date: Thu, 19 Apr 2012 12:22:09 +0000 (+0200)
Subject: enable graphml export of partial traditions
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a30ca502de98d06d416f352736ae855185eabb86;p=scpubgit%2Fstemmatology.git

enable graphml export of partial traditions
---

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 4c410c1..7926844 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -882,9 +882,21 @@ is( scalar $st->collation->relationships, 3, "Reparsed collation has new relatio
 =cut
 
 sub as_graphml {
-    my( $self ) = @_;
+    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 %use_readings;
+	
     # Some namespaces
     my $graphml_ns = 'http://graphml.graphdrawing.org/xmlns';
     my $xsi_ns = 'http://www.w3.org/2001/XMLSchema-instance';
@@ -1012,6 +1024,9 @@ sub as_graphml {
     my %node_hash;
     # Add our readings to the graph
     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++;
@@ -1028,7 +1043,11 @@ sub as_graphml {
     my $edge_ctr = 0;
     foreach my $e ( sort { $a->[0] cmp $b->[0] } $self->sequence->edges() ) {
     	# We add an edge in the graphml for every witness in $e.
-    	foreach my $wit ( sort $self->path_witnesses( $e ) ) {
+    	next unless( $use_readings{$e->[0]} || $use_readings{$e->[1]} );
+    	my @edge_wits = sort $self->path_witnesses( $e );
+    	$e->[0] = $self->start unless $use_readings{$e->[0]};
+    	$e->[1] = $self->end unless $use_readings{$e->[1]};
+    	foreach my $wit ( @edge_wits ) {
 			my( $id, $from, $to ) = ( 'e'.$edge_ctr++,
 										$node_hash{ $e->[0] },
 										$node_hash{ $e->[1] } );
diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index dc2fe1b..de12533 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -537,6 +537,7 @@ sub _as_graphml {
     my $edge_ctr = 0;
     foreach my $e ( sort { $a->[0] cmp $b->[0] } $self->graph->edges ) {
     	# Add an edge and fill in its relationship info.
+    	next unless( exists $node_hash->{$e->[0]} && exists $node_hash->{$e->[1]} );
 		my $edge_el = $rgraph->addNewChild( $graphml_ns, 'edge' );
 		$edge_el->setAttribute( 'source', $node_hash->{$e->[0]} );
 		$edge_el->setAttribute( 'target', $node_hash->{$e->[1]} );