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

Diff of /FigKernelPackages/Observation.pm

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

revision 1.20, Wed Jun 27 22:14:01 2007 UTC revision 1.50, Thu Dec 6 18:47:35 2007 UTC
# Line 2  Line 2 
2    
3  use lib '/vol/ontologies';  use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10    use WebColors;
11    
12  use FIG_Config;  use FIG_Config;
13  use strict;  #use strict;
14  #use warnings;  #use warnings;
15  use HTML;  use HTML;
16    
# Line 26  Line 29 
29    
30  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
31    
 Example:  
   
   
 use FIG;  
 use Observation;  
   
 my $fig = new FIG;  
 my $fid = "fig|83333.1.peg.3";  
   
 my $observations = Observation::get_objects($fid);  
 foreach my $observation (@$observations) {  
     print "ID: " . $fid . "\n";  
     print "Start: " . $observation->start() . "\n";  
     ...  
 }  
   
 B<return an array of objects>  
   
   
 print "$Observation->acc\n" prints the Accession number if present for the Observation  
   
32  =cut  =cut
33    
34  =head1 BACKGROUND  =head1 BACKGROUND
# Line 70  Line 52 
52    
53  The public methods this package provides are listed below:  The public methods this package provides are listed below:
54    
55    
56    =head3 context()
57    
58    Returns close or diverse for purposes of displaying genomic context
59    
60    =cut
61    
62    sub context {
63      my ($self) = @_;
64    
65      return $self->{context};
66    }
67    
68    =head3 rows()
69    
70    each row in a displayed table
71    
72    =cut
73    
74    sub rows {
75      my ($self) = @_;
76    
77      return $self->{rows};
78    }
79    
80  =head3 acc()  =head3 acc()
81    
82  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
# Line 78  Line 85 
85    
86  sub acc {  sub acc {
87    my ($self) = @_;    my ($self) = @_;
   
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91  =head3 description()  =head3 query()
92    
93  The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  The query id
   
 B<Please note:>  
 Either remoteid or description is required.  
94    
95  =cut  =cut
96    
97  sub description {  sub query {
98    my ($self) = @_;    my ($self) = @_;
99        return $self->{query};
   return $self->{description};  
100  }  }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 163  Line 166 
166  sub type {  sub type {
167    my ($self) = @_;    my ($self) = @_;
168    
169    return $self->{acc};    return $self->{type};
170  }  }
171    
172  =head3 start()  =head3 start()
# Line 262  Line 265 
265      return $self->{hlength};      return $self->{hlength};
266  }  }
267    
   
   
268  =head3 evalue()  =head3 evalue()
269    
270  E-value or P-Value if present.  E-value or P-Value if present.
# Line 280  Line 281 
281    
282  Score if present.  Score if present.
283    
 B<Please note: >  
 Either score or eval are required.  
   
284  =cut  =cut
285    
286  sub score {  sub score {
# Line 290  Line 288 
288    return $self->{score};    return $self->{score};
289  }  }
290    
   
291  =head3 display()  =head3 display()
292    
293  will be different for each type  will be different for each type
# Line 303  Line 300 
300    
301  }  }
302    
303    =head3 display_table()
304    
305  =head3 rank()  will be different for each type
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
   
 Currently always returns 1.  
   
 =cut  
   
 sub rank {  
   my ($self) = @_;  
   
 #  return $self->{rank};  
   
   return 1;  
 }  
   
 =head3 supports_annotation()  
   
 Does a this observation support the annotation of its feature?  
   
 Returns  
   
 =over 3  
   
 =item 10, if feature annotation is identical to $self->description  
   
 =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()  
   
 =item undef  
   
 =back  
   
 =cut  
   
 sub supports_annotation {  
   my ($self) = @_;  
   
   # no code here so far  
   
   return $self->{supports_annotation};  
 }  
   
 =head3 url()  
   
 URL describing the subject. In case of a BLAST hit against a sequence, this URL will lead to a page displaying the sequence record for the sequence. In case of an HMM hit, the URL will be to the URL description.  
306    
307  =cut  =cut
308    
309  sub url {  sub display_table {
   my ($self) = @_;  
310    
311    my $url = get_url($self->type, $self->acc);    die "Abstract Table Method Called\n";
312    
   return $url;  
313  }  }
314    
315  =head3 get_objects()  =head3 get_objects()
316    
317  This is the B<REAL WORKHORSE> method of this Package.  This is the B<REAL WORKHORSE> method of this Package.
318    
 It will probably have to:  
   
 - get all sims for the feature  
 - get all bbhs for the feature  
 - copy information from sim to bbh (bbh have no match location etc)  
 - get pchs (difficult)  
 - get attributes (there is code for this that in get_attribute_based_observations  
 - get_attributes_based_observations returns an array of arrays of hashes like this"  
   
   my $dataset  
      [  
        [ { name => 'acc', value => '1234' },  
         { name => 'from', value => '4' },  
         { name => 'to', value => '400' },  
         ....  
        ],  
        [ { name => 'acc', value => '456' },  
         { name => 'from', value => '1' },  
         { name => 'to', value => '100' },  
         ....  
        ],  
        ...  
      ];  
    return $datasets;  
  }  
   
 It will invoke the required calls to the SEED API to retrieve the information required.  
   
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$classes) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
# Line 403  Line 327 
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
329    
330      if(scalar(@$classes) < 1){      if($scope){
331          get_attribute_based_observations($fid,\@matched_datasets);          get_cluster_observations($fid,\@matched_datasets,$scope);
         get_sims_observations($fid,\@matched_datasets);  
         get_identical_proteins($fid,\@matched_datasets);  
         get_functional_coupling($fid,\@matched_datasets);  
332      }      }
333      else{      else{
334          my %domain_classes;          my %domain_classes;
335          my $identical_flag=0;          my @attributes = $fig->get_attributes($fid);
336          my $pch_flag=0;          $domain_classes{'CDD'} = 1;
337          my $location_flag = 0;          $domain_classes{'PFAM'} = 1;
338          my $sims_flag=0;          get_identical_proteins($fid,\@matched_datasets,$fig);
339          my $cluster_flag = 0;          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          my $pdb_flag = 0;          get_sims_observations($fid,\@matched_datasets,$fig);
341          foreach my $class (@$classes){          get_functional_coupling($fid,\@matched_datasets,$fig);
342              if($class =~ /(IPR|CDD|PFAM)/){          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343                  $domain_classes{$class} = 1;          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
             }  
             elsif ($class eq "IDENTICAL")  
             {  
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)  
             {  
                 $location_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_flag = 1;  
             }  
             elsif ($class eq "CLUSTER")  
             {  
                 $cluster_flag = 1;  
             }  
             elsif ($class eq "PDB")  
             {  
                 $pdb_flag = 1;  
             }  
   
         }  
   
         if ($identical_flag ==1)  
         {  
             get_identical_proteins($fid,\@matched_datasets);  
         }  
         if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {  
             get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);  
         }  
         if ($pch_flag == 1)  
         {  
             get_functional_coupling($fid,\@matched_datasets);  
         }  
         if ($sims_flag == 1)  
         {  
             get_sims_observations($fid,\@matched_datasets);  
         }  
   
         if ($location_flag == 1)  
         {  
             get_attribute_based_location_observations($fid,\@matched_datasets);  
         }  
         if ($cluster_flag == 1)  
         {  
             get_cluster_observations($fid,\@matched_datasets);  
         }  
         if ($pdb_flag == 1)  
         {  
             get_pdb_observations($fid,\@matched_datasets);  
         }  
   
   
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 485  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 511  Line 374 
374    
375  }  }
376    
377  =head1 Internal Methods  =head3 display_housekeeping
378    This method returns the housekeeping data for a given peg in a table format
 These methods are not meant to be used outside of this package.  
   
 B<Please do not use them outside of this package!>  
379    
380  =cut  =cut
381    sub display_housekeeping {
382        my ($self,$fid,$fig) = @_;
383        my $content = [];
384        my $row = [];
385    
386        my $org_name = $fig->org_of($fid);
387        my $org_id = $fig->genome_of($fid);
388        my $function = $fig->function_of($fid);
389        #my $taxonomy = $fig->taxonomy_of($org_id);
390        my $length = $fig->translation_length($fid);
391    
392        push (@$row, $org_name);
393        push (@$row, $fid);
394        push (@$row, $length);
395        push (@$row, $function);
396    
397        # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
407    
408  =head3 get_url (internal)      return ($content);
409    }
 get_url() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
