calculate TajimaD in perl

#!/usr/bin/perl
use strict;
use warnings;
=pod
---------------------------------------
this perl script is used to compute tajima's D

Former of tajimaD.tmp.txt is :
chr position #sampled #derived
1 256 12 18
1 12124 14 16

Former of vcf is normal vcf.

Former of population:
accession1
accession2
...

----------------------------------------
=cut

die "\nUsage: compute tajima's D;\ncomands:\nperl $0 vcf.file population tajima.out\n\n" if (@ARGV != 3);

my $snpfile = shift();
my $pop=shift();
my $tajima_outfile = shift();

my $tempfile="tajimaD.tmp.txt";
my $sample = &INPUT($snpfile,$pop,$tempfile);

open AA, $tempfile or die $!;
open BB, ">$tajima_outfile" or die $!;

my $window = 10000;#window site 10 kb
my $bin = 1; # how long two windows is overlapped, 1 means no overlap, 0.8 means 20% is overlap which means 2 kb overlapped with 10 kb window size.
my $cout = int ( 1 / $bin ); #
my $step = $window * $bin; #step size, the step is equal to window size that means no overlap between adjacent windows

#my $sample = 0;
my %filter = ();
my %pi = ();
my %snp = ();

my $chr_name;
my $chrlen = 0;
while ( <AA> ) {
chomp;
my @tt = split;
my @line = @tt;
$chr_name = $line[0];
$chrlen = $tt[1];
# $sample = ($tt[2]+$tt[3]) / 2;
my $k = int ( $tt[1] / $step );
$filter{$k} ++;
$pi{$k} += &pi ( $line[2], $line[3] );
if ( ($line[2]*$line[3]) != 0 ) { $snp{$k}++; }
}
close AA;

print BB "chrname\tposition\tpi\ttajima's.D\tsum.snp\tfilter.site\n";

my $window_num = int ( $chrlen / $step ); #the number of steps
for ( my $i=0; $i<=($window_num-$cout); $i++ ) {
my $sum_pi = 0;
my $sum_snp = 0;
my $filter_site = 0;

my $end = $i + $cout - 1;
for ( my $aa=$i; $aa<=$end; $aa++ ){

if ( !defined($pi{$aa}) ) { $pi{$aa} = 0; }
if ( !defined($snp{$aa}) ) { $snp{$aa} = 0; }
if ( !defined($filter{$aa}) ) { $filter{$aa} = 0; }

$sum_pi += $pi{$aa};
$sum_snp += $snp{$aa};
$filter_site += $filter{$aa};
}

next if ($sample<=1);
my $d = &tajima( $sample, $sum_pi, $sum_snp );
my $id = ($i + 1) * $step;
# my $mean_pi = 0;
my $theta = 0;
# if ( $filter_site ) { $mean_pi = $sum_pi / $filter_site; }
$theta = $sum_pi /$window;
print BB "$chr_name\t$id\t$theta\t$d\t$sum_snp\t$filter_site\n";
}
close BB;
`rm $tempfile`;
sub pi {
my $a = $_[0];
my $b = $_[1];
if ( $a == 0 || $b == 0 ) { return 0; }
my $pi = ( 2 * $a * $b ) / ( ($a+$b) * ($a+$b-1) );
return $pi;
}

sub tajima {
my $n = $_[0];
my $pi = $_[1];
my $t = $_[2];
my $a1;
my $a2;
for ( my $i=1; $i<$n; $i++ ){
$a1 += (1 / $i);
$a2 += (1 / ($i*$i));
}
my $b1 = ($n + 1) / ( 3 * ($n-1) );
my $b2 = 2 * ($n*$n + $n + 3) / (9 * $n * ($n-1));
my $c1 = $b1 - (1 / $a1);
my $c2 = $b2 - ($n + 2) / ($a1 * $n) + $a2 / ($a1*$a1);
my $e1 = $c1 / $a1;
my $e2 = $c2 / ($a1*$a1 + $a2);
if ( $t == 0) { return "NA"; next; }
my $d = ( $pi - ($t/$a1) ) / sqrt ( $e1 * $t + $e2 * $t * ($t-1) );

return $d;
}

sub INPUT{
my $chr=$_[0];
my $pop=$_[1];
my $out=$_[2];
open POP,"$pop";
my %id=();
while(<POP>){
chomp;
my @line=split;
$id{$line[0]}="";
}
close POP;

my $materialnumber=0;
open IN, "$chr";
my %all=();
$all{0}=0;$all{1}=0;
my @array=();
open OUT,">$out";
while(<IN>){
chomp;
if ($_=~/^##/){
}elsif($_=~/^#CHROM/){
my @head=split;
for my $nb (0..$#head){
if(defined $id{$head[$nb]}){
print "$head[$nb]\t$nb\n";
push @array,$nb;
}
}
my $stat=@array;
$materialnumber=$stat;
print "\nTotal material number is: $stat\n\n";
}else{
my @hd=split;
for my $acc (@array){
if($hd[$acc]=~/(\d)\/(\d)/){
$all{$1}++;
$all{$2}++;
}
}
print OUT "$hd[0]\t$hd[1]\t$all{0}\t$all{1}\n";
$all{0}=0;$all{1}=0;
}
}
close IN;
close OUT;

return($materialnumber);
}