annotate extract_data_single_galaxy.pl @ 0:ee1124489f9c draft

Uploaded
author grau
date Wed, 13 Nov 2013 04:10:29 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
ee1124489f9c Uploaded
grau
parents:
diff changeset
1 use strict;
ee1124489f9c Uploaded
grau
parents:
diff changeset
2
ee1124489f9c Uploaded
grau
parents:
diff changeset
3 if(@ARGV == 0){
ee1124489f9c Uploaded
grau
parents:
diff changeset
4 die <<USAGE
ee1124489f9c Uploaded
grau
parents:
diff changeset
5 usage:
ee1124489f9c Uploaded
grau
parents:
diff changeset
6 perl extract_data.pl <chromFa> <bedfile> <chromcol> <startcol> <seccolm> <secondcol> <width> <statcol> <outfile>
ee1124489f9c Uploaded
grau
parents:
diff changeset
7
ee1124489f9c Uploaded
grau
parents:
diff changeset
8 <chromFa>: the chromosome FastA containing all chromosome sequences
ee1124489f9c Uploaded
grau
parents:
diff changeset
9 <bedfile>: the file containing the peaks in tabular format,
ee1124489f9c Uploaded
grau
parents:
diff changeset
10 e.g., bed, gff, narrowPeak
ee1124489f9c Uploaded
grau
parents:
diff changeset
11 <chromcol>: the column of <bedfile> containing the chromosome
ee1124489f9c Uploaded
grau
parents:
diff changeset
12 <startcol>: the column of <bedfile> containing the start position relative to
ee1124489f9c Uploaded
grau
parents:
diff changeset
13 the chromosome start
ee1124489f9c Uploaded
grau
parents:
diff changeset
14 <seccolm>: center: "Center of peak (relative to start)", end: "End of peak (global coordinates)"
ee1124489f9c Uploaded
grau
parents:
diff changeset
15 <secondcol>: the column of <bedfile> containing the peak center position (center) relative to
ee1124489f9c Uploaded
grau
parents:
diff changeset
16 <startcol> or the column of <bedfile> containing the end position (end)
ee1124489f9c Uploaded
grau
parents:
diff changeset
17 <width>: fixed width of all regions
ee1124489f9c Uploaded
grau
parents:
diff changeset
18 <statcol>: the column of <bedfile> containing the peak statistic
ee1124489f9c Uploaded
grau
parents:
diff changeset
19 or a similar measure of confidence
ee1124489f9c Uploaded
grau
parents:
diff changeset
20 <outfile>: the path to the output file, written as FastA
ee1124489f9c Uploaded
grau
parents:
diff changeset
21 USAGE
ee1124489f9c Uploaded
grau
parents:
diff changeset
22 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
23
ee1124489f9c Uploaded
grau
parents:
diff changeset
24
ee1124489f9c Uploaded
grau
parents:
diff changeset
25 my $chromFa = $ARGV[0];
ee1124489f9c Uploaded
grau
parents:
diff changeset
26 my $bed = $ARGV[1];
ee1124489f9c Uploaded
grau
parents:
diff changeset
27 my $chromcol = $ARGV[2]-1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
28 my $startcol = $ARGV[3]-1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
29 my $seccolm = $ARGV[4];
ee1124489f9c Uploaded
grau
parents:
diff changeset
30 my $seccol = $ARGV[5]-1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
31 my $width = $ARGV[6];
ee1124489f9c Uploaded
grau
parents:
diff changeset
32 my $statcol = $ARGV[7]-1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
33 my $outfile = $ARGV[8];
ee1124489f9c Uploaded
grau
parents:
diff changeset
34
ee1124489f9c Uploaded
grau
parents:
diff changeset
35 my $sort = 1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
36
ee1124489f9c Uploaded
grau
parents:
diff changeset
37
ee1124489f9c Uploaded
grau
parents:
diff changeset
38 sub loadSeq{
ee1124489f9c Uploaded
grau
parents:
diff changeset
39 my $prefix = shift;
ee1124489f9c Uploaded
grau
parents:
diff changeset
40 print $prefix," ";
ee1124489f9c Uploaded
grau
parents:
diff changeset
41 open(FA,$chromFa);
ee1124489f9c Uploaded
grau
parents:
diff changeset
42 my $head = "";
ee1124489f9c Uploaded
grau
parents:
diff changeset
43 my @lines = ();
ee1124489f9c Uploaded
grau
parents:
diff changeset
44 while(<FA>){
ee1124489f9c Uploaded
grau
parents:
diff changeset
45 chomp();
ee1124489f9c Uploaded
grau
parents:
diff changeset
46 if(/^>/){
ee1124489f9c Uploaded
grau
parents:
diff changeset
47 if($head){
ee1124489f9c Uploaded
grau
parents:
diff changeset
48 last;
ee1124489f9c Uploaded
grau
parents:
diff changeset
49 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
50 if(/^>\s*(${prefix}|chr${prefix})(\s.*$|$)/i){
ee1124489f9c Uploaded
grau
parents:
diff changeset
51 $head = $_;
ee1124489f9c Uploaded
grau
parents:
diff changeset
52 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
53 }elsif($head){
ee1124489f9c Uploaded
grau
parents:
diff changeset
54 push(@lines,lc($_));
ee1124489f9c Uploaded
grau
parents:
diff changeset
55 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
56 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
57 my $str = join("",@lines);
ee1124489f9c Uploaded
grau
parents:
diff changeset
58 print "loaded\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
59 return $str;
ee1124489f9c Uploaded
grau
parents:
diff changeset
60 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
61
ee1124489f9c Uploaded
grau
parents:
diff changeset
62
ee1124489f9c Uploaded
grau
parents:
diff changeset
63
ee1124489f9c Uploaded
grau
parents:
diff changeset
64 open(IN,$ARGV[1]);
ee1124489f9c Uploaded
grau
parents:
diff changeset
65
ee1124489f9c Uploaded
grau
parents:
diff changeset
66 my @lines = ();
ee1124489f9c Uploaded
grau
parents:
diff changeset
67
ee1124489f9c Uploaded
grau
parents:
diff changeset
68 while(<IN>){
ee1124489f9c Uploaded
grau
parents:
diff changeset
69 chomp();
ee1124489f9c Uploaded
grau
parents:
diff changeset
70 my @parts = split("\t",$_);
ee1124489f9c Uploaded
grau
parents:
diff changeset
71 $parts[$chromcol] =~ s/chr0/chr/g;
ee1124489f9c Uploaded
grau
parents:
diff changeset
72 my @vals = ();
ee1124489f9c Uploaded
grau
parents:
diff changeset
73 if($seccolm eq "center"){
ee1124489f9c Uploaded
grau
parents:
diff changeset
74 @vals = ($parts[$chromcol],$parts[$startcol]+$parts[$seccol],$parts[$statcol]);
ee1124489f9c Uploaded
grau
parents:
diff changeset
75 }else{
ee1124489f9c Uploaded
grau
parents:
diff changeset
76 @vals = ($parts[$chromcol],int(($parts[$startcol]+$parts[$seccol])/2),$parts[$statcol]);
ee1124489f9c Uploaded
grau
parents:
diff changeset
77 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
78 push(@vals,$width);
ee1124489f9c Uploaded
grau
parents:
diff changeset
79 push(@lines,\@vals);
ee1124489f9c Uploaded
grau
parents:
diff changeset
80 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
81
ee1124489f9c Uploaded
grau
parents:
diff changeset
82 close(IN);
ee1124489f9c Uploaded
grau
parents:
diff changeset
83 #print "Read input file ".$bed."\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
84
ee1124489f9c Uploaded
grau
parents:
diff changeset
85
ee1124489f9c Uploaded
grau
parents:
diff changeset
86 if($sort){
ee1124489f9c Uploaded
grau
parents:
diff changeset
87
ee1124489f9c Uploaded
grau
parents:
diff changeset
88 @lines = sort { ${$a}[0] cmp ${$b}[0] } @lines;
ee1124489f9c Uploaded
grau
parents:
diff changeset
89
ee1124489f9c Uploaded
grau
parents:
diff changeset
90 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
91
ee1124489f9c Uploaded
grau
parents:
diff changeset
92 open(OUT,">".$outfile);
ee1124489f9c Uploaded
grau
parents:
diff changeset
93
ee1124489f9c Uploaded
grau
parents:
diff changeset
94 print "Extracting sequences...\n\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
95
ee1124489f9c Uploaded
grau
parents:
diff changeset
96 my $oldchr = "";
ee1124489f9c Uploaded
grau
parents:
diff changeset
97 my $sequence = "";
ee1124489f9c Uploaded
grau
parents:
diff changeset
98 for my $line (@lines){
ee1124489f9c Uploaded
grau
parents:
diff changeset
99 my @ar = @{$line};
ee1124489f9c Uploaded
grau
parents:
diff changeset
100 my $chr = $ar[0];
ee1124489f9c Uploaded
grau
parents:
diff changeset
101 unless($chr eq $oldchr){
ee1124489f9c Uploaded
grau
parents:
diff changeset
102 $sequence = loadSeq($chr);
ee1124489f9c Uploaded
grau
parents:
diff changeset
103 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
104 $oldchr = $chr;
ee1124489f9c Uploaded
grau
parents:
diff changeset
105 my $w = $ar[3];
ee1124489f9c Uploaded
grau
parents:
diff changeset
106 if($w <= 0){
ee1124489f9c Uploaded
grau
parents:
diff changeset
107 print $w," -> next\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
108 next;
ee1124489f9c Uploaded
grau
parents:
diff changeset
109 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
110 if($w % 2 == 0){
ee1124489f9c Uploaded
grau
parents:
diff changeset
111 $w = $w/2;
ee1124489f9c Uploaded
grau
parents:
diff changeset
112 }else{
ee1124489f9c Uploaded
grau
parents:
diff changeset
113 $w = ($w-1)/2;
ee1124489f9c Uploaded
grau
parents:
diff changeset
114 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
115
ee1124489f9c Uploaded
grau
parents:
diff changeset
116 my $start = $ar[1]-$w-1;
ee1124489f9c Uploaded
grau
parents:
diff changeset
117
ee1124489f9c Uploaded
grau
parents:
diff changeset
118 my $head = "> chr: ".$chr."; start: ".$start."; peak: ".($ar[1]-$start)."; signal: ".$ar[2]."\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
119 my $curr = substr($sequence,$start,$ar[3]);
ee1124489f9c Uploaded
grau
parents:
diff changeset
120 if($curr =~ /[^ACGTacgt]/){
ee1124489f9c Uploaded
grau
parents:
diff changeset
121 print "Sequence for\n\t",substr($head,1),"omitted due to ambiguous nucleotides.\n\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
122 }else{
ee1124489f9c Uploaded
grau
parents:
diff changeset
123 print OUT $head,$curr,"\n";
ee1124489f9c Uploaded
grau
parents:
diff changeset
124 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
125 }
ee1124489f9c Uploaded
grau
parents:
diff changeset
126
ee1124489f9c Uploaded
grau
parents:
diff changeset
127 close(OUT);
ee1124489f9c Uploaded
grau
parents:
diff changeset
128 print "\nDone.\n";