#!/usr/bin/perl -w 
#
# $Id$

=head1 NAME

 scramble_space.pl - generate graph of scrambled configurations and paths

=head1 SYNOPSIS

    scramble_space.pl --initial <CONFIG_STRING> > my_scramble_space.dot 

    --label             label edges with inversion types
    --help, --?         print help message
    --tests				compute all possible inversions from starting config, then exit 

Where I<CONFIG_STRING> has single-character uppercase labels for the initial configuration of segments, e.g, 'ABCD'.  

Examples:

    scramble_space.pl --label --initial 'ABC' > scramble_ABC_with_edge_labels.dot
    scramble_space.pl --initial 'ABCD' > scramble_ABCD.dot    
    scramble_space.pl --test --initial 'ABCDEFGHIJKLMNOP'
    
Documentation: 

    perldoc scramble_space.pl 

=head1 DESCRIPTION

For background, see the "Constructive Neutral Evolution" model for ciliate gene-scrambling given in: 

  Stoltzfus A: On the possibility of constructive neutral evolution. J Mol Evol 1999, 49(2):169-181.

This script will compute the graph of inversion paths among all possible configurations of a segmented gene with the initial configuration as specified (by an ordered string of one-character labels) on the command line, e.g., 'ABCD'.  The graph is printed to STDOUT in the "dot" language used by software such as GraphViz, and the nodes are ranked in order of minimum inversion distance from the initial configuration.  To generate a graphical plot, you must use GraphViz or other software.  

All possible arrangements can be reached by inversions.  Other rearrangements such as translocations (e.g., ABCD --> ADBC) are possible, but they do not change the set of possible configurations (however, they would only add more paths between configurations).  

If no initial configuration is given, a hard-coded default is used (set by $default_initial_configuration). 

So far as I know, this script correctly computes the inversion graph for a segmented gene.  Trying to produce a useful visualization of the graph is a separate issue. For N > 4, there will be a huge tangle of lines.  However, because the nodes are ranked by minimum inversion distance from the initial configuration, it remains useful to plot the nodes even without being able to visualize the links between them.   

=head1 KNOWN ISSUES

The script dies deliberately if the input string exceeds the value set by $size_limit.  

The script does not count the set of distinct configurations and compare this to the theoretical expectation given in Stoltzfus, 1999. However, that would be useful. 

=head1 AUTHOR

Arlin Stoltzfus (arlin@umd.edu)

=cut

use strict; 
use Getopt::Long; 
use Pod::Usage; 

# hard-coded defaults
#
my $default_initial_configuration = 'ABC'; 
my $size_limit = 26; 

# process command-line arguments 
#
my $initial = $default_initial_configuration; 
my ( $tests, $help, $label ); 
GetOptions(
    "initial=s" => \$initial,   
    "tests" => \$tests, 
    "label" => \$label, 
    "help|?" => \$help
    ) or pod2usage( "Invalid command-line options." );

pod2usage() if defined( $help ); 

die "Initial configuration exceeds length limit ($size_limit)!" if length( $initial ) > $size_limit; 

# compose stack of configs to process, hash of nodes accessed, etc
#
my ( @stack, @next_stack ); 
my ( %nodeReached, %linkFound );
my @nodes; 
my ( @ulinks, @dlinks );  # undirected and directed links
my @slinks;  # links in the spanning tree 

# initialize 
#
my $symbolMap = initSymbolConversion( $initial );  
my $types = countInversionTypes( length( $initial ) );
my @breakpoints = initBreakPoints( length( $initial ) ); 
push( @stack, $initial );
$nodeReached{ $initial } = 1; 
my $MID = 0;  # minimum inversion distance
push( @nodes, composeGraphNode( $initial, $MID ) );

# some test code here 
if ( $tests ) {
	printf( STDERR "number of possible inversion types is $types\n"); 
	printf( STDERR "initial configuration: \n%s", $nodes[0] ); 
	printf( STDERR "here is the set of possible inversions for the initial config: \n" ); 
	for ( my $i = 0; $i < $types; $i++ ) { 
		my @brk = @{ $breakpoints[$i] }; 
		printf( STDERR "type %d: breakpoints %s\n", $i, join( " and ", @brk ) ); 
		my $neighbor = rearrangeByInversion( $initial, $symbolMap, \@brk );
		printf( STDERR "\tleads to neighbor: $neighbor\n" ); 
		printf( STDERR "\tinverted form is: %s\n", invertBlock( $neighbor, $symbolMap ) ); 
		printf( STDERR "\ttest link: %s", composeGraphLink( $initial, $neighbor, 1, $i, $label ) ); 
	}
	exit; 
}
# compute all paths 
while ( $#stack >= 0 ) {
	foreach my $parent (@stack ) {
		for ( my $type = 0; $type < $types; $type++ ) { 
			my $neighbor = rearrangeByInversion( $parent, $symbolMap, $breakpoints[ $type ] );
			my $inverse = invertBlock( $neighbor, $symbolMap ); 
			# if the inverted form has been discovered already, that is the canonical form
			if ( defined( $nodeReached{ $inverse } ) ) { 
				$neighbor = $inverse; 
			}
			elsif ( !defined( $nodeReached{ $neighbor } ) ) { 
			# neighbor has not been seen yet, add it to stack for next round
				push( @nodes, composeGraphNode( $neighbor, $MID + 1 ) ); 
				push( @next_stack, $neighbor ); 
				# this is place to push a link onto spanning tree-- a node will not linked in twice
				push( @slinks, composeGraphLink( $parent, $neighbor, 0, $type + 1, $label ) ); 
	
			}
			$nodeReached{ $neighbor }++; 
			push( @dlinks, composeGraphLink( $parent, $neighbor, 1, $type + 1, $label ) ); 
			if ( ! $linkFound{ $neighbor . $parent } ) { 
				$linkFound{ $parent . $neighbor }++;   		
				push( @ulinks, composeGraphLink( $parent, $neighbor, 0, $type + 1, $label ) ); 
			}
		}
	}
 	$MID++;
 	@stack = @next_stack; 
 	@next_stack = (); 
}