410    
411  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 get_sims_summary
412    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
413    
414  =cut  =cut
415    
416  sub get_url {  sub get_sims_summary {
417        my ($observation, $fid, $taxes, $dataset, $fig) = @_;
418        my %families;
419        #my @sims= $fig->nsims($fid,20000,10,"fig");
420    
421   my ($self) = @_;      foreach my $thing (@$dataset) {
422   my $url='';          next if ($thing->class ne "SIM");
423    
424  # a hash with a URL for each observation; identified by name()          my $id      = $thing->acc;
425  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\          my $evalue  = $thing->evalue;
 #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\  
 #                          'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'PIR'    => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'FIGFAM' => '',\  
 #                          'sim'=> "http://www.theseed.org/linkin.cgi?id=",\  
 #                          'bbh'=> "http://www.theseed.org/linkin.cgi?id="  
 #};  
426    
427  # if (defined $URL{$self->name}) {          next if ($id !~ /fig\|/);
428  #     $url = $URL{$self->name}.$self->acc;          next if ($fig->is_deleted_fid($id));
429  #     return $url;          my $genome = $fig->genome_of($id);
430  # }          #my ($genome1) = ($genome) =~ /(.*)\./;
431  # else          #my $taxonomy = $taxes->{$genome1};
432       return undef;          my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated
433            my $parent_tax = "Root";
434            my @currLineage = ($parent_tax);
435            foreach my $tax (split(/\; /, $taxonomy)){
436                push (@{$families{children}{$parent_tax}}, $tax);
437                push (@currLineage, $tax);
438                $families{parent}{$tax} = $parent_tax;
439                $families{lineage}{$tax} = join(";", @currLineage);
440                if (defined ($families{evalue}{$tax})){
441                    if ($sim->[10] < $families{evalue}{$tax}){
442                        $families{evalue}{$tax} = $evalue;
443                        $families{color}{$tax} = &get_taxcolor($evalue);
444                    }
445                }
446                else{
447                    $families{evalue}{$tax} = $evalue;
448                    $families{color}{$tax} = &get_taxcolor($evalue);
449  }  }
450    
451  =head3 get_display_method (internal)              $parent_tax = $tax;
452            }
453        }
454    
455  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
456            $families{count}{$key} = @{$families{children}{$key}};
457    
458  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
459  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
460            $families{children}{$key} = \@out;
461        }
462        return (\%families);
463    }
464    
465  =cut  =head1 Internal Methods
466    
467  sub get_display_method {  These methods are not meant to be used outside of this package.
468    
469   my ($self) = @_;  B<Please do not use them outside of this package!>
470    
471  # a hash with a URL for each observation; identified by name()  =cut
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
472    
473  #if (defined $URL{$self->name}) {  sub get_taxcolor{
474  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;      my ($evalue) = @_;
475  #     return $url;      my $color;
476  # }      if ($evalue <= 1e-170){        $color = "#FF2000";    }
477  # else      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
478       return undef;      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
479        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
480        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
481        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
482        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
483        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
484        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
485        else{        $color = "#6666FF";    }
486        return ($color);
487  }  }
488    
489    
490  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
491    
492      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
493      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
494    
495      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
496          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
497          my @parts = split("::",$key);          my @parts = split("::",$key);
498          my $class = $parts[0];          my $class = $parts[0];
499            my $name = $parts[1];
500            next if (($class eq "PFAM") && ($name !~ /interpro/));
501    
502          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
503              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 599  Line 506 
506                  my $from = $2;                  my $from = $2;
507                  my $to = $3;                  my $to = $3;
508                  my $evalue;                  my $evalue;
509                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
510                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
511                      my $part1 = $2/100;                      my $part1 = $2/100;
512                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
513                  }                  }
514                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
515                        $evalue=$raw_evalue;
516                    }
517                  else{                  else{
518                      $evalue = "0.0";                      $evalue = "0.0";
519                  }                  }
# Line 613  Line 523 
523                                 'type' => "dom" ,                                 'type' => "dom" ,
524                                 'evalue' => $evalue,                                 'evalue' => $evalue,
525                                 'start' => $from,                                 'start' => $from,
526                                 'stop' => $to                                 'stop' => $to,
527                                   'fig_id' => $fid,
528                                   'score' => $raw_evalue
529                                 };                                 };
530    
531                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 624  Line 536 
536    
537  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
538    
539      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
540      my $fig = new FIG;      #my $fig = new FIG;
541    
542      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
543    
544      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};      my $dataset = {'type' => "loc",
545      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
546                       'fig_id' => $fid
547                       };
548    
549        foreach my $attr_ref (@$attributes_ref){
550          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
551            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $sub_class = $parts[0];          my $sub_class = $parts[0];
554          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 646  Line 563 
563                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
564              }              }
565          }          }
566    
567          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
568              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
569              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
570          }          }
         elsif($sub_class eq "TMPRED"){  
             my @value_parts = split(";",$value);  
             $dataset->{'tmpred_score'} = $value_parts[0];  
             $dataset->{'tmpred_locations'} = $value_parts[1];  
         }  
     }  
   
     push (@{$datasets_ref} ,$dataset);  
571    
572            elsif($sub_class eq "Phobius"){
573                if($sub_key eq "transmembrane"){
574                    $dataset->{'phobius_tm_locations'} = $value;
575                }
576                elsif($sub_key eq "signal"){
577                    $dataset->{'phobius_signal_location'} = $value;
578  }  }
   
   
 =head3 get_attribute_based_evidence (internal)  
   
 This method retrieves evidence from the attribute server  
   
 =cut  
   
 sub get_attribute_based_observations{  
   
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$datasets_ref) = (@_);  
   
     my $_myfig = new FIG;  
   
     foreach my $attr_ref ($_myfig->get_attributes($fid)) {  
   
         # convert the ref into a string for easier handling  
         my ($string) = "@$attr_ref";  
   
 #       print "S:$string\n";  
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
   
         # THIS SHOULD BE DONE ANOTHER WAY FM->TD  
         # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc  
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
   
         if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  
   
             # some keys are composite CDD::1233244 or PFAM:PF1233  
   
             if ( $key =~ /::/ ) {  
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
579              }              }
580    
581              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );          elsif($sub_class eq "TMPRED"){
582                my @value_parts = split(/\;/,$value);
583              my $evalue= 255;              $dataset->{'tmpred_score'} = $value_parts[0];
584              if (defined $raw_evalue) { # some of the tool do not give us an evalue              $dataset->{'tmpred_locations'} = $value_parts[1];
   
                 my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  
                 my ($new_k, $new_exp);  
   
                 #  
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
   
 #                   $new_exp = (1000+$expo);  
         #           $new_k = $k / 100;  
   
585                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
586              }              }
587    
             # unroll it all into an array of hashes  
             # this needs to be done differently for different types of observations  
             my $dataset = [ { name => 'class', value => $key },  
                             { name => 'acc' , value => $acc},  
                             { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  
                             { name => 'evalue', value => $evalue },  
                             { name => 'start', value => $from},  
                             { name => 'stop' , value => $to}  
                             ];  
   
588              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
589          }  
     }  
590  }  }
591    
592  =head3 get_pdb_observations() (internal)  =head3 get_pdb_observations() (internal)
# Line 741  Line 596 
596  =cut  =cut
597    
598  sub get_pdb_observations{  sub get_pdb_observations{
599      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
600    
601      my $fig = new FIG;      #my $fig = new FIG;
   
     print STDERR "get pdb obs called\n";  
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
602    
603        foreach my $attr_ref (@$attributes_ref){
604          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
605            next if ( ($key !~ /PDB/));
606          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
607          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
608          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 767  Line 621 
621                         'acc' => $key2,                         'acc' => $key2,
622                         'evalue' => $evalue,                         'evalue' => $evalue,
623                         'start' => $start,                         'start' => $start,
624                         'stop' => $stop                         'stop' => $stop,
625                           'fig_id' => $fid
626                         };                         };
627    
628          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
629      }      }
   
630  }  }
631    
   
   
   
