#!/usr/bin/perl -w

###A Perl script to read a proteome or a set of proteins in the SwissProt format and predict prion domains (PrDs)
###Copyright (C) Vladimir Espinosa Angarica 2012
###
###This program 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 of the License, or
###(at your option) any later version.
###
###This program comes with absolutely NO WARRANTY
###
###Vladimir Espinosa Angarica
###Department of Biochemistry and Molecular and Cellular Biology
###University of Zaragoza
###Zaragoza 50009
###Espa–a
###vladimir@espinosa-angarica.com


####Setting the POSIX module to be used by the rounding functions (int, floor and ceil)
use POSIX;
use Getopt::Long;# Loading the Getopt module for handling command line options used by this program
use Pod::Usage;# Loading the POD module to handle HELP and MAN reports about the program
use warnings;#Loading all the libraries to run in a multithreading environment
use threads;
use threads::shared;

my $man = 0;# Setting to (false) the MAN display option
my $help = 0;# Setting to (false) the HELP display option
my $out_file_name = '';# Setting to (false) all the options of the options "mandatory" required by the program
my $dat_file = '';

# Necessary step to find out whether some command line options are actually passed to the program
# because the @ARGV is emptied when parsed by Getopt::Long!!!!
my @command_rescue = @ARGV;

## Parse options and print usage if there is a syntax error,
## or if usage was explicitly requested.
GetOptions(	"help|?" => \$help,
				"man" => \$man,
				"output-file=s" => \$out_file_name, 
				"seq-file=s" => \$dat_file) or pod2usage(2);
pod2usage(1) if $help;# To print the HELP message upon requestion (i.e condensed format)
pod2usage('-verbose' => 2) if $man;# to print the MAN message upon requiestion (i.e "verbose" format)

## If no arguments were given, then allow STDIN to be used only
## if it's not connected to a terminal (otherwise print usage)
pod2usage("$0: No files given.")  if ((@command_rescue == 0) && (-t STDIN));

#### Checking for the existence of the Sequence File to be used
die "Not a valid PATH to the Sequence file!!!!!\n" unless (-e "$dat_file");

#Hash containing the estimated propensities of each amino acid in prion domains
my %aa_scores = (
	'PrD' => {
		'A' => -0.568,
		'C' => -3.807,
		'D' => -1.507,
		'E' => -2.766,
		'F' => -0.478,
		'G' => 0.040,
		'H' => -0.131,
		'I' => -1.515,
		'K' => -1.883,
		'L' => -1.556,
		'M' => 0.170,
		'N' => 2.511,
		'P' => 0.227,
		'Q' => 2.044,
		'R' => -1.196,
		'S' => 0.733,
		'T' => -0.268,
		'V' => -1.716,
		'W' => -3.459,
		'Y' => 0.786,
		'O' => 0,
		'U' => 0,
		'B' => 0,
		'Z' => 0,
		'X' => 0,
	},
	'Core' => {
		'A' => -1.053,
		'C' => -3.807,
		'D' => -2.054,
		'E' => -3.766,
		'F' => -0.893,
		'G' => -0.219,
		'H' => -1.064,
		'I' => -1.737,
		'K' => -2.561,
		'L' => -2.352,
		'M' => 0.115,
		'N' => 2.959,
		'P' => -0.467,
		'Q' => 2.385,
		'R' => -1.322,
		'S' => 0.532,
		'T' => -0.921,
		'V' => -2.301,
		'W' => -3.459,
		'Y' => 1.025,
		'O' => 0,
		'U' => 0,
		'B' => 0,
		'Z' => 0,
		'X' => 0,
	}
);

