From: Tara L Andrews Date: Tue, 19 Apr 2011 11:35:36 +0000 (+0200) Subject: Move some active node logic into the positions library X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=58a3c42480b704aeef167e13b6119e402059a720;p=scpubgit%2Fstemmatology.git Move some active node logic into the positions library --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/lib/Traditions/Graph.pm b/lib/Traditions/Graph.pm index 6f0e0ba..558de2f 100644 --- a/lib/Traditions/Graph.pm +++ b/lib/Traditions/Graph.pm @@ -272,17 +272,14 @@ sub as_svg { 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. + # which ones are common nodes. This should only be run once. - return if exists $self->{'lemma'}; + return if( $self->{'lemmatizer_initialized'} ); + my @active_names = map { $_->name } grep { $self->is_common( $_ ) } + $self->nodes(); + $self->{'positions'}->init_lemmatizer( @active_names ); + $self->{'lemmatizer_initialized'} = 1; - 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 { @@ -314,42 +311,34 @@ sub active_nodes { # have to see if a node has been turned off. my @answer; foreach my $pos ( $self->{'positions'}->all() ) { - my @nodes = $self->{'positions'}->nodes_at_position( $pos ); + # Find the state of this position. If there is an active node, + # its name will be the state; otherwise the state will be 0 + # (nothing at this position) or undef (ellipsis at this position) + my $active = $self->{'positions'}->state( $pos ); - # See if there is an active node for this position. - 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 = $active_nodes[0] ; - } - # Is there a formerly active node that was toggled off? if( exists( $positions_off->{$pos} ) ) { my $off_node = $positions_off->{$pos}; - if( $active ) { + if( $active && $active ne $off_node) { push( @answer, [ $off_node, 0 ], [ $active, 1 ] ); - } elsif ( scalar @nodes == 1 ) { - # This was the only node at its position. No ellipsis. - push( @answer, [ $off_node, 0 ] ); } else { - # More than one node at this position, none now active. - # Restore the ellipsis. - push( @answer, [ $off_node, undef ] ); + push( @answer, [ $off_node, $active ] ); } + # No formerly active node, so we just see if there is a currently # active one. } elsif( $active ) { # Push the active node, whatever it is. push( @answer, [ $active, 1 ] ); } else { - # There is no change here; we need an ellipsis. Use - # the first node in the list, arbitrarily. - push( @answer, [ $nodes[0] , undef ] ); + # Push the state that is there. Arbitrarily use the first node + # at that position. + my @pos_nodes = $self->{'positions'}->nodes_at_position( $pos ); + push( @answer, + [ $pos_nodes[0], $self->{'positions'}->state( $pos ) ] ); } } - + return @answer; } @@ -383,25 +372,47 @@ sub toggle_node { # Do nothing, it's a common node. return; } - + + my $pos = $self->{'positions'}->node_position( $node ); + my $old_state = $self->{'positions'}->state( $pos ); my @nodes_off; - # If we are about to turn on a node... - if( !$self->{'lemma'}->{ $node } ) { + if( $old_state && $old_state eq $node ) { + # Turn off the node. We turn on no others by default. + push( @nodes_off, $node ); + } else { # Turn on the node. - $self->{'lemma'}->{ $node } = 1; - # Turn off any other 'on' nodes in the same position. + $self->{'positions'}->set_state( $pos, $node ); + # Any other 'on' nodes in the same position should be off. push( @nodes_off, $self->colocated_nodes( $node ) ); - # Turn off any node that is an identical transposed one. + # Any node that is an identical transposed one should be off. push( @nodes_off, $self->identical_nodes( $node ) ) if $self->identical_nodes( $node ); - } else { - push( @nodes_off, $node ); } @nodes_off = unique_list( @nodes_off ); # Turn off the nodes that need to be turned off. - map { $self->{'lemma'}->{$_} = 0 } @nodes_off; - return @nodes_off; + my @nodes_turned_off; + foreach my $n ( @nodes_off ) { + my $npos = $self->{'positions'}->node_position( $n ); + my $state = $self->{'positions'}->state( $npos ); + if( $state && $state eq $n ) { + # this node is still on + push( @nodes_turned_off, $n ); + my $new_state = undef; + if( $n eq $node ) { + # This is the node that was clicked, so if there are no + # other nodes there, turn off the position. In all other + # cases, restore the ellipsis. + my @all_n = $self->{'positions'}->nodes_at_position( $pos ); + $new_state = 0 if scalar( @all_n ) == 1; + } + $self->{'positions'}->set_state( $npos, $new_state ); + } elsif( $old_state && $old_state eq $n ) { + # another node has already been turned on here + push( @nodes_turned_off, $n ); + } # else some other node was on anyway, so pass. + } + return @nodes_turned_off; } sub colocated_nodes { diff --git a/lib/Traditions/Graph/Position.pm b/lib/Traditions/Graph/Position.pm index 8011e39..2679ebe 100644 --- a/lib/Traditions/Graph/Position.pm +++ b/lib/Traditions/Graph/Position.pm @@ -78,10 +78,21 @@ sub new { } } } + # Now we have a hash of node positions keyed on node. $self->{'node_positions'} = $node_pos; + # We should also save our witness paths, as long as we have them. + # Right now each path is a list of nodes; we may want to make it + # a list of position refs. $self->{'witness_paths'} = $witness_paths; + # We are also going to want to keep track of whether a position has + # been explicitly emptied, for our lemmatization. + my $position_state = {}; + map { $position_state->{ $_ } = undef } values %$node_pos; + $self->{'position_state'} = $position_state; + + bless( $self, $proto ); return $self; } @@ -119,12 +130,33 @@ sub colocated_nodes { return @cn; } +# Returns an ordered list of positions in this graph sub all { my( $self ) = @_; my $pos = $self->calc_positions; return sort by_position keys( %$pos ); } +# Returns undef if no decision has been taken on this position, the +# node name if there is a lemma for it, and 0 if there is no lemma for +# it. +sub state { + my( $self, $pos ) = @_; + return $self->{'position_state'}->{ $pos }; +} + +sub set_state { + my( $self, $pos, $state ) = @_; + $self->{'position_state'}->{ $pos } = $state; +} + +sub init_lemmatizer { + my( $self, @nodes ) = @_; + foreach my $n ( @nodes ) { + $self->set_state( $self->node_position( $n ), $n ); + } +} + sub witness_path { my( $self, $wit ) = @_; return @{$self->{'witness_paths'}->{ $wit }}; diff --git a/t/graph.t b/t/graph.t index 21418c4..a60353d 100644 --- a/t/graph.t +++ b/t/graph.t @@ -88,7 +88,6 @@ is_deeply( $graph->{'identical_nodes'}, $transposed_nodes, "Found the right tran # Test turning on a node 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 #'; @@ -96,7 +95,7 @@ is( make_text( @active_nodes ), $string, "Got the right text" ); # Test the toggling effects of same-column @off = $graph->toggle_node( '26' ); -splice( @expected_nodes, 15, 2, ( [ "24", 0 ], [ "26", 1 ] ) ); +splice( @expected_nodes, 15, 1, ( [ "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 #'; @@ -106,45 +105,65 @@ is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $graph->toggle_node( '14' ); # Add the turned on node -splice( @expected_nodes, 8, 1, ( [ "15", 0 ], [ "14", 1 ] ) ); -# Add the off transposition node -splice( @expected_nodes, 11, 1, [ "18", undef ] ); -# Remove the explicit turning off of the earlier node -splice( @expected_nodes, 16, 1 ); +$expected_nodes[ 8 ] = [ "14", 1 ]; +# Remove the 'off' for the previous node +splice( @expected_nodes, 15, 1 ); @active_nodes = $graph->active_nodes( @off ); subtest 'Turned on transposition 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( '18' ); -splice( @expected_nodes, 8, 2, [ "14", undef ] ); -splice( @expected_nodes, 10, 1, ( [ "17", 0 ], [ "18", 1 ] ) ); +# Toggle on the new node +$expected_nodes[ 10 ] = [ "18", 1 ]; +# Toggle off the transposed node +$expected_nodes[ 8 ] = [ "14", undef ]; @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( '14' ); -splice( @expected_nodes, 8, 1, [ "15", 0 ], [ "14", 1 ] ); -splice( @expected_nodes, 11, 2, ( [ "18", undef ] ) ); +# Toggle on the new node +$expected_nodes[ 8 ] = [ "14", 1 ]; +# Toggle off the transposed node +$expected_nodes[ 10 ] = [ "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( '15' ); +# Toggle on the new node, and off with the old +splice( @expected_nodes, 8, 1, [ "14", 0 ], [ "15", 1 ] ); +@active_nodes = $graph->active_nodes( @off ); +subtest 'Turned on the colocated node' => \&compare_active; +$string = '# when ... ... showers sweet with ... fruit the march of ... has pierced ... the rood #'; +is( make_text( @active_nodes ), $string, "Got the right text" ); + @off = $graph->toggle_node( '3' ); +# Toggle on the new node splice( @expected_nodes, 3, 1, [ "3", 1 ] ); +# Remove the old toggle-off 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 #'; +$string = '# when ... with his showers sweet with ... fruit the march of ... has pierced ... the rood #'; is( make_text( @active_nodes ), $string, "Got the right text" ); @off = $graph->toggle_node( '3' ); +# Toggle off this node 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 #'; +$string = '# when ... showers sweet with ... fruit the march of ... has pierced ... the rood #'; +is( make_text( @active_nodes ), $string, "Got the right text" ); + +@off = $graph->toggle_node( '21' ); +splice( @expected_nodes, 13, 1, [ "21", 1 ] ); +@active_nodes = $graph->active_nodes( @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 rood #'; is( make_text( @active_nodes ), $string, "Got the right text" ); done_testing();