#!/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);
}

calculate TajimaD in perl的更多相关文章

  1. perl实现监控linux

    1.使用root用户telnet进入linux系统 2.修改DNS以下两种方法 A.通过setup命令配置dns B.通过在/etc目录下创建resolv.conf文件 3.查看DNS是否配置成功 [ ...

  2. 精通Perl(第2版)

    精通Perl(第2版)(通往Perl大师之路必读经典书籍,体现了一种编程思维,能够帮你解决很多实际的问题) [美]brian d foy(布瑞恩·D·福瓦)著   王兴宇 刘宸宇 译 ISBN 978 ...

  3. perl

    introduction: http://www.yiibai.com/perl/perl_introduction.html functions: http://www.yiibai.com/per ...

  4. perl学习之路3

    Perl编程之路3 标签: perl 列表与数组   Perl里面代表复数的就是列表和数组 列表(list)指的是标量的有序集合, 而数组(array)则是存储列表的变量. 在Perl这两个属于尝尝混 ...

  5. perl学习之路2

    这些主要是从 "小骆驼" 书上粘贴或者摘抄出来的, 个人认为需要记的语法知识 "在某些情况下, 你可能需要在一台机器上写程序, 再传送到另一台机器上运行.这时候, 请使用 ...

  6. perl学习之路1

    一切要从Hollo world开始 公司要用perl....啊, 不会只能自学了, 毕竟是公司啊, 不是学校...公司不学习就滚蛋了...惨惨惨 因为是学习嘛, 感觉开虚拟机比较麻烦所以直接用了个 瘟 ...

  7. perl 切换 dnspod 域名记录

    提供域名,dnspod 账户密码(毕竟dns密码比较重要 不能谁 cat一下都可以看到 需要base64加密),原IP,切换目标IP, #!/bin/perl use warnings; use MI ...

  8. perl 删除过期文件

    #!/usr/bin/perl `find /bak/ >list.txt`; open LIST,"/root/list.txt"; while (<LIST> ...

  9. 通过远程 http API 来控制 lnmp 环境的重启perl脚本

    #!/usr/bin/perl use DBD::mysql; use strict; use warnings; use DBI; use utf8; binmode(STDOUT, ':encod ...

随机推荐

  1. mycat环境搭建

    最近工作中突然让搞mycat,特意私下在家先搞一套练个手: 1.先下载一个CentOS7 mini版本就可以(本人机器性能有限): 2.使用VMware创建虚拟机,过程百度下一大堆,这里不做详细介绍. ...

  2. vue中computed、metfods、watch的区别

    一.computed和methods 我们可以将同一函数定义为一个 method 或者一个计算属性.对于最终的结果,两种方式确实是相同的. 不同的是computed计算属性是基于它们的依赖进行缓存的. ...

  3. Day5_Py模块_1

    1. time & datetime模块 ----------------------------------------------------------- >>> im ...

  4. LVS初始使用步骤

    LVS是Linux Virtual Server的简称,也就是Linux虚拟服务器, 是一个由章文嵩博士发起的自由软件项目,它的官方站点是www.linuxvirtualserver.org. 现在L ...

  5. 19_04_19校内训练[Game]

    题意 给出n,等概率地生成一个1~n的数列.现在有n个人从左到右站成一排,每个人拿有当前数列位置上的数字,并且一开始都不知道数字是多少(但知道n是多少).从左到右让每个人进行如下选择: 1.选择保留自 ...

  6. Ehlib 学习

    似乎是为了垂直滚动条 SumList.Active := True; SumList.VirtualRecords := True; TDBGridEh 设计时 It is useful to use ...

  7. 不使用接口的 limit 控制分页的容量

    1.html中v-for 此时的v-for对象并不是在后台获取的数组list,而是计算属性的函数名pageList <div v-for="item in pageList" ...

  8. 小学四则运算编程(c#)

    ---恢复内容开始--- 预计耗时与实际耗时: 代码基本完善后,对代码进行了性能改善,使用递归并减少了一些不必要的代码. 项目分析:二年级以下无乘除,四年级以下无小数 性能: 类图: 通过这次个人项目 ...

  9. List、Set和数组之间的转换(转载)

    本文转自 http://blog.sina.com.cn/s/blog_52fea7b60100s0hl.html 今天做项目中正好遇到该问题,就在网上查了下,这篇有些细节问题还是讲得挺好的. ★ 数 ...

  10. Hello vue.js的随笔记录

    数据双向绑定的script在组件定义位置后面才顶用. 使用它的话,引用js就好,比较简单. 声明一个vm对象,new Vue({}).这个构造里传一个对象,包含el:界面元素,data:数据,meth ...