tools/linkage/markerposfilter.pl

   1 #!/bin/env perl
   2 use strict;
   3 use warnings;
   4 use lib '/nas/RD_09C/resequencing/soft/lib';
   5 #use GalaxyXS::ChromByte;
   6 #use Data::Dump qw(ddx);
   7
   8 unless (@ARGV > 0) {
   9     print "perl $0 <markerpos file>\n";
  10     exit 0;
  11 }
  12
  13 my ($file)=@ARGV;
  14
  15 sub splitMarkerid($) {
  16         my $MarkerID=$_[0];
  17         my ($mChr,$mPos,$mSiderLen)=split /[_m]/,$MarkerID,3;
  18         return [$mChr,$mPos,$mSiderLen];
  19 }
  20
  21 open I,'<',$file or die "Error:[$file] $!\n";
  22 open O,'>',$file.'.f' or die "Error:[$file.f] $!\n";
  23 $_=<I>;
  24 print O $_;
  25 while (<I>) {
  26         next if /^#/;
  27         chomp;
  28         my ($Qid,$mcM,$Sid,$pos,$strand,$Pidentity,$E,$BTOP)=split /\t/;
  29         next if $E > 3e-11;
  30         if ($Sid =~ /^chr/i) {  # needed ? Well, it is what we supposed previously ...
  31                 my ($mChr,$mPos,$mSiderLen)=@{&splitMarkerid($Qid)};
  32                 next if $mChr ne $Sid;
  33         }
  34         print O join("\t",$Qid,$mcM,$Sid,$pos,$strand,$Pidentity,$E,$BTOP),"\n";
  35 }
  36 close I;
  37 close O;
  38
  39 __END__
  40 find ./markerpos/ -name '*.pos'|xargs -n1 ./markerposfilter.pl