632  =head3 get_cluster_observations() (internal)  =head3 get_cluster_observations() (internal)
633    
634  This methods sets the type and class for cluster observations  This methods sets the type and class for cluster observations
# Line 785  Line 636 
636  =cut  =cut
637    
638  sub get_cluster_observations{  sub get_cluster_observations{
639      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$scope) = (@_);
640    
641      my $dataset = {'class' => 'CLUSTER',      my $dataset = {'class' => 'CLUSTER',
642                     'type' => 'fc'                     'type' => 'fc',
643                       'context' => $scope,
644                       'fig_id' => $fid
645                     };                     };
646      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
647  }  }
# Line 802  Line 655 
655    
656  sub get_sims_observations{  sub get_sims_observations{
657    
658      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
659      my $fig = new FIG;      #my $fig = new FIG;
660  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
     my @sims= $fig->nsims($fid,100,1e-20,"all");  
661      my ($dataset);      my ($dataset);
662    
663      foreach my $sim (@sims){      foreach my $sim (@sims){
664            next if ($fig->is_deleted_fid($sim->[1]));
665          my $hit = $sim->[1];          my $hit = $sim->[1];
666          my $percent = $sim->[2];          my $percent = $sim->[2];
667          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 822  Line 676 
676          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
677    
678          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
679                        'query' => $sim->[0],
680                      'acc' => $hit,                      'acc' => $hit,
681                      'identity' => $percent,                      'identity' => $percent,
682                      'type' => 'seq',                      'type' => 'seq',
# Line 834  Line 689 
689                      'organism' => $organism,                      'organism' => $organism,
690                      'function' => $func,                      'function' => $func,
691                      'qlength' => $qlength,                      'qlength' => $qlength,
692                      'hlength' => $hlength                      'hlength' => $hlength,
693                        'fig_id' => $fid
694                      };                      };
695    
696          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
# Line 857  Line 713 
713      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
714      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
715      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
716      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
717      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
718      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
719      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 866  Line 722 
722    
723  }  }
724    
725    
726  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
727    
728  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 874  Line 731 
731    
732  sub get_identical_proteins{  sub get_identical_proteins{
733    
734      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
735      my $fig = new FIG;      #my $fig = new FIG;
736      my @funcs = ();      my $funcs_ref;
737    
738      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
   
739      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
740          my ($tmp, $who);          my ($tmp, $who);
741          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
742              $who = &get_database($id);              $who = &get_database($id);
743              push(@funcs, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
744          }          }
745      }      }
746    
     my ($dataset);  
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
747          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
748                         'type' => 'seq',                         'type' => 'seq',
749                         'database' => $who,                     'fig_id' => $fid,
750                         'function' => $assignment                     'rows' => $funcs_ref
751                         };                         };
752    
753          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
754      }  
755    
756  }  }
757    
# Line 916  Line 763 
763    
764  sub get_functional_coupling{  sub get_functional_coupling{
765    
766      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
767      my $fig = new FIG;      #my $fig = new FIG;
768      my @funcs = ();      my @funcs = ();
769    
770      # initialize some variables      # initialize some variables
# Line 934  Line 781 
781                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
782                    } @fc_data;                    } @fc_data;
783    
     my ($dataset);  
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
784          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
785                         'type' => 'fc',                         'type' => 'fc',
786                         'function' => $description                     'fig_id' => $fid,
787                       'rows' => \@rows
788                         };                         };
789    
790          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
     }  
 }  
   
 =head3 get_sims_and_bbhs() (internal)  
   
 This methods retrieves sims and also BBHs and fills the internal data structures.  
   
 =cut  
   
 #     sub get_sims_and_bbhs{  
   
 #       # blast m8 output format  
 #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit  
   
 #       my $Sims=();  
 #       @sims_src = $fig->sims($fid,80,500,"fig",0);  
 #       print "found $#sims_src SIMs\n";  
 #       foreach $sims (@sims_src) {  
 #           my ($sims_string) = "@$sims";  
 # #       print "$sims_string\n";  
 #           my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+  
 #                                             \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);  
 # #       print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";  
 #           $Sims{$rfid}{'eval'}=$eval;  
 #           $Sims{$rfid}{'start'}=$start;  
 #           $Sims{$rfid}{'stop'}=$stop;  
 #           print "$rfid $Sims{$rfid}{'eval'}\n";  
 #       }  
   
 #       # BBHs  
 #       my $BBHs=();  
   
 #       @bbhs_src = $fig->bbhs($fid,1.0e-10);  
 #       print "found $#bbhs_src BBHs\n";  
 #       foreach $bbh (@bbhs_src) {  
 #           #print "@$bbh\n";  
 #           my ($bbh_string) = "@$bbh";  
 #           my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);  
 #           #print "ID: $rfid, E:$eval, S:$score\n";  
 #           $BBHs{$rfid}{'eval'}=$eval;  
 #           $BBHs{$rfid}{'score'}=$score;  
 # #print "$rfid $BBHs{$rfid}{'eval'}\n";  
 #       }  
   
 #     }  
   
