[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.15, Thu Nov 6 11:07:34 2008 UTC revision 1.16, Thu Feb 5 15:43:22 2009 UTC
# Line 30  Line 30 
30  use Time::HiRes qw( usleep gettimeofday tv_interval );  use Time::HiRes qw( usleep gettimeofday tv_interval );
31    
32  sub pinned_regions {  sub pinned_regions {
33      my($fig, $pin_desc, $fast_color, $sims_from, $map_sz, $add_features) = @_;      my($fig, $pin_desc, $fast_color, $sims_from, $map_sz, $add_features, $extended) = @_;
34      Trace("Pinned regions method called.") if T(3);      Trace("Pinned regions method called.") if T(3);
35      # Get list of pegs required by the description in $pin_desc      # Get list of pegs required by the description in $pin_desc
36      my $pinned_pegs = &expand_peg_list($fig, $pin_desc);      my $pinned_pegs = &expand_peg_list($fig, $pin_desc);
# Line 43  Line 43 
43      $regions = &filter_regions_1($pin_desc, $regions);      $regions = &filter_regions_1($pin_desc, $regions);
44    
45      # Get information for each feature -- location, strand, function etc.      # Get information for each feature -- location, strand, function etc.
46      my $feature_data = &feature_data($fig, $regions);      my $feature_data = &feature_data($fig, $regions, $extended);
47    
48      &add_functional_coupling($fig, $pin_desc, $regions, $feature_data);      &add_functional_coupling($fig, $pin_desc, $regions, $feature_data);
49    
50  #    &add_figfams($fig, $feature_data);  #    &add_figfams($fig, $feature_data);
51      &add_subsystem_data($fig, $pin_desc, $feature_data);      &add_subsystem_data($fig, $pin_desc, $feature_data);
52    
53      Trace("Coloring pegs.") if T(3);      Trace("Coloring pegs.") if T(3);
54      # 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
55      &color_pegs($fig, $pin_desc, $pinned_pegs, $regions, $feature_data, $fast_color, $sims_from);      &color_pegs($fig, $pin_desc, $pinned_pegs, $regions, $feature_data, $fast_color, $sims_from);
# Line 61  Line 63 
63    
64      # Add feature data to the regions to make the final maps      # Add feature data to the regions to make the final maps
65      my $maps = &make_maps($fig, $regions, $feature_data);      my $maps = &make_maps($fig, $regions, $feature_data);
66    
67      return $maps;      return $maps;
68  }  }
69    
# Line 417  Line 420 
420  }  }
421    
422  sub feature_data {  sub feature_data {
423      my($fig, $regions) = @_;      my($fig, $regions, $extended) = @_;
424      my %feature_data;      my %feature_data;
425    
426      foreach my $region ( @$regions )      foreach my $region ( @$regions )
# Line 431  Line 434 
434              #  this step when pegs occur in multiple regions              #  this step when pegs occur in multiple regions
435              if ( not exists $feature_data{$fid} )              if ( not exists $feature_data{$fid} )
436              {              {
437                  $feature_data{$fid} = &feature_entry($fig, $fid, $region_mid);                  $feature_data{$fid} = &feature_entry($fig, $fid, $region_mid, $extended);
438                }
439            }
440        }
441    
442        if ($extended) {
443            # get the evidence codes
444            my @all_fids = keys(%feature_data);
445            my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes(\@all_fids, 'evidence_code');
446            my $pretty_codes = {};
447            foreach my $code (@codes) {
448                my $pretty_code = $code->[2];
449                if ($pretty_code =~ /;/) {
450                    my ($cd, $ss) = split(";", $code->[2]);
451                    $pretty_code = $cd;
452                }
453                $pretty_code =~ s/lit\((\d+)\)/lit\(<a href='http:\/\/www\.ncbi\.nlm\.nih\.gov\/sites\/entrez\?cmd=Retrieve&db=PubMed&list_uids=$1&dopt=AbstractPlus' target=_blank>$1<\/a>\)/;
454                push(@{$pretty_codes->{$code->[0]}}, $pretty_code);
455              }              }
456            foreach my $entry (keys(%$pretty_codes)) {
457                $feature_data{$entry}{'evcodes'} = join(", ", @{$pretty_codes->{$entry}});
458          }          }
459      }      }
460    
# Line 440  Line 462 
462  }  }
463    
464  sub feature_entry {  sub feature_entry {
465      my($fig, $fid, $region_mid) = @_;      my($fig, $fid, $region_mid, $extended) = @_;
466    
467      my $type                = $fig->ftype($fid);      my $type                = $fig->ftype($fid);
468      my $loc                 = $fig->feature_location($fid);      my $loc                 = $fig->feature_location($fid);
# Line 453  Line 475 
475      my $offset_end          = $right - $region_mid;      my $offset_end          = $right - $region_mid;
476      my $func                = scalar $fig->function_of($fid) || '';      my $func                = scalar $fig->function_of($fid) || '';
477    
478      return {      my $retval = { 'fid'        => $fid,
              'fid'        => $fid,  
479               'type'       => $type,               'type'       => $type,
480               'contig'     => $contig,               'contig'     => $contig,
481               'beg'        => $beg,               'beg'        => $beg,
# Line 464  Line 485 
485               'offset'     => $offset,               'offset'     => $offset,
486               'offset_beg' => $offset_beg,               'offset_beg' => $offset_beg,
487               'offset_end' => $offset_end,               'offset_end' => $offset_end,
488               'function'   => $func,                     'function'   => $func };
489           };      if ($extended) {
490            my $aliases = $fig->feature_aliases($fid) || '';
491            $retval->{aliases} = $aliases;
492        }
493    
494        return $retval;
495  }  }
496    
497  sub add_functional_coupling {  sub add_functional_coupling {
# Line 538  Line 564 
564    
565      # Get subsystem_information for =all= pegs      # Get subsystem_information for =all= pegs
566    
567      my %peg_to_ss;      my @fids = keys(%$feature_data);
568      foreach my $fid ( keys %$feature_data )      my %ssdata = $fig->subsystems_for_pegs_complete(\@fids);
569      {      my @subsystems = ();
570          if ( $feature_data->{$fid}{'type'} eq 'peg' )      foreach my $p (keys(%ssdata)) {
571          {          foreach my $entry (@{$ssdata{$p}}) {
572              my @subsystems = grep { $fig->usable_subsystem($_->[0],1) } $fig->subsystems_for_peg_complete($fid, 1);              push(@subsystems, [ $entry->[0], $entry->[1], $entry->[2], $p ]);
573            }
574        }
575        @subsystems = grep { $fig->usable_subsystem($_->[0],1) } @subsystems;
576    
577              foreach my $rec ( @subsystems )      my %peg_to_ss;
578              {      foreach my $rec ( @subsystems ) {
579                  my($ss_name, $role, $variant, $is_auxiliary) = @$rec;          my($ss_name, $role, $variant, $fid) = @$rec;
580                  $ss_name =~ s/_/ /g;                  $ss_name =~ s/_/ /g;
581    
582                  if ( $variant eq '0' )          if ( $variant eq '0' ) {
                 {  
583                      # no subsystem                      # no subsystem
584                  }          } elsif ( $variant eq '-1' or $variant eq '*-1' ) {
                 elsif ( $variant eq '-1' or $variant eq '*-1' )  
                 {  
585                      # subsystem not functional in this organism                      # subsystem not functional in this organism
586                      my $ss_text = "$ss_name (classified 'not active' in this organism)";                      my $ss_text = "$ss_name (classified 'not active' in this organism)";
587                      $peg_to_ss{$fid}{$ss_text} = 1;                      $peg_to_ss{$fid}{$ss_text} = 1;
588                  }          } else {
                 else  
                 {  
589                      $peg_to_ss{$fid}{$ss_name} = 1;                      $peg_to_ss{$fid}{$ss_name} = 1;
590                  }                  }
591              }              }
         }  
     }  
592    
593      # Count number of occurences of each subsystem      # Count number of occurences of each subsystem
594      my %ss_count;      my %ss_count;

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3