use Graph::Easy;
use IPC::Run qw( run binary );
use Module::Load;
+use Traditions::Graph::Position;
+
+=head1 NAME
+
+(Text?)::Traditions::Graph
+
+=head1 SYNOPSIS
+
+use Traditions::Graph;
+
+my $text = Traditions::Graph->new( 'GraphML' => '/my/graphml/file.xml' );
+my $text = Traditions::Graph->new( 'TEI' => '/my/tei/file.xml' );
+my $text = Traditions::Graph->new( 'CSV' => '/my/csv/file.csv',
+ 'base' => '/my/basefile.txt' );
+my $text = Traditions::Graph->new( 'CTE' => '/my/cte/file.txt',
+ 'base' => '/my/basefile.txt' );
+
+my $svg_string = $text->as_svg();
+
+my $lemma_nodes = $text->active_nodes();
+$text->toggle_node( 'some_word' );
+
+=head1 DESCRIPTION
+
+A text tradition is the representation of our knowledge of a text that
+has been passed down via manuscript copies from a time before printing
+presses. Each text has a number of witnesses, that is, manuscripts
+that bear a version of the text. The tradition is the aggregation of
+these witnesses, which is to say, the collation of the text.
+
+This module takes a text collation and represents it as a horizontal
+directed graph, suitable for SVG rendering and for analysis of various
+forms. Since this module was written by a medievalist, it also
+provides a facility for making a critical text reconstruction by
+choosing certain variants to be 'lemma' text - that is, text which
+should be considered the 'standard' reading.
+
+Although the graph is a very good way to render text collation, and is
+visually very easy for a human to interpret, it doesn't have any
+inherent information about which nodes 'go together' - that is, which
+text readings appear in the same place as other readings. This module
+therefore calculates 'positions' on the graph, thus holding some
+information about which readings can and can't be substituted for
+others.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new>
+
+Constructor. Takes a source collation file from which to construct
+the initial graph. This file can be TEI (parallel segmentation) XML,
+CSV in a format yet to be documented, GraphML as documented (someday)
+by CollateX, or a Classical Text Editor apparatus. For CSV and
+Classical Text Editor files, the user must also supply a base text to
+which the line numbering in the collation file refers.
+
+=cut
sub new {
my $proto = shift;
return $self->{'graph'}->node('#START#');
}
-sub save_positions {
- my( $self, $positions ) = @_;
- $self->{'positions'} = $positions;
+sub set_identical_nodes {
+ my( $self, $node_hash ) = @_;
+ $self->{'identical_nodes'} = $node_hash;
}
sub next_word {
return $svg;
}
-1;
-__END__
-#### EXAMINE BELOW ####
+## Methods for lemmatizing a text.
-# Returns a list of the nodes that are currently on and the nodes for
-# which an ellipsis needs to stand in. Optionally takes a list of
-# nodes that have just been turned off, to include in the list.
+sub init_lemmatizer {
+ my $self = shift;
+ # Initialize the 'lemma' hash, going through all the nodes and seeing
+ # which ones are common nodes. This should only be called once.
+
+ return if exists $self->{'lemma'};
+
+ my $lemma = {};
+ foreach my $node ( $self->nodes() ) {
+ my $state = $node->get_attribute('class') eq 'common' ? 1 : 0;
+ $lemma->{ $node->name() } = $state;
+ }
+
+ $self->{'lemma'} = $lemma;
+}
+
+sub make_positions {
+ my( $self, $common_nodes, $paths ) = @_;
+ my $positions = Traditions::Graph::Position->new( $common_nodes, $paths );
+ $self->{'positions'} = $positions;
+}
+
+# Takes a list of nodes that have just been turned off, and returns a
+# set of tuples of the form ['node', 'state'] that indicates what
+# changes need to be made to the graph.
+# A state of 1 means 'turn on this node'
+# A state of 0 means 'turn off this node'
+# A state of undef means 'an ellipsis belongs in the text here because
+# no decision has been made'
sub active_nodes {
my( $self, @toggled_off_nodes ) = @_;
-
- my $all_nodes = {};
- map { $all_nodes->{ $_ } = $self->_find_position( $_ ) } keys %{$self->{node_state}};
- my $positions = _invert_hash( $all_nodes );
+
+ # In case this is the first run
+ $self->init_lemmatizer();
+ # First get the positions of those nodes which have been
+ # toggled off.
my $positions_off = {};
- map { $positions_off->{ $all_nodes->{$_} } = $_ } @toggled_off_nodes;
+ map { $positions_off->{ $self->{'positions'}->node_position( $_ ) } = $_ }
+ @toggled_off_nodes;
+
# Now for each position, we have to see if a node is on, and we
# have to see if a node has been turned off.
my @answer;
- foreach my $pos ( @{$self->{_all_positions}} ) {
- my $nodes = $positions->{$pos};
-
+ foreach my $pos ( $self->{'positions'}->all() ) {
+ my @nodes = $self->{'positions'}->nodes_at_position( $pos );
+
# See if there is an active node for this position.
- my @active_nodes = grep { $self->{node_state}->{$_} == 1 } @$nodes;
+ my @active_nodes = grep { $self->{'lemma'}->{$_} == 1 } @nodes;
warn "More than one active node at position $pos!"
unless scalar( @active_nodes ) < 2;
my $active;
if( scalar( @active_nodes ) ) {
- $active = $self->node_to_svg( $active_nodes[0] );
+ $active = $active_nodes[0] ;
}
# Is there a formerly active node that was toggled off?
if( exists( $positions_off->{$pos} ) ) {
- my $off_node = $self->node_to_svg( $positions_off->{$pos} );
+ my $off_node = $positions_off->{$pos};
if( $active ) {
push( @answer, [ $off_node, 0 ], [ $active, 1 ] );
- } elsif ( scalar @$nodes == 1 ) {
+ } elsif ( scalar @nodes == 1 ) {
# This was the only node at its position. No ellipsis.
push( @answer, [ $off_node, 0 ] );
} else {
} else {
# There is no change here; we need an ellipsis. Use
# the first node in the list, arbitrarily.
- push( @answer, [ $self->node_to_svg( $nodes->[0] ), undef ] );
+ push( @answer, [ $nodes[0] , undef ] );
}
}
return @answer;
}
-# Compares two nodes according to their positions in the witness
-# index hash.
-sub _by_position {
- my $self = shift;
- return _cmp_position( $self->_find_position( $a ),
- $self->_find_position( $b ) );
-}
-
-# Takes two position strings (X,Y) and sorts them.
-sub _cmp_position {
- my @pos_a = split(/,/, $a );
- my @pos_b = split(/,/, $b );
-
- my $big_cmp = $pos_a[0] <=> $pos_b[0];
- return $big_cmp if $big_cmp;
- # else
- return $pos_a[1] <=> $pos_b[1];
-}
-
-# Finds the position of a node in the witness index hash. Warns if
-# the same node has non-identical positions across witnesses. Quite
-# possibly should not warn.
-sub _find_position {
- my $self = shift;
- my $node = shift;
-
- my $position;
- foreach my $wit ( keys %{$self->{indices}} ) {
- if( exists $self->{indices}->{$wit}->{$node} ) {
- if( $position && $self->{indices}->{$wit}->{$node} ne $position ) {
- warn "Position for node $node varies between witnesses";
- }
- $position = $self->{indices}->{$wit}->{$node};
- }
- }
+# A couple of helpers. TODO These should be gathered in the same place
+# eventually
- warn "No position found for node $node" unless $position;
- return $position;
+sub is_common {
+ my( $self, $node ) = @_;
+ $node = $self->_nodeobj( $node );
+ return $node->get_attribute('class') eq 'common';
}
-sub _invert_hash {
- my ( $hash, $plaintext_keys ) = @_;
- my %new_hash;
- foreach my $key ( keys %$hash ) {
- my $val = $hash->{$key};
- my $valkey = $val;
- if( $plaintext_keys
- && ref( $val ) ) {
- $valkey = $plaintext_keys->{ scalar( $val ) };
- warn( "No plaintext value given for $val" ) unless $valkey;
- }
- if( exists ( $new_hash{$valkey} ) ) {
- push( @{$new_hash{$valkey}}, $key );
- } else {
- $new_hash{$valkey} = [ $key ];
- }
+sub _nodeobj {
+ my( $self, $node ) = @_;
+ unless( ref $node eq 'Graph::Easy::Node' ) {
+ $node = $self->node( $node );
}
- return \%new_hash;
+ return $node;
}
+# toggle_node takes a node name, and either lemmatizes or de-lemmatizes it.
+# Returns a list of nodes that are de-lemmatized as a result of the toggle.
-# Takes a node ID to toggle; returns a list of nodes that are
-# turned OFF as a result.
sub toggle_node {
- my( $self, $node_id ) = @_;
- $node_id = $self->node_from_svg( $node_id );
+ my( $self, $node ) = @_;
+
+ # In case this is being called for the first time.
+ $self->init_lemmatizer();
- # Is it a common node? If so, we don't want to turn it off.
- # Later we might want to allow it off, but give a warning.
- if( grep { $_ =~ /^$node_id$/ } @{$self->{common_nodes}} ) {
- return ();
- }
+ if( $self->is_common( $node ) ) {
+ # Do nothing, it's a common node.
+ return;
+ }
my @nodes_off;
# If we are about to turn on a node...
- if( !$self->{node_state}->{$node_id} ) {
+ if( !$self->{'lemma'}->{ $node } ) {
# Turn on the node.
- $self->{node_state}->{$node_id} = 1;
+ $self->{'lemma'}->{ $node } = 1;
# Turn off any other 'on' nodes in the same position.
- push( @nodes_off, $self->colocated_nodes( $node_id ) );
+ push( @nodes_off, $self->colocated_nodes( $node ) );
# Turn off any node that is an identical transposed one.
- push( @nodes_off, $self->identical_nodes( $node_id ) )
- if $self->identical_nodes( $node_id );
+ push( @nodes_off, $self->identical_nodes( $node ) )
+ if $self->identical_nodes( $node );
} else {
- push( @nodes_off, $node_id );
+ push( @nodes_off, $node );
}
+ @nodes_off = unique_list( @nodes_off );
# Turn off the nodes that need to be turned off.
- map { $self->{node_state}->{$_} = 0 } @nodes_off;
+ map { $self->{'lemma'}->{$_} = 0 } @nodes_off;
return @nodes_off;
}
-sub node_from_svg {
- my( $self, $node_id ) = @_;
- # TODO: implement this for real. Need a mapping between SVG titles
- # and GraphML IDs, as created in make_graphviz.
- $node_id =~ s/^node_//;
- return $node_id;
-}
-
-sub node_to_svg {
- my( $self, $node_id ) = @_;
- # TODO: implement this for real. Need a mapping between SVG titles
- # and GraphML IDs, as created in make_graphviz.
- $node_id = "node_$node_id";
- return $node_id;
-}
-
sub colocated_nodes {
- my( $self, $node ) = @_;
- my @cl;
-
- # Get the position of the stated node.
- my $position;
- foreach my $index ( values %{$self->{indices}} ) {
- if( exists( $index->{$node} ) ) {
- if( $position && $position ne $index->{$node} ) {
- warn "Two ms positions for the same node!";
- }
- $position = $index->{$node};
- }
- }
-
- # Now find the other nodes in that position, if any.
- foreach my $index ( values %{$self->{indices}} ) {
- my %location = reverse( %$index );
- push( @cl, $location{$position} )
- if( exists $location{$position}
- && $location{$position} ne $node );
- }
- return @cl;
+ my $self = shift;
+ return $self->{'positions'}->colocated_nodes( @_ );
}
sub identical_nodes {
my( $self, $node ) = @_;
- return undef unless exists $self->{transpositions} &&
- exists $self->{transpositions}->{$node};
- return $self->{transpositions}->{$node};
+ return undef unless exists $self->{'identical_nodes'} &&
+ exists $self->{'identical_nodes'}->{$node};
+ return $self->{'identical_nodes'}->{$node};
+}
+
+sub text_of_node {
+ my( $self, $node_id ) = @_;
+ # This is the label of the given node.
+ return $self->node( $node_id )->label();
}
sub text_for_witness {
my( $self, $wit ) = @_;
- # Get the witness name
- my %wit_id_for = reverse %{$self->{witnesses}};
- my $wit_id = $wit_id_for{$wit};
- unless( $wit_id ) {
- warn "Could not find an ID for witness $wit";
- return;
- }
- my $path = $self->{indices}->{$wit_id};
- my @nodes = sort { $self->_cmp_position( $path->{$a}, $path->{$b} ) } keys( %$path );
- my @words = map { $self->text_of_node( $_ ) } @nodes;
+ my @nodes = $self->{'positions'}->witness_path( $wit );
+ my @words = map { $self->node( $_ )->label() } @nodes;
return join( ' ', @words );
}
-sub text_of_node {
- my( $self, $node_id ) = @_;
- my $xpath = '//g:node[@id="' . $self->node_from_svg( $node_id) .
- '"]/g:data[@key="' . $self->{nodedata}->{token} . '"]/child::text()';
- return $self->{xpc}->findvalue( $xpath );
+sub unique_list {
+ my( @list ) = @_;
+ my %h;
+ map { $h{$_} = 1 } @list;
+ return keys( %h );
}
+
1;
+
--- /dev/null
+package Traditions::Graph::Position;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Traditions::Graph::Position
+
+=head1 SUMMARY
+
+An object to go with a text graph that keeps track of relative
+positions of the nodes.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new>
+
+Takes two arguments: a list of names of common nodes in the graph, and
+a list of witness paths. Calculates position identifiers for each
+node based on this.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my( $common_nodes, $witness_paths ) = @_;
+
+ my $self = {};
+
+ # We have to calculate the position identifiers for each word,
+ # keyed on the common nodes. This will be 'fun'. The end result
+ # is a hash per witness, whose key is the word node and whose
+ # value is its position in the text. Common nodes are always N,1
+ # so have identical positions in each text.
+
+ my $node_pos = {};
+ foreach my $wit ( keys %$witness_paths ) {
+ # First we walk each path, making a matrix for each witness that
+ # corresponds to its eventual position identifier. Common nodes
+ # always start a new row, and are thus always in the first column.
+
+ my $wit_matrix = [];
+ my $cn = 0; # We should hit the common nodes in order.
+ my $row = [];
+ foreach my $wn ( @{$witness_paths->{$wit}} ) { # $wn is a node name
+ if( $wn eq $common_nodes->[$cn] ) {
+ # Set up to look for the next common node, and
+ # start a new row of words.
+ $cn++;
+ push( @$wit_matrix, $row ) if scalar( @$row );
+ $row = [];
+ }
+ push( @$row, $wn );
+ }
+ push( @$wit_matrix, $row ); # Push the last row onto the matrix
+
+ # Now we have a matrix per witness, so that each row in the
+ # matrix begins with a common node, and continues with all the
+ # variant words that appear in the witness. We turn this into
+ # real positions in row,cell format. But we need some
+ # trickery in order to make sure that each node gets assigned
+ # to only one position.
+
+ foreach my $li ( 1..scalar(@$wit_matrix) ) {
+ foreach my $di ( 1..scalar(@{$wit_matrix->[$li-1]}) ) {
+ my $node = $wit_matrix->[$li-1]->[$di-1];
+ my $position = "$li,$di";
+ # If we have seen this node before, we need to compare
+ # its position with what went before.
+ unless( exists $node_pos->{ $node } &&
+ _cmp_position( $position, $node_pos->{ $node }) < 1 ) {
+ # The new position ID replaces the old one.
+ $node_pos->{$node} = $position;
+ } # otherwise, the old position needs to stay.
+ }
+ }
+ }
+ # Now we have a hash of node positions keyed on node.
+ $self->{'node_positions'} = $node_pos;
+ $self->{'witness_paths'} = $witness_paths;
+
+ bless( $self, $proto );
+ return $self;
+}
+
+sub node_position {
+ my( $self, $node ) = @_;
+ $node = _name( $node );
+
+ unless( exists( $self->{'node_positions'}->{ $node } ) ) {
+ warn "No node with name $node known to the graph";
+ return;
+ }
+
+ return $self->{'node_positions'}->{ $node };
+}
+
+sub nodes_at_position {
+ my( $self, $pos ) = @_;
+
+ my $positions = $self->calc_positions();
+ unless( exists $positions->{ $pos } ) {
+ warn "No position $pos in the graph";
+ return;
+ }
+ return @{ $positions->{ $pos }};
+}
+
+sub colocated_nodes {
+ my( $self, $node ) = @_;
+ $node = _name( $node );
+ my $pos = $self->node_position( $node );
+ my @loc_nodes = $self->nodes_at_position( $pos );
+
+ my @cn = grep { $_ !~ /^$node$/ } @loc_nodes;
+ return @cn;
+}
+
+sub all {
+ my( $self ) = @_;
+ my $pos = $self->calc_positions;
+ return sort by_position keys( %$pos );
+}
+
+sub witness_path {
+ my( $self, $wit ) = @_;
+ return @{$self->{'witness_paths'}->{ $wit }};
+}
+
+# At some point I may find myself using scalar references for the node
+# positions, in order to keep them easily in sync. Just in case, I will
+# calculate this every time I need it.
+sub calc_positions {
+ my $self = shift;
+ return _invert_hash( $self->{'node_positions'} )
+}
+
+# Helper for dealing with node refs
+sub _name {
+ my( $node ) = @_;
+ # We work with node names in this library
+ if( ref( $node ) && ref( $node ) eq 'Graph::Easy::Node' ) {
+ $node = $node->name();
+ }
+ return $node;
+}
+
+### Comparison functions
+
+# Compares two nodes according to their positions in the witness
+# index hash.
+sub by_position {
+ my $self = shift;
+ return _cmp_position( $a, $b );
+}
+
+# Takes two position strings (X,Y) and sorts them.
+sub _cmp_position {
+ my( $a, $b ) = @_;
+ my @pos_a = split(/,/, $a );
+ my @pos_b = split(/,/, $b );
+
+ my $big_cmp = $pos_a[0] <=> $pos_b[0];
+ return $big_cmp if $big_cmp;
+ # else
+ return $pos_a[1] <=> $pos_b[1];
+}
+
+# Useful helper. Will be especially useful if I find myself using
+# scalar references for the positions after all - it can dereference
+# them here.
+sub _invert_hash {
+ my ( $hash, $plaintext_keys ) = @_;
+ my %new_hash;
+ foreach my $key ( keys %$hash ) {
+ my $val = $hash->{$key};
+ my $valkey = $val;
+ if( $plaintext_keys
+ && ref( $val ) ) {
+ $valkey = $plaintext_keys->{ scalar( $val ) };
+ warn( "No plaintext value given for $val" ) unless $valkey;
+ }
+ if( exists ( $new_hash{$valkey} ) ) {
+ push( @{$new_hash{$valkey}}, $key );
+ } else {
+ $new_hash{$valkey} = [ $key ];
+ }
+ }
+ return \%new_hash;
+}
+
+1;
## Reverse the node_name hash so that we have two-way lookup.
my %node_id = reverse %node_name;
- ## TODO mark transpositions somehow.
+
+ ## Record the nodes that are marked as transposed.
+ my $id_xpath = '//g:node[g:data[@key="' . $nodedata{'identity'} . '"]]';
+ my $transposed_nodes = $xpc->find( $id_xpath );
+ my $identical_nodes;
+ foreach my $tn ( @$transposed_nodes ) {
+ $identical_nodes->{ $node_name{ $tn->getAttribute('id') }} =
+ $node_name{ $xpc->findvalue( './g:data[@key="'
+ . $nodedata{'identity'}
+ . '"]/text()', $tn ) };
+ }
+ $graph->set_identical_nodes( $identical_nodes );
+
# Find the beginning and end nodes of the graph. The beginning node
# has no incoming edges; the end node has no outgoing edges.
unless $n->get_attribute( 'class' ) eq 'common';
}
- # And then we have to calculate the position identifiers for
- # each word, keyed on the common nodes. This will be 'fun'.
- # The end result is a hash per witness, whose key is the word
- # node and whose value is its position in the text. Common
- # nodes are always N,1 so have identical positions in each text.
- my $wit_indices = {};
- my $positions = {};
- foreach my $wit ( values %witnesses ) {
- my $wit_matrix = [];
- my $cn = 0;
- my $row = [];
- foreach my $wn ( @{$paths->{$wit}} ) {
- if( $wn eq $common_nodes[$cn] ) {
- $cn++;
- push( @$wit_matrix, $row ) if scalar( @$row );
- $row = [];
- }
- push( @$row, $wn );
- }
- push( @$wit_matrix, $row );
- # Now we have a matrix; we really want to invert this.
- my $wit_index;
- foreach my $li ( 1..scalar(@$wit_matrix) ) {
- foreach my $di ( 1..scalar(@{$wit_matrix->[$li-1]}) ) {
- $wit_index->{ $wit_matrix->[$li-1]->[$di-1] } = "$li,$di";
- $positions->{ "$li,$di" } = 1;
- }
- }
-
- $wit_indices->{$wit} = $wit_index;
- }
- $graph->save_positions( $positions, $wit_indices );
+ # Now calculate graph positions.
+ $graph->make_positions( \@common_nodes, $paths );
+
}
1;
use strict; use warnings;
use Test::More;
use lib 'lib';
-use lemmatizer::Model::Graph;
+use Traditions::Graph;
use XML::LibXML;
use XML::LibXML::XPathContext;
open( GRAPHFILE, $datafile ) or die "Could not open $datafile";
my @lines = <GRAPHFILE>;
close GRAPHFILE;
-my $graph = lemmatizer::Model::Graph->new( 'xml' => join( '', @lines ) );
+my $graph = Traditions::Graph->new( 'GraphML' => join( '', @lines ) );
# Test the svg creation
my $parser = XML::LibXML->new();
is( scalar @svg_edges, 27, "Correct number of edges in the graph" );
# Test for the correct common nodes
-my @expected_nodes = map { [ "node_$_", 1 ] } qw/0 1 8 12 13 16 19 20 23 27/;
+my @expected_nodes = map { [ $_, 1 ] } qw/#START# 1 8 12 13 16 19 20 23 27/;
foreach my $idx ( qw/2 3 5 8 10 13 15/ ) {
splice( @expected_nodes, $idx, 0, [ "node_null", undef ] );
}
17 => 15,
18 => 14
};
-is_deeply( $graph->{transpositions}, $transposed_nodes, "Found the right transpositions" );
+is_deeply( $graph->{'identical_nodes'}, $transposed_nodes, "Found the right transpositions" );
# Test turning on a node
-my @off = $graph->toggle_node( 'node_24' );
-$expected_nodes[ 15 ] = [ "node_24", 1 ];
-splice( @expected_nodes, 15, 1, ( [ "node_26", 0 ], [ "node_24", 1 ] ) );
+my @off = $graph->toggle_node( '24' );
+$expected_nodes[ 15 ] = [ "24", 1 ];
+splice( @expected_nodes, 15, 1, ( [ "26", 0 ], [ "24", 1 ] ) );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned on node for new location' => \&compare_active;
$string = '# when ... ... showers sweet with ... fruit the ... of ... has pierced ... the root #';
is( make_text( @active_nodes ), $string, "Got the right text" );
# Test the toggling effects of same-column
-@off = $graph->toggle_node( 'node_26' );
-splice( @expected_nodes, 15, 2, ( [ "node_24", 0 ], [ "node_26", 1 ] ) );
+@off = $graph->toggle_node( '26' );
+splice( @expected_nodes, 15, 2, ( [ "24", 0 ], [ "26", 1 ] ) );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned on other node in that location' => \&compare_active;
$string = '# when ... ... showers sweet with ... fruit the ... of ... has pierced ... the rood #';
# Test the toggling effects of transposition
-@off = $graph->toggle_node( 'node_14' );
+@off = $graph->toggle_node( '14' );
# Add the turned on node
-splice( @expected_nodes, 8, 1, ( [ "node_15", 0 ], [ "node_14", 1 ] ) );
+splice( @expected_nodes, 8, 1, ( [ "15", 0 ], [ "14", 1 ] ) );
# Add the off transposition node
-splice( @expected_nodes, 11, 1, [ "node_18", undef ] );
+splice( @expected_nodes, 11, 1, [ "18", undef ] );
# Remove the explicit turning off of the earlier node
splice( @expected_nodes, 16, 1 );
@active_nodes = $graph->active_nodes( @off );
$string = '# when ... ... showers sweet with ... fruit the drought of ... has pierced ... the rood #';
is( make_text( @active_nodes ), $string, "Got the right text" );
-@off = $graph->toggle_node( 'node_18' );
-splice( @expected_nodes, 8, 2, [ "node_14", undef ] );
-splice( @expected_nodes, 10, 1, ( [ "node_17", 0 ], [ "node_18", 1 ] ) );
+@off = $graph->toggle_node( '18' );
+splice( @expected_nodes, 8, 2, [ "14", undef ] );
+splice( @expected_nodes, 10, 1, ( [ "17", 0 ], [ "18", 1 ] ) );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned on that node\'s partner' => \&compare_active;
$string = '# when ... ... showers sweet with ... fruit the ... of drought has pierced ... the rood #';
is( make_text( @active_nodes ), $string, "Got the right text" );
-@off = $graph->toggle_node( 'node_14' );
-splice( @expected_nodes, 8, 1, [ "node_15", 0 ], [ "node_14", 1 ] );
-splice( @expected_nodes, 11, 2, ( [ "node_18", undef ] ) );
+@off = $graph->toggle_node( '14' );
+splice( @expected_nodes, 8, 1, [ "15", 0 ], [ "14", 1 ] );
+splice( @expected_nodes, 11, 2, ( [ "18", undef ] ) );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned on the original node' => \&compare_active;
$string = '# when ... ... showers sweet with ... fruit the drought of ... has pierced ... the rood #';
is( make_text( @active_nodes ), $string, "Got the right text" );
-@off = $graph->toggle_node( 'node_3' );
-splice( @expected_nodes, 3, 1, [ "node_3", 1 ] );
+@off = $graph->toggle_node( '3' );
+splice( @expected_nodes, 3, 1, [ "3", 1 ] );
splice( @expected_nodes, 8, 1 );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned on a singleton node' => \&compare_active;
$string = '# when ... with his showers sweet with ... fruit the drought of ... has pierced ... the rood #';
is( make_text( @active_nodes ), $string, "Got the right text" );
-@off = $graph->toggle_node( 'node_3' );
-splice( @expected_nodes, 3, 1, [ "node_3", 0 ] );
+@off = $graph->toggle_node( '3' );
+splice( @expected_nodes, 3, 1, [ "3", 0 ] );
@active_nodes = $graph->active_nodes( @off );
subtest 'Turned off a singleton node' => \&compare_active;
$string = '# when ... showers sweet with ... fruit the drought of ... has pierced ... the rood #';
projects / scpubgit/stemmatology.git / commitdiff