791    
792    }
793    
794  =head3 new (internal)  =head3 new (internal)
795    
# Line 1004  Line 800 
800  sub new {  sub new {
801    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
802    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
803    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
804                 type => $dataset->{'type'}                 type => $dataset->{'type'},
805                   fig_id => $dataset->{'fig_id'},
806                   score => $dataset->{'score'},
807             };             };
808    
809    bless($self,$class);    bless($self,$class);
# Line 1043  Line 823 
823      return $self->{identity};      return $self->{identity};
824  }  }
825    
826    =head3 fig_id (internal)
827    
828    =cut
829    
830    sub fig_id {
831      my ($self) = @_;
832      return $self->{fig_id};
833    }
834    
835  =head3 feature_id (internal)  =head3 feature_id (internal)
836    
837    
# Line 1127  Line 916 
916  =cut  =cut
917    
918  sub display{  sub display{
919      my ($self,$gd,$fid) = @_;      my ($self,$gd,$fig) = @_;
920    
921        my $fid = $self->fig_id;
922      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
923    
     print STDERR "PDB::display called\n";  
   
924      my $acc = $self->acc;      my $acc = $self->acc;
925    
     print STDERR "acc:$acc\n";  
926      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
927      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
928      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 1153  Line 940 
940      my $lines = [];      my $lines = [];
941      my $line_data = [];      my $line_data = [];
942      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
943                            'hover_title' => 'PDB',
944                          'short_title' => "best PDB",                          'short_title' => "best PDB",
945                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
946    
947      my $fig = new FIG;      #my $fig = new FIG;
948      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
949      my $fid_stop = length($seq);      my $fid_stop = length($seq);
950    
# Line 1238  Line 1026 
1026    
1027      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1028      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1029      $self->{id} = $dataset->{'id'};      $self->{rows} = $dataset->{'rows'};
     $self->{organism} = $dataset->{'organism'};  
     $self->{function} = $dataset->{'function'};  
     $self->{database} = $dataset->{'database'};  
1030    
1031      bless($self,$class);      bless($self,$class);
1032      return $self;      return $self;
1033  }  }
1034    
1035  =head3 display()  =head3 display_table()
1036    
1037  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1038  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1258  Line 1043 
1043    
1044  =cut  =cut
1045    
 sub display{  
     my ($self, $cgi, $dataset) = @_;  
1046    
1047    sub display_table{
1048        my ($self,$fig) = @_;
1049    
1050        #my $fig = new FIG;
1051        my $fid = $self->fig_id;
1052        my $rows = $self->rows;
1053        my $cgi = new CGI;
1054      my $all_domains = [];      my $all_domains = [];
1055      my $count_identical = 0;      my $count_identical = 0;
1056      my $content;      my $content;
1057      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1058          next if ($thing->class ne "IDENTICAL");          my $id = $row->[0];
1059            my $who = $row->[1];
1060            my $assignment = $row->[2];
1061            my $organism = $fig->org_of($id);
1062          my $single_domain = [];          my $single_domain = [];
1063          push(@$single_domain,$thing->database);          push(@$single_domain,$who);
         my $id = $thing->id;  
         $count_identical++;  
1064          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1065          push(@$single_domain,$thing->organism);          push(@$single_domain,$organism);
1066          #push(@$single_domain,$thing->type);          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->function);  
1067          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
1068            $count_identical++;
1069      }      }
1070    
1071      if ($count_identical >0){      if ($count_identical >0){
# Line 1288  Line 1079 
1079    
1080  1;  1;
1081    
   
1082  #########################################  #########################################
1083  #########################################  #########################################
1084  package Observation::FC;  package Observation::FC;
# Line 1300  Line 1090 
1090    
1091      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1092      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1093      $self->{score} = $dataset->{'score'};      $self->{rows} = $dataset->{'rows'};
     $self->{id} = $dataset->{'id'};  
     $self->{function} = $dataset->{'function'};  
1094    
1095      bless($self,$class);      bless($self,$class);
1096      return $self;      return $self;
1097  }  }
1098    
1099  =head3 display()  =head3 display_table()
1100    
1101  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1102  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1319  Line 1107 
1107    
1108  =cut  =cut
1109    
1110  sub display {  sub display_table {
     my ($self,$cgi,$dataset, $fid) = @_;  
1111    
1112        my ($self,$dataset,$fig) = @_;
1113        my $fid = $self->fig_id;
1114        my $rows = $self->rows;
1115        my $cgi = new CGI;
1116      my $functional_data = [];      my $functional_data = [];
1117      my $count = 0;      my $count = 0;
1118      my $content;      my $content;
1119    
1120      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1121          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
1122          $count++;          $count++;
1123    
1124          # construct the score link          # construct the score link
1125          my $score = $thing->score;          my $score = $row->[0];
1126          my $toid = $thing->id;          my $toid = $row->[1];
1127          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1128          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1129    
1130          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1131          push(@$single_domain,$thing->id);          push(@$single_domain,$row->[1]);
1132          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
1133          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
1134      }      }
1135    
# Line 1376  Line 1166 
1166  sub display {  sub display {
1167      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1168      my $lines = [];      my $lines = [];
1169      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1170                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1171                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1172      my $color = "4";      my $color = "4";
1173    
1174      my $line_data = [];      my $line_data = [];
# Line 1407  Line 1197 
1197              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1198          }          }
1199      }      }
1200        elsif($db =~ /PFAM/){
1201            my ($new_id) = ($id) =~ /(.*?)_/;
1202            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1203            if(!scalar(@$pfam_objs)){
1204                $name_title = "name";
1205                $name_value = "not available";
1206                $description_title = "description";
1207                $description_value = "not available";
1208            }
1209            else{
1210                my $pfam_obj = $pfam_objs->[0];
1211                $name_title = "name";
1212                $name_value = $pfam_obj->term;
1213                #$description_title = "description";
1214                #$description_value = $pfam_obj->description;
1215            }
1216        }
1217    
1218        my $short_title = $thing->acc;
1219        $short_title =~ s/::/ - /ig;
1220        my $new_short_title=$short_title;
1221        if ($short_title =~ /interpro/){
1222            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1223        }
1224        my $line_config = { 'title' => $name_value,
1225                            'hover_title', => 'Domain',
1226                            'short_title' => $new_short_title,
1227                            'basepair_offset' => '1' };
1228    
1229      my $name;      my $name;
1230      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1231               "value" => $name_value};      $name = {"title" => $db,
1232                 "value" => $new_id};
1233      push(@$descriptions,$name);      push(@$descriptions,$name);
1234    
1235      my $description;  #    my $description;
1236      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1237                               "value" => $description_value};  #                   "value" => $description_value};
1238      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1239    
1240      my $score;      my $score;
1241      $score = {"title" => "score",      $score = {"title" => "score",
1242                "value" => $thing->evalue};                "value" => $thing->evalue};
1243      push(@$descriptions,$score);      push(@$descriptions,$score);
1244    
1245        my $location;
1246        $location = {"title" => "location",
1247                     "value" => $thing->start . " - " . $thing->stop};
1248        push(@$descriptions,$location);
1249    
1250      my $link_id;      my $link_id;
1251      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1252          $link_id = $1;          $link_id = $1;
1253      }      }
1254    
# Line 1439  Line 1263 
1263      push(@$links_list,$link);      push(@$links_list,$link);
1264    
1265      my $element_hash = {      my $element_hash = {
1266          "title" => $thing->type,          "title" => $name_value,
1267          "start" => $thing->start,          "start" => $thing->start,
1268          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1269          "color"=> $color,          "color"=> $color,
# Line 1454  Line 1278 
1278    
1279  }  }
1280    
1281  #########################################  sub display_table {
1282  #########################################      my ($self,$dataset) = @_;
1283  package Observation::Location;      my $cgi = new CGI;
1284        my $data = [];
1285        my $count = 0;
1286        my $content;
1287    
1288        foreach my $thing (@$dataset) {
1289            next if ($thing->type !~ /dom/);
1290            my $single_domain = [];
1291            $count++;
1292    
1293            my $db_and_id = $thing->acc;
1294            my ($db,$id) = split("::",$db_and_id);
1295    
1296            my $dbmaster = DBMaster->new(-database =>'Ontology');
1297    
1298            my ($name_title,$name_value,$description_title,$description_value);
1299            if($db eq "CDD"){
1300                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1301                if(!scalar(@$cdd_objs)){
1302                    $name_title = "name";
1303                    $name_value = "not available";
1304                    $description_title = "description";
1305                    $description_value = "not available";
1306                }
1307                else{
1308                    my $cdd_obj = $cdd_objs->[0];
1309                    $name_title = "name";
1310                    $name_value = $cdd_obj->term;
1311                    $description_title = "description";
1312                    $description_value = $cdd_obj->description;
1313                }
1314            }
1315    
1316            my $location =  $thing->start . " - " . $thing->stop;
1317    
1318            push(@$single_domain,$db);
1319            push(@$single_domain,$thing->acc);
1320            push(@$single_domain,$name_value);
1321            push(@$single_domain,$location);
1322            push(@$single_domain,$thing->evalue);
1323            push(@$single_domain,$description_value);
1324            push(@$data,$single_domain);
1325        }
1326    
1327        if ($count >0){
1328            $content = $data;
1329        }
1330        else
1331        {
1332            $content = "<p>This PEG does not have any similarities to domains</p>";
1333        }
1334    }
1335    
1336    
1337    #########################################
1338    #########################################
1339    package Observation::Location;
1340    
1341  use base qw(Observation);  use base qw(Observation);
1342    
# Line 1471  Line 1351 
1351      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1352      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1353      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1354        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1355        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1356    
1357      bless($self,$class);      bless($self,$class);
1358      return $self;      return $self;
1359  }  }
1360    
1361    sub display_cello {
1362        my ($thing) = @_;
1363        my $html;
1364        my $cello_location = $thing->cello_location;
1365        my $cello_score = $thing->cello_score;
1366        if($cello_location){
1367            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1368            #$html .= "<p>CELLO score: $cello_score </p>";
1369        }
1370        return ($html);
1371    }
1372    
1373  sub display {  sub display {
1374      my ($thing,$gd,$fid) = @_;      my ($thing,$gd,$fig) = @_;
1375    
1376      my $fig= new FIG;      my $fid = $thing->fig_id;
1377        #my $fig= new FIG;
1378      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1379    
1380      my $cleavage_prob;      my $cleavage_prob;
# Line 1491  Line 1386 
1386      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1387      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1388    
1389        my $phobius_signal_location = $thing->phobius_signal_location;
1390        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1391    
1392      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1393    
1394      #color is      #color is
1395      my $color = "5";      my $color = "6";
1396    
1397      my $line_data = [];  =pod=
1398    
1399      if($cello_location){      if($cello_location){
1400          my $cello_descriptions = [];          my $cello_descriptions = [];
1401            my $line_data =[];
1402    
1403            my $line_config = { 'title' => 'Localization Evidence',
1404                                'short_title' => 'CELLO',
1405                                'hover_title' => 'Localization',
1406                                'basepair_offset' => '1' };
1407    
1408          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1409                                            "value" => $cello_location};                                            "value" => $cello_location};
1410    
# Line 1515  Line 1417 
1417    
1418          my $element_hash = {          my $element_hash = {
1419              "title" => "CELLO",              "title" => "CELLO",
1420                "color"=> $color,
1421              "start" => "1",              "start" => "1",
1422              "end" =>  $length + 1,              "end" =>  $length + 1,
1423              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1424              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1425    
1426          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1427            $gd->add_line($line_data, $line_config);
1428      }      }
1429    
1430      my $color = "6";      $color = "2";
     #if(0){  
1431      if($tmpred_score){      if($tmpred_score){
1432            my $line_data =[];
1433            my $line_config = { 'title' => 'Localization Evidence',
1434                                'short_title' => 'Transmembrane',
1435                                'basepair_offset' => '1' };
1436    
1437          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1438              my $descriptions = [];              my $descriptions = [];
1439              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1542  Line 1448 
1448              "end" =>  $end + 1,              "end" =>  $end + 1,
1449              "color"=> $color,              "color"=> $color,
1450              "zlayer" => '5',              "zlayer" => '5',
1451              "type" => 'smallbox',              "type" => 'box',
1452              "description" => $descriptions};              "description" => $descriptions};
1453    
1454              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1455    
1456            }
1457            $gd->add_line($line_data, $line_config);
1458          }          }
1459    =cut
1460    
1461        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1462            my $line_data =[];
1463            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1464                                'short_title' => 'TM and SP',
1465                                'hover_title' => 'Localization',
1466                                'basepair_offset' => '1' };
1467    
1468            foreach my $tm_loc (@phobius_tm_locations){
1469                my $descriptions = [];
1470                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1471                                 "value" => $tm_loc};
1472                push(@$descriptions,$description_phobius_tm_locations);
1473    
1474                my ($begin,$end) =split("-",$tm_loc);
1475    
1476                my $element_hash = {
1477                "title" => "Phobius",
1478                "start" => $begin + 1,
1479                "end" =>  $end + 1,
1480                "color"=> '6',
1481                "zlayer" => '4',
1482                "type" => 'bigbox',
1483                "description" => $descriptions};
1484    
1485                push(@$line_data,$element_hash);
1486    
1487      }      }
1488    
1489      my $color = "1";          if($phobius_signal_location){
1490                my $descriptions = [];
1491                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1492                                 "value" => $phobius_signal_location};
1493                push(@$descriptions,$description_phobius_signal_location);
1494    
1495    
1496                my ($begin,$end) =split("-",$phobius_signal_location);
1497                my $element_hash = {
1498                "title" => "phobius signal locations",
1499                "start" => $begin + 1,
1500                "end" =>  $end + 1,
1501                "color"=> '1',
1502                "zlayer" => '5',
1503                "type" => 'box',
1504                "description" => $descriptions};
1505                push(@$line_data,$element_hash);
1506            }
1507    
1508            $gd->add_line($line_data, $line_config);
1509        }
1510    
1511    =head3
1512        $color = "1";
1513      if($signal_peptide_score){      if($signal_peptide_score){
1514            my $line_data = [];
1515          my $descriptions = [];          my $descriptions = [];
1516    
1517            my $line_config = { 'title' => 'Localization Evidence',
1518                                'short_title' => 'SignalP',
1519                                'hover_title' => 'Localization',
1520                                'basepair_offset' => '1' };
1521    
1522          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1523                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1524    
# Line 1565  Line 1532 
1532          my $element_hash = {          my $element_hash = {
1533              "title" => "SignalP",              "title" => "SignalP",
1534              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1535              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1536              "type" => 'bigbox',              "type" => 'bigbox',
1537              "color"=> $color,              "color"=> $color,
1538              "zlayer" => '10',              "zlayer" => '10',
1539              "description" => $descriptions};              "description" => $descriptions};
1540    
1541          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1542      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1543        }
1544    =cut
1545    
1546      return ($gd);      return ($gd);
1547    
# Line 1622  Line 1589 
1589    return $self->{cello_score};    return $self->{cello_score};
1590  }  }
1591    
1592    sub phobius_signal_location {
1593      my ($self) = @_;
1594      return $self->{phobius_signal_location};
1595    }
1596    
1597    sub phobius_tm_locations {
1598      my ($self) = @_;
1599      return $self->{phobius_tm_locations};
1600    }
1601    
1602    
1603    
1604  #########################################  #########################################
1605  #########################################  #########################################
# Line 1635  Line 1613 
1613      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1614      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1615      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1616        $self->{query} = $dataset->{'query'};
1617      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1618      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1619      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1652  Line 1631 
1631    
1632  =head3 display()  =head3 display()
1633    
1634    If available use the function specified here to display a graphical observation.
1635    This code will display a graphical view of the similarities using the genome drawer object
1636    
1637    =cut
1638    
1639    sub display {
1640        my ($self,$gd,$array,$fig) = @_;
1641        #my $fig = new FIG;
1642    
1643        my @ids;
1644        foreach my $thing(@$array){
1645            next if ($thing->class ne "SIM");
1646            push (@ids, $thing->acc);
1647        }
1648    
1649        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1650    
1651        foreach my $thing (@$array){
1652            if ($thing->class eq "SIM"){
1653    
1654                my $peg = $thing->acc;
1655                my $query = $thing->query;
1656    
1657                my $organism = $thing->organism;
1658                my $genome = $fig->genome_of($peg);
1659                my ($org_tax) = ($genome) =~ /(.*)\./;
1660                my $function = $thing->function;
1661                my $abbrev_name = $fig->abbrev($organism);
1662                my $align_start = $thing->qstart;
1663                my $align_stop = $thing->qstop;
1664                my $hit_start = $thing->hstart;
1665                my $hit_stop = $thing->hstop;
1666    
1667                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1668    
1669                my $line_config = { 'title' => "$organism [$org_tax]",
1670                                    'short_title' => "$abbrev_name",
1671                                    'title_link' => '$tax_link',
1672                                    'basepair_offset' => '0'
1673                                    };
1674    
1675                my $line_data = [];
1676    
1677                my $element_hash;
1678                my $links_list = [];
1679                my $descriptions = [];
1680    
1681                # get subsystem information
1682                my $url_link = "?page=Annotation&feature=".$peg;
1683                my $link;
1684                $link = {"link_title" => $peg,
1685                         "link" => $url_link};
1686                push(@$links_list,$link);
1687    
1688                #my @subsystems = $fig->peg_to_subsystems($peg);
1689                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1690                my @subsystems;
1691    
1692                foreach my $array (@subs){
1693                    my $subsystem = $$array[0];
1694                    push(@subsystems,$subsystem);
1695                    my $link;
1696                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1697                             "link_title" => $subsystem};
1698                    push(@$links_list,$link);
1699                }
1700    
1701                $link = {"link_title" => "view blast alignment",
1702                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1703                push (@$links_list,$link);
1704    
1705                my $description_function;
1706                $description_function = {"title" => "function",
1707                                         "value" => $function};
1708                push(@$descriptions,$description_function);
1709    
1710                my ($description_ss, $ss_string);
1711                $ss_string = join (",", @subsystems);
1712                $description_ss = {"title" => "subsystems",
1713                                   "value" => $ss_string};
1714                push(@$descriptions,$description_ss);
1715    
1716                my $description_loc;
1717                $description_loc = {"title" => "location start",
1718                                    "value" => $hit_start};
1719                push(@$descriptions, $description_loc);
1720    
1721                $description_loc = {"title" => "location stop",
1722                                    "value" => $hit_stop};
1723                push(@$descriptions, $description_loc);
1724    
1725                my $evalue = $thing->evalue;
1726                while ($evalue =~ /-0/)
1727                {
1728                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1729                    $chunk2 = substr($chunk2,1);
1730                    $evalue = $chunk1 . "-" . $chunk2;
1731                }
1732    
1733                my $color = &color($evalue);
1734    
1735                my $description_eval = {"title" => "E-Value",
1736                                        "value" => $evalue};
1737                push(@$descriptions, $description_eval);
1738    
1739                my $identity = $self->identity;
1740                my $description_identity = {"title" => "Identity",
1741                                            "value" => $identity};
1742                push(@$descriptions, $description_identity);
1743    
1744                $element_hash = {
1745                    "title" => $peg,
1746                    "start" => $align_start,
1747                    "end" =>  $align_stop,
1748                    "type"=> 'box',
1749                    "color"=> $color,
1750                    "zlayer" => "2",
1751                    "links_list" => $links_list,
1752                    "description" => $descriptions
1753                    };
1754                push(@$line_data,$element_hash);
1755                $gd->add_line($line_data, $line_config);
1756            }
1757        }
1758        return ($gd);
1759    }
1760    
1761    =head3 display_domain_composition()
1762    
1763    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1764    
1765    =cut
1766    
1767    sub display_domain_composition {
1768        my ($self,$gd,$fig) = @_;
1769    
1770        #$fig = new FIG;
1771        my $peg = $self->acc;
1772    
1773        my $line_data = [];
1774        my $links_list = [];
1775        my $descriptions = [];
1776    
1777        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1778        #my @domain_query_results = ();
1779        foreach $dqr (@domain_query_results){
1780            my $key = @$dqr[1];
1781            my @parts = split("::",$key);
1782            my $db = $parts[0];
1783            my $id = $parts[1];
1784            my $val = @$dqr[2];
1785            my $from;
1786            my $to;
1787            my $evalue;
1788    
1789            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1790                my $raw_evalue = $1;
1791                $from = $2;
1792                $to = $3;
1793                if($raw_evalue =~/(\d+)\.(\d+)/){
1794                    my $part2 = 1000 - $1;
1795                    my $part1 = $2/100;
1796                    $evalue = $part1."e-".$part2;
1797                }
1798                else{
1799                    $evalue = "0.0";
1800                }
1801            }
1802    
1803            my $dbmaster = DBMaster->new(-database =>'Ontology');
1804            my ($name_value,$description_value);
1805    
1806            if($db eq "CDD"){
1807                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1808                if(!scalar(@$cdd_objs)){
1809                    $name_title = "name";
1810                    $name_value = "not available";
1811                    $description_title = "description";
1812                    $description_value = "not available";
1813                }
1814                else{
1815                    my $cdd_obj = $cdd_objs->[0];
1816                    $name_value = $cdd_obj->term;
1817                    $description_value = $cdd_obj->description;
1818                }
1819            }
1820    
1821            my $domain_name;
1822            $domain_name = {"title" => "name",
1823                            "value" => $name_value};
1824            push(@$descriptions,$domain_name);
1825    
1826            my $description;
1827            $description = {"title" => "description",
1828                            "value" => $description_value};
1829            push(@$descriptions,$description);
1830    
1831            my $score;
1832            $score = {"title" => "score",
1833                      "value" => $evalue};
1834            push(@$descriptions,$score);
1835    
1836            my $link_id = $id;
1837            my $link;
1838            my $link_url;
1839            if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1840            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1841            else{$link_url = "NO_URL"}
1842    
1843            $link = {"link_title" => $name_value,
1844                     "link" => $link_url};
1845            push(@$links_list,$link);
1846    
1847            my $domain_element_hash = {
1848                "title" => $peg,
1849                "start" => $from,
1850                "end" =>  $to,
1851                "type"=> 'box',
1852                "zlayer" => '4',
1853                "links_list" => $links_list,
1854                "description" => $descriptions
1855                };
1856    
1857            push(@$line_data,$domain_element_hash);
1858    
1859            #just one CDD domain for now, later will add option for multiple domains from selected DB
1860            last;
1861        }
1862    
1863        my $line_config = { 'title' => $peg,
1864                            'hover_title' => 'Domain',
1865                            'short_title' => $peg,
1866                            'basepair_offset' => '1' };
1867    
1868        $gd->add_line($line_data, $line_config);
1869    
1870        return ($gd);
1871    
1872    }
1873    
1874    =head3 display_table()
1875    
1876  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1877  This code will display a table for the similarities protein  This code will display a table for the similarities protein
1878    
# Line 1659  Line 1880 
1880    
1881  =cut  =cut
1882    
1883  sub display {  sub display_table {
1884      my ($self,$cgi,$dataset) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1885    
1886      my $data = [];      my $data = [];
1887      my $count = 0;      my $count = 0;
1888      my $content;      my $content;
1889      my $fig = new FIG;      #my $fig = new FIG;
1890        my $cgi = new CGI;
1891        my @ids;
1892        foreach my $thing (@$dataset) {
1893            next if ($thing->class ne "SIM");
1894            push (@ids, $thing->acc);
1895        }
1896    
1897        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1898        my @attributes = $fig->get_attributes(\@ids);
1899    
1900        # get the column for the subsystems
1901        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1902    
1903        # get the column for the evidence codes
1904        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1905    
1906        # get the column for pfam_domain
1907        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1908    
1909        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1910        my $alias_col = &get_aliases(\@ids,$fig);
1911        #my $alias_col = {};
1912    
1913      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
         my $single_domain = [];  
1914          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1915            my $single_domain = [];
1916          $count++;          $count++;
1917    
1918          my $id = $thing->acc;          my $id = $thing->acc;
1919            my $taxid   = $fig->genome_of($id);
1920            my $iden    = $thing->identity;
1921            my $ln1     = $thing->qlength;
1922            my $ln2     = $thing->hlength;
1923            my $b1      = $thing->qstart;
1924            my $e1      = $thing->qstop;
1925            my $b2      = $thing->hstart;
1926            my $e2      = $thing->hstop;
1927            my $d1      = abs($e1 - $b1) + 1;
1928            my $d2      = abs($e2 - $b2) + 1;
1929            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1930            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1931    
1932          # add the subsystem information          # checkbox column
1933          my @in_sub  = $fig->peg_to_subsystems($id);          my $field_name = "tables_" . $id;
1934          my $in_sub;          my $pair_name = "visual_" . $id;
1935            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1936            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1937    
1938            # get the linked fig id
1939            my $fig_col;
1940            if (defined ($e_identical{$id})){
1941                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1942            }
1943            else{
1944                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1945            }
1946    
1947          if (@in_sub > 0) {          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1948              $in_sub = @in_sub;                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1949    
1950              # RAE: add a javascript popup with all the subsystems          foreach my $col (sort keys %$scroll_list){
1951              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1952              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1953                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1954                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1955                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1956                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1957                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1958                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1959                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1960                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1961                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1962                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1963                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1964                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1965                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1966            }
1967            push(@$data,$single_domain);
1968        }
1969        if ($count >0 ){
1970            $content = $data;
1971        }
1972        else{
1973            $content = "<p>This PEG does not have any similarities</p>";
1974        }
1975        return ($content);
1976    }
1977    
1978    sub get_box_column{
1979        my ($ids) = @_;
1980        my %column;
1981        foreach my $id (@$ids){
1982            my $field_name = "tables_" . $id;
1983            my $pair_name = "visual_" . $id;
1984            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1985        }
1986        return (%column);
1987    }
1988    
1989    sub get_subsystems_column{
1990        my ($ids,$fig) = @_;
1991    
1992        #my $fig = new FIG;
1993        my $cgi = new CGI;
1994        my %in_subs  = $fig->subsystems_for_pegs($ids);
1995        my %column;
1996        foreach my $id (@$ids){
1997            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1998            my @subsystems;
1999    
2000            if (@in_sub > 0) {
2001                foreach my $array(@in_sub){
2002                    my $ss = $$array[0];
2003                    $ss =~ s/_/ /ig;
2004                    push (@subsystems, "-" . $ss);
2005                }
2006                my $in_sub_line = join ("<br>", @subsystems);
2007                $column{$id} = $in_sub_line;
2008          } else {          } else {
2009              $in_sub = "&nbsp;";              $column{$id} = "&nbsp;";
2010            }
2011        }
2012        return (%column);
2013    }
2014    
2015    sub get_essentially_identical{
2016        my ($fid,$dataset,$fig) = @_;
2017        #my $fig = new FIG;
2018    
2019        my %id_list;
2020        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2021    
2022        foreach my $thing (@$dataset){
2023            if($thing->class eq "IDENTICAL"){
2024                my $rows = $thing->rows;
2025                my $count_identical = 0;
2026                foreach my $row (@$rows) {
2027                    my $id = $row->[0];
2028                    if (($id ne $fid) && ($fig->function_of($id))) {
2029                        $id_list{$id} = 1;
2030                    }
2031                }
2032            }
2033        }
2034    
2035    #    foreach my $id (@maps_to) {
2036    #        if (($id ne $fid) && ($fig->function_of($id))) {
2037    #           $id_list{$id} = 1;
2038    #        }
2039    #    }
2040        return(%id_list);
2041    }
2042    
2043    
2044    sub get_evidence_column{
2045        my ($ids, $attributes,$fig) = @_;
2046        #my $fig = new FIG;
2047        my $cgi = new CGI;
2048        my (%column, %code_attributes);
2049    
2050        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2051        foreach my $key (@codes){
2052            push (@{$code_attributes{$$key[0]}}, $key);
2053          }          }
2054    
2055        foreach my $id (@$ids){
2056          # add evidence code with tool tip          # add evidence code with tool tip
2057          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
2058          my @ev_codes = "";  
2059          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2060              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);          my @ev_codes = ();
             @ev_codes = ();  
