#!/usr/bin/perl -w
use POSIX;
use Getopt::Long qw(:config bundling require_order auto_version);
use Pod::Usage;
use FAST;
use FAST::Bio::AlignIO;
use FAST::Bio::UnivAln;
use Bit::Vector;
use strict;

use vars qw($VERSION $DESC $NAME $COMMAND $DATE);
$VERSION = $FAST::VERSION; 
$DESC    = "Filter sites in alignments based on variation and gap-content.\n";
$NAME    = $0;
$NAME    =~ s/^.*\///;
$COMMAND = join " ",$NAME,@ARGV;
$DATE = POSIX::strftime("%c",localtime());

use constant { true => 1, false => 0 };

## DEFAULT OPTION VALUES
my $def_format  = $FAST::DEF_FORMAT;  #7/1/13 "fasta";
my $def_logname = $FAST::DEF_LOGNAME; #7/1/13 "FAST.log.txt";

## OPTION VARIABLES
my $man                  = undef;  # --man
my $help                 = undef;  # -h
my $moltype              = undef;  # -m, in case bioperl can't tell
my $format               = $def_format;  # --format
my $log                  = undef;        # -l
my $logname              = $def_logname; # -L
my $comment              = undef;        # -C
my $negate               = undef; # -v
my $gapfree              = undef; # -g
my $allgap               = undef; # -a
my $parsinf              = undef; # -p
my $frequency            = 0;     # -f
my $verbose              = undef; # --verbose

GetOptions('help|h'         		 => \$help, 
	   'man'            		 => \$man,
	   'moltype|m=s'                 => sub{  my (undef,$val) = @_; 
						  die "$NAME: --moltype or -m option argument must be \"dna\", \"rna\" or \"protein\"" 
						    unless $val =~ /dna|rna|protein/i; 
						  $moltype = $val;
						},
	   'format=s'                    => \$format,
	   'log|l'                       => \$log,
	   'logname|L=s'                 => \$logname,
	   'comment|C=s'                 => \$comment,
           'negate|v'                    => \$negate,
           'gapfree|g'                   => \$gapfree,
           'allgap|a'                    => \$allgap,
           'parsinf|p'                   => \$parsinf,
	   'frequency|f=f'                => sub{  my (undef,$val) = @_; # keep if complement of largest component freq <= arg or if gap-freq <= arg.
                                                  die "$NAME: --frequency or f option expects a positive integer or a floating-point argument between 0 and 1.\n"
						    unless (($val =~ /\A[1-9]\d*\Z/ && $val >= 1) || ($val =~ /(([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+)))?/ && $val > 0 && $val < 1));
						  $frequency = $val;
						},   
	   'verbose|V'                   => \$verbose,
	  ) 
  or pod2usage(2);
	
	  
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;

my $fromSTDIN = ((-t STDIN) ? false : true);

pod2usage("$NAME: Expects at least one input filename or glob. Try \"perldoc $NAME\"") if (!($fromSTDIN) && (@ARGV < 1));
pod2usage("$NAME: Expects no arguments with input on STDIN. Try \"perldoc $NAME\"") if ($fromSTDIN && @ARGV != 0);

&FAST::log($logname, $DATE, $COMMAND, $comment) if ($log); 

my $mapf;
sub generate_map_function {
  my $cutoff = shift;
  if ($parsinf) {
    $mapf = sub {
      my @chars = @{ $_[0] };
      my %freqs = ();
      map $freqs{$_}++, @chars;
      my @vals = sort {$b <=> $a} values %freqs;
      if (@vals > 1 && $vals[1] > 1) {
	return ($negate ? 0 : 1);
      }
      else {
	return ($negate ? 1 : 0);
      }
    }
  }
  elsif ($allgap) {
    $mapf = sub {
      my @chars = @{ $_[0] };
      my @gaps = grep /-/, @chars;
      if (@gaps == @chars) {
	return ($negate ? 0 : 1);
      }
      else {
	return ($negate ? 1 : 0);
      }
    }
  }
  elsif ($gapfree) {
    $mapf = sub {
      my @chars = @{ $_[0] };
      my @gaps = grep {/-/} @chars;
      if ((@gaps/@chars) <= $cutoff) {
	return ($negate ? 0 : 1);
      }
      else {
	return ($negate ? 1 : 0);
      }
    }
  }
  else {
    $mapf = sub {
      my @chars = @{ $_[0] };
      my %freqs = ();
      map $freqs{$_}++, @chars;
      my @vals = sort {$b <=> $a} values %freqs;
      if ((1 - ($vals[0]/@chars)) <= $cutoff) {
	return ($negate ? 0 : 1);
      }
      else {
	return ($negate ? 1 : 0);
      }
    }
  }
  return $mapf;
}

