#!/usr/bin/env perl

# MANUAL FOR functional_report_generation.pl

=pod

=head1 NAME

functional_report_generation.pl -- parse seqscreen output files into a seqscreen functional report

=head1 SYNOPSIS

 functional_report_generation.pl --urbtab /Path/to/uniref_blastx.btab --interproscan /Path/to/interproscan_output.txt --go /Path/to/go_network.txt --out /Path/to/output.txt [--cutoff 3]
                     [--help] [--manual]

=head1 DESCRIPTION

 Convert a set of seqscreen-related output files a seqscreen-style functional report. The input BTAB
 file must be from a UniRef blast. The input interproscan file msut be from the InterProScan run.
 
=head1 OPTIONS

=over 3

=item B<-u, --urbtab>=FILENAME

Input file in tabular format from UniRef BLAST. (Required) 

=item B<-i, --interproscan>=FILENAME

Input InterProScan file. (Required)

=item B<-g, --go>=FILENAME

The go_network.txt file from the database. (Required)

=item B<-o, --out>=FILENAME

Output file in tabular format. (Required)

=item B<-c, --cutoff>=INT

Report Tax ID's that are within --cutoff percent of the top-hit bit score.
--cutoff should be an integer from 0 to 50 (inclusively). E.g. 3 would mean use all BLAST
 results with hits that are within 3% of the top-hit bit score. (Default=0).

=item B<-h, --help>

Displays the usage message.  (Optional) 

=item B<-m, --manual>

Displays full manual.  (Optional) 

=back

=head1 DEPENDENCIES

Requires the following Perl libraries.



=head1 AUTHOR

Written by Daniel Nasko, 
Center for Bioinformatics and Computational Biology, University of Maryland.

=head1 REPORTING BUGS

Report bugs to dnasko@umiacs.umd.edu

=head1 COPYRIGHT

Copyright 2017 The S2FAST Team.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>.  
This is free software: you are free to change and redistribute it.  
There is NO WARRANTY, to the extent permitted by law.  

=cut


use strict;
use warnings;
use Getopt::Long;
use File::Basename;
use Pod::Usage;

#ARGUMENTS WITH NO DEFAULT
my($urbtab,$interproscan,$gonetwork,$swissfile,$outfile,$help,$manual);

##ARGS WITH DEFAULT
my $cutoff=0;

GetOptions (	
				"u|urbtab=s"	=>	\$urbtab,
                                "g|go=s"        =>      \$gonetwork,
				"o|out=s"	=>	\$outfile,
                                "c|cutoff=i"    =>      \$cutoff,
                                "h|help"	=>	\$help,
				"m|manual"	=>	\$manual) || pod2usage({-exitval => 2, -verbose => 1, -output => \*STDERR});

# VALIDATE ARGS
pod2usage(-verbose => 2)  if ($manual);
pod2usage( {-exitval => 0, -verbose => 2, -output => \*STDERR} )  if ($help);
pod2usage( -msg  => "\n\n ERROR!  Required argument --urbtab not found.\n\n", -exitval => 2, -verbose => 1)  if (! $urbtab );
pod2usage( -msg  => "\n\n ERROR!  Required argument --go not found.\n\n", -exitval => 2, -verbose => 1)  if (! $gonetwork );
pod2usage( -msg  => "\n\n ERROR!  Required argument --out not found.\n\n", -exitval => 2, -verbose => 1)  if (! $outfile);
if ($cutoff < 0 or $cutoff > 50) { die "\n Error: The --cutoff value must be between 0 and 50. Was $cutoff\n\n"; }
$cutoff = (100 - int($cutoff)) / 100; ## transforming the cut off to a number we can just multiply against the top-hit. e.g. 5 becomes 0.95.


my %TopHit; ## Dictionary that holds top-hit blast info for queries
my %Header; ## Dictionary that holds header info for each hit
my %Assigned; ## Dictionary that holds the UniProt ID and gene assignment for each query (not necessarily the top-hit)
my %Interproscan; ## Dictionary that holds IPS info for queries
my @Order; ## Array to keep track of query order
my %Rel;   ## Dictionary of arrays that holds the GO tree

## Read the GO network file in to a hash of arrays
open(my $gfh, '<', "$gonetwork") || die "\n Cannot open the file: $gonetwork\n";
while(<$gfh>) {
    chomp;
    my @a = split(/\t/, $_);
    my $child = $a[1];
    my $parent = $a[0];
    push(@{$Rel{$child}}, $parent);
}
close($gfh);

