|
1
|
1
|
|
|
2 #!/usr/bin/perl
|
|
|
3
|
|
|
4 use strict;
|
|
|
5 use Getopt::Long;
|
|
|
6
|
|
|
7 my $usage = qq~Usage:$0 <args> [<opts>]
|
|
|
8
|
|
|
9 where <args> are:
|
|
|
10
|
|
|
11 -i, --in <PED input>
|
|
|
12 -o, --out <Fasta output>
|
|
|
13 ~;
|
|
|
14 $usage .= "\n";
|
|
|
15
|
|
|
16 my ($input,$out);
|
|
|
17
|
|
|
18
|
|
|
19
|
|
|
20 GetOptions(
|
|
|
21 "in=s" => \$input,
|
|
|
22 "out=s" => \$out,
|
|
|
23 );
|
|
|
24
|
|
|
25
|
|
|
26 die $usage
|
|
|
27 if ( !$input || !$out);
|
|
|
28
|
|
|
29
|
|
|
30 my %IUPAC =
|
|
|
31 (
|
|
|
32 '00'=> "?",
|
|
|
33 'AA'=> "A",
|
|
|
34 'CC'=> "C",
|
|
|
35 'GG'=> "G",
|
|
|
36 'TT'=> "T",
|
|
|
37 'AG'=> "R",
|
|
|
38 'GA'=> "R",
|
|
|
39 'CT'=> "Y",
|
|
|
40 'TC'=> "Y",
|
|
|
41 'TG'=> "K",
|
|
|
42 'GT'=> "K",
|
|
|
43 'CG'=> "S",
|
|
|
44 'GC'=> "S",
|
|
|
45 'AT'=> "W",
|
|
|
46 'TA'=> "W",
|
|
|
47 'AC'=> "M",
|
|
|
48 'CA'=> "M",
|
|
|
49 );
|
|
|
50
|
|
|
51 open(my $O,">$out");
|
|
|
52 open(my $P,$input) or die "File does not exist";
|
|
|
53 while(<$P>)
|
|
|
54 {
|
|
|
55 my $line = $_;
|
|
|
56 $line =~s/\r//g;
|
|
|
57 $line =~s/\n//g;
|
|
|
58 my @infos = split("\t",$_);
|
|
|
59 my $ind = $infos[0];
|
|
|
60 print $O ">$ind\n";
|
|
|
61 for (my $i = 6; $i <= $#infos; $i= $i+2)
|
|
|
62 {
|
|
|
63 my $code = $infos[$i].$infos[$i+1];
|
|
|
64 my $letter = $IUPAC{$code};
|
|
|
65 print $O $letter;
|
|
|
66 }
|
|
|
67 print $O "\n";
|
|
|
68 }
|
|
|
69 close($P);
|
|
|
70 close($O);
|