2061              foreach my $code (@codes) {              foreach my $code (@codes) {
2062                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2063                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 1703  Line 2067 
2067                  }                  }
2068                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2069              }              }
         }  
2070    
2071          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2072              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 1711  Line 2074 
2074                                  {                                  {
2075                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2076          }          }
2077            $column{$id}=$ev_codes;
2078        }
2079        return (%column);
2080    }
2081    
2082          # add the aliases  sub get_pfam_column{
2083          my $aliases = undef;      my ($ids, $attributes,$fig) = @_;
2084          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      #my $fig = new FIG;
2085          $aliases = &HTML::set_prot_links( $cgi, $aliases );      my $cgi = new CGI;
2086          $aliases ||= "&nbsp;";      my (%column, %code_attributes, %attribute_locations);
2087        my $dbmaster = DBMaster->new(-database =>'Ontology');
2088    
2089          my $iden    = $thing->identity;      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2090          my $ln1     = $thing->qlength;      foreach my $key (@codes){
2091          my $ln2     = $thing->hlength;          my $name = $key->[1];
2092          my $b1      = $thing->qstart;          if ($name =~ /_/){
2093          my $e1      = $thing->qstop;              ($name) = ($key->[1]) =~ /(.*?)_/;
2094          my $b2      = $thing->hstart;          }
2095          my $e2      = $thing->hstop;          push (@{$code_attributes{$key->[0]}}, $name);
2096          my $d1      = abs($e1 - $b1) + 1;          push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2097          my $d2      = abs($e2 - $b2) + 1;      }
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
2098    
2099        foreach my $id (@$ids){
2100            # add evidence code
2101            my $pfam_codes=" &nbsp; ";
2102            my @pfam_codes = "";
2103            my %description_codes;
2104    
2105          push(@$single_domain,$thing->database);          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2106          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2107          push(@$single_domain,$thing->evalue);              @pfam_codes = ();
2108          push(@$single_domain,"$iden\%");  
2109          push(@$single_domain,$reg1);              # get only unique values
2110          push(@$single_domain,$reg2);              my %saw;
2111          push(@$single_domain,$in_sub);              foreach my $key (@ncodes) {$saw{$key}=1;}
2112          push(@$single_domain,$ev_codes);              @ncodes = keys %saw;
2113          push(@$single_domain,$thing->organism);  
2114          push(@$single_domain,$thing->function);              foreach my $code (@ncodes) {
2115          push(@$single_domain,$aliases);                  my @parts = split("::",$code);
2116          push(@$data,$single_domain);                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2117    
2118                    # get the locations for the domain
2119                    my @locs;
2120                    foreach my $part (@{$attribute_location{$id}{$code}}){
2121                        my ($loc) = ($part) =~ /\;(.*)/;
2122                        push (@locs,$loc);
2123                    }
2124                    my %locsaw;
2125                    foreach my $key (@locs) {$locsaw{$key}=1;}
2126                    @locs = keys %locsaw;
2127    
2128                    my $locations = join (", ", @locs);
2129    
2130                    if (defined ($description_codes{$parts[1]})){
2131                        push(@pfam_codes, "$parts[1] ($locations)");
2132                    }
2133                    else {
2134                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2135                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2136                        push(@pfam_codes, "$pfam_link ($locations)");
2137                    }
2138                }
2139      }      }
2140    
2141      if ($count >0){          $column{$id}=join("<br><br>", @pfam_codes);
         $content = $data;  
2142      }      }
2143      else      return (%column);
2144      {  
2145          $content = "<p>This PEG does not have any similarities</p>";  }
2146    
2147    sub get_aliases {
2148        my ($ids,$fig) = @_;
2149    
2150        my $all_aliases = $fig->feature_aliases_bulk($ids);
2151        foreach my $id (@$ids){
2152            foreach my $alias (@{$$all_aliases{$id}}){
2153                my $id_db = &Observation::get_database($alias);
2154                next if ($aliases->{$id}->{$id_db});
2155                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2156      }      }
2157      return ($content);      }
2158        return ($aliases);
2159  }  }
2160    
2161  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2162    
2163    sub color {
2164        my ($evalue) = @_;
2165        my $palette = WebColors::get_palette('vitamins');
2166        my $color;
2167        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2168        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2169        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2170        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2171        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2172        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2173        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2174        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2175        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2176        else{        $color = $palette->[9];    }
2177        return ($color);
2178    }
2179    
2180    
2181  ############################  ############################
# Line 1768  Line 2187 
2187    
2188      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
2189      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
2190        $self->{context} = $dataset->{'context'};
2191      bless($self,$class);      bless($self,$class);
2192      return $self;      return $self;
2193  }  }
2194    
2195  sub display {  sub display {
2196      my ($self,$gd, $fid) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2197    
2198      my $fig = new FIG;      my $fid = $self->fig_id;
2199        my $compare_or_coupling = $self->context;
2200        my $gd_window_size = $gd->window_size;
2201        my $range = $gd_window_size;
2202      my $all_regions = [];      my $all_regions = [];
2203        my $gene_associations={};
2204    
2205      #get the organism genome      #get the organism genome
2206      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2207        $gene_associations->{$fid}->{"organism"} = $target_genome;
2208        $gene_associations->{$fid}->{"main_gene"} = $fid;
2209        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2210    
2211      # get location of the gene      # get location of the gene
2212      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
2213      my ($contig, $beg, $end);      my ($contig, $beg, $end);
2214        my %reverse_flag;
2215    
2216      if ($data =~ /(.*)_(\d+)_(\d+)$/){      if ($data =~ /(.*)_(\d+)_(\d+)$/){
2217          $contig = $1;          $contig = $1;
# Line 1792  Line 2219 
2219          $end = $3;          $end = $3;
2220      }      }
2221    
2222        my $offset;
2223      my ($region_start, $region_end);      my ($region_start, $region_end);
2224      if ($beg < $end)      if ($beg < $end)
2225      {      {
2226          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2227          $region_end = $end+4000;          $region_end = $end+ ($range);
2228            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2229      }      }
2230      else      else
2231      {      {
2232          $region_end = $end+4000;          $region_start = $end-($range);
2233          $region_start = $beg-4000;          $region_end = $beg+($range);
2234            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2235            $reverse_flag{$target_genome} = $fid;
2236            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2237      }      }
2238    
2239      # call genes in region      # call genes in region
2240      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2241        #foreach my $feat (@$target_gene_features){
2242        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2243        #}
2244      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2245      my (@start_array_region);      my (@start_array_region);
2246      push (@start_array_region, $region_start);      push (@start_array_region, $offset);
2247    
2248      my %all_genes;      my %all_genes;
2249      my %all_genomes;      my %all_genomes;
2250      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2251            #if ($feature =~ /peg/){
2252      my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2253            #}
2254        }
2255    
2256      my $coup_count = 0;      my @selected_sims;
2257    
2258      foreach my $pair (@{$coup[0]->[2]}) {      if ($compare_or_coupling eq "sims"){
2259          last if ($coup_count > 10);          # get the selected boxes
2260          my ($peg1,$peg2) = @$pair;          my @selected_taxonomy = @$selected_taxonomies;
2261    
2262          my $location = $fig->feature_location($peg1);          # get the similarities and store only the ones that match the lineages selected
2263          my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);          if (@selected_taxonomy > 0){
2264          if($location =~/(.*)_(\d+)_(\d+)$/){              foreach my $sim (@$sims_array){
2265              $pair_contig = $1;                  next if ($sim->class ne "SIM");
2266              $pair_beg = $2;                  next if ($sim->acc !~ /fig\|/);
2267              $pair_end = $3;  
2268              if ($pair_beg < $pair_end)                  #my $genome = $fig->genome_of($sim->[1]);
2269              {                  my $genome = $fig->genome_of($sim->acc);
2270                  $pair_region_start = $pair_beg - 4000;                  #my ($genome1) = ($genome) =~ /(.*)\./;
2271                  $pair_region_stop = $pair_end+4000;                  #my $lineage = $taxes->{$genome1};
2272                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2273                    foreach my $taxon(@selected_taxonomy){
2274                        if ($lineage =~ /$taxon/){
2275                            #push (@selected_sims, $sim->[1]);
2276                            push (@selected_sims, $sim->acc);
2277              }              }
             else  
             {  
                 $pair_region_stop = $pair_end+4000;  
                 $pair_region_start = $pair_beg-4000;  
2278              }              }
   
             push (@start_array_region, $pair_region_start);  
   
             $pair_genome = $fig->genome_of($peg1);  
             $all_genomes{$pair_genome} = 1;  
             my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
             push(@$all_regions,$pair_features);  
             foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2279          }          }
         $coup_count++;  
2280      }      }
2281            else{
2282                my $simcount = 0;
2283                foreach my $sim (@$sims_array){
2284                    next if ($sim->class ne "SIM");
2285                    next if ($sim->acc !~ /fig\|/);
2286    
2287      my $bbh_sets = [];                  push (@selected_sims, $sim->acc);
2288      my %already;                  $simcount++;
2289      foreach my $gene_key (keys(%all_genes)){                  last if ($simcount > 4);
2290          if($already{$gene_key}){next;}              }
2291          my $gene_set = [$gene_key];          }
2292    
2293          my $gene_key_genome = $fig->genome_of($gene_key);          my %saw;
2294            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2295    
2296          foreach my $genome_key (keys(%all_genomes)){          # get the gene context for the sorted matches
2297              #next if ($gene_key_genome eq $genome_key);          foreach my $sim_fid(@selected_sims){
2298              my $return = $fig->bbh_list($genome_key,[$gene_key]);              #get the organism genome
2299                my $sim_genome = $fig->genome_of($sim_fid);
2300                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2301                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2302                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2303    
2304              my $feature_list = $return->{$gene_key};              # get location of the gene
2305              foreach my $fl (@$feature_list){              my $data = $fig->feature_location($sim_fid);
2306                  push(@$gene_set,$fl);              my ($contig, $beg, $end);
             }  
         }  
         $already{$gene_key} = 1;  
         push(@$bbh_sets,$gene_set);  
     }  
2307    
2308      my %bbh_set_rank;              if ($data =~ /(.*)_(\d+)_(\d+)$/){
2309      my $order = 0;                  $contig = $1;
2310      foreach my $set (@$bbh_sets){                  $beg = $2;
2311          my $count = scalar(@$set);                  $end = $3;
         $bbh_set_rank{$order} = $count;  
         $order++;  
2312      }      }
2313    
2314      my %peg_rank;              my $offset;
2315      my $counter =  1;              my ($region_start, $region_end);
2316      foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){              if ($beg < $end)
         my $good_set = @$bbh_sets[$bbh_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
2317          {          {
2318              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2319                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2320                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2321          }          }
2322          else          else
2323          {          {
2324              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2325                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2326                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2327                    $reverse_flag{$sim_genome} = $sim_fid;
2328                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2329              }              }
2330    
2331                # call genes in region
2332                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2333                push(@$all_regions,$sim_gene_features);
2334                push (@start_array_region, $offset);
2335                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2336                $all_genomes{$sim_genome} = 1;
2337          }          }
2338    
2339      }      }
2340    
2341      open (FH, ">$FIG_Config::temp/good_sets.txt");      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2342      foreach my $pr (sort {$peg_rank{$a} <=> $peg_rank{$b}} keys(%peg_rank)){ print FH "rank:$peg_rank{$pr}\tpr:$pr\n";}      # cluster the genes
2343      close (FH);      my @all_pegs = keys %all_genes;
2344        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2345        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2346        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2347    
2348      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2349          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2350          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2351          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2352          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2353            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2354            #my $lineage = $taxes->{$genome1};
2355            my $lineage = $fig->taxonomy_of($region_genome);
2356            #$region_gs .= "Lineage:$lineage";
2357          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2358                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2359                              'basepair_offset' => '0'                              'basepair_offset' => '0'
2360                              };                              };
2361    
2362          my $offset = shift @start_array_region;          my $offsetting = shift @start_array_region;
2363    
2364            my $second_line_config = { 'title' => "$lineage",
2365                                       'short_title' => "",
2366                                       'basepair_offset' => '0',
2367                                       'no_middle_line' => '1'
2368                                       };
2369    
2370          my $line_data = [];          my $line_data = [];
2371            my $second_line_data = [];
2372    
2373            # initialize variables to check for overlap in genes
2374            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2375            my $major_line_flag = 0;
2376            my $prev_second_flag = 0;
2377    
2378          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2379                $second_line_flag = 0;
2380              my $element_hash;              my $element_hash;
2381              my $links_list = [];              my $links_list = [];
2382              my $descriptions = [];              my $descriptions = [];
2383    
2384              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
             if ($color == 1) {  
                 print STDERR "PEG: $fid1, RANK: $color";  
             }  