#Log-odds for the bin formed between a pair of prolines in proteins
my %proline_pair_logodd = (
'0' =>  -5.009,
'1' =>  -5.002,
'2' =>  -5.173,
'3' =>  -5.366,
'4' =>  -5.566,
'5' =>  -5.735,
'6' =>  -5.880,
'7' =>  -6.015,
'8' =>  -6.144,
'9' =>  -6.206,
'10' => -6.313,
'11' => -6.419,
'12' => -6.503,
'13' => -6.576,
'14' => -6.663,
'15' => -6.757,
'16' => -6.833,
'17' => -6.898,
'18' => -6.976,
'19' => -7.066,
'20' => -7.136,
'21' => -7.242,
'22' => -7.300,
'23' => -7.379,
'24' => -7.485,
'25' => -7.570,
'26' => -7.643,
'27' => -7.676,
'28' => -7.788,
'29' => -7.862,
'30' => -7.933,
'31' => -8.019,
'32' => -8.090,
'33' => -8.137,
'34' => -8.226,
'35' => -8.330,
'36' => -8.403,
'37' => -8.482,
'38' => -8.568,
'39' => -8.637,
'40' => -8.701,
'41' => -8.778,
'42' => -8.864,
'43' => -8.932,
'44' => -8.999,
'45' => -9.086,
'46' => -9.180,
'47' => -9.238,
'48' => -9.307,
'49' => -9.350,
'50' => -9.434,
'51' => -9.500,
'52' => -9.575,
'53' => -9.637,
'54' => -9.733,
'55' => -9.784,
'56' => -9.848,
'57' => -9.919,
'58' => -10.003,
'59' => -10.062,
'60' => -10.132,
);

my $WINDOW = 60;
my $CUTOFF = 50;
my $CORES = 8;#Number of CPUs to be used to distribute the calculations. Edit this line according to your system architecture
my $PREDICTIONS_DIR = '.';# Predefined PATH to the OUTPUT files directory. Edit this if you prefer another directory instead the current working directory

my $predictions_file = $out_file_name;

open (PRED_FILE_FILTERED, ">$PREDICTIONS_DIR/$predictions_file") or die "Predictions file couldn't be opened for writing\n";

open (IN_FILE, "$dat_file") or die "Sequence file couldn't be opened for reading\n";

my $seq_id;
my $description;
my $organism;
my $sci_name;
my %sequences;

