forked from tetramerFreqs/Binning
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathesomCodonMod.pl
executable file
·95 lines (81 loc) · 1.72 KB
/
esomCodonMod.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
#!/usr/bin/perl
=head1 USAGE
perl esomCodonMod.pl -lrn file.lrn -o outputFile.lrn
=cut
use strict;
use Getopt::Long;
my ($lrn, $tri);
my $out=$$."_".$lrn;
my $version=0.2.0;
GetOptions(
'lrn=s'=>\$lrn,
'o|out:s'=>\$out,
'tri'=>\$tri,
'v|version'=>sub{print STDERR $0."\tversion:".$version."\n";},
'h|help'=>sub{system('perldoc', $0); exit;},
);
&help if (! $lrn);
sub help{system('perldoc', $0); exit;}
my @removeCodons=qw (ATG TAG TAA TGA);
my @nucl=qw(A T G C);
my %removeTetra;
foreach my $c(@removeCodons){
foreach my $n(@nucl){
$removeTetra{$n.$c}++;
$removeTetra{$c.$n}++;
}
}
if($tri){
foreach (@removeCodons){ $removeTetra{$_}++; }
}
#print "Possible Tetramers that can be Removed:\t".keys(%removeTetra)."\n";
open(LRN, $lrn) || die $!;
my (@codonOrder);
my ($cols, $secondPart, $firstLine, $removed);
while(my $line=<LRN>){
chomp $line;
next unless $line;
if ($line=~ /^\% Key/){
@codonOrder=split(/\t/, $line);
my $thisLine;
foreach (@codonOrder){
if ($removeTetra{$_}){
$removed++;
next;
}
$thisLine.=$_."\t";
$cols++;
}
$thisLine=~ s/\t$/\n/;
$secondPart.=$thisLine;
}
elsif($line=~ /^\d/){
my $thisLine;
my @frequencies=split(/\t/, $line);
my $pos=-1;
foreach my $freq(@frequencies){
$pos++;
next if ($removeTetra{$codonOrder[$pos]});
$thisLine.=$freq."\t";
}
$thisLine=~ s/\t$/\n/;
$secondPart.=$thisLine;
}
elsif($.==1){
$firstLine=$line;
}
}
close LRN;
print "Tetramers Removed:\t".$removed."\n";
open(OUT, ">".$out) || die $!;
print OUT $firstLine."\n";
print OUT "% ".$cols."\n";
my $thisLine.="% 9\t";
for (my $i=$cols; $i > 1; $i--){
$thisLine.="1\t";
}
$thisLine=~ s/\t$/\n/;
print OUT $thisLine;
print OUT $secondPart;
close OUT;
exit 0;