[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.10, Wed Jun 20 20:55:36 2007 UTC revision 1.42, Fri Oct 12 21:16:02 2007 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    use lib '/vol/ontologies';
4    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 strict;  use FIG_Config;
11  use warnings;  #use strict;
12    #use warnings;
13  use HTML;  use HTML;
14    
15  1;  1;
# Line 22  Line 27 
27    
28  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).
29    
 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  
   
30  =cut  =cut
31    
32  =head1 BACKGROUND  =head1 BACKGROUND
# Line 66  Line 50 
50    
51  The public methods this package provides are listed below:  The public methods this package provides are listed below:
52    
53    
54    =head3 context()
55    
56    Returns close or diverse for purposes of displaying genomic context
57    
58    =cut
59    
60    sub context {
61      my ($self) = @_;
62    
63      return $self->{context};
64    }
65    
66    =head3 rows()
67    
68    each row in a displayed table
69    
70    =cut
71    
72    sub rows {
73      my ($self) = @_;
74    
75      return $self->{rows};
76    }
77    
78  =head3 acc()  =head3 acc()
79    
80  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 74  Line 83 
83    
84  sub acc {  sub acc {
85    my ($self) = @_;    my ($self) = @_;
   
86    return $self->{acc};    return $self->{acc};
87  }  }
88    
89  =head3 description()  =head3 query()
90    
91  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.  
92    
93  =cut  =cut
94    
95  sub description {  sub query {
96    my ($self) = @_;    my ($self) = @_;
97        return $self->{query};
   return $self->{description};  
98  }  }
99    
100    
101  =head3 class()  =head3 class()
102    
103  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 118  Line 123 
123    
124  =item PFAM (dom)  =item PFAM (dom)
125    
126  =item SIGNALP (dom)  =item SIGNALP_CELLO_TMPRED (loc)
127    
128  =item  CELLO(loc)  =item PDB (seq)
129    
130  =item TMHMM (loc)  =item TMHMM (loc)
131    
# Line 159  Line 164 
164  sub type {  sub type {
165    my ($self) = @_;    my ($self) = @_;
166    
167    return $self->{acc};    return $self->{type};
168  }  }
169    
170  =head3 start()  =head3 start()
# Line 186  Line 191 
191    return $self->{stop};    return $self->{stop};
192  }  }
193    
194  =head3 evalue()  =head3 start()
195    
196  E-value or P-Value if present.  Start of hit in query sequence.
197    
198  =cut  =cut
199    
200  sub evalue {  sub qstart {
201    my ($self) = @_;    my ($self) = @_;
202    
203    return $self->{evalue};      return $self->{qstart};
204  }  }
205    
206  =head3 score()  =head3 qstop()
   
 Score if present.  
207    
208  B<Please note: >  End of the hit in query sequence.
 Either score or eval are required.  
209    
210  =cut  =cut
211    
212  sub score {  sub qstop {
213    my ($self) = @_;    my ($self) = @_;
214    return $self->{score};  
215        return $self->{qstop};
216  }  }
217    
218    =head3 hstart()
219    
220  =head3 display_method()  Start of hit in hit sequence.
221    
222  If available use the function specified here to display the "raw" observation.  =cut
 In the case of a BLAST alignment of fid1 and fid2 a cgi script  
 will be called to display the results of running the command "bl2seq fid1 fid2".  
223    
224  B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  sub hstart {
225        my ($self) = @_;
226    
227  =cut      return $self->{hstart};
228    }
229    
230  sub display {  =head3 end()
231    
232    die "Abstract Method Called\n";  End of the hit in hit sequence.
233    
234  }  =cut
235    
236    sub hstop {
237        my ($self) = @_;
238    
239  =head3 rank()      return $self->{hstop};
240    }
241    
242  Returns an integer from 1 - 10 indicating the importance of this observations.  =head3 qlength()
243    
244  Currently always returns 1.  length of the query sequence in similarities
245    
246  =cut  =cut
247    
248  sub rank {  sub qlength {
249    my ($self) = @_;    my ($self) = @_;
250    
251  #  return $self->{rank};      return $self->{qlength};
   
   return 1;  
252  }  }
253    
254  =head3 supports_annotation()  =head3 hlength()
   
 Does a this observation support the annotation of its feature?  
255    
256  Returns  length of the hit sequence in similarities
257    
258  =over 3  =cut
259    
260  =item 10, if feature annotation is identical to $self->description  sub hlength {
261        my ($self) = @_;
262    
263  =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()      return $self->{hlength};
264    }
265    
266  =item undef  =head3 evalue()
267    
268  =back  E-value or P-Value if present.
269    
270  =cut  =cut
271    
272  sub supports_annotation {  sub evalue {
273    my ($self) = @_;    my ($self) = @_;
274    
275    # no code here so far    return $self->{evalue};
   
   return $self->{supports_annotation};  
276  }  }
277    
278  =head3 url()  =head3 score()
279    
280  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.  Score if present.
281    
282  =cut  =cut
283    
284  sub url {  sub score {
285    my ($self) = @_;    my ($self) = @_;
286      return $self->{score};
287    }
288    
289    =head3 display()
290    
291    will be different for each type
292    
293    =cut
294    
295    sub display {
296    
297    my $url = get_url($self->type, $self->acc);    die "Abstract Method Called\n";
298    
   return $url;  
299  }  }
300    
301  =head3 get_objects()  =head3 display_table()
302    
303  This is the B<REAL WORKHORSE> method of this Package.  will be different for each type
304    
305  It will probably have to:  =cut
306    
307    sub display_table {
308    
309      die "Abstract Table Method Called\n";
310    
 - 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;  
311   }   }
312    
313  It will invoke the required calls to the SEED API to retrieve the information required.  =head3 get_objects()
314    
315    This is the B<REAL WORKHORSE> method of this Package.
316    
317  =cut  =cut
318    
319  sub get_objects {  sub get_objects {
320      my ($self,$fid,$classes) = @_;      my ($self,$fid,$fig,$scope) = @_;
   
321    
322      my $objects = [];      my $objects = [];
323      my @matched_datasets=();      my @matched_datasets=();
# Line 330  Line 325 
325      # call function that fetches attribute based observations      # call function that fetches attribute based observations
326      # returns an array of arrays of hashes      # returns an array of arrays of hashes
327    
328      if(scalar(@$classes) < 1){      if($scope){
329          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);  
330      }      }
331      else{      else{
         #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based  
332          my %domain_classes;          my %domain_classes;
333          my $identical_flag=0;          my @attributes = $fig->get_attributes($fid);
334          my $pch_flag=0;          $domain_classes{'CDD'} = 1;
335          my $sims_flag=0;          $domain_classes{'PFAM'} = 1;
336          foreach my $class (@$classes){          get_identical_proteins($fid,\@matched_datasets,$fig);
337              if($class =~ /(IPR|CDD|PFAM)/){          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
338                  $domain_classes{$class} = 1;          get_sims_observations($fid,\@matched_datasets,$fig);
339              }          get_functional_coupling($fid,\@matched_datasets,$fig);
340              elsif ($class eq "IDENTICAL")          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
341              {          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_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);  
         }  
   
         #add CELLO and SignalP later  
342      }      }
343    
344      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 384  Line 346 
346          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
347              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
348          }          }
349          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
350              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
351          }          }
352          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
353              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
356                $object = Observation::Location->new($dataset);
357            }
358            elsif ($dataset->{'class'} eq "SIM"){
359              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
360          }          }
361            elsif ($dataset->{'class'} eq "CLUSTER"){
362                $object = Observation::Cluster->new($dataset);
363            }
364            elsif ($dataset->{'class'} eq "PDB"){
365                $object = Observation::PDB->new($dataset);
366            }
367    
368          push (@$objects, $object);          push (@$objects, $object);
369      }      }
370    
# Line 400  Line 372 
372    
373  }  }
374    
375  =head1 Internal Methods  =head3 display_housekeeping
376    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!>  
377    
378  =cut  =cut
379    sub display_housekeeping {
380        my ($self,$fid,$fig) = @_;
381        my $content = [];
382        my $row = [];
383    
384        my $org_name = $fig->org_of($fid);
385        my $function = $fig->function_of($fid);
386        #my $taxonomy = $fig->taxonomy_of($org_id);
387        my $length = $fig->translation_length($fid);
388    
389        push (@$row, $org_name);
390        push (@$row, $fid);
391        push (@$row, $length);
392        push (@$row, $function);
393    
394        # initialize the table for commentary and annotations
395        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
396        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
397        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
398        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
399        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
400        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
401        #$content .= qq(</table><p>\n);
402    
403        push(@$content, $row);
404    
405  =head3 get_url (internal)      return ($content);
406    }
 get_url() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
