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

Diff of /FigKernelScripts/load_features.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Mon Dec 1 20:46:40 2003 UTC revision 1.22, Sun Jan 15 20:21:44 2006 UTC
# Line 1  Line 1 
1  # -*- perl -*-  # -*- perl -*-
2    #
3    # Copyright (c) 2003-2006 University of Chicago and Fellowship
4    # for Interpretations of Genomes. All Rights Reserved.
5    #
6    # This file is part of the SEED Toolkit.
7    #
8    # The SEED Toolkit is free software. You can redistribute
9    # it and/or modify it under the terms of the SEED Toolkit
10    # Public License.
11    #
12    # You should have received a copy of the SEED Toolkit Public License
13    # along with this program; if not write to the University of Chicago
14    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15    # Genomes at veronika@thefig.info or download a copy from
16    # http://www.theseed.org/LICENSE.TXT.
17    #
18    
19    
20  use strict;  use strict;
21  use FIG;  use FIG;
22  my $fig = new FIG;  my $fig = new FIG;
23    
24  use DBrtns;  use Tracer;
25    if ($ENV{'VERBOSE'}) { TSetup("3 FIG DBKernel","TEXT") }
26    
27    Trace("Preparing to load features.") if T(2);
28    my ($mode, @genomes) = FIG::parse_genome_args(@ARGV);
29  my $temp_dir = "$FIG_Config::temp";  my $temp_dir = "$FIG_Config::temp";
30  my($organisms_dir) = "$FIG_Config::organisms";  my $organisms_dir = "$FIG_Config::organisms";
31    
32  my($genome,@types,$type,$id,$loc,@aliases,$aliases,$contig);  my($genome,@types,$type,$id,$loc,@aliases,$aliases,$contig);
33    
34  # usage: load_features [G1 G2 G3 ... ]  # usage: load_features [G1 G2 G3 ... ]
35    
36  open(REL,">$temp_dir/tmpfeat$$") || die "could not open $temp_dir/tmpfeat$$";  Open(\*REL, ">$temp_dir/tmpfeat$$");
37    Open(\*ALIAS, "| sort -T $temp_dir -u > $temp_dir/tmpalias$$");
38  my $dbf = $fig->{_dbf};  Open(\*DELFIDS,"| sort -u > $temp_dir/tmpdel$$");
39    Open(\*REPFIDS,"| sort -u > $temp_dir/tmprel$$");
40    
41    if ($mode eq 'all') {
42    
43        # Process any remaining deleted.features or replaced.features in Global
44  my @genomes;      if (open(GLOBDEL,"<$FIG_Config::global/deleted.features"))
 if (@ARGV == 0)  
45  {  {
46      $dbf->drop_table( tbl => "features" );          while (defined($_ = <GLOBDEL>) && ($_ =~ /^fig\|(\d+\.\d+)/))
     if ($FIG_Config::dbms eq "Pg")  
47      {      {
48          $dbf->create_table( tbl  => "features",              print DELFIDS "$1\t$_";
                             flds => "id varchar(32) UNIQUE NOT NULL, type varchar(16),genome varchar(16),"  .  
                                     "location varchar(5000),"  .  
                                     "contig varchar(96), minloc INTEGER, maxloc INTEGER,"  .  
                                     "aliases TEXT, PRIMARY KEY ( id )"  
                             );  
49      }      }
50      elsif ($FIG_Config::dbms eq "mysql")      }
51        close(GLOBDEL);
52    
53        if (open(GLOBREP,"<$FIG_Config::global/replaced.features"))
54      {      {
55          $dbf->create_table( tbl  => "features",          while (defined($_ = <GLOBREP>) && ($_ =~ /^fig\|(\d+\.\d+)/))
56                              flds => "id varchar(32) UNIQUE NOT NULL, type varchar(16),genome varchar(16),"  .          {
57                                      "location TEXT,"  .              print REPFIDS "$1\t$_";
                                     "contig varchar(96), minloc INTEGER, maxloc INTEGER,"  .  
                                     "aliases TEXT, PRIMARY KEY ( id )"  
                             );  
58      }      }
59        }
60        close(GLOBREP);
61    
62    
     $dbf->create_index( idx  => "features_org_ix",  
                         tbl  => "features",  
                         type => "btree",  
                         flds => "genome" );  
     $dbf->create_index( idx  => "features_type_ix",  
                         type => "btree",  
                         tbl  => "features",  
                         flds => "type" );  
     $dbf->create_index( idx  => "features_beg_ix",  
                         type => "btree",  
                         tbl  => "features",  
                         flds => "genome,contig,minloc" );  
63    
64      @genomes = $fig->genomes;      # Here we extract external aliases from the peg.synonyms table, when they can be inferred
65        # accurately.
66            Trace("Extracting external aliases from the peg.synonyms table.") if T(2);
67        Open(\*SYN, "<$FIG_Config::global/peg.synonyms");
68        while (defined($_ = <SYN>))
69        {
70                    chop;
71                    my($x,$y) = split(/\t/,$_);
72                    my @ids = map { $_ =~ /^([^,]+),(\d+)/; [$1,$2] } ($x,split(/;/,$y));
73                    my @fig = ();
74                    my(@nonfig) = ();
75                    foreach $_ (@ids)
76                    {
77                            if ($_->[0] =~ /^fig\|/)
78                            {
79                                    push(@fig,$_);
80  }  }
81  else  else
82  {  {
83      @genomes = @ARGV;                                  push(@nonfig,$_);
84                            }
85                    }
86    
87                    foreach $x (@fig)
88                    {
89                            my($peg,$peg_ln) = @$x;
90                            my $genome = &FIG::genome_of($peg);
91                            foreach $_ (@nonfig)
92                            {
93                                    if ((@fig == 1) || ($peg_ln == $_->[1]))
94                                    {
95                                            print ALIAS "$peg\t$_->[0]\t$genome\n";
96                                            Trace("Alias record $peg, $_->[0] for $genome.") if T(4);
97                                    }
98                            }
99                    }
100        }
101        close(SYN);
102  }  }
103    
104  foreach $genome (@genomes)  foreach $genome (@genomes)
105  {  {
106            Trace("Processing $genome.") if T(3);
107      opendir(FEAT,"$organisms_dir/$genome/Features")      opendir(FEAT,"$organisms_dir/$genome/Features")
108          || die "could not open $genome/Features";          || die "could not open $genome/Features";
109      @types = grep { $_ =~ /^[a-zA-Z]+$/ } readdir(FEAT);      @types = grep { $_ =~ /^[a-zA-Z]+$/ } readdir(FEAT);
# Line 72  Line 111 
111    
112      foreach $type (@types)      foreach $type (@types)
113      {      {
114            if ((-s "$organisms_dir/$genome/Features/$type/deleted.features") &&
115                open(TMP,"<$organisms_dir/$genome/Features/$type/deleted.features"))
116            {
117                while (defined($_ = <TMP>) && ($_ =~ /^fig\|(\d+\.\d+)/))
118                {
119                    print DELFIDS "$1\t$_";
120                }
121                close(TMP);
122            }
123    
124            if ((-s "$organisms_dir/$genome/Features/$type/replaced.features") &&
125                open(TMP,"<$organisms_dir/$genome/Features/$type/replaced.features"))
126            {
127                while (defined($_ = <TMP>) && ($_ =~ /^fig\|(\d+\.\d+)/))
128                {
129                    print REPFIDS "$1\t$_";
130                }
131                close(TMP);
132            }
133    
134          if ((-s "$organisms_dir/$genome/Features/$type/tbl") &&          if ((-s "$organisms_dir/$genome/Features/$type/tbl") &&
135              open(TBL,"<$organisms_dir/$genome/Features/$type/tbl"))              open(TBL,"<$organisms_dir/$genome/Features/$type/tbl"))
136          {          {
137  #           print STDERR "loading $genome/Features/$type/tbl\n";              Trace("Loading $genome/Features/$type/tbl") if T(4);
138              while (defined($_ = <TBL>))              my @tbl = <TBL>;
139                close(TBL);
140                my %seen;
141    
142                while ($_ = pop @tbl)
143              {              {
144                  chop;                  chop;
145                  ($id,$loc,@aliases) = split(/\t/,$_);                  ($id,$loc,@aliases) = split(/\t/,$_);
146                  if ($id)  
147                    if ($id && (! $seen{$id}))
148                  {                  {
149                        $seen{$id} = 1;
150                      my($minloc,$maxloc);                      my($minloc,$maxloc);
151                      if ($loc)                      if ($loc)
152                      {                      {
# Line 101  Line 166 
166                      if (@aliases > 0)                      if (@aliases > 0)
167                      {                      {
168                          $aliases = join(",",grep(/\S/,@aliases));                          $aliases = join(",",grep(/\S/,@aliases));
169                            my $alias;
170                            foreach $alias (@aliases)
171                            {
172                                if ($alias =~ /^([NXYZA]P_|gi\||sp\|\tr\||kegg\||uni\|)/)
173                                {
174    
175                                    print ALIAS "$id\t$alias\t$genome\tOVERRIDE\n";
176                                    Trace("$id override alias $alias for $genome") if T(4);
177                                }
178                            }
179                      }                      }
180                      else                      else
181                      {                      {
# Line 108  Line 183 
183                      }                      }
184                      $minloc = (! $minloc) ? 0 : $minloc;                      $minloc = (! $minloc) ? 0 : $minloc;
185                      $maxloc = (! $maxloc) ? 0 : $maxloc;                      $maxloc = (! $maxloc) ? 0 : $maxloc;
186                      print REL "$id\t$type\t$genome\t$loc\t$contig\t$minloc\t$maxloc\t$aliases\n";                      if ((length($loc) < 5000) && (length($contig) < 96) && (length($id) < 32) && ($id =~ /(\d+)$/))
187                        {
188                            print REL "$id\t$1\t$type\t$genome\t$loc\t$contig\t$minloc\t$maxloc\t$aliases\n";
189                        }
190                  }                  }
191              }              }
             close(TBL);  
192          }          }
193      }      }
194  }  }
195    close(REPFIDS);
196    close(DELFIDS);
197  close(REL);  close(REL);
198    close(ALIAS);
199    Open(\*ALIASIN, "<$temp_dir/tmpalias$$");
200    Open(\*ALIASOUT, ">$temp_dir/tmpalias$$.1");
201    Trace("Parsing alias file.") if T(2);
202    $_ = <ALIASIN>;
203    while ($_ && ($_ =~ /^(\S+)/))
204    {
205        my @aliases = ();
206        my $curr = $1;
207        while ($_ && ($_ =~ /^(\S+)\t(\S+)(\t(\S+))?/) && ($1 eq $curr))
208        {
209                    push(@aliases,[$2,$3 ? 1 : 0]);
210                    $_ = <ALIASIN>;
211        }
212        my $x;
213        my $genome = &FIG::genome_of($curr);
214        foreach $x (@aliases)
215        {
216            if ($x->[1])
217            {
218                print ALIASOUT "$curr\t$x->[0]\t$genome\n";
219            }
220            else
221            {
222                my $i;
223                for ($i=0; ($i < @aliases) && ((! $aliases[$i]->[1]) || (! &same_class($x->[0],$aliases[$i]->[0]))); $i++) {}
224                if ($i == @aliases)
225                {
226                    print ALIASOUT "$curr\t$x->[0]\t$genome\n";
227                }
228            }
229        }
230    }
231    close(ALIASIN);
232    close(ALIASOUT);
233    unlink("$temp_dir/tmpalias$$");
234    
235    $fig->reload_table($mode, 'deleted_fids',"genome varchar(16), fid varchar(32)",
236                                             { deleted_fids_fid_ix => 'fid', deleted_fids_genome_ix => 'genome' },
237                                             "$temp_dir/tmpdel$$",\@genomes);
238    
239  $dbf->load_table( tbl => "features",  unlink("$temp_dir/tmpdel$$");
                   file => "$temp_dir/tmpfeat$$" );  
240    
241  if (@ARGV == 0) {  $dbf->vacuum_it("features") }  $fig->reload_table($mode, 'replaced_fids',"genome varchar(16), from_fid varchar(32), to_fid varchar(32)",
242                                             { replaced_fids_from_ix => 'from_fid',
243                                               replaced_fids_to_ix => 'to_fid',
244                                               replaced_fids_genome_ix => 'genome'
245                                             },
246                                             "$temp_dir/tmprep$$",\@genomes);
247    
248    unlink("$temp_dir/tmprep$$");
249    
250    $fig->reload_table($mode, 'features',
251                                       "id varchar(32), idN INTEGER, type varchar(16),genome varchar(16),"  .
252                                        "location TEXT,"  .
253                                        "contig varchar(96), minloc INTEGER, maxloc INTEGER,"  .
254                                        "aliases TEXT",
255                                            { features_id_ix => "id", features_org_ix => "genome",
256                                              features_type_ix => "type", features_beg_ix => "genome, contig, minloc" },
257                                            "$temp_dir/tmpfeat$$", \@genomes);
258  unlink("$temp_dir/tmpfeat$$");  unlink("$temp_dir/tmpfeat$$");
259    
260    $fig->reload_table($mode, 'ext_alias',
261                                            "id varchar(32), alias varchar(32), genome varchar(16)",
262                                            { ext_alias_alias_ix => "alias", ext_alias_genome_ix => "genome",
263                                              ext_alias_ix_id => "id" },
264                                            "$temp_dir/tmpalias$$.1", \@genomes );
265    
266    unlink("$temp_dir/tmpalias$$.1");
267    Trace("Features loaded.") if T(2);
268    
269    sub same_class {
270        my($x,$y) = @_;
271    
272        my $class1 = &classA($x);
273        my $class2 = &classA($y);
274        return ($class1 && ($class1 eq $class2));
275    }
276    
277    sub classA {
278        my($alias) = @_;
279    
280        if ($alias =~ /^([^\|]+)\|/)
281        {
282                    return $1;
283        }
284        elsif ($alias =~ /^[NXYZA]P_[0-9\.]+$/)
285        {
286                    return "refseq";
287        }
288        else
289        {
290                    return "";
291        }
292    }

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.22

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3