#!/usr/bin/perl -w

=head1 NAME

change_comm.pl - Compare two tab delimited change files (from blast_compare.pl) 

=head1 SYNOPSIS

change_comm.pl -a input1.txt -b input2.txt [-1] [-2] [-3] [-help] 

 Required arguments:
    -a        Tab delimited change file a
    -b        Tab delimited change file b

 Options:
    -1        Suppress output of changes only in file a
    -2        Suppress output of changes only in file b
    -3        Suppress output of changes in both files
    -help -h  Help

 Examples:
 Output only changes in input1.txt that are not also in input2.txt
	change_comm.pl -a input1.txt -b input2.txt -2 -3
     
 Output only changes that are in both input1.txt and input2.txt
	change_comm.pl -a input1.txt -b input2.txt -1 -2

=head1 DESCRIPTION

Read two tab delimited change files (from blast_compare.pl) and output changes only in first, only in second, and changes in both
	
=head1 AUTHOR

Lance Parsons <lparsons@princeton.edu>

=head1 LICENSE

This script is licensed by the Simplified BSD License
See LICENSE.TXT and <http://www.opensource.org/licenses/bsd-license>

Copyright (c) 2011, Lance Parsons
All rights reserved.

=cut

use strict;

use Getopt::Long;
use English;
use Carp;
use Pod::Usage;

my $needsHelp = '';
my $fileA;
my $fileB;
my $hide_only_a = 0;
my $hide_only_b = 0;
my $hide_both   = 0;

my $options_okay = &Getopt::Long::GetOptions(
	'fileA|a=s' => \$fileA,
	'fileB|b=s' => \$fileB,
	'1'         => \$hide_only_a,
	'2'         => \$hide_only_b,
	'3'         => \$hide_both,
	'help|h'    => \$needsHelp
);

# Check to make sure options are specified correctly and files exist
&check_opts();

my $a = &read_aa_table($fileA);
my $b = &read_aa_table($fileB);

my %aonly = my %bonly = my %both = ();

foreach my $gene ( keys %$a ) {
	my $afieldsr = $a->{$gene};
	my $achanges = $afieldsr->[15] ? $afieldsr->[15] : "";

	my $bfieldsr = $b->{$gene}     ? $b->{$gene}     : ();
	my $bchanges = $bfieldsr->[15] ? $bfieldsr->[15] : "";

	my @achanges = split( ", ", $achanges );
	my @bchanges = split( ", ", $bchanges );

	$aonly{$gene} = &array_diff( \@achanges, \@bchanges );
	$bonly{$gene} = &array_diff( \@bchanges, \@achanges );
	$both{$gene}  = &array_diff( \@achanges, $aonly{$gene} );

}

if ( !$hide_only_a ) {
	&print_header();
	&print_data( \%aonly );
}

if ( !$hide_only_b ) {
	&print_header();
	&print_data( \%bonly );
}

if ( !$hide_both ) {
	&print_header();
	&print_data( \%both );
}

sub read_aa_table {
	my $filename = shift;
	open( my $file, "<", $filename )
	  or croak "Can't open '$filename': $OS_ERROR";
	my %regions;
	<$file>;
	while ( my $line = <$file> ) {
		chomp($line);
		my (@fields) = split( /\t/, $line );
		if ( substr( $fields[1], 0, 1 ) eq "#" ) {
			next;
		}
		$regions{ $fields[0] } = \@fields;
	}
	return \%regions;
}

sub print_header {
	printf( "%s\t%s\t%s\n",
		"Gene(strand)",
		"# Change Events",
		"Change Summary",
	);
}

sub print_data {
	my $data = shift;
	foreach my $gene ( keys %$data ) {
		printf( "%s\t%s\t%s\n",
			$gene,
			&noncontig_count( $data->{$gene} ),
			join( ", ", @{ $data->{$gene} } ) );
	}
}

sub noncontig_count {
	my $diffr = shift;
	my @diff  = @$diffr;
	my $count = 0;
	my $pp    = -2;
	for ( my $i = 0 ; $i < scalar(@diff) ; $i++ ) {
		$diff[$i] =~ /\d+/;
		my $p = $&;
		if ( $p > $pp + 1 ) {
			$count++;
		}
		$pp = $p;
	}
	return $count;
}

sub array_diff {
	my $rA = shift;
	my $rB = shift;
	my @A  = @$rA;
	my @B  = @$rB;

	# assume @A and @B are already loaded
	my %seen  = ();    # lookup table to test membership of B
	my @aonly = ();    # answer

	# build lookup table
	foreach my $item (@B) { $seen{$item} = 1 }

	# find only elements in @A and not in @B
	foreach my $item (@A) {
		unless ( $seen{$item} ) {

			# it's not in %seen, so add to @aonly
			push( @aonly, $item );
		}
	}

	return \@aonly;
}

# Check for problem with the options or if user requests help
sub check_opts {
	if ($needsHelp) {
		pod2usage( -verbose => 2 );
	}

	if ( !$options_okay ) {
		pod2usage(
			-exitval => 2,
			-verbose => 1,
			-message => "Error specifying options."
		);
	}
	if (! -e $fileA ) {
		pod2usage(
			-exitval => 2,
			-verbose => 1,
			-message => "Cannot read file a: '$fileA!'\n"
		);
	}
	if (! -e $fileB ) {
		pod2usage(
			-exitval => 2,
			-verbose => 1,
			-message => "Cannot read file b: '$fileB!'\n"
		);
	}
}