407    
408  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 get_sims_summary
409    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
410    
411  =cut  =cut
412    
413  sub get_url {  sub get_sims_summary {
414        my ($observation, $fid, $taxes, $dataset, $fig) = @_;
415        my %families;
416        #my @sims= $fig->nsims($fid,20000,10,"fig");
417    
418   my ($self) = @_;      foreach my $thing (@$dataset) {
419   my $url='';          next if ($thing->class ne "SIM");
420    
421  # a hash with a URL for each observation; identified by name()          my $id      = $thing->acc;
422  #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="  
 #};  
423    
424  # if (defined $URL{$self->name}) {          next if ($id !~ /fig\|/);
425  #     $url = $URL{$self->name}.$self->acc;          next if ($fig->is_deleted_fid($id));
426  #     return $url;          my $genome = $fig->genome_of($id);
427  # }          my ($genome1) = ($genome) =~ /(.*)\./;
428  # else          my $taxonomy = $taxes->{$genome1};
429       return undef;          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($id)); # use this if the taxonomies have been updated
430            my $parent_tax = "Root";
431            my @currLineage = ($parent_tax);
432            foreach my $tax (split(/\; /, $taxonomy)){
433                push (@{$families{children}{$parent_tax}}, $tax);
434                push (@currLineage, $tax);
435                $families{parent}{$tax} = $parent_tax;
436                $families{lineage}{$tax} = join(";", @currLineage);
437                if (defined ($families{evalue}{$tax})){
438                    if ($sim->[10] < $families{evalue}{$tax}){
439                        $families{evalue}{$tax} = $evalue;
440                        $families{color}{$tax} = &get_taxcolor($evalue);
441                    }
442                }
443                else{
444                    $families{evalue}{$tax} = $evalue;
445                    $families{color}{$tax} = &get_taxcolor($evalue);
446  }  }
447    
448  =head3 get_display_method (internal)              $parent_tax = $tax;
449            }
450        }
451    
452  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
453            $families{count}{$key} = @{$families{children}{$key}};
454    
455  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
456  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
457            $families{children}{$key} = \@out;
458        }
459        return (\%families);
460    }
461    
462  =cut  =head1 Internal Methods
463    
464  sub get_display_method {  These methods are not meant to be used outside of this package.
465    
466   my ($self) = @_;  B<Please do not use them outside of this package!>
467    
468  # 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="  
 # };  
469    
470  #if (defined $URL{$self->name}) {  sub get_taxcolor{
471  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;      my ($evalue) = @_;
472  #     return $url;      my $color;
473  # }      if ($evalue <= 1e-170){        $color = "#FF2000";    }
474  # else      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
475       return undef;      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
476        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
477        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
478        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
479        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
480        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
481        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
482        else{        $color = "#6666FF";    }
483        return ($color);
484  }  }
485    
486    
487  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
488    
489      # 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)
490      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
491    
492      my $fig = new FIG;      #my $fig = new FIG;
493    
494      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
495          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
496          my @parts = split("::",$key);          my @parts = split("::",$key);
497          my $class = $parts[0];          my $class = $parts[0];
# Line 502  Line 517 
517                                 'type' => "dom" ,                                 'type' => "dom" ,
518                                 'evalue' => $evalue,                                 'evalue' => $evalue,
519                                 'start' => $from,                                 'start' => $from,
520                                 'stop' => $to                                 'stop' => $to,
521                                   'fig_id' => $fid,
522                                   'score' => $raw_evalue
523                                 };                                 };
524    
525                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 511  Line 528 
528      }      }
529  }  }
530    
531  =head3 get_attribute_based_evidence (internal)  sub get_attribute_based_location_observations{
532    
533  This method retrieves evidence from the attribute server      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
534        #my $fig = new FIG;
535    
536  =cut      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
537    
538  sub get_attribute_based_observations{      my $dataset = {'type' => "loc",
539                       'class' => 'SIGNALP_CELLO_TMPRED',
540                       'fig_id' => $fid
541                       };
542    
543      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      foreach my $attr_ref (@$attributes_ref){
544      my ($fid,$datasets_ref) = (@_);          my $key = @$attr_ref[1];
545            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
546            my @parts = split("::",$key);
547            my $sub_class = $parts[0];
548            my $sub_key = $parts[1];
549            my $value = @$attr_ref[2];
550            if($sub_class eq "SignalP"){
551                if($sub_key eq "cleavage_site"){
552                    my @value_parts = split(";",$value);
553                    $dataset->{'cleavage_prob'} = $value_parts[0];
554                    $dataset->{'cleavage_loc'} = $value_parts[1];
555                }
556                elsif($sub_key eq "signal_peptide"){
557                    $dataset->{'signal_peptide_score'} = $value;
558                }
559            }
560    
561            elsif($sub_class eq "CELLO"){
562                $dataset->{'cello_location'} = $sub_key;
563                $dataset->{'cello_score'} = $value;
564            }
565    
566      my $_myfig = new FIG;          elsif($sub_class eq "Phobius"){
567                if($sub_key eq "transmembrane"){
568                    $dataset->{'phobius_tm_locations'} = $value;
569                }
570                elsif($sub_key eq "signal"){
571                    $dataset->{'phobius_signal_location'} = $value;
572                }
573            }
574    
575      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          elsif($sub_class eq "TMPRED"){
576                my @value_parts = split(/\;/,$value);
577                $dataset->{'tmpred_score'} = $value_parts[0];
578                $dataset->{'tmpred_locations'} = $value_parts[1];
579            }
580        }
581    
582          # convert the ref into a string for easier handling      push (@{$datasets_ref} ,$dataset);
         my ($string) = "@$attr_ref";  
583    
584  #       print "S:$string\n";  }
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
585    
586          # THIS SHOULD BE DONE ANOTHER WAY FM->TD  =head3 get_pdb_observations() (internal)
         # 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  
         #  
587    
588          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  This methods sets the type and class for pdb observations
589    
590              # some keys are composite CDD::1233244 or PFAM:PF1233  =cut
591    
592              if ( $key =~ /::/ ) {  sub get_pdb_observations{
593                  my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
594    
595              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );      #my $fig = new FIG;
596    
597              my $evalue= 255;      foreach my $attr_ref (@$attributes_ref){
598              if (defined $raw_evalue) { # some of the tool do not give us an evalue          my $key = @$attr_ref[1];
599            next if ( ($key !~ /PDB/));
600            my($key1,$key2) =split("::",$key);
601            my $value = @$attr_ref[2];
602            my ($evalue,$location) = split(";",$value);
603    
604                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);          if($evalue =~/(\d+)\.(\d+)/){
605                  my ($new_k, $new_exp);              my $part2 = 1000 - $1;
606                my $part1 = $2/100;
607                $evalue = $part1."e-".$part2;
608            }
609    
610                  #          my($start,$stop) =split("-",$location);
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
611    
612  #                   $new_exp = (1000+$expo);          my $url = @$attr_ref[3];
613          #           $new_k = $k / 100;          my $dataset = {'class' => 'PDB',
614                           'type' => 'seq' ,
615                           'acc' => $key2,
616                           'evalue' => $evalue,
617                           'start' => $start,
618                           'stop' => $stop,
619                           'fig_id' => $fid
620                           };
621    
622            push (@{$datasets_ref} ,$dataset);
623                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
624              }              }
625    
626              # unroll it all into an array of hashes  =head3 get_cluster_observations() (internal)
627              # this needs to be done differently for different types of observations  
628              my $dataset = [ { name => 'class', value => $key },  This methods sets the type and class for cluster observations
                             { 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}  
                             ];  
629    
630    =cut
631    
632    sub get_cluster_observations{
633        my ($fid,$datasets_ref,$scope) = (@_);
634    
635        my $dataset = {'class' => 'CLUSTER',
636                       'type' => 'fc',
637                       'context' => $scope,
638                       'fig_id' => $fid
639                       };
640              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
641          }          }
642      }  
 }  
