[scpubgit/stemmatology.git] / lib / Traditions / Graph.pm

package Traditions::Graph;

use strict;
use warnings;
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;
    my $class = ref( $proto ) || $proto;
    my %opts = ( 'on_color' => 'yellow',
		 'off_color' => 'white',
		 @_ );
    my $self = {};

    # opts can be: GraphML, base+CSV, base+CTE, TEI.  We need
    # something to parse.
    my @formats = grep { /^(GraphML|CSV|CTE|TEI)$/ } keys( %opts );
    my $format = shift( @formats );
    unless( $format ) {
	warn "No data given to create a graph: need GraphML, CSV, or TEI";
	return;
    }
    if( $format =~ /^(CSV|CTE)$/ && !exists $opts{'base'} ) {
	warn "Cannot make a graph from $format without a base text";
	return;
    }

    # Make a graph object.
    my $collation_graph = Graph::Easy->new();
    $collation_graph->set_attribute( 'node', 'shape', 'ellipse' );
    # Starting point for all texts
    my $last_node = $collation_graph->add_node( '#START#' );

    $self->{'graph'} = $collation_graph;
    bless( $self, $class );

    # Now do the parsing.
    my $mod = "Traditions::Parser::$format";
    load( $mod );
    my @args = ( $opts{ $format } );
    if( $format =~ /^(CSV|CTE)$/ ) {
	push( @args, $opts{'base'} );
    }
    $mod->can('parse')->( $self, @args );

    return $self;
}


### Graph::Easy object accessor methods
sub node {
    my $self = shift;
    return $self->{'graph'}->node( @_ );
}

sub edge {
    my $self = shift;
    return $self->{'graph'}->edge( @_ );
}

sub add_node {
    my $self = shift;
    return $self->{'graph'}->add_node( @_ );
}

sub add_edge {
    my $self = shift;
    return $self->{'graph'}->add_edge( @_ );
}

sub del_node {
    my $self = shift;
    return $self->{'graph'}->del_node( @_ );
}

sub del_edge {
    my $self = shift;
    return $self->{'graph'}->del_edge( @_ );
}

sub nodes {
    my $self = shift;
    return $self->{'graph'}->nodes( @_ );
}

sub edges {
    my $self = shift;
    return $self->{'graph'}->edges( @_ );
}

sub merge_nodes {
    my $self = shift;
    return $self->{'graph'}->merge_nodes( @_ );
}

### Helper methods for navigating the tree

sub start {
    # Return the beginning node of the graph.
    my $self = shift;
    my( $new_start ) = @_;
    if( $new_start ) {
	$self->{'graph'}->rename_node( $new_start, '#START#' );
    }
    return $self->{'graph'}->node('#START#');
}

sub set_identical_nodes {
    my( $self, $node_hash ) = @_;
    $self->{'identical_nodes'} = $node_hash;
}

sub next_word {
    # Return the successor via the corresponding edge.
    my( $self, $node, $edge ) = @_;
    $edge = "base text" unless $edge;
    my @next_edges = $node->outgoing();
    return undef unless scalar( @next_edges );
    
    foreach my $e ( @next_edges ) {
	next unless $e->label() eq $edge;
	return $e->to();
    }

    warn "Could not find node connected to edge $edge";
    return undef;
}

sub prior_word {
    # Return the predecessor via the corresponding edge.
    my( $self, $node, $edge ) = @_;
    $edge = "base text" unless $edge;
    my @prior_edges = $node->incoming();
    return undef unless scalar( @prior_edges );
    
    foreach my $e ( @prior_edges ) {
	next unless $e->label() eq $edge;
	return $e->from();
    }

    warn "Could not find node connected from edge $edge";
    return undef;
}

