[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.7, Wed Feb 20 19:23:58 2008 UTC revision 1.8, Tue Feb 26 17:44:16 2008 UTC
# Line 29  Line 29 
29  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
30    
31  sub pinned_regions {  sub pinned_regions {
32      my($fig, $pin_desc, $fast_color, $sims_from, $map_sz) = @_;      my($fig, $pin_desc, $fast_color, $sims_from, $map_sz, $add_features) = @_;
33    
34      # Get list of pegs required by the description in $pin_desc      # Get list of pegs required by the description in $pin_desc
35      my $pinned_pegs = &expand_peg_list($fig, $pin_desc);      my $pinned_pegs = &expand_peg_list($fig, $pin_desc);
# Line 45  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);  #    &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 54  Line 54 
54      # Filter out regions which have only a single PEG (the pinned one) colored.      # Filter out regions which have only a single PEG (the pinned one) colored.
55  #    $regions = &filter_regions_2($pin_desc, $regions, $feature_data);  #    $regions = &filter_regions_2($pin_desc, $regions, $feature_data);
56    
57        if ( defined( $add_features ) ) {
58            &add_features_to_fdata( $fig, $feature_data, $add_features, $regions );
59        }
60    
61      # Add feature data to the regions to make the final maps      # Add feature data to the regions to make the final maps
62      my $maps = &make_maps($fig, $regions, $feature_data);      my $maps = &make_maps($fig, $regions, $feature_data);
63    
# Line 311  Line 315 
315          foreach my $fid ( @$fids )          foreach my $fid ( @$fids )
316          {          {
317              push @$features, $feature_data->{$fid};              push @$features, $feature_data->{$fid};
318    #           if ( !( $fid =~ /fig/ ) ) {
319    #             print STDERR $fid." FIDMAKEMAPS\n";
320    #           }
321          }          }
322    
323          $region->{'features'} = $features;          $region->{'features'} = $features;
# Line 355  Line 362 
362      return $regions;      return $regions;
363  }  }
364    
365    sub add_features_to_fdata {
366        my ( $fig, $feature_data, $add_features, $regions ) = @_;
367    
368        foreach my $region ( @$regions ) {
369            my $new_feats = $add_features->{ $region->{ 'genome_id' } };
370            foreach my $nf ( @$new_feats ) {
371                if ( $nf->{ 'contig' } eq $region->{ 'contig' } &&
372                     $nf->{ 'start' } < $region->{ 'end' } &&
373                     $nf->{ 'start' } > $region->{ 'beg' } ) {
374                    $feature_data->{ $nf->{ 'name' } } = &new_feature_entry( $fig, $nf->{ 'name' }, $region->{ 'mid' }, $region->{ 'contig' }, $nf->{ 'start' }, $nf->{ 'stop' }, $nf->{ 'type' }, $nf->{ 'function' } );
375                    push @{ $region->{ 'features' } }, $nf->{ 'name' };
376                }
377            }
378        }
379    }
380    
381    sub new_feature_entry {
382        my ( $fig, $fid, $region_mid, $contig, $beg, $end, $type, $func ) = @_;
383    
384        if ( !defined( $type ) ) {
385            $type = 'unknown';
386        }
387    
388        if ( !defined( $func ) ) {
389            $func = '';
390        }
391    
392        my($left, $right)       = sort {$a <=> $b} ($beg, $end);
393        my $size                = $right - $left + 1;
394        my $strand              = ($beg <= $end)? '+' : '-';
395        my $offset              = int(($left + $right)/2) - $region_mid;
396        my $offset_beg          = $left  - $region_mid;
397        my $offset_end          = $right - $region_mid;
398    
399        return {
400                 'fid'        => $fid,
401                 'type'       => $type,
402                 'contig'     => $contig,
403                 'beg'        => $beg,
404                 'end'        => $end,
405                 'size'       => $size,
406                 'strand'     => $strand,
407                 'offset'     => $offset,
408                 'offset_beg' => $offset_beg,
409                 'offset_end' => $offset_end,
410                 'function'   => $func,
411        };
412    }
413    
414  sub feature_data {  sub feature_data {
415      my($fig, $regions) = @_;      my($fig, $regions) = @_;
416      my %feature_data;      my %feature_data;

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3