my $IN;
unless (@ARGV) {   
  if ($moltype){
    $IN = FAST::Bio::AlignIO->new(-fh => *STDIN{IO}, '-format' => $def_format, '-alphabet' => $moltype);
  }
  else{
    $IN = FAST::Bio::AlignIO->new(-fh => *STDIN{IO}, '-format' => $def_format);
  }
}

while ($IN or @ARGV) {
  if (@ARGV) {
    my $file = shift (@ARGV);
    unless (-e $file) {
      warn "$NAME: Could not find file $file. Skipping.\n";
      next;
    }
    elsif ($moltype) {
      $IN = FAST::Bio::AlignIO->new(-file => $file, '-format' => $def_format, '-alphabet' => $moltype);
    }
    else {
      $IN = FAST::Bio::AlignIO->new(-file => $file, '-format' => $def_format);
    }
  }
  if ($IN) { 
    while (my $saln = $IN->next_aln){
      my @seqs = $saln->each_seq();
      my $aln  = FAST::Bio::UnivAln->new('-seqs' => \@seqs);
      my $nseqs = scalar (@seqs);
      my $cutoff;
      if ($frequency >= 1) {
	$cutoff = $frequency / $nseqs;
      }
      else {
	$cutoff = $frequency;
      }

      my $mapf = generate_map_function($cutoff);
     
      if ($verbose) {
	my $inds = [$aln->map_c($mapf)];
	my $bv = Bit::Vector->new_Bin(scalar(@$inds),join "",@$inds);
	my $type;
	if ($parsinf) {
	  $type = "parsimoniously informative";
	}
	elsif ($allgap) {
	  $type = "all-gap";
	}
	elsif ($gapfree) {
	  $type = "gap-free";
	}
	else {
	  $type = "invariant";
	}
	$type = "non-" . $type      if ($negate);
	printf STDERR "# $NAME matched %d %s sites.\n", (scalar (grep {$_ == 1} @$inds)), $type;
	printf STDERR "# A relative frequency cutoff of %6.4f gaps or variants was allowed.\n", $cutoff if ($frequency > 0);
	printf STDERR "# Matching indices (zero-based):\n%s\n", $bv->to_Enum();
      }
   
      my $subaln = new FAST::Bio::UnivAln(-seqs=>scalar($aln->seqs([],$mapf)), -row_ids=>$aln->row_ids, -row_descs=>$aln->row_descs());
      #$subaln->ffmt($opt_f); 
      my $layout = $subaln->layout();
      ## FIX FASTA PRINT BUG (IDs SHOULD GO RIGHT AFTER '>') 
      $layout =~ s/^>\s+/>/gm;
      print "$layout";
    }
    undef $IN;
  }
}



__END__

=head1 NAME

alncut - filter sites in alignments based on variation and gap-content

=head1 SYNOPSIS

B<alncut> [options] [MULTIFASTA-FILE...]

=head1 DESCRIPTION

B<alncut> takes multifasta format alignment data as input and returns
that data filtered for sites with various properties. By default, only
invariant sites (sites with no variation) are returned. When the B<-f>
option is used, sites will be returned that are invariant up to a
specified cut-off. More precisely, a site will be returned if the
complement of the largest frequency component of that site is less
than or equal to the cut-off.

B<alncut> may also be used to degap alignments. Gap-free sites may be
selected with the B<-g> option. When combined with the B<-f> option,
sites will be returned that are gap-free up to a cut-off, i.e. in
which the gap-frequency is less than or equal to the cut-off.

With the B<---allgap> or B<-a> option, B<alncut> returns sites that
contain only gaps. The B<-f> option is ignored. In all of its uses,
the B<-v> option will cause B<alnsite> to output the set-complement of
sites it has selected. Therefore, to print all sites that are not all
gap, combine the B<-a> and B<-v> options.

Parsimoniously informative sites are variable sites in which at least
two different site-characters or states are each represented in at
least two different sequences. B<alnsite> wil return parsimoniously
informative sites with the B<-parsinf> or B<-p> option.

