[Bio] / FigKernelScripts / to_gg.pl Repository:
ViewVC logotype

Annotation of /FigKernelScripts/to_gg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : olson 1.2 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : overbeek 1.1
19 :     $usage = "usage: to_gg Sets Org.abbr GG.in Legend < map.coords";
20 :    
21 :     use FIG;
22 :     my $fig = new FIG;
23 :    
24 :     (
25 :     ($sets = shift @ARGV) && open(SETS,"<$sets") &&
26 :     ($org_abbr = shift @ARGV) && open(ORGS,"<$org_abbr") &&
27 :     ($ggF = shift @ARGV) && open(GG,">$ggF") &&
28 :     ($legendF = shift @ARGV) && open(LEGEND,">$legendF")
29 :     )
30 :     || die $usage;
31 :    
32 :     while (defined($_ = <ORGS>))
33 :     {
34 :     if ($_ =~ /^(\d+\.\d+)\s+(\S.*\S)/)
35 :     {
36 :     $to_org_abbr{$1} = $2;
37 :     }
38 :     }
39 :     close(ORGS);
40 :    
41 :     if (defined($_ = <STDIN>) && ($_ =~ /^(\d+)\s+(\d+)$/))
42 :     {
43 :     print GG $_;
44 :     }
45 :     else
46 :     {
47 :     die "BAD: $_";
48 :     }
49 :    
50 :     $maps = [];
51 :     $/ = "\n//\n";
52 :     while (defined($_ = <STDIN>))
53 :     {
54 :     chomp;
55 :     $map = [];
56 :     my @lines = split(/\n/,$_);
57 :     my $oligo_line = shift @lines;
58 :     my($org,$contig,$beg,$end,undef) = split(/\t/,$oligo_line);
59 :     push(@$map,$to_org_abbr{$org});
60 :    
61 :     if ($beg < $end)
62 :     {
63 :     push(@$map,["",$beg,$end,"rightArrow","red",""]);
64 :     }
65 :     else
66 :     {
67 :     push(@$map,["",$end,$beg,"leftArrow","red",""]);
68 :     }
69 :    
70 :     foreach $gene_line (@lines)
71 :     {
72 :     ($peg,$beg,$end,$aliases,$func) = split(/\t/,$gene_line);
73 :     $peg_aliases{$peg} = [split(/,/,$aliases)];
74 :     $peg_function{$peg} = $func;
75 :    
76 :     if ($beg < $end)
77 :     {
78 :     push(@$map,[$peg,$beg,$end,"rightArrow","",""]);
79 :     }
80 :     else
81 :     {
82 :     push(@$map,[$peg,$end,$beg,"leftArrow","",""]);
83 :     }
84 :     }
85 :     push(@$maps,$map);
86 :     }
87 :     $/ = "\n";
88 :    
89 :     while (defined($_ = <SETS>))
90 :     {
91 :     chop;
92 :     @pegs = grep { defined($peg_function{$_}) } split(/\t/,$_);
93 :     if (@pegs > 0)
94 :     {
95 :     $pegs = [@pegs];
96 :     foreach $peg (@pegs)
97 :     {
98 :     $in_set{$peg} = $pegs;
99 :     }
100 :     }
101 :     }
102 :     close(SETS);
103 :    
104 :     $next = 1;
105 :     foreach $map (@$maps)
106 :     {
107 :     for ($i=2; ($i < @$map); $i++)
108 :     {
109 :     $gene = $map->[$i];
110 :     $peg = $gene->[0];
111 :     if (! $in_legend{$peg})
112 :     {
113 :     $which = $next;
114 :     $next++;
115 :     $color = "color" . ($which+2);
116 :     $set = $in_set{$peg};
117 :     if (! $set)
118 :     {
119 :     $set = [$peg];
120 :     }
121 :     $func = &pick_func($set);
122 :     $alias = &pick_alias($set);
123 :     print LEGEND join("\t",($which,$alias,$func)),"\n";
124 :     foreach $peg1 (@$set)
125 :     {
126 :     $in_legend{$peg1} = [$which,$color];
127 :     }
128 :     }
129 :     $gene->[5] = $in_legend{$peg}->[0];
130 :     $gene->[4] = $in_legend{$peg}->[1];
131 :     }
132 :     }
133 :     close(LEGEND);
134 :    
135 :     foreach $map (@$maps)
136 :     {
137 :     print GG "$map->[0]\n";
138 :     for ($i=1; ($i < @$map); $i++)
139 :     {
140 :     $gene = $map->[$i];
141 :     (undef,$beg,$end,$shape,$color,$text) = @$gene;
142 :     print GG join("\t",($beg,$end,$shape,$color,$text)),"\n";
143 :     }
144 :     print GG "//\n";
145 :     }
146 :    
147 :     sub pick_func {
148 :     my($set) = @_;
149 :     my($peg,%func);
150 :    
151 :     foreach $peg (@$set)
152 :     {
153 :     my $f = $peg_function{$peg};
154 :    
155 :     if (! defined($f) ) { $f = "" }
156 :     $func{$f}++;
157 :     }
158 :     my @funcs = sort { $func{$b} <=> $func{$a} } keys(%func);
159 :     return (@funcs > 0) ? $funcs[0] : "";
160 :     }
161 :    
162 :     sub pick_alias {
163 :     my($set) = @_;
164 :     my($peg,$best,$x);
165 :    
166 :     my @poss = ();
167 :     foreach $peg (@$set)
168 :     {
169 :     push(@poss,@{$peg_aliases{$peg}});
170 :     }
171 :     $best = $set->[0];
172 :     foreach $x (@poss)
173 :     {
174 :     if (&better($x,$best))
175 :     {
176 :     $best = $x;
177 :     }
178 :     }
179 :     return $best;
180 :     }
181 :    
182 :     sub better {
183 :     my($x,$y) = @_;
184 :    
185 :     return &sc($x) >= &sc($y);
186 :     }
187 :    
188 :     sub sc {
189 :     my($x) = @_;
190 :    
191 :     if ($x =~ /^SAV\d+$/)
192 :     {
193 :     return 10;
194 :     }
195 :     elsif ($x =~ /SAV\d+/)
196 :     {
197 :     return 8;
198 :     }
199 :     elsif ($x =~ /^SA\d+$/)
200 :     {
201 :     return 9;
202 :     }
203 :     elsif ($x =~ /^[a-z]{2,3}[A-Z]$/)
204 :     {
205 :     return 7;
206 :     }
207 :     elsif ($x =~ /^sp\|/)
208 :     {
209 :     return 6;
210 :     }
211 :     elsif ($x =~ /^uni\|/)
212 :     {
213 :     return 5;
214 :     }
215 :     elsif ($x =~ /^gi\|/)
216 :     {
217 :     return 4;
218 :     }
219 :     return 1;
220 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3