#!/usr/bin/env perl
#pk

##########################################################################################
#	  This file is part of proteinortho.
#	  (C) 2009 Marcus Lechner
# 
#	  proteinortho is free software; you can redistribute it and/or modify
#	  it under the terms of the GNU General Public License as published
#	  by the Free Software Foundation; either version 2, or (at your
#	  option) any later version.
#
#	  proteinortho is distributed in the hope that it will be useful, but
#	  WITHOUT ANY WARRANTY; without even the implied warranty of
#	  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#	  General Public License for more details.
#
#	  You should have received a copy of the GNU General Public License
#	  along with proteinortho; see the file COPYING.  If not, write to the
#	  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#	  Boston, MA 02111-1307, USA.	
##########################################################################################

##########################################################################################
# About
##########################################################################################
# 
# @author Paul Klemm
# @email klemmp@staff.uni-marburg.de
# @company Bioinformatics, University of Leipzig
# @version 3 (proteinortho v6.1.1)
# @date 12-09-2022
#
##########################################################################################

use POSIX;

my $usage = "
proteinortho_summary.pl        produces a summary on species level.
 
SYNOPSIS
 
proteinortho_summary.pl (options) GRAPH (GRAPH2)

	GRAPH	Path to the *.proteinortho-graph or *.blast-graph file generated by proteinortho. 
	GRAPH2	(optional) If you provide a blast-graph AND a proteinortho-graph, the difference is calculated (GRAPH - GRAPH2)

	Note: The *.proteinortho.tsv will be picked up if available (but use the proteinortho-graph file as input)

	OPTIONS

		-format,-f	enables the table formatting instead of the plain csv output.

";

my $graphfilenameA="";
my $pofilenameA="";
my $graphfilenameB="";
my $notableformat=1;

for(my $v = 0 ; $v < scalar @ARGV ; $v++){
	if($ARGV[$v] =~ m/^--?(help|h)$/){$help=1;}
	elsif($ARGV[$v] =~ m/^--?(format|f)$/){$notableformat=0;}
	elsif($ARGV[$v] =~ m/^-.+/){ print $usage; print STDERR "ERROR: invalid option ".$ARGV[$v]."!\n\n";exit(1);}
	elsif($graphfilenameA eq ""){$graphfilenameA = $ARGV[$v];}
	elsif($graphfilenameB eq ""){$graphfilenameB = $ARGV[$v];}
}

if ($help){
    print $usage;
    exit(0);
}
my $fail="";
if ($graphfilenameA eq ""){
    $fail.="ERROR: GRAPH not provided!\n";
}
if($fail ne ""){
	print $usage.$fail;
	exit(1);
}
our $maxNumOfCharsInOneLine=`tput cols`;
chomp($maxNumOfCharsInOneLine);
if($maxNumOfCharsInOneLine<10){$maxNumOfCharsInOneLine=160;}
our $split_delim="[:\t]";
our @spl_header;
our @spl;
our $last_isHeaderLine=0;
our $last_isHeaderLine=0;$isHeaderLine=1;
our $noheader=0;

my %species_matrix;
my %species_matrix_pow2;
my $currentSpeciesA;
my $currentSpeciesB;

