use Graph::Easy;
use IPC::Run qw( run binary );
use Text::Tradition::Collation::Reading;
+use Text::Tradition::Collation::Path;
use Moose;
has 'graph' => (
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';
$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 {
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
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 );
my $in = $self->graphviz;
run( \@cmd, \$in, ">", binary(), \$svg );
$self->{'svg'} = $svg;
- $self->expand_graph_edges();
+ $self->expand_graph_paths();
return $svg;
}
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 ) {
$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 );
}
}
}
$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, $_ );
}
--- /dev/null
+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;
+
use Moose;
use Moose::Util::TypeConstraints;
use MooseX::NonMoose;
+use Text::Tradition::Collation::Relationship;
extends 'Graph::Easy::Node';
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;
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,
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;
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;
=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 = {};
# 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.
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"} );
}
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";
+ }
}
}
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
+<graphml xmlns="http://graphml.graphdrawing.org/xmlns" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
<key attr.name="number" attr.type="int" for="node" id="d1"/>
<key attr.name="token" attr.type="string" for="node" id="d0"/>
<key attr.name="identical" attr.type="string" for="node" id="d2"/>
<key attr.name="A" attr.type="string" for="edge" id="w0"/>
<key attr.name="B" attr.type="string" for="edge" id="w1"/>
<key attr.name="C" attr.type="string" for="edge" id="w2"/>
- <graph edgedefault="directed" id="g0" parse.edgeids="free"
- parse.edges="30" parse.nodeids="free" parse.nodes="24"
- parse.order="nodesfirst">
+ <graph edgedefault="directed" id="g0" parse.edgeids="canonical" parse.edges="32" parse.nodeids="canonical" parse.nodes="26" parse.order="nodesfirst">
<node id="n0">
<data key="d0">#</data>
<data key="d1">n0</data>
<data key="d0">with</data>
<data key="d1">n7</data>
</node>
+ <node id="n8">
+ <data key="d0">teh</data>
+ <data key="d1">n8</data>
+ </node>
+ <node id="n9">
+ <data key="d0">teh</data>
+ <data key="d1">n9</data>
+ </node>
<node id="n11">
<data key="d0">april</data>
<data key="d1">n11</data>
</edge>
<edge id="e5" source="n5" target="n6">
<data key="w0">A</data>
- <data key="w2">C</data>
<data key="w1">B</data>
+ <data key="w2">C</data>
</edge>
<edge id="e6" source="n6" target="n7">
<data key="w0">A</data>
- <data key="w2">C</data>
<data key="w1">B</data>
+ <data key="w2">C</data>
</edge>
<edge id="e7" source="n1" target="n5">
<data key="w2">C</data>
<data key="w1">B</data>
</edge>
+ <edge id="e8" source="n12" target="n8">
+ <data key="w2">C</data>
+ </edge>
+ <edge id="e9" source="n8" target="n14">
+ <data key="w2">C</data>
+ </edge>
<edge id="e10" source="n7" target="n11">
<data key="w2">C</data>
<data key="w1">B</data>
</edge>
<edge id="e13" source="n12" target="n13">
<data key="w0">A</data>
- <data key="w2">C</data>
<data key="w1">B</data>
</edge>
<edge id="e14" source="n13" target="n14">
<data key="w0">A</data>
- <data key="w2">C</data>
</edge>
<edge id="e15" source="n13" target="n15">
<data key="w1">B</data>
<edge id="e26" source="n22" target="n23">
<data key="w1">B</data>
</edge>
- <edge id="e27" source="n20" target="n23">
+ <edge id="e27" source="n20" target="n9">
<data key="w2">C</data>
</edge>
- <edge id="e28" source="n23" target="n25">
+ <edge id="e28" source="n9" target="n25">
<data key="w2">C</data>
</edge>
<edge id="e29" source="n23" target="n26">
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 {
# 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" );
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
# 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' );
$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' );
$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' );
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' );
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' );
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();