Options specific to B<alnsite>:
  B<-g>, B<--gapfree>                     print gap-free sites              
  B<-a>, B<--allgap>                      print all-gap sites
  B<-p>, B<--parsinf>                     print parsimoniously informative sites
  B<-v>, B<--negate>                      print set-complement of selected sites 
  B<-f>, B<--frequency>=<int>             print sites with max <int> minor variants or gaps
  B<-f>, B<--frequency>=<float>           print sites with max <float> minor variants or gaps
  B<-V>, B<--verbose>                     report number and indices of selected sites to STDERR

Options general to FAST:
  B<-h>, B<--help>                  	 print a brief help message
  B<--man>             	           print full documentation
  B<--version>                         print version
  B<-l>, B<--log>                         create/append to logfile	
  B<-L>, B<--logname>=<string>            use logfile name <string>
  B<-C>, B<--comment>=<string>            save comment <string> to log
  B<--format>=<format>                 use alternative format for input  
  B<--moltype>=<[dna|rna|protein]>     specify input sequence type

=head1 INPUT AND OUTPUT

B<alnsite> is part of FAST, the FAST Analysis of Sequences Toolbox, based
on Bioperl. Most core FAST utilities expect input and return output in
multifasta format. Input can occur in one or more files or on
STDIN. Output occurs to STDOUT. The FAST utility B<fasconvert> can
reformat other formats to and from multifasta.

=head1 OPTIONS

=over 8

=item B<-g>
      B<--gapfree>

Print only sites that contain no gaps

=item B<-a>
      B<--allgap>

Print only sites that contain exclusively gaps

=item B<-p>
      B<--parsinf>

Print only sites that are parsimoniously informative. Parsimoniously
informative sites are variable sites in which at least two different
site-characters or states are each represented in at least two
different sequences.

=item B<-v>
      B<--negate>

Print set-complement of sites otherwise selected; as a sole option,
will print only variable sites

=item B<-f [int]>,
      B<--frequency=[int]>

Print sites that contain gaps or minor variants up to a maximum of
[int] sequences


=item B<-f [float]>,
      B<--frequency=[float]>

Print sites that contain gaps or minor variants up to a maximum of
[float] relative frequency


=item B<--verbose>

Print numbers and indices of sites selected by the criteria to STDERR

=item B<-h>,
      B<--help>

Print a brief help message and exit.

=item B<--man>

Print the manual page and exit.

=item B<--version>

Print version information and exit.

=item B<-l>,
      B<--log>

Creates, or appends to, a generic FAST logfile in the current working
directory. The logfile records date/time of execution, full command
with options and arguments, and an optional comment.

=item B<-L [string]>,
      B<--logname=[string]>

Use [string] as the name of the logfile. Default is "FAST.log.txt".

=item B<-C [string]>,
      B<--comment=[string]>

Include comment [string] in logfile. No comment is saved by default.

=item B<--format=[format]> 		  

Use alternative format for input. See man page for "fasconvert" for
allowed formats. This is for convenience; the FAST tools are designed
to exchange data in Fasta format, and "fasta" is the default format
for this tool.

=item B<-m [dna|rna|protein]>,
      B<--moltype=[dna|rna|protein]> 		  

Specify the type of sequence on input (should not be needed in most
cases, but sometimes Bioperl cannot guess and complains when
processing data).

=back

=head1 EXAMPLES

Print sites that are not all gap:

=over 8

B<alncut> -av data.fas 

=back

Print sites with gaps in maximum 2 sequences:

=over 8

B<alncut> -gf 2 data.fas 

=back

Print sites in which the frequency of minor variants is less than 15 percent:

=over 8

B<alncut> -f 0.15 data.fas 

=back

Print variable sites:

=over 8

B<alncut> -v data.fas 

=back


=head1 SEE ALSO

=over 8

To degap each sequence on input individually, see

=back

=over 8

=item C<fastr --degap>

=item C<man perlre>

=item C<perldoc perlre>

Documentation on perl regular expressions.

=item C<man FAST>

=item C<perldoc FAST>

Introduction and cookbook for FAST

=item L<The FAST Home Page|http://compbio.ucmerced.edu/ardell/FAST>"

=back 

=head1 CITING

If you use FAST, please cite I<Ardell (2013). FAST: FAST Analysis of
Sequences Toolbox. Bioinformatics> and Bioperl I<Stajich et al.>.

=cut