$pofilenameA=$graphfilenameA;
$pofilenameA=~s/-graph$/.tsv/;
if(-e $pofilenameA){
	open(my $FH,"<",$pofilenameA) || die $!;
	my %poStatA = ("num_groups"=>0,"core_groups"=>0,"core_groups_genesum"=>0,"core_groups_connsum"=>0,
					"p1_groups"=>0,"p1_genes"=>0,"p1_species"=>0,"p1_conn"=>0,
					"p0.8_groups"=>0,"p0.8_genes"=>0,"p0.8_species"=>0,"p0.8_conn"=>0,
					"p0.5_groups"=>0,"p0.5_genes"=>0,"p0.5_species"=>0,"p0.5_conn"=>0,
					"p0.2_groups"=>0,"p0.2_genes"=>0,"p0.2_species"=>0,"p0.2_conn"=>0,
					"p0.1_groups"=>0,"p0.1_genes"=>0,"p0.1_species"=>0,"p0.1_conn"=>0,
					"p0_groups"=>0,"p0_genes"=>0,"p0_species"=>0,"p0_conn"=>0,
					"single_groups"=>0,"single_genes"=>0,"single_species"=>1,"single_conn"=>0
				);

	my $species2groupnum;

	my $num_species=0;
	my @header_species;
	while(<$FH>){
		chomp;
		my @arr=split("\t",$_);
		if(scalar @arr >3){
			if($_ =~ /^#/){
				@header_species = @arr[3..$#arr];
				next;
			}
			$num_species = (scalar @arr) -3;

			for (my $i = 0; $i < $num_species; $i++) {
				if(!exists $species2groupnum{$header_species[$i]}){$species2groupnum{$header_species[$i]}=0;}
				if($arr[$i+3] ne "*"){
					$species2groupnum{$header_species[$i]}++;
				}
			}

			foreach my $p (0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1) {
				if(int($arr[0]) >= int($p*$num_species)){
					$poStatA{"p${p}_groups"}++;
					$poStatA{"p${p}_genes"}+=$arr[1];
					$poStatA{"p${p}_conn"}+=$arr[2];
					$poStatA{"p${p}_species"}=int($p*$num_species);
				}
			}
			if(int($arr[0])==1){
				$poStatA{"single_groups"}++;
				$poStatA{"single_genes"}+=$arr[1];
				$poStatA{"single_conn"}+=$arr[2];
				$poStatA{"single_species"}=$num_species;
			}
		}
	}
	close($FH);

	print "# $pofilenameA statistics:\n";
	print "# number of groups that contains at least p\% species:\n";
	print "# p\tspecies\tgroups\tgenes in groups\n";

	my $last_species=-1;
	foreach my $p (0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1) {
		if($poStatA{"p${p}_species"} == $last_species){next}
		$last_species=int($p*$num_species);
		print "".($p*100)."\%\t".int($p*$num_species)."\t".
			(!exists $poStatA{"p${p}_groups"} ? 0 : $poStatA{"p${p}_groups"})." (".($poStatA{"p0_groups"}>0?int(($poStatA{"p${p}_groups"}/$poStatA{"p0_groups"})*10000)/100:"-")."\%)"."\t".
			(!exists $poStatA{"p${p}_genes"} ? 0 : $poStatA{"p${p}_genes"})." (".($poStatA{"p0_genes"}>0?int(($poStatA{"p${p}_genes"}/$poStatA{"p0_genes"})*10000)/100:"-")."\%)"."\t".
			#(!exists $poStatA{"p${p}_conn"} || $poStatA{"p${p}_groups"}==0 ? "-" : $poStatA{"p${p}_conn"}/$poStatA{"p0_groups"}).
			"\n";
	}

	print "# NOTE: p=100\% correspond to the core proteome and p=0\% to all groups\n";
	if($poStatA{"single_groups"}>0){
		print "# groups that contains only one species:\n";
		print "single\t".
			($poStatA{"single_species"})."\t".
			($poStatA{"single_groups"})." (".($poStatA{"p0_groups"}>0?int(($poStatA{"single_groups"}/$poStatA{"p0_groups"})*10000)/100:"-")."\%)"."\t".
			($poStatA{"single_genes"})." (".($poStatA{"p0_genes"}>0?int(($poStatA{"single_genes"}/$poStatA{"p0_genes"})*10000)/100:"-")."\%)"."\t".
			#(!exists $poStatA{"single_conn"} || $poStatA{"single_groups"}==0 ? "-" : $poStatA{"single_conn"}/$poStatA{"p0_groups"}).
			"\n";
	}

	print "# number of groups for each input species:\n";
	my @sortkeys = sort {($species2groupnum{$b} <=> $species2groupnum{$a}) || ($a cmp $b)} keys %species2groupnum;
	if(scalar @sortkeys > 10){ @sortkeys = (@sortkeys[0..4],"...",@sortkeys[ ($#sortkeys - 4) .. $#sortkeys ]) }
	foreach my $k (@sortkeys){
		if($k eq "..."){ print "...\n"; next; }
		print "$k\t".$species2groupnum{$k}."\t".($poStatA{"p0_groups"}>0?int(($species2groupnum{$k}/$poStatA{"p0_groups"})*10000)/100:"-")."\%\n";
	}

	print "\n# ----------------------------------\n# graph file statistics:\n";
}

open(my $FH,"<",$graphfilenameA) || die $!;
while(<$FH>){
	chomp;
	if($_ eq " *"){next;}
	if($_ eq "# file_a	file_b" || $_ =~ m/^# a	b/){next;}
	my @arr=split("\t",$_);
	if(substr($_,0,1) eq "#" && scalar @arr == 2){
		$currentSpeciesA=$arr[0];
		$currentSpeciesB=$arr[1];
		$currentSpeciesA=~s/^# ?//g;
	}elsif(substr($_,0,1) ne "#" && (scalar @arr == 6 || scalar @arr == 8) ){
		if(!exists $species_matrix{$currentSpeciesA}{$currentSpeciesB}){
			$species_matrix{$currentSpeciesA}{$currentSpeciesB} = 1;
			$species_matrix{$currentSpeciesB}{$currentSpeciesA} = 1;
			$species_matrix_pow2{$currentSpeciesA}{$currentSpeciesB} = 0;
			$species_matrix_pow2{$currentSpeciesB}{$currentSpeciesA} = 0;
		}else{
			$species_matrix{$currentSpeciesA}{$currentSpeciesB} ++;
			$species_matrix{$currentSpeciesB}{$currentSpeciesA} ++;
		}
	}elsif( !(substr($_,0,1) eq "#" && scalar @arr == 4) ){
		print STDERR "[STDERR] Error: wrong fromat...'$_' Please make sure you only provide *.blast-graph or *.proteinortho-graph files as input...\n";die;
	}
}
close($FH);

if($graphfilenameB ne ""){
	open(my $FH,"<",$graphfilenameB) || die $!;
	while(<$FH>){
		if($_ eq ""){next;}
		chomp;
		my @arr=split("\t",$_);
		if(substr($_,0,1) eq "#" && scalar @arr == 2){
			$currentSpeciesA=$arr[0];
			$currentSpeciesB=$arr[1];
			$currentSpeciesA=~s/^# ?//g;
		}elsif(substr($_,0,1) ne "#"){
			if(!exists $species_matrix{$currentSpeciesA}{$currentSpeciesB}){
				$species_matrix{$currentSpeciesA}{$currentSpeciesB} = 1;
				$species_matrix{$currentSpeciesB}{$currentSpeciesA} = 1;
				$species_matrix_pow2{$currentSpeciesA}{$currentSpeciesB} = 0;
				$species_matrix_pow2{$currentSpeciesB}{$currentSpeciesA} = 0;
			}else{
				$species_matrix{$currentSpeciesA}{$currentSpeciesB} --;
				$species_matrix{$currentSpeciesB}{$currentSpeciesA} --;
			}
		}
	}
	close($FH);
}

my @keys=sort keys %species_matrix;

$noheader=0;$last_isHeaderLine=0;$isHeaderLine=1;@spl_header=();@spl=();

print "\n";
my $ret= "# The adjacency matrix, the number of edges between 2 species\n";
processLine($ret);
$ret= "# file\t";

for(my $i = 0 ; $i < scalar @keys; $i++){
	if(scalar @keys>10 && !$notableformat){$ret.= "($i)\t";}
	else{$ret.=$keys[$i]."\t";}
}
$ret.= "\n";
processLine($ret);
for(my $i = 0 ; $i < scalar @keys; $i++){
	if(scalar @keys >10 && !$notableformat){
		$ret=$keys[$i]."($i)\t";
	}else{
		$ret=$keys[$i]."\t";
	}
	for(my $j = 0 ; $j < scalar @keys; $j++){
		if($i==$j){$species_matrix{$keys[$i]}{$keys[$j]}=0;}
		$ret.= $species_matrix{$keys[$i]}{$keys[$j]};
		if($j<scalar @keys -1){$ret.="\t";}
	}
	$ret.= "\n";
	processLine($ret);
}

$noheader=0;$last_isHeaderLine=0;$isHeaderLine=1;@spl_header=();@spl=();
$maxNumOfCharsInOneLine=`tput cols`;
chomp($maxNumOfCharsInOneLine);$maxNumOfCharsInOneLine/=2;
if($maxNumOfCharsInOneLine<10){$maxNumOfCharsInOneLine=160;}

print "\n";
$ret= "# file\taverage number of edges\n";
processLine($ret);
for(my $i = 0 ; $i < scalar @keys; $i++){
	$ret= $keys[$i]."\t";
	my $sum=0;
	for(my $j = 0 ; $j < scalar @keys; $j++){
		$sum+=$species_matrix{$keys[$i]}{$keys[$j]};
	}
	$ret.= $sum/scalar @keys;
	if($j<scalar @keys -1){$ret.= "\t";}
	$ret.= "\n";
	processLine($ret);
}

$noheader=0;$last_isHeaderLine=0;$isHeaderLine=1;@spl_header=();@spl=();
$maxNumOfCharsInOneLine=`tput cols`;
chomp($maxNumOfCharsInOneLine);
if($maxNumOfCharsInOneLine<10){$maxNumOfCharsInOneLine=160;}

print "\n";
$ret= "# The 2-path matrix, the number of paths between 2 species of length 2\n";
processLine($ret);
$ret= "# file\t";
for(my $i = 0 ; $i < scalar @keys; $i++){
	if(scalar @keys>10 && !$notableformat){$ret.= "($i)\t";}
	else{$ret.=$keys[$i]."\t";}
}
$ret.= "\n";
processLine($ret);
for(my $i = 0 ; $i < scalar @keys; $i++){
	$ret= $keys[$i]."($i)\t";
	for(my $j = 0 ; $j < scalar @keys; $j++){
		if($i<$i+1){
			for(my $k = 0 ; $k < scalar @keys; $k++){
				$species_matrix_pow2{$keys[$i]}{$keys[$j]}+=$species_matrix{$keys[$i]}{$keys[$k]}*$species_matrix{$keys[$k]}{$keys[$j]};
				$species_matrix_pow2{$keys[$j]}{$keys[$i]}=$species_matrix_pow2{$keys[$i]}{$keys[$j]};
			}
		}
		$ret.= $species_matrix_pow2{$keys[$i]}{$keys[$j]};
		if($j<scalar @keys -1){$ret.= "\t";}
	}
	$ret.= "\n";
	processLine($ret);
}

$noheader=0;$last_isHeaderLine=0;$isHeaderLine=1;@spl_header=();@spl=();
$maxNumOfCharsInOneLine=`tput cols`;
chomp($maxNumOfCharsInOneLine);$maxNumOfCharsInOneLine/=2;
if($maxNumOfCharsInOneLine<10){$maxNumOfCharsInOneLine=160;}

print "\n";
processLine("# file\taverage number of 2-paths\n");
for(my $i = 0 ; $i < scalar @keys; $i++){
	
	my $sum=0;
	for(my $j = 0 ; $j < scalar @keys; $j++){
		$sum+=$species_matrix_pow2{$keys[$i]}{$keys[$j]};
	}
	processLine($keys[$i]."($i)\t".($sum/scalar @keys)."\n");
}



sub processLine{
	$_=shift;chomp;
	if($notableformat == 1){print "$_\n";return 1;}
	
	if(length($_)<1){return 1;}

	@spl=split($split_delim,$_);
	
	if(scalar @spl <2){print "$_\n";return 1;}

	@spl_backup=@spl;

	if(scalar @spl_header > 0 && scalar @spl != scalar @spl_header){$isHeaderLine=1;}
	if(scalar @spl < 2 ){return 1;}
	if(substr($spl[0],0,1) eq "#"){$spl[0]=~s/^# ?//g;}
	if(scalar(@spl)*2-1>$maxNumOfCharsInOneLine){$maxNumOfCharsInOneLine= -1+2*scalar @spl;print STDERR "Corrected minimum table width: -w=$maxNumOfCharsInOneLine such that at least 1 character per column is displayed.\n";}

	$sumOfCharsLine=length(join("",@spl));

	if($isHeaderLine){ # is a header row 
		while(($sumOfCharsLine + scalar @spl-1) > $maxNumOfCharsInOneLine){ # shave of chars from widest cell
			$max_l=0;
			@max_l_is;
			for (my $i = 0; $i < scalar @spl; $i++) {
				if($max_l < length $spl[$i]){$max_l=length $spl[$i];@max_l_is=();push(@max_l_is,$i)}elsif($max_l == length $spl[$i]){push(@max_l_is,$i)}
			}
			for (my $i = 0; $i < scalar @max_l_is; $i++) {
				if(length $spl[$max_l_is[$i]] > 8 && substr($spl[$max_l_is[$i]],-3) ne "..." ){
					$spl[$max_l_is[$i]]=substr($spl[$max_l_is[$i]],0,length($spl[$max_l_is[$i]])-3-1)."..."
				}
				else{
					$spl[$max_l_is[$i]]=substr($spl_backup[$max_l_is[$i]],0,length($spl[$max_l_is[$i]])-1)
				}
			}
			$sumOfCharsLine=length(join("",@spl));
		}


		while(($sumOfCharsLine + scalar @spl-1) < $maxNumOfCharsInOneLine ){ # add of chars to smallest cell
			$min_l=$maxNumOfCharsInOneLine*10;
			@min_l_is;
			for (my $i = 0; $i < scalar @spl; $i++) {
				if($min_l > length $spl[$i]){$min_l=length $spl[$i];@min_l_is=();push(@min_l_is,$i)}
			}
			for (my $i = 0; $i < scalar @min_l_is; $i++) {

				$leftPad=0;
				$rightPad=0;
				if($spl[$min_l_is[$i]]=~m/( +)$/){$rightPad=length $1}
				if($spl[$min_l_is[$i]]=~m/^( +)/){$leftPad=length $1}

				if( $leftPad < $rightPad ){
					$spl[$min_l_is[$i]]=" ".$spl[$min_l_is[$i]];
				}else{
					$spl[$min_l_is[$i]]=$spl[$min_l_is[$i]]." ";
				}
				
			}
			$sumOfCharsLine=length(join("",@spl));
		}

		@spl_header=@spl;

	}else{ # is not headerline -> do the same as in headerline
		
		while(scalar @spl > scalar @spl_header){pop @spl;}

		for (my $i = 0; $i < scalar @spl; $i++) {
			while(length $spl[$i]< length $spl_header[$i]){ # add pads
				$leftPad=0;
				$rightPad=0;
				if($spl[$i]=~m/( +)$/){$rightPad=length $1}
				if($spl[$i]=~m/^( +)/){$leftPad=length $1}

				if( $leftPad < $rightPad ){
					$spl[$i]=" ".$spl[$i];
				}else{
					$spl[$i]=$spl[$i]." ";
				}
			}
			while(length $spl[$i]>length $spl_header[$i]){ # trim
				if(length $spl[$i] > 5 && substr($spl[$i],-3) ne "..." ){
					$spl[$i]=substr($spl[$i],0,length($spl[$i])-3-1)."..."
				}
				else{
					$spl[$i]=substr($spl_backup[$i],0,length($spl[$i])-2)."#"
				}
			}
		}
	}

	if($isHeaderLine && !$last_isHeaderLine ){$tmp=join("|",@spl);$tmp=~s/\|/+/g;$tmp=~s/[^+]/-/g; print "$tmp\n";}
	print join("|",@spl);
	if($isHeaderLine ){print "\n";$tmp=join("|",@spl);$tmp=~s/\|/+/g;$tmp=~s/[^+]/-/g; print "$tmp";}
	print "\n";
	$last_isHeaderLine=$isHeaderLine;
	$isHeaderLine=0;


}

