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

Diff of /FigKernelPackages/FIG.pm

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

revision 1.356, Thu Sep 1 18:14:53 2005 UTC revision 1.357, Thu Sep 1 19:23:49 2005 UTC
# Line 3651  Line 3651 
3651      }      }
3652  }  }
3653    
3654    =head3 by_genome_id
3655    
3656    C<< my @sorted_by_genome_id = sort { FIG::by_genome_id($a,$b) } @genome_ids; >>
3657    
3658    Compare two genome IDs.
3659    
3660    This function is designed to assist in sorting genomes by ID.
3661    
3662    =over 4
3663    
3664    =item a
3665    
3666    First genome ID.
3667    
3668    =item b
3669    
3670    Second genome ID.
3671    
3672    =item RETURN
3673    
3674    Returns a negative number if the first parameter is smaller, zero if both parameters
3675    are equal, and a positive number if the first parameter is greater.
3676    
3677    =back
3678    
3679    =cut
3680    
3681    sub by_genome_id {
3682        my($a,$b) = @_;
3683        my($g1,$g2,$s1, $s2);
3684        if (($a =~ /^(\d+)\.(\d+)$/) && (($g1, $s1) = ($1, $2)) &&
3685            ($b =~ /^(\d+)\.(\d+)$/) && (($g2, $s2) = ($1, $2))) {
3686            ($g1 <=> $g2) or ($s1 <=> $s2);
3687        } else {
3688            $a cmp $b;
3689        }
3690    }
3691    
3692  =head3 genes_in_region  =head3 genes_in_region
3693    
3694  C<< my ($features_in_region, $beg1, $end1) = $fig->genes_in_region($genome, $contig, $beg, $end, size_limit); >>  C<< my ($features_in_region, $beg1, $end1) = $fig->genes_in_region($genome, $contig, $beg, $end, size_limit); >>
# Line 6949  Line 6987 
6987      if (! defined($genomes)) { $genomes = [$self->genomes] }      if (! defined($genomes)) { $genomes = [$self->genomes] }
6988    
6989      my %genomes = map { $_ => 1 } @$genomes;      my %genomes = map { $_ => 1 } @$genomes;
6990      if ($date =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/)  
6991      {      $epoch_date = $self->parse_date($date);
6992          my($mm,$dd,$yyyy) = ($1,$2,$3);  
         $epoch_date = &Time::Local::timelocal(0,0,0,$dd,$mm-1,$yyyy-1900,0,0,0);  
     }  
     elsif ($date =~ /^\d+$/)  
     {  
         $epoch_date = $date;  
     }  
     else  
     {  
         $epoch_date = 0;  
     }  
6993      $epoch_date = defined($epoch_date) ? $epoch_date-1 : 0;      $epoch_date = defined($epoch_date) ? $epoch_date-1 : 0;
6994    
6995      my @assignments = ();      my @assignments = ();
6996      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
6997      if ($who eq "master")      if ($who eq "master")
# Line 7004  Line 7033 
7033      return @assignments;      return @assignments;
7034  }  }
7035    
7036    =head3 extract_assignments_from_annotations
7037    
7038    Extract a list of assignments from an annotations package as created by
7039    annotations_made_fast. Assumes that the user and date filtering was
7040    done by the annotations extraction, so all this has to do is to
7041    sort the lists of annotations by date and grab the latest one.
7042    
7043    Return value is a list of tuples [$peg, $assignment, $date, $who].
7044    
7045    =cut
7046    
7047    sub extract_assignments_from_annotations
7048    {
7049        my($self, $annos) = @_;
7050    
7051        #
7052        # $annos is a list of pairs [$genome, $genomeannos]
7053        # $genomeannos is a hash keyed on peg. value is a list of lists [$peg, $time, $who, $anno].
7054        #
7055    
7056        #
7057        # Sort on genome.
7058        #
7059        my @annos = sort { &FIG::by_genome_id($a->[0], $b->[0]) } @$annos;
7060    
7061        my @out;
7062        for my $gent (@annos)
7063        {
7064            my($genome, $genome_anno_list) = @$gent;
7065    
7066            #
7067            # Sort on peg id.
7068            for my $peg (sort { &FIG::by_fig_id($a, $b) } keys %$genome_anno_list)
7069            {
7070                my $anno_list = $genome_anno_list->{$peg};
7071    
7072                my @a = sort { $b->[1] <=> $a->[1] } @$anno_list;
7073    
7074                my $winner = $a[0];
7075                my($mpeg, $time, $who, $anno) = @$winner;
7076                $mpeg eq $peg or confess "KEY mismatch in annotations_made_fast output";
7077    
7078                if ($anno =~ /Set.*function to\n(.*)\n?/s)
7079                {
7080                    push(@out, [$peg, $1, $time, $who]);
7081                }
7082            }
7083        }
7084        return @out;
7085    }
7086    
7087  sub assignments_made_for_protein {  sub assignments_made_for_protein {
7088      my($self, $fid) = @_;      my($self, $fid) = @_;
7089      my($relational_db_response,$entry,$fileno,$seek,$len,$ann);      my($relational_db_response,$entry,$fileno,$seek,$len,$ann);
# Line 7189  Line 7269 
7269                  chomp $ann;                  chomp $ann;
7270    
7271                  if ((($fid, $anno_time, $who, $anno_text, $anno_who) =                  if ((($fid, $anno_time, $who, $anno_text, $anno_who) =
7272                       ($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\n(Set\s+(\S+)\s+function\s+to.*)/s)) and                       ($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\n(Set\s+(\S+)\s+function\s+to.*\S)/s)) and
7273                        not $self->is_deleted_fid($fid) and
7274                      $anno_time >= $start_time and                      $anno_time >= $start_time and
7275                      $anno_time <= $end_time and                      $anno_time <= $end_time and
7276                      ($anno_by eq 'all' or ($master_anno ? ($anno_who eq 'FIG' or $anno_who eq 'master') : ($who eq $anno_by))))                      ($anno_by eq 'all' or ($master_anno ? ($anno_who eq 'FIG' or $anno_who eq 'master') : ($who eq $anno_by))))

Legend:
Removed from v.1.356  
changed lines
  Added in v.1.357

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3