# write output 
printf( "graph \"scramble space of %s\" {\n", $initial );
foreach (@nodes ) { 
	print $_; 
}
foreach (@ulinks ) { 
	print $_; 
}
printf( "}\n" ); 

exit; 

=head2 initSymbolConversion

 Title   : initSymbolConversion
 Usage   : my $symbolMap = initSymbolConversion( $initial );  
 Function: map segment symbols in label_string to symbols (+32 in ascii) that will represent inverted segments
 Returns : a reference to the hash with the mapping
 Args    : this assumes that the label string is upper-case letters, e.g., "ABCDE" 

=cut

sub initSymbolConversion{ 
	my $string = shift; 
	my %map; 
	foreach my $char ( split( //, $string ) ) { 
		my $other = chr( ord($char) + 32 );  # assume string is in uppercase, map to lowercase
		$map{ $char } = $other;
		$map{ $other } = $char; 
	}
	return( \%map );
}

=head2 countInversionTypes

 Title   : countInversionTypes
 Usage   : my $types = countInversionTypes( length( $initial ) )
 Function: compute how many types of inversions we need to consider 
 Returns : the number of types of inversions
 Args    : the number of segments  

=cut

sub countInversionTypes { 
	my $n = shift; 
	my $result = 0; 
	$result += $_ foreach 2..$n;
	return( $result ); 
} 

=head2 initBreakPoints

 Title   : initBreakPoints
 Usage   : my $breakpoints = initBreakPoints( length( $initial ) ); 
 Function: compute the breakpoints for all possible 
 Returns : 
 Args    :  the number of segments

=cut

sub initBreakPoints { 
	my $n = shift; 
	my @b; 
	for ( my $begin = 0; $begin <= $n; $begin++ ) {
		for ( my $len = 1; $len <= $n - $begin; $len++ ) {
			next if $len == $n;
			push( @b, [  $begin, $begin + $len ] );
		}
	}
	return( @b ); 
}

=head2 rearrangeByInversion

 Title   : rearrangeByInversion
 Usage   : my $neighbor = invert( $parent, $symbolMap, $ref_to_breaks  ) 
 Function: invert a segment to generate a new configuration 
 Returns : the inverted configuration
 Args    : the parent string, the symbol map (std-->inverted), and the breakpoints to use

=cut

sub rearrangeByInversion { 
	my $parent = shift; 
	my $symbolMap = shift; 
	my @breaks = @{ shift() };
	my $inverted; 
	my $upstream = substr( $parent, 0, $breaks[0] );
	my $target = substr( $parent, $breaks[0], $breaks[1] - $breaks[0] );
	my $downstream = substr( $parent, $breaks[1], length( $parent ) - $breaks[1] );
	$inverted = invertBlock( $target, $symbolMap ); 
	return( $upstream . $inverted . $downstream ); 
}

=head2 invertBlock

 Title   : invertBlock
 Usage   : my $breakpoints = initBreakPoints( length( $initial ) ); 
 Function: invert a segment or set of segments using the symbol map provided 
 Returns : the label of the inverted block
 Args    : the block to be inverted and the symbol map

=cut

sub invertBlock { 
	my $s = shift; 
	my $map = shift; 
	my $inverted;
	$s = reverse( $s ); 
	foreach my $char ( split( //, $s ) ) { 
		$inverted .= $$symbolMap{ $char }; 
	}
	return( $inverted ); 
}

=head2 composeGraphNode

 Title   : composeGraphNode
 Usage   : composeGraphNode( $neighbor, $MID + 1 );
 Function: composes the output line to specify a node 
 Returns : a formatted node string in the "dot" language used by graphviz
 Args    : node and rank

=cut

sub composeGraphNode{ 
	my $node = shift; 
	my $rank = shift; 
	return( sprintf( "\"%s\" [rank=%d];\n", $node, $rank ) );
} 

=head2 composeGraphLink

 Title   : composeGraphLink
 Usage   : composeGraphLink( $parent, $neighbor, $type );
 Function: composes the output line to specify a link 
 Returns : a formatted edge string in the "dot" language used by graphviz
 Args    : parent node, neighbor node, directed, link label, use label

=cut

sub composeGraphLink{ 
	my $parent = shift; 
	my $nbr = shift; 
	my $directed = shift; 
	my $label = shift;
	my $use_label = shift;  
	my $link = $directed ? "->" : "--"; 
	my $label_string = $use_label ? sprintf( "[label=%s]", $label ): "";
	return( sprintf( "%s %s %s %s;\n", $parent, $link, $nbr, $label_string ) );
}
# the end