From: tla Date: Sat, 28 May 2011 09:07:37 +0000 (+0200) Subject: first crack at implementing relationships X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3265b0ce233468b116be19a3bfcc80a0fa3e3af9;p=scpubgit%2Fstemmatology.git first crack at implementing relationships --- diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 21b3c96..8489ddf 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -3,6 +3,7 @@ package Text::Tradition::Collation; use Graph::Easy; use IPC::Run qw( run binary ); use Text::Tradition::Collation::Reading; +use Text::Tradition::Collation::Path; use Moose; has 'graph' => ( @@ -98,6 +99,7 @@ has 'linear' => ( sub BUILD { my( $self, $args ) = @_; $self->graph->use_class('node', 'Text::Tradition::Collation::Reading'); + $self->graph->use_class('edge', 'Text::Tradition::Collation::Path'); # Pass through any graph-specific options. my $shape = exists( $args->{'shape'} ) ? $args->{'shape'} : 'ellipse'; @@ -130,6 +132,15 @@ around add_path => sub { $self->$orig( @_ ); }; +# Wrapper around paths +around paths => sub { + my $orig = shift; + my $self = shift; + + my @result = grep { $_->class eq 'path' } $self->$orig( @_ ); + return @result; +}; + # Wrapper around merge_nodes sub merge_readings { @@ -149,6 +160,42 @@ sub has_path { return scalar @paths; } +## Dealing with relationships between readings. This is a different +## sort of graph edge. + +sub add_relationship { + my( $self, $type, $source, $target, $global ) = @_; + my $rel = Text::Tradition::Collation::Relationship->new( + 'sort' => $type, + 'global' => $global, + 'orig_relation' => [ $source, $target ], + ); + print STDERR sprintf( "Setting relationship %s between readings %s (%s)" + . " and %s (%s)\n", $type, + $source->label, $source->name, + $target->label, $target->name ); + $self->graph->add_edge( $source, $target, $rel ); + if( $global ) { + # Look for all readings with the source label, and if there are + # colocated readings with the target label, join them too. + foreach my $r ( $self->readings() ) { + next unless $r->label eq $source->label; + my @colocated = grep { $_->label eq $target->label } + $self->same_position_as( $r ); + if( @colocated ) { + warn "Multiple readings with same label at same position!" + if @colocated > 1; + my $dup_rel = Text::Tradition::Collation::Relationship->new( + 'sort' => $type, + 'global' => $global, + 'orig_relation' => [ $source, $target ], + ); + $self->graph->add_edge( $r, $colocated[0], $dup_rel ); + } + } + } +} + =head2 Output method(s) =over @@ -168,7 +215,7 @@ sub as_svg { my( $self, $recalc ) = @_; return $self->svg if $self->has_svg; - $self->collapse_graph_edges(); + $self->collapse_graph_paths(); $self->_save_graphviz( $self->graph->as_graphviz() ) unless( $self->has_graphviz && !$recalc ); @@ -177,7 +224,7 @@ sub as_svg { my $in = $self->graphviz; run( \@cmd, \$in, ">", binary(), \$svg ); $self->{'svg'} = $svg; - $self->expand_graph_edges(); + $self->expand_graph_paths(); return $svg; } @@ -286,24 +333,24 @@ sub as_graphml { return $graphml; } -sub collapse_graph_edges { +sub collapse_graph_paths { my $self = shift; - # Our collation graph has an edge per witness. This is great for + # 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 edge between any two nodes. + # display only one path between any two nodes. return if $self->collapsed; - print STDERR "Collapsing path edges in graph...\n"; + 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; foreach my $node( $self->readings ) { my $newlabels = {}; # We will visit each node, so we only look ahead. - foreach my $edge ( $node->outgoing() ) { - add_hash_entry( $newlabels, $edge->to->name, $edge->name ); - $self->del_path( $edge ); + foreach my $path ( $node->outgoing() ) { + add_hash_entry( $newlabels, $path->to->name, $path->name ); + $self->del_path( $path ); } foreach my $newdest ( keys %$newlabels ) { @@ -324,12 +371,10 @@ sub collapse_graph_edges { $label = join( ', ', 'majority', @aclabels ); } - my $newedge = + my $newpath = $self->add_path( $node, $self->reading( $newdest ), $label ); if( @compressed_wits ) { - ## TODO fix this hack too. - $newedge->set_attribute( 'class', - join( '|', @compressed_wits ) ); + $newpath->hidden_witnesses( \@compressed_wits ); } } } @@ -337,24 +382,24 @@ sub collapse_graph_edges { $self->collapsed( 1 ); } -sub expand_graph_edges { +sub expand_graph_paths { my $self = shift; - # Our collation graph has only one edge between any two nodes. + # 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 edge between any + # Expand this so that each witness has its own path between any # two reading nodes. return unless $self->collapsed; - print STDERR "Expanding path edges in graph...\n"; - - foreach my $edge( $self->paths ) { - my $from = $edge->from; - my $to = $edge->to; - my @wits = split( /, /, $edge->label ); - if( grep { $_ eq 'majority' } @wits ) { - push( @wits, split( /\|/, $edge->get_attribute( 'class' ) ) ); + print STDERR "Expanding witness paths in graph...\n"; + $DB::single = 1; + foreach my $path( $self->paths ) { + my $from = $path->from; + my $to = $path->to; + my @wits = split( /, /, $path->label ); + if( $path->has_hidden_witnesses ) { + push( @wits, @{$path->hidden_witnesses} ); } - $self->del_path( $edge ); + $self->del_path( $path ); foreach ( @wits ) { $self->add_path( $from, $to, $_ ); } diff --git a/lib/Text/Tradition/Collation/Path.pm b/lib/Text/Tradition/Collation/Path.pm new file mode 100644 index 0000000..eea0169 --- /dev/null +++ b/lib/Text/Tradition/Collation/Path.pm @@ -0,0 +1,26 @@ +package Text::Tradition::Collation::Path; + +use Moose; +use MooseX::NonMoose; + +## CAREFUL if we want to use Moose::Util::TypeConstraints. That +## 'from' clashes with Graph::Easy::Edge 'from', so we'll need to +## unimport TypeConstraints after defining the types. Or else we +## would have to finally split out our types into another module. + +extends 'Graph::Easy::Edge'; + +has 'hidden_witnesses' => ( + is => 'rw', + isa => 'ArrayRef[Str]', + predicate => 'has_hidden_witnesses' +); + +sub BUILD { + my $self = shift; + $self->set_attribute( 'class', 'path' ); +} + +no Moose; +__PACKAGE__->meta->make_immutable; + diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm index 59c60ca..8402751 100644 --- a/lib/Text/Tradition/Collation/Reading.pm +++ b/lib/Text/Tradition/Collation/Reading.pm @@ -3,6 +3,7 @@ package Text::Tradition::Collation::Reading; use Moose; use Moose::Util::TypeConstraints; use MooseX::NonMoose; +use Text::Tradition::Collation::Relationship; extends 'Graph::Easy::Node'; @@ -25,14 +26,6 @@ has 'same_as' => ( isa => 'ArrayRef[Text::Tradition::Collation::Reading]', ); -# # This is a hash mapping of 'relationship => reading'. -# # TODO we should validate the relationships sometime. -has 'relationships' => ( - is => 'ro', - isa => 'HashRef[Text::Tradition::Collation::Reading]', - default => sub { {} }, - ); - # Deal with the non-arg option for Graph::Easy's constructor. around BUILDARGS => sub { my $orig = shift; @@ -68,23 +61,12 @@ sub merge_from { my $new_pool = _merge_array_pool( \@now_identical, $self->same_as ) if @now_identical; - # Adopt the relationship attributes of the other node. - my $now_rel = $merged_node->relationships; - foreach my $key ( %$now_rel ) { - if( $self->has_relationship( $key ) ) { - my $related = $self->get_relationship( $key ); - if( $now_rel->{$key} ne $related ) { - warn( sprintf( "Merged reading %s has relationship %s to reading %s instead of %s; skipping", - $merged_node->name, $key, - $now_rel->{$key}, - $related) ); - } # else no action needed - } else { - $self->set_relationship( $key, $now_rel->{$key} ); - } - } + # TODO Adopt the relationship attributes of the other node. } +## Dealing with transposed readings. These methods are only really +## applicable if we have a linear collation graph. + sub set_identical { my( $self, $other_node ) = @_; my $enlarged_pool = _merge_array_pool( $self->same_as, @@ -127,26 +109,7 @@ sub primary { return $self->same_as->[0]; } -# Much easier to do this with a hash than with an array of Relationship objects, -# which would be the proper OO method. - -sub has_relationship { - my( $self, $rel ) = @_; - return exists( $self->relationships->{ $rel } ); -} - -sub get_relationship { - my( $self, $rel ) = @_; - if( $self->has_relationship( $rel ) ) { - return $self->relationships->{ $rel }; - } - return undef; -} - -sub set_relationship { - my( $self, $rel, $value ) = @_; - $self->relationships->{ $rel } = $value; -} +## Keep track of which readings are unchanged across witnesses. sub is_common { my( $self ) = shift; diff --git a/lib/Text/Tradition/Collation/Relationship.pm b/lib/Text/Tradition/Collation/Relationship.pm index 85f872d..03f9b14 100644 --- a/lib/Text/Tradition/Collation/Relationship.pm +++ b/lib/Text/Tradition/Collation/Relationship.pm @@ -2,26 +2,81 @@ package Text::Tradition::Collation::Relationship; use Moose; use Moose::Util::TypeConstraints; +## CAREFUL in our use of Moose::Util::TypeConstraints. That 'from' +## clashes with Graph::Easy::Edge 'from', so we'll need to unimport +## TypeConstraints after defining the types. Or else we would have to +## finally split out our types into another module. +use MooseX::NonMoose; -enum 'RelationshipType' => qw( spelling orthographic grammatical ); +extends 'Graph::Easy::Edge'; +enum 'RelationshipType' => qw( spelling orthographic grammatical repetition ); + +subtype 'RelationshipVector', + => as 'ArrayRef', + => where { @$_ == 2 + && $_->[0]->isa( 'Text::Tradition::Collation::Reading' ) + && $_->[1]->isa( 'Text::Tradition::Collation::Reading' ) + }, + message { 'Argument should be [ SourceReading, TargetReading ]' }; + +subtype 'RelationshipTokenVector', + => as 'ArrayRef', + => where { @$_ == 2 }, + message { 'Argument should be [ \'source\', \'target\' ]' }; + +no Moose::Util::TypeConstraints; ## see comment above + has 'sort' => ( is => 'rw', isa => 'RelationshipType', required => 1, ); -has 'reading' => ( +has 'orig_relation' => ( is => 'rw', - isa => 'Text::Tradition::Collation::Reading', + isa => 'RelationshipVector', required => 1, ); +has 'related_readings' => ( + is => 'rw', + isa => 'RelationshipTokenVector', +); + has 'global' => ( is => 'rw', isa => 'Bool', - default => 1, + default => 0, ); - no Moose; - __PACKAGE__->meta->make_immutable; +sub FOREIGNBUILDARGS { + my $class = shift; + my %args = @_; + + # Make the label match our 'sort' attribute. + my @superclass_args; + if( exists $args{'sort'} ) { + push( @superclass_args, 'label', $args{'sort'} ); + } + return @superclass_args; +} + +sub BUILD { + my( $self, $args ) = @_; + + $self->set_attribute( 'class', 'relationship' ); + + my( $source, $target ) = @{$self->orig_relation}; + if( $source->has_position && $target->has_position + && $source->position ne $target->position ) { + die "Cannot set relationship between readings in different positions"; + } + unless( $self->related_readings ) { + $self->related_readings( [ $self->orig_relation->[0]->label, + $self->orig_relation->[1]->label ] ); + } +} + +no Moose; +__PACKAGE__->meta->make_immutable; diff --git a/lib/Text/Tradition/Parser/BaseText.pm b/lib/Text/Tradition/Parser/BaseText.pm index 8ddd9a3..214e337 100644 --- a/lib/Text/Tradition/Parser/BaseText.pm +++ b/lib/Text/Tradition/Parser/BaseText.pm @@ -76,7 +76,7 @@ underscore in its name. =cut -my $SHORTEND; # Debug var - set this to limit the number of lines parsed +my $SHORTEND = 20; # Debug var - set this to limit the number of lines parsed my %base_text_index; my $edits_required = {}; @@ -215,7 +215,7 @@ sub merge_base { # TODO Here would be a very good place to set up relationships # between the nodes and the lemma. - set_relationships( $app, \@lemma_set, $variant_objects ); + set_relationships( $collation, $app, \@lemma_set, $variant_objects ); # Now create the splice-edit objects that will be used # to reconstruct each witness. @@ -250,7 +250,7 @@ sub merge_base { foreach my $w ( grep { $_ !~ /_post$/ } keys %$edits_required ) { print STDERR "Creating witness $w\n"; my $witness_obj = $collation->tradition->add_witness( sigil => $w ); - my $debug = $w eq 'Vb10'; + my $debug = undef; # $w eq 'Vb10'; my @ante_corr_seq = apply_edits( $collation, $edits_required->{$w}, $debug ); my @post_corr_seq = apply_edits( $collation, $edits_required->{$w."_post"}, $debug ) if exists( $edits_required->{$w."_post"} ); @@ -475,17 +475,58 @@ sub _collation_hash { } sub set_relationships { - my( $app, $lemma, $variants ) = @_; + my( $collation, $app, $lemma, $variants ) = @_; foreach my $rkey ( keys %$variants ) { my $var = $variants->{$rkey}->{'reading'}; my $typekey = sprintf( "_%s_type", $rkey ); my $type = $app->{$typekey}; - # Transposition: look for nodes with the same label but different IDs - # and mark them as transposed-identical. - - # Lexical / Grammatical / Spelling: look for non-identical nodes. - # Need to work out how to handle many-to-many mapping. + if( $type =~ /^(inv|tr)$/i ) { + # Transposition: look for nodes with the same label but + # different IDs and mark them as transposed-identical. + my %labels; + foreach my $r ( @$lemma ) { + $labels{$r->label} = $r; + } + foreach my $r( @$var ) { + if( exists $labels{$r->label} && + $r->name ne $labels{$r->label}->name ) { + $r->set_identical( $labels{$r->label} ); + } + } + } elsif( $type =~ /^(gr|sp(el)?|rep)$/i ) { + # Grammar/spelling: this can be a one-to-one or one-to-many + # mapping. We should think about merging readings if it is + # one-to-many. + $type = 'grammatical' if $type =~ /gr/i; + $type = 'spelling' if $type =~ /sp/i; + $type = 'repetition' if $type =~ /rep/i; + if( @$lemma == @$var ) { + foreach my $i ( 0 .. $#{$lemma} ) { + $collation->add_relationship( $type, $var->[$i], + $lemma->[$i] ); + } + } elsif ( @$lemma > @$var && @$var == 1 ) { + # Merge the lemma readings into one + my $ln1 = shift @$lemma; + foreach my $ln ( @$lemma ) { + $collation->merge_readings( $ln1, $ln, ' ' ); + } + $lemma = [ $ln1 ]; + $collation->add_relationship( $type, $var->[0], $lemma->[0] ); + } elsif ( @$lemma < @$var && @$lemma == 1 ) { + my $vn1 = shift @$var; + foreach my $vn ( @$var ) { + $collation->merge_readings( $vn1, $vn, ' ' ); + } + $var = [ $vn1 ]; + $collation->add_relationship( $type, $var->[0], $lemma->[0] ); + } else { + warn "Cannot set $type relationship on a many-to-many variant"; + } + } elsif( $type !~ /^(lex|add|om)$/i ) { + warn "Unrecognized type $type"; + } } } diff --git a/t/data/Collatex-16.xml b/t/data/Collatex-16.xml index d8c4350..7554174 100644 --- a/t/data/Collatex-16.xml +++ b/t/data/Collatex-16.xml @@ -1,16 +1,12 @@ - + - + # n0 @@ -43,6 +39,14 @@ with n7 + + teh + n8 + + + teh + n9 + april n11 @@ -129,18 +133,24 @@ A - C B + C A - C B + C C B + + C + + + C + C B @@ -154,12 +164,10 @@ A - C B A - C B @@ -202,10 +210,10 @@ B - + C - + C diff --git a/t/graph.t b/t/graph.t index 9209e8d..de42d50 100644 --- a/t/graph.t +++ b/t/graph.t @@ -25,21 +25,21 @@ is( $svg->documentElement->nodeName(), 'svg', 'Got an svg document' ); my $svg_xpc = XML::LibXML::XPathContext->new( $svg->documentElement() ); $svg_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' ); my @svg_nodes = $svg_xpc->findnodes( '//svg:g[@class="node"]' ); -is( scalar @svg_nodes, 24, "Correct number of nodes in the graph" ); +is( scalar @svg_nodes, 26, "Correct number of nodes in the graph" ); # Test for the correct number of edges my @svg_edges = $svg_xpc->findnodes( '//svg:g[@class="edge"]' ); -is( scalar @svg_edges, 30, "Correct number of edges in the graph" ); +is( scalar @svg_edges, 32, "Correct number of edges in the graph" ); # Test for the correct common nodes -my @expected_nodes = map { [ $_, 1 ] } qw/ #START# n1 n5 n6 n7 n12 n13 - n16 n19 n20 n23 n27 /; -foreach my $idx ( qw/2 3 4 8 11 13 16 18/ ) { +my @expected_nodes = map { [ $_, 1 ] } qw/ #START# n1 n5 n6 n7 n12 + n16 n19 n20 n27 /; +foreach my $idx ( qw/2 3 4 8 10 11 13 16 17 18/ ) { splice( @expected_nodes, $idx, 0, [ "node_null", undef ] ); } my @active_nodes = $collation->lemma_readings(); subtest 'Initial common points' => \&compare_active; -my $string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the ... #'; +my $string = '# when ... ... ... showers sweet with ... fruit ... ... of ... has pierced ... ... ... #'; is( make_text( @active_nodes ), $string, "Got the right starting text" ); sub compare_active { @@ -72,7 +72,7 @@ sub make_text { # Test the manuscript paths my $wit_a = '# when april with his showers sweet with fruit the drought of march has pierced unto the root #'; my $wit_b = '# when showers sweet with april fruit the march of drought has pierced to the root #'; -my $wit_c = '# when showers sweet with april fruit the drought of march has pierced the rood #'; +my $wit_c = '# when showers sweet with april fruit teh drought of march has pierced teh rood #'; is( join( ' ', @{$tradition->witness( "A" )->text} ), $wit_a, "Correct path for witness A" ); is( join( ' ', @{$tradition->witness( "B" )->text} ), $wit_b, "Correct path for witness B" ); is( join( ' ', @{$tradition->witness( "C" )->text} ), $wit_c, "Correct path for witness C" ); @@ -97,19 +97,19 @@ foreach my $r ( $collation->readings ) { is_deeply( $real_transposed_nodes, $transposed_nodes, "Found the right transpositions" ); # Test turning on a node -my @off = $collation->toggle_reading( 'n25' ); -$expected_nodes[ 18 ] = [ "n25", 1 ]; +my @off = $collation->toggle_reading( 'n21' ); +$expected_nodes[ 16 ] = [ "n21", 1 ]; @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on node for new location' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the rood #'; +$string = '# when ... ... ... showers sweet with ... fruit ... ... of ... has pierced unto ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); # Test the toggling effects of same-column -@off = $collation->toggle_reading( 'n26' ); -splice( @expected_nodes, 18, 1, ( [ "n25", 0 ], [ "n26", 1 ] ) ); +@off = $collation->toggle_reading( 'n22' ); +splice( @expected_nodes, 16, 1, ( [ "n21", 0 ], [ "n22", 1 ] ) ); @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on other node in that location' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the root #'; +$string = '# when ... ... ... showers sweet with ... fruit ... ... of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); # Test the toggling effects of transposition @@ -118,10 +118,10 @@ is( make_text( @active_nodes ), $string, "Got the right text" ); # Add the turned on node $expected_nodes[ 11 ] = [ "n14", 1 ]; # Remove the 'off' for the previous node -splice( @expected_nodes, 18, 1 ); +splice( @expected_nodes, 16, 1 ); @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on transposition node' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the drought of ... has pierced ... the root #'; +$string = '# when ... ... ... showers sweet with ... fruit ... drought of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n18' ); @@ -131,7 +131,7 @@ $expected_nodes[ 13 ] = [ "n18", 1 ]; $expected_nodes[ 11 ] = [ "n14", undef ]; @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on that node\'s partner' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the ... of drought has pierced ... the root #'; +$string = '# when ... ... ... showers sweet with ... fruit ... ... of drought has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n14' ); @@ -141,7 +141,7 @@ $expected_nodes[ 11 ] = [ "n14", 1 ]; $expected_nodes[ 13 ] = [ "n18", undef ]; @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on the original node' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the drought of ... has pierced ... the root #'; +$string = '# when ... ... ... showers sweet with ... fruit ... drought of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n15' ); @@ -149,7 +149,7 @@ is( make_text( @active_nodes ), $string, "Got the right text" ); splice( @expected_nodes, 11, 1, [ "n14", 0 ], [ "n15", 1 ] ); @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on the colocated node' => \&compare_active; -$string = '# when ... ... ... showers sweet with ... fruit the march of ... has pierced ... the root #'; +$string = '# when ... ... ... showers sweet with ... fruit ... march of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n3' ); @@ -159,7 +159,7 @@ splice( @expected_nodes, 3, 1, [ "n3", 1 ] ); splice( @expected_nodes, 11, 1 ); @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned on a singleton node' => \&compare_active; -$string = '# when ... with ... showers sweet with ... fruit the march of ... has pierced ... the root #'; +$string = '# when ... with ... showers sweet with ... fruit ... march of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n3' ); @@ -167,14 +167,14 @@ is( make_text( @active_nodes ), $string, "Got the right text" ); splice( @expected_nodes, 3, 1, [ "n3", 0 ] ); @active_nodes = $collation->lemma_readings( @off ); subtest 'Turned off a singleton node' => \&compare_active; -$string = '# when ... ... showers sweet with ... fruit the march of ... has pierced ... the root #'; +$string = '# when ... ... showers sweet with ... fruit ... march of ... has pierced to ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $collation->toggle_reading( 'n21' ); -splice( @expected_nodes, 16, 1, [ "n21", 1 ] ); +splice( @expected_nodes, 16, 1, ["n22", 0 ], [ "n21", 1 ] ); @active_nodes = $collation->lemma_readings( @off ); -subtest 'Turned on a new node after singleton switchoff' => \&compare_active; -$string = '# when ... ... showers sweet with ... fruit the march of ... has pierced unto the root #'; +subtest 'Turned on another node after singleton switchoff' => \&compare_active; +$string = '# when ... ... showers sweet with ... fruit ... march of ... has pierced unto ... ... #'; is( make_text( @active_nodes ), $string, "Got the right text" ); done_testing();