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

Annotation of /FigKernelScripts/to_gg.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3