## Parse through the UniRef blast output once to get top-hits
open(my $ufh,'<',"$urbtab") || die "\n Cannot open the file: $urbtab\n";
while(<$ufh>) {
    chomp;
    my @a = split(/\t/, $_); ## split line by tabs
    my $query = base_query($a[0]); ## get the query's base name
    my $evalue = $a[10];
    my $bitscore = $a[11];
    my $uniref = $a[1];
    $uniref =~ s/UniRef100_//;
    my $header = $a[-1]; ## UniRef header is the last field 
    if (exists $TopHit{$query}{'evalue'}) { ## we've seen this query before
	if ($TopHit{$query}{'evalue'} > $evalue) { ## if this HSP produced a lower (better) E value than what we've seen before
	    $TopHit{$query}{'evalue'} = $evalue; ## record this new best E value
	    $TopHit{$query}{'bitscore'} = $bitscore; ## and its bit score
	    $TopHit{$query}{'uniref'} = $uniref; ## the uniref ID
	}
	elsif ($TopHit{$query}{'evalue'} == 0) { ## BLAST will round E values < 1e-300 to zero. If that's the case then use bit score as the tie breaker
	    if ($TopHit{$query}{'bitscore'} < $bitscore) { ## if this HSP's bit score is better
		$TopHit{$query}{'bitscore'} = $bitscore; ## then set the TopHit bit score to that
		$TopHit{$query}{'uniref'} = $uniref; ## the uniref ID
	    }
	}
    }
    else { ## this is the first time we've seen this query in the file.
	$TopHit{$query}{'evalue'} = $evalue; ## Set the E value for this query
	$TopHit{$query}{'bitscore'}  = $bitscore; ## and bit score
	$TopHit{$query}{'uniref'} = $uniref; ## the uniref ID
	push(@Order, $query); ## record the order of queries in the file so when we report the output it's in the same order as the input. Dictionaries lose track of order.
    }
}
close($ufh);

## Initialize the %Assigned to the Top-Hit
foreach my $qry (keys %TopHit) {
    $Assigned{$qry}{'evalue'}   = $TopHit{$qry}{'evalue'};
    $Assigned{$qry}{'bitscore'} = $TopHit{$qry}{'bitscore'};
    $Assigned{$qry}{'uniref'}   = $TopHit{$qry}{'uniref'};
}

## Parse through the UniRef blast output one more time to get sequences within the cut-off
open(my $ufh2,'<',"$urbtab") || die "\n Cannot open the file: $urbtab\n";
while(<$ufh2>) {
    chomp;
    my @a = split(/\t/, $_); ## split line by tabs
    my $query = base_query($a[0]); ## get the query's base name
    my $subject = $a[1];
    $subject =~ s/UniRef100_//;
    my $evalue = $a[10];
    my $bitscore = $a[11];
    my $header = $a[-1];
    $Header{$query}{$subject} = $header;
    my $bitscore_cutoff = $cutoff * $TopHit{$query}{'bitscore'};
    if ($bitscore >= $bitscore_cutoff) { ## If the bit score here is within the top-bit score cut-off
        $Header{$query}{$subject} = $header;
    }
}

## Write the output file
open(my $ofh,'>',"$outfile") || die "\n Cannot write to: $outfile\n";
print $ofh join("\t", "#query", "evalue", "gene_name", "uniprot", "patric", "go", "pfam", "other_uniprots") . "\n";
foreach my $qry (@Order) { ## Going through each query in the order it came
    my @Results = parse_uniref($qry); ## return($assigned_gene, $assigned_urid, $patric_join, $go_join, $ur_join);
    my $pfam = "";
    if (exists $Interproscan{$qry}{"Pfam"}) { $pfam = $Interproscan{$qry}{"Pfam"}; }
    print $ofh join("\t", $qry, $Assigned{$qry}{'evalue'}, $Results[0], $Results[1], $Results[2], $Results[3], $pfam, $Results[4]) . "\n";
}
close($ofh);

exit 0;

sub base_query
{
    ## Input: a query sequence from the seqscreen pipeline, will have _unambig_ identifiers that we added, but want to remove
    ## Output: the "base" name of the query sequence
    my $s = $_[0];
    $s =~ s/_unambig_\d.*//; ## this _unambig_ tag is added to all query sequences during the unambiguous module
    return $s;
}