sub node_sequence {
    my( $self, $start, $end, $label ) = @_;
    # TODO make label able to follow a single MS
    unless( ref( $start ) eq 'Graph::Easy::Node'
	&& ref( $end ) eq 'Graph::Easy::Node' ) {
	warn "Called node_sequence without two nodes!";
	return ();
    }
    $label = 'base text' unless $label;
    my @nodes = ( $start );
    my %seen;
    my $n = $start;
    while( $n ne $end ) {
	if( exists( $seen{$n->name()} ) ) {
	    warn "Detected loop at " . $n->name();
	    last;
	}
	$seen{$n->name()} = 1;

	my @edges = $n->outgoing();
	my @relevant_edges = grep { $_->label =~ /^$label$/ } @edges;
	warn "Did not find an edge $label from node " . $n->label
	    unless scalar @relevant_edges;
	warn "Found more than one edge $label from node " . $n->label
	    unless scalar @relevant_edges == 1;
	my $next = $relevant_edges[0]->to();
	push( @nodes, $next );
	$n = $next;
    }
    # Check that the last node is our end node.
    my $last = $nodes[$#nodes];
    warn "Last node found from " . $start->label() . 
	" via path $label is not the end!"
	unless $last eq $end;

    return @nodes;
}

sub string_lemma {
    my( $self, $start, $end, $label ) = @_;

    my @nodes = $self->node_sequence( $start, $end, $label );
    my @words = map { $_->label() } @nodes;
    return join( ' ', @words );
}

## Output.  We use GraphViz for the layout because it handles large
## graphs better than Graph::Easy does natively.

sub as_svg {
    my( $self, $recalc ) = @_;
    return $self->{'svg'} if( exists $self->{'svg'} && !$recalc );
    
    $self->{'graphviz'} = $self->{'graph'}->as_graphviz()
	unless( exists $self->{'graphviz'} && !$recalc );
    
    my @cmd = qw/dot -Tsvg/;
    my( $svg, $err );
    my $in = $self->{'graphviz'};
    run( \@cmd, \$in, ">", binary(), \$svg );
    $self->{'svg'} = $svg;
    return $svg;
}

## Methods for lemmatizing a text.

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 run once.

    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;

}

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 ) = @_;

    # 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->{ $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->{'positions'}->all() ) {
	# 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 );
	
	# Is there a formerly active node that was toggled off?
	if( exists( $positions_off->{$pos} ) ) {
	    my $off_node = $positions_off->{$pos};
	    if( $active && $active ne $off_node) {
		push( @answer, [ $off_node, 0 ], [ $active, 1 ] );
	    } else {
		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 {
	    # 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;
}

# A couple of helpers. TODO These should be gathered in the same place
# eventually

sub is_common {
    my( $self, $node ) = @_;
    $node = $self->_nodeobj( $node );
    return $node->get_attribute('class') eq 'common';
}

sub _nodeobj {
    my( $self, $node ) = @_;
    unless( ref $node eq 'Graph::Easy::Node' ) {
	$node = $self->node( $node );
    }
    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.

sub toggle_node {
    my( $self, $node ) = @_;
    
    # In case this is being called for the first time.
    $self->init_lemmatizer();

    if( $self->is_common( $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( $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->{'positions'}->set_state( $pos, $node );
	# Any other 'on' nodes in the same position should be off.
	push( @nodes_off, $self->colocated_nodes( $node ) );
	# Any node that is an identical transposed one should be off.
	push( @nodes_off, $self->identical_nodes( $node ) )
	    if $self->identical_nodes( $node );
    }
    @nodes_off = unique_list( @nodes_off );

    # Turn off the nodes that need to be turned 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 {
    my $self = shift;
    return $self->{'positions'}->colocated_nodes( @_ );
}

sub identical_nodes {
    my( $self, $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 ) = @_;
    
    my @nodes = $self->{'positions'}->witness_path( $wit );
    my @words = map { $self->node( $_ )->label() } @nodes;
    return join( ' ', @words );
}

sub unique_list {
    my( @list ) = @_;
    my %h;
    map { $h{$_} = 1 } @list;
    return keys( %h );
}

1;
Commit	Line	Data
b49c4318	1	package Traditions::Graph;
	2
	3	use strict;
	4	use warnings;
	5	use Graph::Easy;
	6	use IPC::Run qw( run binary );
	7	use Module::Load;
a25d4374	8	use Traditions::Graph::Position;
	9
	10	=head1 NAME
	11
	12	(Text?)::Traditions::Graph
	13
	14	=head1 SYNOPSIS
	15
	16	use Traditions::Graph;
	17
	18	my $text = Traditions::Graph->new( 'GraphML' => '/my/graphml/file.xml' );
	19	my $text = Traditions::Graph->new( 'TEI' => '/my/tei/file.xml' );
	20	my $text = Traditions::Graph->new( 'CSV' => '/my/csv/file.csv',
	21	'base' => '/my/basefile.txt' );
	22	my $text = Traditions::Graph->new( 'CTE' => '/my/cte/file.txt',
	23	'base' => '/my/basefile.txt' );
	24
	25	my $svg_string = $text->as_svg();
	26
	27	my $lemma_nodes = $text->active_nodes();
	28	$text->toggle_node( 'some_word' );
	29
	30	=head1 DESCRIPTION
	31
	32	A text tradition is the representation of our knowledge of a text that
	33	has been passed down via manuscript copies from a time before printing
	34	presses. Each text has a number of witnesses, that is, manuscripts
	35	that bear a version of the text. The tradition is the aggregation of
	36	these witnesses, which is to say, the collation of the text.
	37
	38	This module takes a text collation and represents it as a horizontal
	39	directed graph, suitable for SVG rendering and for analysis of various
	40	forms. Since this module was written by a medievalist, it also
	41	provides a facility for making a critical text reconstruction by
	42	choosing certain variants to be 'lemma' text - that is, text which
	43	should be considered the 'standard' reading.
	44
	45	Although the graph is a very good way to render text collation, and is
	46	visually very easy for a human to interpret, it doesn't have any
	47	inherent information about which nodes 'go together' - that is, which
	48	text readings appear in the same place as other readings. This module
	49	therefore calculates 'positions' on the graph, thus holding some
	50	information about which readings can and can't be substituted for
	51	others.
	52
	53	=head1 METHODS
	54
	55	=over 4
	56
	57	=item B<new>
	58
	59	Constructor. Takes a source collation file from which to construct
	60	the initial graph. This file can be TEI (parallel segmentation) XML,
	61	CSV in a format yet to be documented, GraphML as documented (someday)
	62	by CollateX, or a Classical Text Editor apparatus. For CSV and
	63	Classical Text Editor files, the user must also supply a base text to
	64	which the line numbering in the collation file refers.
	65
	66	=cut
b49c4318	67
	68	sub new {
	69	my $proto = shift;
	70	my $class = ref( $proto ) \|\| $proto;
	71	my %opts = ( 'on_color' => 'yellow',
	72	'off_color' => 'white',
	73	@_ );
	74	my $self = {};
	75
	76	# opts can be: GraphML, base+CSV, base+CTE, TEI. We need
	77	# something to parse.
	78	my @formats = grep { /^(GraphML\|CSV\|CTE\|TEI)$/ } keys( %opts );
	79	my $format = shift( @formats );
	80	unless( $format ) {
	81	warn "No data given to create a graph: need GraphML, CSV, or TEI";
	82	return;
	83	}
	84	if( $format =~ /^(CSV\|CTE)$/ && !exists $opts{'base'} ) {
	85	warn "Cannot make a graph from $format without a base text";
	86	return;
	87	}
	88
	89	# Make a graph object.
	90	my $collation_graph = Graph::Easy->new();
	91	$collation_graph->set_attribute( 'node', 'shape', 'ellipse' );
	92	# Starting point for all texts
	93	my $last_node = $collation_graph->add_node( '#START#' );
	94
	95	$self->{'graph'} = $collation_graph;
	96	bless( $self, $class );
	97
	98	# Now do the parsing.
	99	my $mod = "Traditions::Parser::$format";
	100	load( $mod );
	101	my @args = ( $opts{ $format } );
	102	if( $format =~ /^(CSV\|CTE)$/ ) {
	103	push( @args, $opts{'base'} );
	104	}
	105	$mod->can('parse')->( $self, @args );
	106
	107	return $self;
	108	}
	109
	110
	111	### Graph::Easy object accessor methods
	112	sub node {
	113	my $self = shift;
	114	return $self->{'graph'}->node( @_ );
	115	}
	116
	117	sub edge {
	118	my $self = shift;
	119	return $self->{'graph'}->edge( @_ );
	120	}
	121
	122	sub add_node {
	123	my $self = shift;
	124	return $self->{'graph'}->add_node( @_ );
	125	}
	126
	127	sub add_edge {
	128	my $self = shift;
	129	return $self->{'graph'}->add_edge( @_ );
	130	}
131
132	sub del_node {
133	my $self = shift;
134	return $self->{'graph'}->del_node( @_ );
135	}
136
137	sub del_edge {
138	my $self = shift;
139	return $self->{'graph'}->del_edge( @_ );
140	}
141
142	sub nodes {
143	my $self = shift;
144	return $self->{'graph'}->nodes( @_ );
145	}
146
147	sub edges {
148	my $self = shift;
149	return $self->{'graph'}->edges( @_ );
150	}
151
152	sub merge_nodes {
153	my $self = shift;
154	return $self->{'graph'}->merge_nodes( @_ );
155	}
156
157	### Helper methods for navigating the tree
158
159	sub start {
160	# Return the beginning node of the graph.
161	my $self = shift;
162	my( $new_start ) = @_;
163	if( $new_start ) {
164	$self->{'graph'}->rename_node( $new_start, '#START#' );
165	}
166	return $self->{'graph'}->node('#START#');
167	}
168
a25d4374	169	sub set_identical_nodes {
	170	my( $self, $node_hash ) = @_;
	171	$self->{'identical_nodes'} = $node_hash;
b49c4318	172	}
	173
	174	sub next_word {
	175	# Return the successor via the corresponding edge.
	176	my( $self, $node, $edge ) = @_;
	177	$edge = "base text" unless $edge;
	178	my @next_edges = $node->outgoing();
	179	return undef unless scalar( @next_edges );
	180
	181	foreach my $e ( @next_edges ) {
	182	next unless $e->label() eq $edge;
	183	return $e->to();
	184	}
	185
	186	warn "Could not find node connected to edge $edge";
	187	return undef;
	188	}
	189
	190	sub prior_word {
	191	# Return the predecessor via the corresponding edge.
	192	my( $self, $node, $edge ) = @_;
	193	$edge = "base text" unless $edge;
	194	my @prior_edges = $node->incoming();
	195	return undef unless scalar( @prior_edges );
	196
	197	foreach my $e ( @prior_edges ) {
	198	next unless $e->label() eq $edge;
	199	return $e->from();
	200	}
	201
	202	warn "Could not find node connected from edge $edge";
	203	return undef;
	204	}
	205
	206	sub node_sequence {
	207	my( $self, $start, $end, $label ) = @_;
	208	# TODO make label able to follow a single MS
	209	unless( ref( $start ) eq 'Graph::Easy::Node'
	210	&& ref( $end ) eq 'Graph::Easy::Node' ) {
	211	warn "Called node_sequence without two nodes!";
	212	return ();
	213	}
	214	$label = 'base text' unless $label;
	215	my @nodes = ( $start );
	216	my %seen;
	217	my $n = $start;
	218	while( $n ne $end ) {
	219	if( exists( $seen{$n->name()} ) ) {
	220	warn "Detected loop at " . $n->name();
	221	last;
	222	}
	223	$seen{$n->name()} = 1;
	224
	225	my @edges = $n->outgoing();
	226	my @relevant_edges = grep { $_->label =~ /^$label$/ } @edges;
	227	warn "Did not find an edge $label from node " . $n->label
	228	unless scalar @relevant_edges;
	229	warn "Found more than one edge $label from node " . $n->label
	230	unless scalar @relevant_edges == 1;
	231	my $next = $relevant_edges[0]->to();
	232	push( @nodes, $next );
	233	$n = $next;
	234	}
	235	# Check that the last node is our end node.
236	my $last = $nodes[$#nodes];
237	warn "Last node found from " . $start->label() .
238	" via path $label is not the end!"
239	unless $last eq $end;
240
241	return @nodes;
242	}
243
244	sub string_lemma {
245	my( $self, $start, $end, $label ) = @_;
246
247	my @nodes = $self->node_sequence( $start, $end, $label );
248	my @words = map { $_->label() } @nodes;
249	return join( ' ', @words );
250	}
251
252	## Output. We use GraphViz for the layout because it handles large
253	## graphs better than Graph::Easy does natively.
254
255	sub as_svg {
256	my( $self, $recalc ) = @_;
257	return $self->{'svg'} if( exists $self->{'svg'} && !$recalc );
258
259	$self->{'graphviz'} = $self->{'graph'}->as_graphviz()
260	unless( exists $self->{'graphviz'} && !$recalc );
261
262	my @cmd = qw/dot -Tsvg/;
263	my( $svg, $err );
264	my $in = $self->{'graphviz'};
265	run( \@cmd, \$in, ">", binary(), \$svg );
266	$self->{'svg'} = $svg;
267	return $svg;
268	}
269
a25d4374	270	## Methods for lemmatizing a text.
b49c4318	271
a25d4374	272	sub init_lemmatizer {
	273	my $self = shift;
	274	# Initialize the 'lemma' hash, going through all the nodes and seeing
58a3c424	275	# which ones are common nodes. This should only be run once.
a25d4374	276
58a3c424	277	return if( $self->{'lemmatizer_initialized'} );
	278	my @active_names = map { $_->name } grep { $self->is_common( $_ ) }
	279	$self->nodes();
	280	$self->{'positions'}->init_lemmatizer( @active_names );
	281	$self->{'lemmatizer_initialized'} = 1;
a25d4374	282
a25d4374	283	}
	284
	285	sub make_positions {
	286	my( $self, $common_nodes, $paths ) = @_;
	287	my $positions = Traditions::Graph::Position->new( $common_nodes, $paths );
	288	$self->{'positions'} = $positions;
	289	}
	290
	291	# Takes a list of nodes that have just been turned off, and returns a
	292	# set of tuples of the form ['node', 'state'] that indicates what
	293	# changes need to be made to the graph.
	294	# A state of 1 means 'turn on this node'
	295	# A state of 0 means 'turn off this node'
	296	# A state of undef means 'an ellipsis belongs in the text here because
	297	# no decision has been made'
b49c4318	298	sub active_nodes {
b49c4318	299	my( $self, @toggled_off_nodes ) = @_;
a25d4374	300
	301	# In case this is the first run
	302	$self->init_lemmatizer();
	303	# First get the positions of those nodes which have been
	304	# toggled off.
b49c4318	305	my $positions_off = {};
a25d4374	306	map { $positions_off->{ $self->{'positions'}->node_position( $_ ) } = $_ }
	307	@toggled_off_nodes;
	308
b49c4318	309
	310	# Now for each position, we have to see if a node is on, and we
	311	# have to see if a node has been turned off.
	312	my @answer;
a25d4374	313	foreach my $pos ( $self->{'positions'}->all() ) {
58a3c424	314	# Find the state of this position. If there is an active node,
	315	# its name will be the state; otherwise the state will be 0
	316	# (nothing at this position) or undef (ellipsis at this position)
	317	my $active = $self->{'positions'}->state( $pos );
a25d4374	318
b49c4318	319	# Is there a formerly active node that was toggled off?
b49c4318	320	if( exists( $positions_off->{$pos} ) ) {
a25d4374	321	my $off_node = $positions_off->{$pos};
58a3c424	322	if( $active && $active ne $off_node) {
b49c4318	323	push( @answer, [ $off_node, 0 ], [ $active, 1 ] );
b49c4318	324	} else {
58a3c424	325	push( @answer, [ $off_node, $active ] );
b49c4318	326	}
58a3c424	327
b49c4318	328	# No formerly active node, so we just see if there is a currently
	329	# active one.
	330	} elsif( $active ) {
	331	# Push the active node, whatever it is.
	332	push( @answer, [ $active, 1 ] );
	333	} else {
58a3c424	334	# Push the state that is there. Arbitrarily use the first node
	335	# at that position.
	336	my @pos_nodes = $self->{'positions'}->nodes_at_position( $pos );
	337	push( @answer,
	338	[ $pos_nodes[0], $self->{'positions'}->state( $pos ) ] );
b49c4318	339	}
b49c4318	340	}
58a3c424	341
b49c4318	342	return @answer;
	343	}
	344
a25d4374	345	# A couple of helpers. TODO These should be gathered in the same place
a25d4374	346	# eventually
b49c4318	347
a25d4374	348	sub is_common {
	349	my( $self, $node ) = @_;
	350	$node = $self->_nodeobj( $node );
	351	return $node->get_attribute('class') eq 'common';
b49c4318	352	}
b49c4318	353
a25d4374	354	sub _nodeobj {
	355	my( $self, $node ) = @_;
	356	unless( ref $node eq 'Graph::Easy::Node' ) {
	357	$node = $self->node( $node );
b49c4318	358	}
a25d4374	359	return $node;
b49c4318	360	}
b49c4318	361
a25d4374	362	# toggle_node takes a node name, and either lemmatizes or de-lemmatizes it.
a25d4374	363	# Returns a list of nodes that are de-lemmatized as a result of the toggle.
b49c4318	364
b49c4318	365	sub toggle_node {
a25d4374	366	my( $self, $node ) = @_;
	367
	368	# In case this is being called for the first time.
	369	$self->init_lemmatizer();
b49c4318	370
a25d4374	371	if( $self->is_common( $node ) ) {
	372	# Do nothing, it's a common node.
	373	return;
	374	}
58a3c424	375
	376	my $pos = $self->{'positions'}->node_position( $node );
	377	my $old_state = $self->{'positions'}->state( $pos );
b49c4318	378	my @nodes_off;
58a3c424	379	if( $old_state && $old_state eq $node ) {
	380	# Turn off the node. We turn on no others by default.
	381	push( @nodes_off, $node );
	382	} else {
b49c4318	383	# Turn on the node.
58a3c424	384	$self->{'positions'}->set_state( $pos, $node );
58a3c424	385	# Any other 'on' nodes in the same position should be off.
a25d4374	386	push( @nodes_off, $self->colocated_nodes( $node ) );
58a3c424	387	# Any node that is an identical transposed one should be off.
a25d4374	388	push( @nodes_off, $self->identical_nodes( $node ) )
a25d4374	389	if $self->identical_nodes( $node );
b49c4318	390	}
a25d4374	391	@nodes_off = unique_list( @nodes_off );
b49c4318	392
b49c4318	393	# Turn off the nodes that need to be turned off.
58a3c424	394	my @nodes_turned_off;
	395	foreach my $n ( @nodes_off ) {
	396	my $npos = $self->{'positions'}->node_position( $n );
	397	my $state = $self->{'positions'}->state( $npos );
	398	if( $state && $state eq $n ) {
	399	# this node is still on
	400	push( @nodes_turned_off, $n );
	401	my $new_state = undef;
	402	if( $n eq $node ) {
	403	# This is the node that was clicked, so if there are no
	404	# other nodes there, turn off the position. In all other
	405	# cases, restore the ellipsis.
	406	my @all_n = $self->{'positions'}->nodes_at_position( $pos );
	407	$new_state = 0 if scalar( @all_n ) == 1;
	408	}
	409	$self->{'positions'}->set_state( $npos, $new_state );
	410	} elsif( $old_state && $old_state eq $n ) {
	411	# another node has already been turned on here
	412	push( @nodes_turned_off, $n );
	413	} # else some other node was on anyway, so pass.
	414	}
	415	return @nodes_turned_off;
b49c4318	416	}
b49c4318	417
b49c4318	418	sub colocated_nodes {
a25d4374	419	my $self = shift;
a25d4374	420	return $self->{'positions'}->colocated_nodes( @_ );
b49c4318	421	}
	422
	423	sub identical_nodes {
	424	my( $self, $node ) = @_;
a25d4374	425	return undef unless exists $self->{'identical_nodes'} &&
	426	exists $self->{'identical_nodes'}->{$node};
	427	return $self->{'identical_nodes'}->{$node};
	428	}
	429
	430	sub text_of_node {
	431	my( $self, $node_id ) = @_;
	432	# This is the label of the given node.
	433	return $self->node( $node_id )->label();
b49c4318	434	}
	435
	436	sub text_for_witness {
	437	my( $self, $wit ) = @_;
b49c4318	438
a25d4374	439	my @nodes = $self->{'positions'}->witness_path( $wit );
a25d4374	440	my @words = map { $self->node( $_ )->label() } @nodes;
b49c4318	441	return join( ' ', @words );
	442	}
	443
a25d4374	444	sub unique_list {
	445	my( @list ) = @_;
	446	my %h;
	447	map { $h{$_} = 1 } @list;
	448	return keys( %h );
b49c4318	449	}
a25d4374	450
b49c4318	451	1;
a25d4374	452