643    
644  =head3 get_sims_observations() (internal)  =head3 get_sims_observations() (internal)
645    
# Line 591  Line 649 
649    
650  sub get_sims_observations{  sub get_sims_observations{
651    
652      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
653      my $fig = new FIG;      #my $fig = new FIG;
654      my @sims= $fig->nsims($fid,100,1e-20,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
655      my ($dataset);      my ($dataset);
656    
657      foreach my $sim (@sims){      foreach my $sim (@sims){
658            next if ($fig->is_deleted_fid($sim->[1]));
659          my $hit = $sim->[1];          my $hit = $sim->[1];
660            my $percent = $sim->[2];
661          my $evalue = $sim->[10];          my $evalue = $sim->[10];
662          my $from = $sim->[8];          my $qfrom = $sim->[6];
663          my $to = $sim->[9];          my $qto = $sim->[7];
664            my $hfrom = $sim->[8];
665            my $hto = $sim->[9];
666            my $qlength = $sim->[12];
667            my $hlength = $sim->[13];
668            my $db = get_database($hit);
669            my $func = $fig->function_of($hit);
670            my $organism = $fig->org_of($hit);
671    
672          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
673                        'query' => $sim->[0],
674                      'acc' => $hit,                      'acc' => $hit,
675                        'identity' => $percent,
676                      'type' => 'seq',                      'type' => 'seq',
677                      'evalue' => $evalue,                      'evalue' => $evalue,
678                      'start' => $from,                      'qstart' => $qfrom,
679                      'stop' => $to                      'qstop' => $qto,
680                        'hstart' => $hfrom,
681                        'hstop' => $hto,
682                        'database' => $db,
683                        'organism' => $organism,
684                        'function' => $func,
685                        'qlength' => $qlength,
686                        'hlength' => $hlength,
687                        'fig_id' => $fid
688                      };                      };
689    
690          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
691      }      }
692  }  }
693    
694    =head3 get_database (internal)
695    This method gets the database association from the sequence id
696    
697    =cut
698    
699    sub get_database{
700        my ($id) = (@_);
701    
702        my ($db);
703        if ($id =~ /^fig\|/)              { $db = "FIG" }
704        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
705        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
706        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
707        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
708        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
709        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
710        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
711        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
712        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
713        elsif ($id =~ /^img\|/)           { $db = "JGI" }
714    
715        return ($db);
716    
717    }
718    
719    
720  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
721    
722  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 620  Line 725 
725    
726  sub get_identical_proteins{  sub get_identical_proteins{
727    
728      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
729      my $fig = new FIG;      #my $fig = new FIG;
730      my @funcs = ();      my $funcs_ref;
731    
732      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);
   
733      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
734          my ($tmp, $who);          my ($tmp, $who);
735          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
736              if ($id =~ /^fig\|/)           { $who = "FIG" }              $who = &get_database($id);
737              elsif ($id =~ /^gi\|/)            { $who = "NCBI" }              push(@$funcs_ref, [$id,$who,$tmp]);
             elsif ($id =~ /^^[NXYZA]P_/)      { $who = "RefSeq" }  
             elsif ($id =~ /^sp\|/)            { $who = "SwissProt" }  
             elsif ($id =~ /^uni\|/)           { $who = "UniProt" }  
             elsif ($id =~ /^tigr\|/)          { $who = "TIGR" }  
             elsif ($id =~ /^pir\|/)           { $who = "PIR" }  
             elsif ($id =~ /^kegg\|/)          { $who = "KEGG" }  
             elsif ($id =~ /^tr\|/)            { $who = "TrEMBL" }  
             elsif ($id =~ /^eric\|/)          { $who = "ASAP" }  
   
             push(@funcs, [$id,$who,$tmp]);  
738          }          }
739      }      }
740    
     my ($dataset);  
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
741          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
742                         'type' => 'seq',                         'type' => 'seq',
743                         'database' => $who,                     'fig_id' => $fid,
744                         'function' => $assignment                     'rows' => $funcs_ref
745                         };                         };
746    
747          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
748      }  
749    
750  }  }
751    
# Line 672  Line 757 
757    
758  sub get_functional_coupling{  sub get_functional_coupling{
759    
760      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
761      my $fig = new FIG;      #my $fig = new FIG;
762      my @funcs = ();      my @funcs = ();
763    
764      # initialize some variables      # initialize some variables
# Line 691  Line 776 
776                    } @fc_data;                    } @fc_data;
777    
778      my ($dataset);      my ($dataset);
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
779          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
780                         'type' => 'fc',                         'type' => 'fc',
781                         'function' => $description                     'fig_id' => $fid,
782                       'rows' => \@rows
783                         };                         };
784    
785          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
786      }  
787  }  }
788    
789  =head3 get_sims_and_bbhs() (internal)  =head3 new (internal)
790    
791  This methods retrieves sims and also BBHs and fills the internal data structures.  Instantiate a new object.
792    
793  =cut  =cut
794    
795  #     sub get_sims_and_bbhs{  sub new {
796      my ($class,$dataset) = @_;
 #       # 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";  
 #       }  
797    
798  #     }    my $self = { class => $dataset->{'class'},
799                   type => $dataset->{'type'},
800                   fig_id => $dataset->{'fig_id'},
801                   score => $dataset->{'score'},
802               };
803    
804      bless($self,$class);
805    
806      return $self;
807    }
808    
809  =head3 new (internal)  =head3 identity (internal)
810    
811  Instantiate a new object.  Returns the % identity of the similar sequence
812    
813  =cut  =cut
814    
815  sub new {  sub identity {
816    my ($class,$dataset) = @_;      my ($self) = @_;
   
817    
818    #$self = { acc => '',      return $self->{identity};
819  #           description => '',  }
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
820    
821    my $self = { class => $dataset->{'class'},  =head3 fig_id (internal)
                type => $dataset->{'type'}  
            };  
822    
823    bless($self,$class);  =cut
824    
825    return $self;  sub fig_id {
826      my ($self) = @_;
827      return $self->{fig_id};
828  }  }
829    
830  =head3 feature_id (internal)  =head3 feature_id (internal)
# Line 846  Line 886 
886      return $self->{database};      return $self->{database};
887  }  }
888    
889    sub score {
890      my ($self) = @_;
891    
892      return $self->{score};
893    }
894    
895  ############################################################  ############################################################
896  ############################################################  ############################################################
897  package Observation::Identical;  package Observation::PDB;
898    
899  use base qw(Observation);  use base qw(Observation);
900    
# Line 857  Line 902 
902    
903      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
904      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
905      $self->{id} = $dataset->{'id'};      $self->{acc} = $dataset->{'acc'};
906      $self->{organism} = $dataset->{'organism'};      $self->{evalue} = $dataset->{'evalue'};
907      $self->{function} = $dataset->{'function'};      $self->{start} = $dataset->{'start'};
908      $self->{database} = $dataset->{'database'};      $self->{stop} = $dataset->{'stop'};
   
909      bless($self,$class);      bless($self,$class);
910      return $self;      return $self;
911  }  }
912    
913  =head3 display()  =head3 display()
914    
915  If available use the function specified here to display the "raw" observation.  displays data stored in best_PDB attribute and in Ontology server for given PDB id
 This code will display a table for the identical protein  
   
   
 B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi  
 dence.  
