change analysis graph calculation - closer but not correct yet.

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation.pm

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 2879026..d28d7d7 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -246,12 +246,12 @@ sub relationship_valid {
     # The lists of 'in' and 'out' should not have any element that appears
     # in 'proposed_related'.
     foreach my $pr ( @proposed_related ) {
-        foreach my $e ( $pr->incoming ) {
+        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->incoming ) {
             if( exists $pr_ids{ $e->from->name } ) {
                 return 0;
             }
         }
-        foreach my $e ( $pr->outgoing ) {
+        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->outgoing ) {
             if( exists $pr_ids{ $e->to->name } ) {
                 return 0;
             }
@@ -528,7 +528,7 @@ sub as_csv {
 # in the table are the nodes or simply their readings.
 
 sub make_alignment_table {
-    my( $self, $noderefs ) = @_;
+    my( $self, $noderefs, $include ) = @_;
     unless( $self->linear ) {
         warn "Need a linear graph in order to make an alignment table";
         return;
@@ -547,8 +547,19 @@ sub make_alignment_table {
         }           
     }
 
+    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;
 }