2385    
2386              # get subsystem information              # get subsystem information
2387              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2388              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2389    
2390              my $link;              my $link;
2391              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2392                       "link" => $url_link};                       "link" => $url_link};
2393              push(@$links_list,$link);              push(@$links_list,$link);
2394    
2395              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2396              foreach my $subsystem (@subsystems){              my @subsystems;
2397                foreach my $array (@subs){
2398                    my $subsystem = $$array[0];
2399                    my $ss = $subsystem;
2400                    $ss =~ s/_/ /ig;
2401                    push (@subsystems, $ss);
2402                  my $link;                  my $link;
2403                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2404                           "link_title" => $subsystem};                           "link_title" => $ss};
2405                    push(@$links_list,$link);
2406                }
2407    
2408                if ($fid1 eq $fid){
2409                    my $link;
2410                    $link = {"link_title" => "Annotate this sequence",
2411                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2412                  push(@$links_list,$link);                  push(@$links_list,$link);
2413              }              }
2414    
# Line 1961  Line 2427 
2427              my $fid_location = $fig->feature_location($fid1);              my $fid_location = $fig->feature_location($fid1);
2428              if($fid_location =~/(.*)_(\d+)_(\d+)$/){              if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2429                  my($start,$stop);                  my($start,$stop);
2430                  if ($2 < $3){$start = $2; $stop = $3;}                  $start = $2 - $offsetting;
2431                  else{$stop = $2; $start = $3;}                  $stop = $3 - $offsetting;
2432                  $start = $start - $offset;  
2433                  $stop = $stop - $offset;                  if ( (($prev_start) && ($prev_stop) ) &&
2434                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2435                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2436                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2437                            $second_line_flag = 1;
2438                            $major_line_flag = 1;
2439                        }
2440                    }
2441                    $prev_start = $start;
2442                    $prev_stop = $stop;
2443                    $prev_fig = $fid1;
2444    
2445                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2446                        $start = $gd_window_size - $start;
2447                        $stop = $gd_window_size - $stop;
2448                    }
2449    
2450                    my $title = $fid1;
2451                    if ($fid1 eq $fid){
2452                        $title = "My query gene: $fid1";
2453                    }
2454    
2455                  $element_hash = {                  $element_hash = {
2456                      "title" => $fid1,                      "title" => $title,
2457                      "start" => $start,                      "start" => $start,
2458                      "end" =>  $stop,                      "end" =>  $stop,
2459                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1975  Line 2462 
2462                      "links_list" => $links_list,                      "links_list" => $links_list,
2463                      "description" => $descriptions                      "description" => $descriptions
2464                  };                  };
2465                  push(@$line_data,$element_hash);  
2466                    # if there is an overlap, put into second line
2467                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2468                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2469    
2470                    if ($fid1 eq $fid){
2471                        $element_hash = {
2472                            "title" => 'Query',
2473                            "start" => $start,
2474                            "end" =>  $stop,
2475                            "type"=> 'bigbox',
2476                            "color"=> $color,
2477                            "zlayer" => "1"
2478                            };
2479    
2480                        # if there is an overlap, put into second line
2481                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2482                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2483                    }
2484              }              }
2485          }          }
2486          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2487            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2488        }
2489        return ($gd, \@selected_sims);
2490    }
2491    
2492    sub cluster_genes {
2493        my($fig,$all_pegs,$peg) = @_;
2494        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2495    
2496        my @color_sets = ();
2497    
2498        $conn = &get_connections_by_similarity($fig,$all_pegs);
2499    
2500        for ($i=0; ($i < @$all_pegs); $i++) {
2501            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2502            if (! $seen{$i}) {
2503                $cluster = [$i];
2504                $seen{$i} = 1;
2505                for ($j=0; ($j < @$cluster); $j++) {
2506                    $x = $conn->{$cluster->[$j]};
2507                    foreach $k (@$x) {
2508                        if (! $seen{$k}) {
2509                            push(@$cluster,$k);
2510                            $seen{$k} = 1;
2511                        }
2512                    }
2513                }
2514    
2515                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2516                    push(@color_sets,$cluster);
2517                }
2518            }
2519        }
2520        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2521        $red_set = $color_sets[$i];
2522        splice(@color_sets,$i,1);
2523        @color_sets = sort { @$b <=> @$a } @color_sets;
2524        unshift(@color_sets,$red_set);
2525    
2526        my $color_sets = {};
2527        for ($i=0; ($i < @color_sets); $i++) {
2528            foreach $x (@{$color_sets[$i]}) {
2529                $color_sets->{$all_pegs->[$x]} = $i;
2530            }
2531        }
2532        return $color_sets;
2533    }
2534    
2535    sub get_connections_by_similarity {
2536        my($fig,$all_pegs) = @_;
2537        my($i,$j,$tmp,$peg,%pos_of);
2538        my($sim,%conn,$x,$y);
2539    
2540        for ($i=0; ($i < @$all_pegs); $i++) {
2541            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2542            push(@{$pos_of{$tmp}},$i);
2543            if ($tmp ne $all_pegs->[$i]) {
2544                push(@{$pos_of{$all_pegs->[$i]}},$i);
2545            }
2546        }
2547    
2548        foreach $y (keys(%pos_of)) {
2549            $x = $pos_of{$y};
2550            for ($i=0; ($i < @$x); $i++) {
2551                for ($j=$i+1; ($j < @$x); $j++) {
2552                    push(@{$conn{$x->[$i]}},$x->[$j]);
2553                    push(@{$conn{$x->[$j]}},$x->[$i]);
2554                }
2555            }
2556        }
2557    
2558        for ($i=0; ($i < @$all_pegs); $i++) {
2559            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2560                if (defined($x = $pos_of{$sim->id2})) {
2561                    foreach $y (@$x) {
2562                        push(@{$conn{$i}},$y);
2563                    }
2564                }
2565      }      }
     return $gd;  