916    
917  =cut  =cut
918    
919  sub display{  sub display{
920      my ($self, $cgi, $dataset) = @_;      my ($self,$gd,$fig) = @_;
921    
922      my $all_domains = [];      my $fid = $self->fig_id;
923      my $count_identical = 0;      my $dbmaster = DBMaster->new(-database =>'Ontology');
924      my $content;  
925      foreach my $thing (@$dataset) {      my $acc = $self->acc;
926          next if ($thing->class ne "IDENTICAL");  
927          my $single_domain = [];      my ($pdb_description,$pdb_source,$pdb_ligand);
928          push(@$single_domain,$thing->database);      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
929          my $id = $thing->id;      if(!scalar(@$pdb_objs)){
930          $count_identical++;          $pdb_description = "not available";
931            $pdb_source = "not available";
932            $pdb_ligand = "not available";
933        }
934        else{
935            my $pdb_obj = $pdb_objs->[0];
936            $pdb_description = $pdb_obj->description;
937            $pdb_source = $pdb_obj->source;
938            $pdb_ligand = $pdb_obj->ligand;
939        }
940    
941        my $lines = [];
942        my $line_data = [];
943        my $line_config = { 'title' => "PDB hit for $fid",
944                            'short_title' => "best PDB",
945                            'basepair_offset' => '1' };
946    
947        #my $fig = new FIG;
948        my $seq = $fig->get_translation($fid);
949        my $fid_stop = length($seq);
950    
951        my $fid_element_hash = {
952            "title" => $fid,
953            "start" => '1',
954            "end" =>  $fid_stop,
955            "color"=> '1',
956            "zlayer" => '1'
957            };
958    
959        push(@$line_data,$fid_element_hash);
960    
961        my $links_list = [];
962        my $descriptions = [];
963    
964        my $name;
965        $name = {"title" => 'id',
966                 "value" => $acc};
967        push(@$descriptions,$name);
968    
969        my $description;
970        $description = {"title" => 'pdb description',
971                        "value" => $pdb_description};
972        push(@$descriptions,$description);
973    
974        my $score;
975        $score = {"title" => "score",
976                  "value" => $self->evalue};
977        push(@$descriptions,$score);
978    
979        my $start_stop;
980        my $start_stop_value = $self->start."_".$self->stop;
981        $start_stop = {"title" => "start-stop",
982                       "value" => $start_stop_value};
983        push(@$descriptions,$start_stop);
984    
985        my $source;
986        $source = {"title" => "source",
987                  "value" => $pdb_source};
988        push(@$descriptions,$source);
989    
990        my $ligand;
991        $ligand = {"title" => "pdb ligand",
992                   "value" => $pdb_ligand};
993        push(@$descriptions,$ligand);
994    
995        my $link;
996        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
997    
998        $link = {"link_title" => $acc,
999                 "link" => $link_url};
1000        push(@$links_list,$link);
1001    
1002        my $pdb_element_hash = {
1003            "title" => "PDB homology",
1004            "start" => $self->start,
1005            "end" =>  $self->stop,
1006            "color"=> '6',
1007            "zlayer" => '3',
1008            "links_list" => $links_list,
1009            "description" => $descriptions};
1010    
1011        push(@$line_data,$pdb_element_hash);
1012        $gd->add_line($line_data, $line_config);
1013    
1014        return $gd;
1015    }
1016    
1017    1;
1018    
1019    ############################################################
1020    ############################################################
1021    package Observation::Identical;
1022    
1023    use base qw(Observation);
1024    
1025    sub new {
1026    
1027        my ($class,$dataset) = @_;
1028        my $self = $class->SUPER::new($dataset);
1029        $self->{rows} = $dataset->{'rows'};
1030    
1031        bless($self,$class);
1032        return $self;
1033    }
1034    
1035    =head3 display_table()
1036    
1037    If available use the function specified here to display the "raw" observation.
1038    This code will display a table for the identical protein
1039    
1040    
1041    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi
1042    dence.
1043    
1044    =cut
1045    
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 = [];
1055        my $count_identical = 0;
1056        my $content;
1057        foreach my $row (@$rows) {
1058            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 = [];
1063            push(@$single_domain,$who);
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 907  Line 1079 
1079    
1080  1;  1;
1081    
   
1082  #########################################  #########################################
1083  #########################################  #########################################
1084  package Observation::FC;  package Observation::FC;
# Line 919  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 938  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) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
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 995  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 = [];
1175      my $links_list = [];      my $links_list = [];
1176      my $descriptions = [];      my $descriptions = [];
1177    
1178      my $description_function;      my $db_and_id = $thing->acc;
1179      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1180    
1181      push(@$descriptions,$description_function);      my $dbmaster = DBMaster->new(-database =>'Ontology');
1182    
1183        my ($name_title,$name_value,$description_title,$description_value);
1184        if($db eq "CDD"){
1185            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1186            if(!scalar(@$cdd_objs)){
1187                $name_title = "name";
1188                $name_value = "not available";
1189                $description_title = "description";
1190                $description_value = "not available";
1191            }
1192            else{
1193                my $cdd_obj = $cdd_objs->[0];
1194                $name_title = "name";
1195                $name_value = $cdd_obj->term;
1196                $description_title = "description";
1197                $description_value = $cdd_obj->description;
1198            }
1199        }
1200        elsif($db =~ /PFAM/){
1201            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1202            if(!scalar(@$pfam_objs)){
1203                $name_title = "name";
1204                $name_value = "not available";
1205                $description_title = "description";
1206                $description_value = "not available";
1207            }
1208            else{
1209                my $pfam_obj = $pfam_objs->[0];
1210                $name_title = "name";
1211                $name_value = $pfam_obj->term;
1212                #$description_title = "description";
1213                #$description_value = $pfam_obj->description;
1214            }
1215        }
1216    
1217        my $short_title = $thing->acc;
1218        $short_title =~ s/::/ - /ig;
1219        my $line_config = { 'title' => $name_value,
1220                            'short_title' => $short_title,
1221                            'basepair_offset' => '1' };
1222    
1223        my $name;
1224        $name = {"title" => $db,
1225                 "value" => $id};
1226        push(@$descriptions,$name);
1227    
1228    #    my $description;
1229    #    $description = {"title" => $description_title,
1230    #                   "value" => $description_value};
1231    #    push(@$descriptions,$description);
1232    
1233      my $score;      my $score;
1234      $score = {"title" => "score",      $score = {"title" => "score",
1235                "value" => $thing->evalue};                "value" => $thing->evalue};
1236      push(@$descriptions,$score);      push(@$descriptions,$score);
1237    
1238        my $location;
1239        $location = {"title" => "location",
1240                     "value" => $thing->start . " - " . $thing->stop};
1241        push(@$descriptions,$location);
1242    
1243      my $link_id;      my $link_id;
1244      if ($thing->acc =~/CDD::(\d+)/){      if ($thing->acc =~/::(.*)/){
1245          $link_id = $1;          $link_id = $1;
1246      }      }
1247    
1248      my $link;      my $link;
1249        my $link_url;
1250        if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1251        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1252        else{$link_url = "NO_URL"}
1253    
1254      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
1255               "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};               "link" => $link_url};
1256      push(@$links_list,$link);      push(@$links_list,$link);
1257    
1258      my $element_hash = {      my $element_hash = {
1259          "title" => $thing->type,          "title" => $name_value,
1260          "start" => $thing->start,          "start" => $thing->start,
1261          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1262          "color"=> $color,          "color"=> $color,
# Line 1041  Line 1271 
1271    
1272  }  }
1273    
1274    sub display_table {
1275        my ($self,$dataset) = @_;
1276        my $cgi = new CGI;
1277        my $data = [];
1278        my $count = 0;
1279        my $content;
1280    
1281        foreach my $thing (@$dataset) {
1282            next if ($thing->type !~ /dom/);
1283            my $single_domain = [];
1284            $count++;
1285    
1286            my $db_and_id = $thing->acc;
1287            my ($db,$id) = split("::",$db_and_id);
1288    
1289            my $dbmaster = DBMaster->new(-database =>'Ontology');
1290    
1291            my ($name_title,$name_value,$description_title,$description_value);
1292            if($db eq "CDD"){
1293                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1294                if(!scalar(@$cdd_objs)){
1295                    $name_title = "name";
1296                    $name_value = "not available";
1297                    $description_title = "description";
1298                    $description_value = "not available";
1299                }
1300                else{
1301                    my $cdd_obj = $cdd_objs->[0];
1302                    $name_title = "name";
1303                    $name_value = $cdd_obj->term;
1304                    $description_title = "description";
1305                    $description_value = $cdd_obj->description;
1306                }
1307            }
1308    
1309            my $location =  $thing->start . " - " . $thing->stop;
1310    
1311            push(@$single_domain,$db);
1312            push(@$single_domain,$thing->acc);
1313            push(@$single_domain,$name_value);
1314            push(@$single_domain,$location);
1315            push(@$single_domain,$thing->evalue);
1316            push(@$single_domain,$description_value);
1317            push(@$data,$single_domain);
1318        }
1319    
1320        if ($count >0){
1321            $content = $data;
1322        }
1323        else
1324        {
1325            $content = "<p>This PEG does not have any similarities to domains</p>";
1326        }
1327    }
1328    
1329    
1330  #########################################  #########################################
1331  #########################################  #########################################
1332  package Observation::Sims;  package Observation::Location;
1333    
1334  use base qw(Observation);  use base qw(Observation);
1335    
# Line 1051  Line 1337 
1337    
1338      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1339      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1340      $self->{acc} = $dataset->{'acc'};      $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1341      $self->{evalue} = $dataset->{'evalue'};      $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1342      $self->{start} = $dataset->{'start'};      $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1343      $self->{stop} = $dataset->{'stop'};      $self->{cello_location} = $dataset->{'cello_location'};
1344        $self->{cello_score} = $dataset->{'cello_score'};
1345        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1346        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1347        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1348        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1349    
1350      bless($self,$class);      bless($self,$class);
1351      return $self;      return $self;
1352  }  }
1353    
1354  =head3 display()  sub display_cello {
1355        my ($thing,$fig) = @_;
1356        my $html;
1357        my $cello_location = $thing->cello_location;
1358        my $cello_score = $thing->cello_score;
1359        if($cello_location){
1360            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1361            #$html .= "<p>CELLO score: $cello_score </p>";
1362        }
1363        return ($html);
1364    }
1365    
1366  If available use the function specified here to display the "raw" observation.  sub display {
1367  This code will display a table for the similarities protein      my ($thing,$gd,$fig) = @_;
1368    
1369  B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.      my $fid = $thing->fig_id;
1370        #my $fig= new FIG;
1371        my $length = length($fig->get_translation($fid));
1372    
1373        my $cleavage_prob;
1374        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1375        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1376        my $signal_peptide_score = $thing->signal_peptide_score;
1377        my $cello_location = $thing->cello_location;
1378        my $cello_score = $thing->cello_score;
1379        my $tmpred_score = $thing->tmpred_score;
1380        my @tmpred_locations = split(",",$thing->tmpred_locations);
1381    
1382        my $phobius_signal_location = $thing->phobius_signal_location;
1383        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1384    
1385        my $lines = [];
1386    
1387        #color is
1388        my $color = "6";
1389    
1390    =pod=
1391    
1392        if($cello_location){
1393            my $cello_descriptions = [];
1394            my $line_data =[];
1395    
1396            my $line_config = { 'title' => 'Localization Evidence',
1397                                'short_title' => 'CELLO',
1398                                'basepair_offset' => '1' };
1399    
1400            my $description_cello_location = {"title" => 'Best Cello Location',
1401                                              "value" => $cello_location};
1402    
1403            push(@$cello_descriptions,$description_cello_location);
1404    
1405            my $description_cello_score = {"title" => 'Cello Score',
1406                                           "value" => $cello_score};
1407    
1408            push(@$cello_descriptions,$description_cello_score);
1409    
1410            my $element_hash = {
1411                "title" => "CELLO",
1412                "color"=> $color,
1413                "start" => "1",
1414                "end" =>  $length + 1,
1415                "zlayer" => '1',
1416                "description" => $cello_descriptions};
1417    
1418            push(@$line_data,$element_hash);
1419            $gd->add_line($line_data, $line_config);
1420        }
1421    
1422        $color = "2";
1423        if($tmpred_score){
1424            my $line_data =[];
1425            my $line_config = { 'title' => 'Localization Evidence',
1426                                'short_title' => 'Transmembrane',
1427                                'basepair_offset' => '1' };
1428    
1429            foreach my $tmpred (@tmpred_locations){
1430                my $descriptions = [];
1431                my ($begin,$end) =split("-",$tmpred);
1432                my $description_tmpred_score = {"title" => 'TMPRED score',
1433                                 "value" => $tmpred_score};
1434    
1435                push(@$descriptions,$description_tmpred_score);
1436    
1437                my $element_hash = {
1438                "title" => "transmembrane location",
1439                "start" => $begin + 1,
1440                "end" =>  $end + 1,
1441                "color"=> $color,
1442                "zlayer" => '5',
1443                "type" => 'box',
1444                "description" => $descriptions};
1445    
1446                push(@$line_data,$element_hash);
1447    
1448            }
1449            $gd->add_line($line_data, $line_config);
1450        }
1451  =cut  =cut
1452    
1453  sub display {      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1454      my ($self,$cgi,$dataset) = @_;          my $line_data =[];
1455            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1456                                'short_title' => 'TM and SP',
1457                                'basepair_offset' => '1' };
1458    
1459      my $data = [];          foreach my $tm_loc (@phobius_tm_locations){
1460      my $count = 0;              my $descriptions = [];
1461      my $content;              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1462                                 "value" => $tm_loc};
1463                push(@$descriptions,$description_phobius_tm_locations);
1464    
1465      foreach my $thing (@$dataset) {              my ($begin,$end) =split("-",$tm_loc);
1466          my $single_domain = [];  
1467          next if ($thing->class ne "SIM");              my $element_hash = {
1468          $count++;              "title" => "Phobius",
1469                "start" => $begin + 1,
1470                "end" =>  $end + 1,
1471                "color"=> '6',
1472                "zlayer" => '4',
1473                "type" => 'bigbox',
1474                "description" => $descriptions};
1475    
1476                push(@$line_data,$element_hash);
1477    
         push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));  
         push(@$single_domain,$thing->start);  
         push(@$single_domain,$thing->stop);  
         push(@$single_domain,$thing->evalue);  
         push(@$data,$single_domain);  
1478      }      }
1479    
1480      if ($count >0){          if($phobius_signal_location){
1481          $content = $data;              my $descriptions = [];
1482                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1483                                 "value" => $phobius_signal_location};
1484                push(@$descriptions,$description_phobius_signal_location);
1485    
1486    
1487                my ($begin,$end) =split("-",$phobius_signal_location);
1488                my $element_hash = {
1489                "title" => "phobius signal locations",
1490                "start" => $begin + 1,
1491                "end" =>  $end + 1,
1492                "color"=> '1',
1493                "zlayer" => '5',
1494                "type" => 'box',
1495                "description" => $descriptions};
1496                push(@$line_data,$element_hash);
1497      }      }
1498      else  
1499      {          $gd->add_line($line_data, $line_config);
1500          $content = "<p>This PEG does not have any similarities</p>";      }
1501    
1502    =head3
1503        $color = "1";
1504        if($signal_peptide_score){
1505            my $line_data = [];
1506            my $descriptions = [];
1507    
1508            my $line_config = { 'title' => 'Localization Evidence',
1509                                'short_title' => 'SignalP',
1510                                'basepair_offset' => '1' };
1511    
1512            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1513                                                    "value" => $signal_peptide_score};
1514    
1515            push(@$descriptions,$description_signal_peptide_score);
1516    
1517            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1518                                             "value" => $cleavage_prob};
1519    
1520            push(@$descriptions,$description_cleavage_prob);
1521    
1522            my $element_hash = {
1523                "title" => "SignalP",
1524                "start" => $cleavage_loc_begin - 2,
1525                "end" =>  $cleavage_loc_end + 1,
1526                "type" => 'bigbox',
1527                "color"=> $color,
1528                "zlayer" => '10',
1529                "description" => $descriptions};
1530    
1531            push(@$line_data,$element_hash);
1532            $gd->add_line($line_data, $line_config);
1533        }
1534    =cut
1535    
1536        return ($gd);
1537    
1538    }
1539    
1540    sub cleavage_loc {
1541      my ($self) = @_;
1542    
1543      return $self->{cleavage_loc};
1544    }
1545    
1546    sub cleavage_prob {
1547      my ($self) = @_;
1548    
1549      return $self->{cleavage_prob};
1550    }
1551    
1552    sub signal_peptide_score {
1553      my ($self) = @_;
1554    
1555      return $self->{signal_peptide_score};
1556    }
1557    
1558    sub tmpred_score {
1559      my ($self) = @_;
1560    
1561      return $self->{tmpred_score};
1562    }
1563    
1564    sub tmpred_locations {
1565      my ($self) = @_;
1566    
1567      return $self->{tmpred_locations};
1568    }
1569    
1570    sub cello_location {
1571      my ($self) = @_;
1572    
1573      return $self->{cello_location};
1574    }
1575    
1576    sub cello_score {
1577      my ($self) = @_;
1578    
1579      return $self->{cello_score};
1580    }
1581    
1582    sub phobius_signal_location {
1583      my ($self) = @_;
1584      return $self->{phobius_signal_location};
1585      }      }
1586    
1587    sub phobius_tm_locations {
1588      my ($self) = @_;
1589      return $self->{phobius_tm_locations};
1590    }
1591    
1592    
1593    
1594    #########################################
1595    #########################################
1596    package Observation::Sims;
1597    
1598    use base qw(Observation);
1599    
1600    sub new {
1601    
1602        my ($class,$dataset) = @_;
1603        my $self = $class->SUPER::new($dataset);
1604        $self->{identity} = $dataset->{'identity'};
1605        $self->{acc} = $dataset->{'acc'};
1606        $self->{query} = $dataset->{'query'};
1607        $self->{evalue} = $dataset->{'evalue'};
1608        $self->{qstart} = $dataset->{'qstart'};
1609        $self->{qstop} = $dataset->{'qstop'};
1610        $self->{hstart} = $dataset->{'hstart'};
1611        $self->{hstop} = $dataset->{'hstop'};
1612        $self->{database} = $dataset->{'database'};
1613        $self->{organism} = $dataset->{'organism'};
1614        $self->{function} = $dataset->{'function'};
1615        $self->{qlength} = $dataset->{'qlength'};
1616        $self->{hlength} = $dataset->{'hlength'};
1617    
1618        bless($self,$class);
1619        return $self;
1620    }
1621    
1622    =head3 display()
1623    
1624    If available use the function specified here to display a graphical observation.
1625    This code will display a graphical view of the similarities using the genome drawer object
1626    
1627    =cut
1628    
1629    sub display {
1630        my ($self,$gd,$array,$fig) = @_;
1631        #my $fig = new FIG;
1632    
1633        my @ids;
1634        foreach my $thing(@$array){
1635            next if ($thing->class ne "SIM");
1636            push (@ids, $thing->acc);
1637        }
1638    
1639        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1640    
1641        foreach my $thing (@$array){
1642            if ($thing->class eq "SIM"){
1643    
1644                my $peg = $thing->acc;
1645                my $query = $thing->query;
1646    
1647                my $organism = $thing->organism;
1648                my $genome = $fig->genome_of($peg);
1649                my ($org_tax) = ($genome) =~ /(.*)\./;
1650                my $function = $thing->function;
1651                my $abbrev_name = $fig->abbrev($organism);
1652                my $align_start = $thing->qstart;
1653                my $align_stop = $thing->qstop;
1654                my $hit_start = $thing->hstart;
1655                my $hit_stop = $thing->hstop;
1656    
1657                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1658    
1659                my $line_config = { 'title' => "$organism [$org_tax]",
1660                                    'short_title' => "$abbrev_name",
1661                                    'title_link' => '$tax_link',
1662                                    'basepair_offset' => '0'
1663                                    };
1664    
1665                my $line_data = [];
1666    
1667                my $element_hash;
1668                my $links_list = [];
1669                my $descriptions = [];
1670    
1671                # get subsystem information
1672                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1673                my $link;
1674                $link = {"link_title" => $peg,
1675                         "link" => $url_link};
1676                push(@$links_list,$link);
1677    
1678                #my @subsystems = $fig->peg_to_subsystems($peg);
1679                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1680                my @subsystems;
1681    
1682                foreach my $array (@subs){
1683                    my $subsystem = $$array[0];
1684                    push(@subsystems,$subsystem);
1685                    my $link;
1686                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1687                             "link_title" => $subsystem};
1688                    push(@$links_list,$link);
1689                }
1690    
1691                $link = {"link_title" => "view blast alignment",
1692                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1693                push (@$links_list,$link);
1694    
1695                my $description_function;
1696                $description_function = {"title" => "function",
1697                                         "value" => $function};
1698                push(@$descriptions,$description_function);
1699    
1700                my ($description_ss, $ss_string);
1701                $ss_string = join (",", @subsystems);
1702                $description_ss = {"title" => "subsystems",
1703                                   "value" => $ss_string};
1704                push(@$descriptions,$description_ss);
1705    
1706                my $description_loc;
1707                $description_loc = {"title" => "location start",
1708                                    "value" => $hit_start};
1709                push(@$descriptions, $description_loc);
1710    
1711                $description_loc = {"title" => "location stop",
1712                                    "value" => $hit_stop};
1713                push(@$descriptions, $description_loc);
1714    
1715                my $evalue = $thing->evalue;
1716                while ($evalue =~ /-0/)
1717                {
1718                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1719                    $chunk2 = substr($chunk2,1);
1720                    $evalue = $chunk1 . "-" . $chunk2;
1721                }
1722    
1723                my $color = &color($evalue);
1724    
1725                my $description_eval = {"title" => "E-Value",
1726                                        "value" => $evalue};
1727                push(@$descriptions, $description_eval);
1728    
1729                my $identity = $self->identity;
1730                my $description_identity = {"title" => "Identity",
1731                                            "value" => $identity};
1732                push(@$descriptions, $description_identity);
1733    
1734                $element_hash = {
1735                    "title" => $peg,
1736                    "start" => $align_start,
1737                    "end" =>  $align_stop,
1738                    "type"=> 'box',
1739                    "color"=> $color,
1740                    "zlayer" => "2",
1741                    "links_list" => $links_list,
1742                    "description" => $descriptions
1743                    };
1744                push(@$line_data,$element_hash);
1745                $gd->add_line($line_data, $line_config);
1746            }
1747        }
1748        return ($gd);
1749    }
1750    
1751    =head3 display_domain_composition()
1752    
1753    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
1754    
1755    =cut
1756    
1757    sub display_domain_composition {
1758        my ($self,$gd,$fig) = @_;
1759    
1760        #my $fig = new FIG;
1761        my $peg = $self->acc;
1762    
1763        my $line_data = [];
1764        my $links_list = [];
1765        my $descriptions = [];
1766    
1767        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1768        my @domain_query_results = ();
1769        foreach $dqr (@domain_query_results){
1770            my $key = @$dqr[1];
1771            my @parts = split("::",$key);
1772            my $db = $parts[0];
1773            my $id = $parts[1];
1774            my $val = @$dqr[2];
1775            my $from;
1776            my $to;
1777            my $evalue;
1778    
1779            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1780                my $raw_evalue = $1;
1781                $from = $2;
1782                $to = $3;
1783                if($raw_evalue =~/(\d+)\.(\d+)/){
1784                    my $part2 = 1000 - $1;
1785                    my $part1 = $2/100;
1786                    $evalue = $part1."e-".$part2;
1787                }
1788                else{
1789                    $evalue = "0.0";
1790                }
1791            }
1792    
1793            my $dbmaster = DBMaster->new(-database =>'Ontology');
1794            my ($name_value,$description_value);
1795    
1796            if($db eq "CDD"){
1797                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1798                if(!scalar(@$cdd_objs)){
1799                    $name_title = "name";
1800                    $name_value = "not available";
1801                    $description_title = "description";
1802                    $description_value = "not available";
1803                }
1804                else{
1805                    my $cdd_obj = $cdd_objs->[0];
1806                    $name_value = $cdd_obj->term;
1807                    $description_value = $cdd_obj->description;
1808                }
1809            }
1810    
1811            my $domain_name;
1812            $domain_name = {"title" => "name",
1813                     "value" => $name_value};
1814            push(@$descriptions,$domain_name);
1815    
1816            my $description;
1817            $description = {"title" => "description",
1818                            "value" => $description_value};
1819            push(@$descriptions,$description);
1820    
1821            my $score;
1822            $score = {"title" => "score",
1823                      "value" => $evalue};
1824            push(@$descriptions,$score);
1825    
1826            my $link_id = $id;
1827            my $link;
1828            my $link_url;
1829            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"}
1830            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1831            else{$link_url = "NO_URL"}
1832    
1833            $link = {"link_title" => $name_value,
1834                     "link" => $link_url};
1835            push(@$links_list,$link);
1836    
1837            my $domain_element_hash = {
1838                "title" => $peg,
1839                "start" => $from,
1840                "end" =>  $to,
1841                "type"=> 'box',
1842                "zlayer" => '4',
1843                "links_list" => $links_list,
1844                "description" => $descriptions
1845                };
1846    
1847            push(@$line_data,$domain_element_hash);
1848    
1849            #just one CDD domain for now, later will add option for multiple domains from selected DB
1850            last;
1851        }
1852    
1853        my $line_config = { 'title' => $peg,
1854                            'short_title' => $peg,
1855                            'basepair_offset' => '1' };
1856    
1857        $gd->add_line($line_data, $line_config);
1858    
1859        return ($gd);
1860    
1861    }
1862    
1863    =head3 display_table()
1864    
1865    If available use the function specified here to display the "raw" observation.
1866    This code will display a table for the similarities protein
1867    
1868    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
1869    
1870    =cut
1871    
1872    sub display_table {
1873        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1874    
1875        my $data = [];
1876        my $count = 0;
1877        my $content;
1878        #my $fig = new FIG;
1879        my $cgi = new CGI;
1880        my @ids;
1881        foreach my $thing (@$dataset) {
1882            next if ($thing->class ne "SIM");
1883            push (@ids, $thing->acc);
1884        }
1885    
1886        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1887        my @attributes = $fig->get_attributes(\@ids);
1888    
1889        # get the column for the subsystems
1890        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1891    
1892        # get the column for the evidence codes
1893        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1894    
1895        # get the column for pfam_domain
1896        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1897    
1898        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1899        my $alias_col = &get_aliases(\@ids,$fig);
1900        #my $alias_col = {};
1901    
1902        foreach my $thing (@$dataset) {
1903            next if ($thing->class ne "SIM");
1904            my $single_domain = [];
1905            $count++;
1906    
1907            my $id      = $thing->acc;
1908            my $iden    = $thing->identity;
1909            my $ln1     = $thing->qlength;
1910            my $ln2     = $thing->hlength;
1911            my $b1      = $thing->qstart;
1912            my $e1      = $thing->qstop;
1913            my $b2      = $thing->hstart;
1914            my $e2      = $thing->hstop;
1915            my $d1      = abs($e1 - $b1) + 1;
1916            my $d2      = abs($e2 - $b2) + 1;
1917            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1918            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1919    
1920            # checkbox column
1921            my $field_name = "tables_" . $id;
1922            my $pair_name = "visual_" . $id;
1923            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1924            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1925    
1926            # get the linked fig id
1927            my $fig_col;
1928            if (defined ($e_identical{$id})){
1929                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1930            }
1931            else{
1932                $fig_col = &HTML::set_prot_links($cgi,$id);
1933            }
1934    
1935            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1936                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1937    
1938            foreach my $col (sort keys %$scroll_list){
1939                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1940                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1941                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1942                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1943                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1944                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1945                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1946                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1947                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1948                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1949                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1950                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1951                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1952                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1953            }
1954            push(@$data,$single_domain);
1955        }
1956        if ($count >0 ){
1957            $content = $data;
1958        }
1959        else{
1960            $content = "<p>This PEG does not have any similarities</p>";
1961        }
1962        return ($content);
1963    }
1964    
1965    sub get_box_column{
1966        my ($ids) = @_;
1967        my %column;
1968        foreach my $id (@$ids){
1969            my $field_name = "tables_" . $id;
1970            my $pair_name = "visual_" . $id;
1971            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1972        }
1973        return (%column);
1974    }
1975    
1976    sub get_subsystems_column{
1977        my ($ids,$fig) = @_;
1978    
1979        #my $fig = new FIG;
1980        my $cgi = new CGI;
1981        my %in_subs  = $fig->subsystems_for_pegs($ids);
1982        my %column;
1983        foreach my $id (@$ids){
1984            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1985            my @subsystems;
1986    
1987            if (@in_sub > 0) {
1988                foreach my $array(@in_sub){
1989                    my $ss = $$array[0];
1990                    $ss =~ s/_/ /ig;
1991                    push (@subsystems, "-" . $ss);
1992                }
1993                my $in_sub_line = join ("<br>", @subsystems);
1994                $column{$id} = $in_sub_line;
1995            } else {
1996                $column{$id} = "&nbsp;";
1997            }
1998        }
1999        return (%column);
2000    }
2001    
2002    sub get_essentially_identical{
2003        my ($fid,$dataset,$fig) = @_;
2004        #my $fig = new FIG;
2005    
2006        my %id_list;
2007        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2008    
2009        foreach my $thing (@$dataset){
2010            if($thing->class eq "IDENTICAL"){
2011                my $rows = $thing->rows;
2012                my $count_identical = 0;
2013                foreach my $row (@$rows) {
2014                    my $id = $row->[0];
2015                    if (($id ne $fid) && ($fig->function_of($id))) {
2016                        $id_list{$id} = 1;
2017                    }
2018                }
2019            }
2020        }
2021    
2022    #    foreach my $id (@maps_to) {
2023    #        if (($id ne $fid) && ($fig->function_of($id))) {
2024    #           $id_list{$id} = 1;
2025    #        }
2026    #    }
2027        return(%id_list);
2028    }
2029    
2030    
2031    sub get_evidence_column{
2032        my ($ids, $attributes,$fig) = @_;
2033        #my $fig = new FIG;
2034        my $cgi = new CGI;
2035        my (%column, %code_attributes);
2036    
2037        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2038        foreach my $key (@codes){
2039            push (@{$code_attributes{$$key[0]}}, $key);
2040        }
2041    
2042        foreach my $id (@$ids){
2043            # add evidence code with tool tip
2044            my $ev_codes=" &nbsp; ";
2045    
2046            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2047            my @ev_codes = ();
2048            foreach my $code (@codes) {
2049                my $pretty_code = $code->[2];
2050                if ($pretty_code =~ /;/) {
2051                    my ($cd, $ss) = split(";", $code->[2]);
2052                    $ss =~ s/_/ /g;
2053                    $pretty_code = $cd;# . " in " . $ss;
2054                }
2055                push(@ev_codes, $pretty_code);
2056            }
2057    
2058            if (scalar(@ev_codes) && $ev_codes[0]) {
2059                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2060                $ev_codes = $cgi->a(
2061                                    {
2062                                        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));
2063            }
2064            $column{$id}=$ev_codes;
2065        }
2066        return (%column);
2067    }
2068    
2069    sub get_pfam_column{
2070        my ($ids, $attributes,$fig) = @_;
2071        #my $fig = new FIG;
2072        my $cgi = new CGI;
2073        my (%column, %code_attributes, %attribute_locations);
2074        my $dbmaster = DBMaster->new(-database =>'Ontology');
2075    
2076        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2077        foreach my $key (@codes){
2078            my $name = $key->[1];
2079            if ($name =~ /_/){
2080                ($name) = ($key->[1]) =~ /(.*?)_/;
2081            }
2082            push (@{$code_attributes{$key->[0]}}, $name);
2083            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2084        }
2085    
2086        foreach my $id (@$ids){
2087            # add evidence code
2088            my $pfam_codes=" &nbsp; ";
2089            my @pfam_codes = "";
2090            my %description_codes;
2091    
2092            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2093                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2094                @pfam_codes = ();
2095    
2096                # get only unique values
2097                my %saw;
2098                foreach my $key (@ncodes) {$saw{$key}=1;}
2099                @ncodes = keys %saw;
2100    
2101                foreach my $code (@ncodes) {
2102                    my @parts = split("::",$code);
2103                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2104    
2105                    # get the locations for the domain
2106                    my @locs;
2107                    foreach my $part (@{$attribute_location{$id}{$code}}){
2108                        my ($loc) = ($part) =~ /\;(.*)/;
2109                        push (@locs,$loc);
2110                    }
2111                    my %locsaw;
2112                    foreach my $key (@locs) {$locsaw{$key}=1;}
2113                    @locs = keys %locsaw;
2114    
2115                    my $locations = join (", ", @locs);
2116    
2117                    if (defined ($description_codes{$parts[1]})){
2118                        push(@pfam_codes, "$parts[1] ($locations)");
2119                    }
2120                    else {
2121                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2122                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2123                        push(@pfam_codes, "$pfam_link ($locations)");
2124                    }
2125                }
2126            }
2127    
2128            $column{$id}=join("<br><br>", @pfam_codes);
2129        }
2130        return (%column);
2131    
2132    }
2133    
2134    sub get_aliases {
2135        my ($ids,$fig) = @_;
2136    
2137        my $all_aliases = $fig->feature_aliases_bulk($ids);
2138        foreach my $id (@$ids){
2139            foreach my $alias (@{$$all_aliases{$id}}){
2140                my $id_db = &Observation::get_database($alias);
2141                next if ($aliases->{$id}->{$id_db});
2142                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2143            }
2144        }
2145        return ($aliases);
2146    }
2147    
2148    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2149    
2150    sub color {
2151        my ($evalue) = @_;
2152        my $color;
2153        if ($evalue <= 1e-170){        $color = 51;    }
2154        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2155        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2156        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2157        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2158        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2159        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2160        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2161        elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2162        else{        $color = 60;    }
2163        return ($color);
2164    }
2165    
2166    
2167    ############################
2168    package Observation::Cluster;
2169    
2170    use base qw(Observation);
2171    
2172    sub new {
2173    
2174        my ($class,$dataset) = @_;
2175        my $self = $class->SUPER::new($dataset);
2176        $self->{context} = $dataset->{'context'};
2177        bless($self,$class);
2178        return $self;
2179    }
2180    
2181    sub display {
2182        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2183    
2184        my $fid = $self->fig_id;
2185        my $compare_or_coupling = $self->context;
2186        my $gd_window_size = $gd->window_size;
2187        my $range = $gd_window_size;
2188        my $all_regions = [];
2189        my $gene_associations={};
2190    
2191        #get the organism genome
2192        my $target_genome = $fig->genome_of($fid);
2193        $gene_associations->{$fid}->{"organism"} = $target_genome;
2194        $gene_associations->{$fid}->{"main_gene"} = $fid;
2195        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2196    
2197        # get location of the gene
2198        my $data = $fig->feature_location($fid);
2199        my ($contig, $beg, $end);
2200        my %reverse_flag;
2201    
2202        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2203            $contig = $1;
2204            $beg = $2;
2205            $end = $3;
2206        }
2207    
2208        my $offset;
2209        my ($region_start, $region_end);
2210        if ($beg < $end)
2211        {
2212            $region_start = $beg - ($range);
2213            $region_end = $end+ ($range);
2214            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2215        }
2216        else
2217        {
2218            $region_start = $end-($range);
2219            $region_end = $beg+($range);
2220            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2221            $reverse_flag{$target_genome} = $fid;
2222            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2223        }
2224    
2225        # call genes in region
2226        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2227        #foreach my $feat (@$target_gene_features){
2228        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2229        #}
2230        push(@$all_regions,$target_gene_features);
2231        my (@start_array_region);
2232        push (@start_array_region, $offset);
2233    
2234        my %all_genes;
2235        my %all_genomes;
2236        foreach my $feature (@$target_gene_features){
2237            #if ($feature =~ /peg/){
2238                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2239            #}
2240        }
2241    
2242        my @selected_sims;
2243    
2244        if ($compare_or_coupling eq "sims"){
2245            # get the selected boxes
2246            my @selected_taxonomy = @$selected_taxonomies;
2247    
2248            # get the similarities and store only the ones that match the lineages selected
2249            if (@selected_taxonomy > 0){
2250                foreach my $sim (@$sims_array){
2251                    next if ($sim->class ne "SIM");
2252                    next if ($sim->acc !~ /fig\|/);
2253    
2254                    #my $genome = $fig->genome_of($sim->[1]);
2255                    my $genome = $fig->genome_of($sim->acc);
2256                    my ($genome1) = ($genome) =~ /(.*)\./;
2257                    my $lineage = $taxes->{$genome1};
2258                    #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2259                    foreach my $taxon(@selected_taxonomy){
2260                        if ($lineage =~ /$taxon/){
2261                            #push (@selected_sims, $sim->[1]);
2262                            push (@selected_sims, $sim->acc);
2263                        }
2264                    }
2265                }
2266            }
2267            else{
2268                my $simcount = 0;
2269                foreach my $sim (@$sims_array){
2270                    next if ($sim->class ne "SIM");
2271                    next if ($sim->acc !~ /fig\|/);
2272    
2273                    push (@selected_sims, $sim->acc);
2274                    $simcount++;
2275                    last if ($simcount > 4);
2276                }
2277            }
2278    
2279            my %saw;
2280            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2281    
2282            # get the gene context for the sorted matches
2283            foreach my $sim_fid(@selected_sims){
2284                #get the organism genome
2285                my $sim_genome = $fig->genome_of($sim_fid);
2286                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2287                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2288                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2289    
2290                # get location of the gene
2291                my $data = $fig->feature_location($sim_fid);
2292                my ($contig, $beg, $end);
2293    
2294                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2295                    $contig = $1;
2296                    $beg = $2;
2297                    $end = $3;
2298                }
2299    
2300                my $offset;
2301                my ($region_start, $region_end);
2302                if ($beg < $end)
2303                {
2304                    $region_start = $beg - ($range/2);
2305                    $region_end = $end+($range/2);
2306                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2307                }
2308                else
2309                {
2310                    $region_start = $end-($range/2);
2311                    $region_end = $beg+($range/2);
2312                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2313                    $reverse_flag{$sim_genome} = $sim_fid;
2314                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2315                }
2316    
2317                # call genes in region
2318                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2319                push(@$all_regions,$sim_gene_features);
2320                push (@start_array_region, $offset);
2321                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2322                $all_genomes{$sim_genome} = 1;
2323            }
2324    
2325        }
2326    
2327        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2328        # cluster the genes
2329        my @all_pegs = keys %all_genes;
2330        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2331        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2332        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2333    
2334        foreach my $region (@$all_regions){
2335            my $sample_peg = @$region[0];
2336            my $region_genome = $fig->genome_of($sample_peg);
2337            my $region_gs = $fig->genus_species($region_genome);
2338            my $abbrev_name = $fig->abbrev($region_gs);
2339            my ($genome1) = ($region_genome) =~ /(.*?)\./;
2340            my $lineage = $taxes->{$genome1};
2341            #$region_gs .= "Lineage:$lineage";
2342            my $line_config = { 'title' => $region_gs,
2343                                'short_title' => $abbrev_name,
2344                                'basepair_offset' => '0'
2345                                };
2346    
2347            my $offsetting = shift @start_array_region;
2348    
2349            my $second_line_config = { 'title' => "$lineage",
2350                                       'short_title' => "",
2351                                       'basepair_offset' => '0',
2352                                       'no_middle_line' => '1'
2353                                       };
2354    
2355            my $line_data = [];
2356            my $second_line_data = [];
2357    
2358            # initialize variables to check for overlap in genes
2359            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2360            my $major_line_flag = 0;
2361            my $prev_second_flag = 0;
2362    
2363            foreach my $fid1 (@$region){
2364                $second_line_flag = 0;
2365                my $element_hash;
2366                my $links_list = [];
2367                my $descriptions = [];
2368    
2369                my $color = $color_sets->{$fid1};
2370    
2371                # get subsystem information
2372                my $function = $fig->function_of($fid1);
2373                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;
2374    
2375                my $link;
2376                $link = {"link_title" => $fid1,
2377                         "link" => $url_link};
2378                push(@$links_list,$link);
2379    
2380                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2381                my @subsystems;
2382                foreach my $array (@subs){
2383                    my $subsystem = $$array[0];
2384                    my $ss = $subsystem;
2385                    $ss =~ s/_/ /ig;
2386                    push (@subsystems, $ss);
2387                    my $link;
2388                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
2389                             "link_title" => $ss};
2390                    push(@$links_list,$link);
2391                }
2392    
2393                if ($fid1 eq $fid){
2394                    my $link;
2395                    $link = {"link_title" => "Annotate this sequence",
2396                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2397                    push (@$links_list,$link);
2398                }
2399    
2400                my $description_function;
2401                $description_function = {"title" => "function",
2402                                         "value" => $function};
2403                push(@$descriptions,$description_function);
2404    
2405                my $description_ss;
2406                my $ss_string = join (", ", @subsystems);
2407                $description_ss = {"title" => "subsystems",
2408                                   "value" => $ss_string};
2409                push(@$descriptions,$description_ss);
2410    
2411    
2412                my $fid_location = $fig->feature_location($fid1);
2413                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2414                    my($start,$stop);
2415                    $start = $2 - $offsetting;
2416                    $stop = $3 - $offsetting;
2417    
2418                    if ( (($prev_start) && ($prev_stop) ) &&
2419                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2420                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2421                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2422                            $second_line_flag = 1;
2423                            $major_line_flag = 1;
2424                        }
2425                    }
2426                    $prev_start = $start;
2427                    $prev_stop = $stop;
2428                    $prev_fig = $fid1;
2429    
2430                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2431                        $start = $gd_window_size - $start;
2432                        $stop = $gd_window_size - $stop;
2433                    }
2434    
2435                    my $title = $fid1;
2436                    if ($fid1 eq $fid){
2437                        $title = "My query gene: $fid1";
2438                    }
2439    
2440                    $element_hash = {
2441                        "title" => $title,
2442                        "start" => $start,
2443                        "end" =>  $stop,
2444                        "type"=> 'arrow',
2445                        "color"=> $color,
2446                        "zlayer" => "2",
2447                        "links_list" => $links_list,
2448                        "description" => $descriptions
2449                    };
2450    
2451                    # if there is an overlap, put into second line
2452                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2453                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2454    
2455                    if ($fid1 eq $fid){
2456                        $element_hash = {
2457                            "title" => 'Query',
2458                            "start" => $start,
2459                            "end" =>  $stop,
2460                            "type"=> 'bigbox',
2461                            "color"=> $color,
2462                            "zlayer" => "1"
2463                            };
2464    
2465                        # if there is an overlap, put into second line
2466                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2467                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2468                    }
2469                }
2470            }
2471            $gd->add_line($line_data, $line_config);
2472            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2473        }
2474        return ($gd, \@selected_sims);
2475    }
2476    
2477    sub cluster_genes {
2478        my($fig,$all_pegs,$peg) = @_;
2479        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2480    
2481        my @color_sets = ();
2482    
2483        $conn = &get_connections_by_similarity($fig,$all_pegs);
2484    
2485        for ($i=0; ($i < @$all_pegs); $i++) {
2486            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2487            if (! $seen{$i}) {
2488                $cluster = [$i];
2489                $seen{$i} = 1;
2490                for ($j=0; ($j < @$cluster); $j++) {
2491                    $x = $conn->{$cluster->[$j]};
2492                    foreach $k (@$x) {
2493                        if (! $seen{$k}) {
2494                            push(@$cluster,$k);
2495                            $seen{$k} = 1;
2496                        }
2497                    }
2498                }
2499    
2500                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2501                    push(@color_sets,$cluster);
2502                }
2503            }
2504        }
2505        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2506        $red_set = $color_sets[$i];
2507        splice(@color_sets,$i,1);
2508        @color_sets = sort { @$b <=> @$a } @color_sets;
2509        unshift(@color_sets,$red_set);
2510    
2511        my $color_sets = {};
2512        for ($i=0; ($i < @color_sets); $i++) {
2513            foreach $x (@{$color_sets[$i]}) {
2514                $color_sets->{$all_pegs->[$x]} = $i;
2515            }
2516        }
2517        return $color_sets;
2518    }
2519    
2520    sub get_connections_by_similarity {
2521        my($fig,$all_pegs) = @_;
2522        my($i,$j,$tmp,$peg,%pos_of);
2523        my($sim,%conn,$x,$y);
2524    
2525        for ($i=0; ($i < @$all_pegs); $i++) {
2526            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2527            push(@{$pos_of{$tmp}},$i);
2528            if ($tmp ne $all_pegs->[$i]) {
2529                push(@{$pos_of{$all_pegs->[$i]}},$i);
2530            }
2531        }
2532    
2533        foreach $y (keys(%pos_of)) {
2534            $x = $pos_of{$y};
2535            for ($i=0; ($i < @$x); $i++) {
2536                for ($j=$i+1; ($j < @$x); $j++) {
2537                    push(@{$conn{$x->[$i]}},$x->[$j]);
2538                    push(@{$conn{$x->[$j]}},$x->[$i]);
2539                }
2540            }
2541        }
2542    
2543        for ($i=0; ($i < @$all_pegs); $i++) {
2544            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2545                if (defined($x = $pos_of{$sim->id2})) {
2546                    foreach $y (@$x) {
2547                        push(@{$conn{$i}},$y);
2548                    }
2549                }
2550            }
2551        }
2552        return \%conn;
2553    }
2554    
2555    sub in {
2556        my($x,$xL) = @_;
2557        my($i);
2558    
2559        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2560        return ($i < @$xL);
2561    }
2562    
2563    #############################################
2564    #############################################
2565    package Observation::Commentary;
2566    
2567    use base qw(Observation);
2568    
2569    =head3 display_protein_commentary()
2570    
2571    =cut
2572    
2573    sub display_protein_commentary {
2574        my ($self,$dataset,$mypeg,$fig) = @_;
2575    
2576        my $all_rows = [];
2577        my $content;
2578        #my $fig = new FIG;
2579        my $cgi = new CGI;
2580        my $count = 0;
2581        my $peg_array = [];
2582        my (%evidence_column, %subsystems_column,  %e_identical);
2583    
2584        if (@$dataset != 1){
2585            foreach my $thing (@$dataset){
2586                if ($thing->class eq "SIM"){
2587                    push (@$peg_array, $thing->acc);
2588                }
2589            }
2590            # get the column for the evidence codes
2591            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2592    
2593            # get the column for the subsystems
2594            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2595    
2596            # get essentially identical seqs
2597            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2598        }
2599        else{
2600            push (@$peg_array, @$dataset);
2601        }
2602    
2603        my $selected_sims = [];
2604        foreach my $id (@$peg_array){
2605            last if ($count > 10);
2606            my $row_data = [];
2607            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2608            $org = $fig->org_of($id);
2609            $function = $fig->function_of($id);
2610            if ($mypeg ne $id){
2611                $function_cell = qq(<input type=radio name=function id=$id value=$function onClick="clearText('newAnnotation');">&nbsp;&nbsp;$function);
2612                $id_cell .= &HTML::set_prot_links($cgi,$id);
2613                if (defined($e_identical{$id})) { $id_cell .= "*";}
2614            }
2615            else{
2616                $function_cell = "&nbsp;&nbsp;$function";
2617                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2618                $id_cell .= &HTML::set_prot_links($cgi,$id);
2619            }
2620    
2621            push(@$row_data,$id_cell);
2622            push(@$row_data,$org);
2623            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2624            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2625            push(@$row_data, $fig->translation_length($id));
2626            push(@$row_data,$function_cell);
2627            push(@$all_rows,$row_data);
2628            push (@$selected_sims, $id);
2629            $count++;
2630        }
2631    
2632        if ($count >0){
2633            $content = $all_rows;
2634        }
2635        else{
2636            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2637        }
2638        return ($content,$selected_sims);
2639    }
2640    
2641    sub display_protein_history {
2642        my ($self, $id,$fig) = @_;
2643        my $all_rows = [];
2644        my $content;
2645    
2646        my $cgi = new CGI;
2647        my $count = 0;
2648        foreach my $feat ($fig->feature_annotations($id)){
2649            my $row = [];
2650            my $col1 = $feat->[2];
2651            my $col2 = $feat->[1];
2652            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2653            my $text = $feat->[3];
2654    
2655            push (@$row, $col1);
2656            push (@$row, $col2);
2657            push (@$row, $text);
2658            push (@$all_rows, $row);
2659            $count++;
2660        }
2661        if ($count > 0){
2662            $content = $all_rows;
2663        }
2664        else {
2665            $content = "There is no history for this PEG";
2666        }
2667    
2668      return ($content);      return ($content);
2669  }  }

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.42

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3