[Bio] / FigKernelPackages / PinnedRegions.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/PinnedRegions.pm

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

revision 1.4, Mon Jan 14 16:38:27 2008 UTC revision 1.5, Tue Feb 5 21:04:36 2008 UTC
# Line 23  Line 23 
23  use warnings;  use warnings;
24    
25  use FIG;  use FIG;
26    use FigFams;
27  use FIG_Config;  use FIG_Config;
28    
29  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
# Line 44  Line 45 
45      my $feature_data = &feature_data($fig, $regions);      my $feature_data = &feature_data($fig, $regions);
46    
47      &add_functional_coupling($fig, $pin_desc, $regions, $feature_data);      &add_functional_coupling($fig, $pin_desc, $regions, $feature_data);
48        &add_figfams($fig, $feature_data);
49      &add_subsystem_data($fig, $pin_desc, $feature_data);      &add_subsystem_data($fig, $pin_desc, $feature_data);
50    
51      # Assign a set number to some PEGs through transitive closure based on similarity, from blast scores      # Assign a set number to some PEGs through transitive closure based on similarity, from blast scores
# Line 65  Line 67 
67      # Filter for legitimate genome IDS -- should handle deleted organisms and (in NMPDR) non-NMPDR orgs      # Filter for legitimate genome IDS -- should handle deleted organisms and (in NMPDR) non-NMPDR orgs
68      my %ok_genome_id = map {$_ => 1} $fig->genomes;      my %ok_genome_id = map {$_ => 1} $fig->genomes;
69    
70        # If the user has selected the genomes to be displayed, filter out all other genomes
71        if ( @{ $pin_desc->{'show_genomes'} } )
72        {
73            # create new %ok_genome_id hash from intersection of selected genomes and legitimate genome IDs
74            %ok_genome_id = map {$_ => 1} grep {$ok_genome_id{$_}} @{ $pin_desc->{'show_genomes'} };
75        }
76    
77      if ( @{ $pin_desc->{'pegs'} } > 1 )      if ( @{ $pin_desc->{'pegs'} } > 1 )
78      {      {
79          # Input already contains list of pegs, no need for expansion          # Input already contains list of pegs, no need for expansion
# Line 170  Line 179 
179          # To collapse the PEG list, we want to:          # To collapse the PEG list, we want to:
180          # a. Return at most $n_pegs PEGs,          # a. Return at most $n_pegs PEGs,
181          # b. include a representative PEG from every genus, subject to a, and          # b. include a representative PEG from every genus, subject to a, and
182          # c. include a representative PEG from each organism (genus-species), subject to a and b.          # c. include a representative PEG from each genus-species, subject to a and b.
183            # Individual strains will get represented by a single PEG, chosen arbitrarily.
184    
185          my(%seen, @unique_genus, @unique_org);          # The PEG selection is defined by the order of the PEGs. This could be done beter.
186    
187            my(%seen, @unique_genus, @unique_genus_species);
188    
189          foreach my $peg ( @$pegs )          foreach my $peg ( @$pegs )
190          {          {
# Line 181  Line 193 
193    
194              if ( $org )              if ( $org )
195              {              {
196                  my($genus) = split(/\s+/, $org);                  # Use only genus+species to drop strain information
197                    my($genus, $species) = split(/\s+/, $org);
198                  if ( not $seen{$genus}++ ) {                  my $gs = "$genus $species";
199    
200                    if ( not $seen{$genus}++ )
201                    {
202                        # First PEG from this genus, add it to @unique_genus.
203                        # Mark the genus+species as seen.
204                        # A subsequent PEG with the same genus and species will be dropped.
205                        # A subsequent PEG with the same genus but different species will be added to @unique_genus_species.
206                        $seen{$gs}++;
207                      push @unique_genus, $peg;                      push @unique_genus, $peg;
208                  } elsif ( not $seen{$org}++ ) {                  }
209                      push @unique_org, $peg;                  elsif ( not $seen{$gs}++ )
210                    {
211                        # First PEG from this genus+species, add it to @unique_genus_species.
212                        push @unique_genus_species, $peg;
213                  }                  }
214              }              }
215          }          }
216    
217          $pegs = [@unique_genus, @unique_org];          # Keep the unique_genus PEGS at the top, followed by the unique_genus_species
218            $pegs = [@unique_genus, @unique_genus_species];
219      }      }
220    
221      # Truncate list if necessary      # Truncate list if necessary
# Line 405  Line 429 
429      }      }
430  }  }
431    
432    sub add_figfams {
433        my($fig, $feature_data) = @_;
434    
435        my @pegs = grep {$feature_data->{$_}{'type'} eq 'peg'} keys %$feature_data;
436    
437        my $figfam_data = $FIG_Config::FigfamsData;
438        my $figfams     = new FigFams($fig, $figfam_data);
439    
440        my $figfam          = $figfams->families_containing_peg_bulk(\@pegs);
441        my $family_function = $figfams->family_functions();
442    
443        foreach my $fid  ( keys %$feature_data )
444        {
445            if ( $figfam->{$fid} )
446            {
447                $feature_data->{$fid}{'figfam'} = $figfam->{$fid} . ": " . $family_function->{$figfam->{$fid}};
448            }
449        }
450    }
451    
452  sub add_subsystem_data {  sub add_subsystem_data {
453      my($fig, $pin_desc, $feature_data) = @_;      my($fig, $pin_desc, $feature_data) = @_;
454    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3