while (my $line = <IN_FILE>)
{
	chomp $line;
	if ($line =~ m/^ID\s+(\w+)\s+/)
	{
		$seq_id = $1;
		next;
	}
	elsif (($line =~ m/^DE\s+(.*)/) or ($line =~ m/^SQ\s+(.*)/))
	{
		$description .= $1;
		#$description =~ s/^RecName:\sFull=|^AltName:\sFull=|^SubName:\sFull=//;
	}
	elsif ($line =~ m/^OS\s+(.*)/)
	{
		#$organism = $organism . " $1" unless ($organism eq '');
		#$organism = $1;
		$organism .= $organism ? " $1" : $1;
		$sci_name = &os_name_cleaning ($organism);
	}
	elsif ($line =~ m/^\s+(.*)/)
	{
		my $id = '>' . $seq_id . '; ' . $description . "  [$sci_name]";
		$sequences{$id} .= $1;
		$sequences{$id} =~ s/\s//g;
	}
	elsif ($line =~ m/^\/\//)
	{
		$description = '';
		$organism = '';
		$sci_name = '';
	}
}
close (IN_FILE);

my @seq_ids = keys %sequences;
my $total_sequences = scalar @seq_ids;
my $fragment_size = int ($total_sequences / $CORES);
my @threads;
for my $i (0 .. ($CORES - 1))
{
	my @partial_array = splice (@seq_ids, 0, $fragment_size);
	my $t = threads->new(\&parse_proteome, \@partial_array);
	push(@threads,$t);
}
my $t = threads->new(\&parse_proteome, \@seq_ids);
push(@threads,$t);

my %cores;
my %organism_total_proteins;
foreach my $thread (@threads)
{
	my @pack = @{$thread->join};
	my %partial_results = %{$pack[0]};
	my %partial_organism_total_proteins = %{$pack[1]};
	
	while (my ($organism, $predictions_ref) = each (%partial_results))
	{
		$organism_total_proteins{$organism} += $partial_organism_total_proteins{$organism};
		my @predictions;
		while (my ($seq_id, $info_ref) = each (%{$predictions_ref}))
		{
			my $score = $info_ref->{'Score'};
			my $core = $info_ref->{'Seq'};
			my $window_pos = $info_ref->{'Window'};
			my $protein_id = $1 if ($seq_id =~ m/^>(\w+);/);
			
			push @predictions, "\t$protein_id\tWindow Position=$window_pos; Score=$score | Prion Domain: $core\n";
		}
		push @{$cores{$organism}}, @predictions;
	}
}

while (my ($organism, $predictions_ref) = each (%cores))
{
	my @predictions = @{$predictions_ref};
	my $proteins = $organism_total_proteins{$organism};
	
	my $total_predictions = scalar (@predictions);
	print PRED_FILE_FILTERED ">$organism: Total=$total_predictions\n@predictions\n";
}

close (PRED_FILE_FILTERED);


#A subroutine to move a window along a sequence and report a score relative to the prionogenicity of the stretch
sub parse_proteome
{
	my $ids = shift; 
	my @identifiers = @{$ids};
	
	my %cores;
	my %organism_total_proteins;
	
	foreach my $seq_id (@identifiers)
	{
		my $seq = $sequences{$seq_id};
		next unless (length ($seq) >= $WINDOW);
		
		my $organism = &get_organism($seq_id);
		$organism_total_proteins{"$organism"}++;
		
		my %results;
		for my $i (0 .. (length ($seq) - $WINDOW))
		{
			my $domain = substr ($seq, $i, $WINDOW);
			my @domain = split (//, $domain);

			my $prolines = $domain;
			$prolines =~ s/[^P]/-/g;
			@prolines_number = $prolines =~ m/[P]/g;

			my $domain_score = 0;
			foreach my $aa (@domain)
			{
				$domain_score += $aa_scores{'PrD'}{$aa};
			}
		
			my $correction_factor = 0;
			my $corrected_score;
			if (scalar @prolines_number >= 2)
			{
				my @positions;
				while ($prolines =~ m/[P]/g)
				{
					$position = pos($prolines);
					push @positions, $position;
				}
				
				for my $i (0 .. ($#positions - 1))
				{
					my $pos_1 = $positions[$i];
					my $pos_2 = $positions[$i + 1];
					my $dist = $pos_2 - $pos_1;
					$correction_factor += $proline_pair_logodd{$dist};
				}
				$corrected_score = sprintf ("%.3f", ($domain_score + $correction_factor));
			}
			else
			{
				$corrected_score = sprintf ("%.3f", $domain_score);
			}

			if (exists ($results{$seq_id}))
			{
				$results{$seq_id} = {
					'Score' => $corrected_score,
					'Seq' => $domain,
					'Window' => $i,
				} if ($corrected_score > $results{$seq_id}{'Score'});
			}
			else
			{
				$results{$seq_id} = {
					'Score' => $corrected_score,
					'Seq' => $domain,
					'Window' => $i,
				};
			}
		}
		$cores{$organism}{$seq_id} = $results{$seq_id} if ($results{$seq_id}{'Score'} >= $CUTOFF);
	}
	my @pack = (\%cores, \%organism_total_proteins);
	return \@pack;
}

#A subroutine to format the organism name as extracted from a SwissProt files as distributed in Uniprot
sub os_name_cleaning
{
	my $osline = shift;
	
	my($sub_species, $species, $common, $variant, $sci_name, $descr);
	if ($osline =~ s/(,|, and|\.)$//)
	{
		# OS lines are usually like:
		# Homo sapiens (human)
		# where we have $sci_name followed by $descr (common name) in
		# brackets, but we can also have:
		# Venerupis (Ruditapes) philippinarum
		# where we have brackets but they don't indicate a $descr
		if ($osline =~ /[^\(\)]+\(.+\)[^\(\)]+$/)
		{
			 #*** Danger! no idea if this will pick up some syntaxes for
		 	# 	common names as well)
		 	$sci_name = $osline;
		 	$sci_name =~ s/\.$//;
		 	$descr = '';
		}
		else
		{
			($sci_name, $descr) = $osline =~ /(\S[^\(]+)(.*)/;
		}
		$sci_name =~ s/\s+$//;
	}
	return $sci_name;
}

#A subroutine to extract the organism name
sub get_organism
{
	my $line = shift;
	
	my $seq_id;
	my $function;
	my $organism;
	
	if ($line =~ m/^>(\w+);\sRecName: Full=(.+);SEQUENCE.*\[(.*)\]$/)
	{
		$seq_id = $1;
		$function = $2;	
		$organism = $3;
	}
	elsif ($line =~ m/^>(\w+);\sRecName: Full=(.+);AltName.*\[(.*)\]$/)
   {
   	$seq_id = $1;
   	$function = $2;
   	$organism = $3;
   }
	elsif ($line =~ m/^>(\w+);\sSubName: Full=(.+);SEQUENCE.*\[(.*)\]$/)
	{
		$seq_id = $1;
		$function = $2;
		$organism = $3;
	}
	elsif ($line =~ m/^>(\w+);\sSubName: Full=(.+);AltName.*\[(.*)\]$/)
	{
		$seq_id = $1;
		$function = $2;
		$organism = $3;
	}
	
	return ($organism);
}

__END__

=head1 NAME

prion_parse_proteome.pl - A Perl Script originally designed to read proteome files distributed in the SwissProt format
in the Uniprot Knowledgebase and scan all the proteins in the search for putative prionogenic domains (PrD)

=head1 SYNOPSIS

prion_parse_proteome.pl [I<OPTIONS>]

This script is designed to be run in a UNIX/Linux environment and require the previous installation of a group of libraries
such as: Getopt::Long, Pod::Usage, warnings, threads and threads::shared. Please satisfy this dependencies on your system prior
to running the program. The program is set to run on a multithreading environment, distributing the load along the number of
CPUs available on the working machine, so please edit the number of CPUs on the variable $CORES to take full advantage of this.
The program simply read the Sequence file and then performed the scanning of all the sequences and filter the domains by taking
into account a CUTOFF for the score of the stretches. For more description regarding this CUTOFF you can read the accompanying
paper:

Angarica, V.E., Ventura, S. and Sancho, J. (2013). Discovering putative prion sequences in complete proteomes using probabilistic representations of Q/N-rich domains. BMC Genomics

Please also read the paper that inspired this work:

Alberti S, Halfmann R, King O, Kapila A, Lindquist S: A systematic survey identifies prions and illuminates sequence features of prionogenic proteins. Cell 2009, 137(1):146-158.

FOR HELP USING THIS PROGRAM PLEASE TRY: ./prion_parse_proteome.pl --help

FOR A COMPLETE DESCRIPTION OF THE PROGRAM TRY: ./prion_parse_proteome.pl --man

=head1 OPTIONS

=over 3

=item B<-help>:

	Print a brief help message and exits (CONDITIONAL).

=item B<-man>:

	Prints the manual page and exits (CONDITIONAL).

=item B<-output-file>:

	Name of the file where results are going to be printed (MANDATORY).

=item B<-seq-file>:

	PATH to the Sequence file for the proteome or protein dataset (MANDATORY).

=back

=head1 DESCRIPTION


This program takes two mandatory arguments from the command line (i.e. the PATH to the Sequence (or proteome) file in Swissprot Format and the name of the file to store the output of the program).
So a common way of using this program would be as follows:

=over 3

=item B<Example>:

	./prion_parse_proteome.pl --output-file=predictions.dat --seq-file=proteome.dat

=back


=head1 AUTHOR

Vladimir Espinosa Angarica: 2012. University of Zaragoza, Spain

=cut