sub parse_uniref
{
    ## Input: A query ID that will be used to access the %TopHit and %Header dictionaries for header info
    ##        which contains the header of a UniRef sequence that a query hit. This header line
    ##        contains a lot of information that needs to be parsed.
    ## Example: UniRef100_A0A0B8PMK2 Glutaredoxin n=1 Tax=Vibrio ishigakensis TaxID=1481914 RepID=A0A0B8PMK2_9VIBR GO=GO:0009055;GO:0015035;GO:0045454;GO:0055114
    ## Output: The assigned gene name, assigned UniRef ID, PATRIC ID(s), GO ID(s), and other UniRef IDs
    my $qry = $_[0];
    my ($assigned_gene, $assigned_urid) = parse_tophit($qry);
    my %Patric;
    my %GO;
    my %URid;
    foreach my $subject (keys %{$Header{$qry}}) {
	my $h = $Header{$qry}{$subject};
	if ($h =~ m/GO=/) { ## if there are go terms in the header
	    my $go_string = $h;
	    $go_string =~ s/.*GO=//;
	    $go_string =~ s/ .*//;
	    my @G = split(/;/, $go_string); ## break the go_string into an array of GO ids by ';'
	    foreach my $g (@G) { $GO{$g}++; }
	}
	if ($h =~ m/PATRIC=/) { ## if there are PATRIC terms in the header
	    my $pat_string = $h;
	    $pat_string =~ s/.* PATRIC=//;
	    $Patric{$pat_string} = 1;
	}
	$URid{$subject}++;
    }
    my (@GO,@Patric,@URid); ## Initialize the database-specific arrays
    
    ## Check if there are any InterProScan GO IDs
    if (exists $Interproscan{$qry}{'GO'}) {
	my @goint = split(/\|/, $Interproscan{$qry}{'GO'});
	foreach my $i (@goint) {
	    $GO{$i}++; ## Add them to the dictionary
	}
    }
    
    ## Fill the db-specific arrays with the unique list of IDs
    foreach my $i (keys %GO)     { push(@GO, $i); }
    foreach my $i (keys %Patric) { push(@Patric, $i); }
    foreach my $i (keys %URid)   { push(@URid, $i); }

   # ## Fill @GO with the parental GO terms
   # if (1 && scalar(@GO) > 0) {
   # foreach my $g (@GO) {
   #     my @go_parents = get_parents($g);
   #     foreach my $k (@go_parents) { $GO{$k} = 1; }
   # }
   # @GO = (); ## Empty out the array for the new set of parental GO terms
   # foreach my $k (keys %GO) {
   #     unless ($k eq "root") {
   # 	push(@GO, $k);
   #     }
   # }
   # @GO = uniq(@GO); ## Make sure the set of GO terms in the array are unique
   # }

    my ($patric_join, $go_join, $ur_join) = ('','','');
    if (scalar(@Patric) > 0) { $patric_join = join(";", @Patric); }
    if (scalar(@GO) > 0) { $go_join = join(";", @GO); }
    if (scalar(@URid) > 0) { $ur_join = join(";", @URid); }
    return($assigned_gene, $assigned_urid, $patric_join, $go_join, $ur_join);
}

sub parse_tophit
{
    my $qry = $_[0];
    my ($gene,$urid) = ("","");
    if (exists $Header{$qry}{$Assigned{$qry}{'uniref'}}) {
	$gene = $Header{$qry}{$Assigned{$qry}{'uniref'}};
	$urid = $Header{$qry}{$Assigned{$qry}{'uniref'}};
	$urid =~ s/ .*//;
	$urid =~ s/^UniRef100_//;
	$gene =~ s/.*? //;
	$gene =~ s/ n=\d+ .*//;
    }
    else { die "\n Error: Cannot find the header information for this query's top-hit: $qry\n"; }
    return($gene,$urid);
}

sub get_parents
{
    my $g = $_[0];
    my $parent = 0;
    my @Results;
    push(@Results, $g);
    my @Hold;
    push(@Hold, $g);
    while (scalar(@Hold) > 0) {
        my $elements = scalar(@Hold);
        for (my $i=0; $i<$elements; $i++) {
            foreach my $p (@{$Rel{$Hold[$i]}}) {
                push(@Results, $p);
                push(@Hold, $p);
            }
        }
        for (my $i=0; $i<$elements; $i++) { shift(@Hold); }
    }
    @Results = uniq(@Results);
    return @Results;
}

sub uniq
{
    my @tmp = @_;
    my %T;
    my @uniq;
    foreach my $i (@tmp) {
        unless (exists $T{$i}) {
            push(@uniq, $i);
            $T{$i} = 1;
        }
    }
    return @uniq;
}
