assessProbis.pl

#!/usr/bin/perl -w
# Author: Abdullah Kahraman
# Date: 01.01.2000

###############################################################################
###############################################################################
### bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla         ###
###############################################################################
###############################################################################

use strict;
use warnings;
use Getopt::Long;

my (
    # variable for parameters which are read in from commandline
    $help,
    $colTargetId,
    $colRefId,
    $colTargetBs,
    $colRefBs,
    $selfHit,
   );

##############################################################################
### read all needed parameters from commandline ##############################

&GetOptions(
    "help!"          => \$help,          # print this help
    "refBsCol=i"     => \$colRefBs,      # column number of reference BS residue numbers. Starts with 0. 
    "targetBsCol=i"  => \$colTargetBs,   # column number of template BS residue numbers. Starts with 0. 
    "refIdCol=i"     => \$colRefId,      # column number of reference Id. Starts with 0. 
    "targetIdCol=i"  => \$colTargetId,   # column number of template Id. Starts with 0.
    "selfHit!"       => \$selfHit,       # check only for self hits, otherwise use distinct hits.
) or die "\nTry \"$0 -h\" for a complete list of options\n\n";

##############################################################################

# help
if ($help) {printHelp(); exit}

##############################################################################
### SETTINGS #################################################################
##############################################################################

##############################################################################
### SUBROUTINES ##############################################################
############################################################################## 

###############################################################################
sub printHelp {
###############################################################################
    # prints a help about the using and parameters of this scripts 
    # (execute if user types commandline parameter -h)
    # param:  no paramaters
    # return: no return value

    my (
	$usage,
	$sourceCode,
	@rows,
	$row,
	$option,
	$scriptInfo,
	$example,
       );

    $usage = "$0\n";


    print "\nUsage: " .  $usage . "\n";

    print "Valid options are:\n\n";
    open(MYSELF, "$0") or
      die "Cannot read source code file $0: $!\n";
    $sourceCode .= join "", <MYSELF>;
    close MYSELF;
    $sourceCode =~ s/^.+?\&GetOptions\(\n//s;
    $sourceCode =~ s/\n\).+$//s;
    @rows = split /\n/, $sourceCode;
    foreach $row (@rows){
        $option = $row;
	$option =~ s/\s+\"//g;
	$option =~ s/\"\s.+\#/\t\#/g;
	$option =~ s/=./\t<value> [required]/;
	$option =~ s/:./\t<value> [optional]/;
	$option =~ s/!/\t<non value> [optional]/;

	$row =~ s/^.*//;
	print "\t";
	printf("%-1s%-30s%-30s\n", "-",$option,$row);

    } # end of foreach $row (@rows)
    print "\n";
    print "Options may be abreviated, e.g. -h for --help\n\n";

    $example  = "$0";
}

##############################################################################
### END OF SUBROUTINES########################################################
############################################################################## 


############
### MAIN ###
############

if(!defined $colTargetBs or !defined $colRefBs or !defined $colTargetBs or !defined $colRefBs) {
    print STDERR "\n\tERROR: Parameter missing. Try $0 -help to get list of all options.\n\n";
    exit 0;
}

my %bsRef = ();
my %bsTarget = ();
my $n = 0;
my %n = ();
while(<>) {
    $n++;
    chomp($_);
    my @a = split(/\t/, $_);
    my $refId = $a[$colRefId];
    my $targetId = $a[$colTargetId];
    my $refBs = $a[$colRefBs];
    my $targetBs = $a[$colTargetBs];

    my @refBs    = split(/\,/, $refBs);
    my @targetBs = split(/\,/, $targetBs);
    
    my $p = 0;
    my $fn = 0;
    my $fp = 0;
    my ($rp, $rfn, $rfp);

    if($selfHit) {
	next if($refId ne $targetId);
    } else {
	next if($refId eq $targetId);
    }

    foreach my $refBsAA (@refBs) {
	if($targetBs =~ /\b$refBsAA\b/) {
	    $p++;
	} else {
	    $fn++;
	}
    }
    foreach my $targetBsAA (@targetBs) {
	next if($targetBsAA eq "-");
	if($refBs =~ /\b$targetBsAA\b/) {
	    $fp++;
	}
    }
    $rp = $p/@refBs;
    $rfn = $fn/@refBs;
    $rfp = $fp/@targetBs;

    printf("%s\t%i\t%.3f\t%i\t%.3f\t%i\t%.3f\n", $_, $p, $rp, $fn, $rfn, $fp, $rfp);    
}