2566  }  }
2567        return \%conn;
2568    }
2569    
2570    sub in {
2571        my($x,$xL) = @_;
2572        my($i);
2573    
2574        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2575        return ($i < @$xL);
2576    }
2577    
2578    #############################################
2579    #############################################
2580    package Observation::Commentary;
2581    
2582    use base qw(Observation);
2583    
2584    =head3 display_protein_commentary()
2585    
2586    =cut
2587    
2588    sub display_protein_commentary {
2589        my ($self,$dataset,$mypeg,$fig) = @_;
2590    
2591        my $all_rows = [];
2592        my $content;
2593        #my $fig = new FIG;
2594        my $cgi = new CGI;
2595        my $count = 0;
2596        my $peg_array = [];
2597        my (%evidence_column, %subsystems_column,  %e_identical);
2598    
2599        if (@$dataset != 1){
2600            foreach my $thing (@$dataset){
2601                if ($thing->class eq "SIM"){
2602                    push (@$peg_array, $thing->acc);
2603                }
2604            }
2605            # get the column for the evidence codes
2606            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2607    
2608            # get the column for the subsystems
2609            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2610    
2611            # get essentially identical seqs
2612            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2613        }
2614        else{
2615            push (@$peg_array, @$dataset);
2616        }
2617    
2618        my $selected_sims = [];
2619        foreach my $id (@$peg_array){
2620            last if ($count > 10);
2621            my $row_data = [];
2622            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2623            $org = $fig->org_of($id);
2624            $function = $fig->function_of($id);
2625            if ($mypeg ne $id){
2626                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2627                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2628                if (defined($e_identical{$id})) { $id_cell .= "*";}
2629            }
2630            else{
2631                $function_cell = "&nbsp;&nbsp;$function";
2632                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2633                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2634            }
2635    
2636            push(@$row_data,$id_cell);
2637            push(@$row_data,$org);
2638            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2639            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2640            push(@$row_data, $fig->translation_length($id));
2641            push(@$row_data,$function_cell);
2642            push(@$all_rows,$row_data);
2643            push (@$selected_sims, $id);
2644            $count++;
2645        }
2646    
2647        if ($count >0){
2648            $content = $all_rows;
2649        }
2650        else{
2651            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2652        }
2653        return ($content,$selected_sims);
2654    }
2655    
2656    sub display_protein_history {
2657        my ($self, $id,$fig) = @_;
2658        my $all_rows = [];
2659        my $content;
2660    
2661        my $cgi = new CGI;
2662        my $count = 0;
2663        foreach my $feat ($fig->feature_annotations($id)){
2664            my $row = [];
2665            my $col1 = $feat->[2];
2666            my $col2 = $feat->[1];
2667            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2668            my $text = $feat->[3];
2669    
2670            push (@$row, $col1);
2671            push (@$row, $col2);
2672            push (@$row, $text);
2673            push (@$all_rows, $row);
2674            $count++;
2675        }
2676        if ($count > 0){
2677            $content = $all_rows;
2678        }
2679        else {
2680            $content = "There is no history for this PEG";
2681        }
2682    
2683        return($content);
2684    }

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.50

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3