[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.24, Tue Jul 10 20:11:38 2007 UTC revision 1.76, Fri Mar 20 18:35:46 2009 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  use strict;  use LWP::Simple;
15    #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
18    use FFs;
19    
20  1;  1;
21    
 # $Id$  
   
22  =head1 NAME  =head1 NAME
23    
24  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 85  Line 89 
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92    =head3 query()
93    
94    The query id
95    
96    =cut
97    
98    sub query {
99        my ($self) = @_;
100        return $self->{query};
101    }
102    
103    
104  =head3 class()  =head3 class()
105    
106  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 151  Line 167 
167  sub type {  sub type {
168    my ($self) = @_;    my ($self) = @_;
169    
170    return $self->{acc};    return $self->{type};
171  }  }
172    
173  =head3 start()  =head3 start()
# Line 304  Line 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
# Line 317  Line 333 
333      }      }
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          $domain_classes{'CDD'} = 1;          my @attributes = $fig->get_attributes($fid);
337          get_identical_proteins($fid,\@matched_datasets);          #$domain_classes{'CDD'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_sims_observations($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_pdb_observations($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
343            get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 331  Line 349 
349          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
350              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
351          }          }
352          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
353              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
356              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
359              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
362              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
365              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
366          }          }
367          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
368              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
369          }          }
370    
# Line 357  Line 375 
375    
376  }  }
377    
378    =head3 get_attributes
379        provides layer of abstraction between tools and underlying access method to Attribute Server
380    =cut
381    
382    sub get_attributes{
383        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
384        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
385        return @attributes;
386    }
387    
388    =head3 get_sims_objects()
389    
390    This is the B<REAL WORKHORSE> method of this Package.
391    
392    =cut
393    
394    sub get_sims_objects {
395        my ($self,$fid,$fig,$parameters) = @_;
396    
397        my $objects = [];
398        my @matched_datasets=();
399    
400        # call function that fetches attribute based observations
401        # returns an array of arrays of hashes
402        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
403    
404        foreach my $dataset (@matched_datasets) {
405            my $object;
406            if ($dataset->{'class'} eq "SIM"){
407                $object = Observation::Sims->new($dataset);
408            }
409            push (@$objects, $object);
410        }
411        return $objects;
412    }
413    
414    
415    =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418    =cut
419    sub display_housekeeping {
420        my ($self,$fid,$fig) = @_;
421        my $content = [];
422        my $row = [];
423    
424        my $org_name = "Data not available";
425        if ( $fig->org_of($fid)){
426            $org_name = $fig->org_of($fid);
427        }
428        my $org_id = $fig->genome_of($fid);
429        my $function = $fig->function_of($fid);
430        #my $taxonomy = $fig->taxonomy_of($org_id);
431        my $length = $fig->translation_length($fid);
432    
433        push (@$row, $org_name);
434        push (@$row, $fid);
435        push (@$row, $length);
436        push (@$row, $function);
437    
438        # initialize the table for commentary and annotations
439        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
440        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
441        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
442        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
444        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
445        #$content .= qq(</table><p>\n);
446    
447        push(@$content, $row);
448    
449        return ($content);
450    }
451    
452    =head3 get_sims_summary
453    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
454    
455    =cut
456    
457    sub get_sims_summary {
458        my ($observation, $dataset, $fig) = @_;
459        my %families;
460        my $taxes = $fig->taxonomy_list();
461    
462        foreach my $thing (@$dataset) {
463            my ($id, $evalue);
464            if ($thing =~ /fig\|/){
465                $id = $thing;
466                $evalue = -1;
467            }
468            else{
469                next if ($thing->class ne "SIM");
470                $id      = $thing->acc;
471                $evalue  = $thing->evalue;
472            }
473            next if ($id !~ /fig\|/);
474            next if ($fig->is_deleted_fid($id));
475    
476            my $genome = $fig->genome_of($id);
477            #my ($genome1) = ($genome) =~ /(.*)\./;
478            my $taxonomy = $taxes->{$genome};
479            my $parent_tax = "Root";
480            my @currLineage = ($parent_tax);
481            push (@{$families{figs}{$parent_tax}}, $id);
482            my $level = 2;
483    
484            foreach my $tax (split(/\; /, $taxonomy),$id){
485              next if ($tax eq $parent_tax);
486              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
487              push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
488              $families{level}{$tax} = $level;
489              push (@currLineage, $tax);
490              $families{parent}{$tax} = $parent_tax;
491              $families{lineage}{$tax} = join(";", @currLineage);
492              if (defined ($families{evalue}{$tax})){
493                if ($evalue < $families{evalue}{$tax}){
494                  $families{evalue}{$tax} = $evalue;
495                  $families{color}{$tax} = &get_taxcolor($evalue);
496                }
497              }
498              else{
499                $families{evalue}{$tax} = $evalue;
500                $families{color}{$tax} = &get_taxcolor($evalue);
501              }
502    
503              $parent_tax = $tax;
504              $level++;
505            }
506        }
507    
508        foreach my $key (keys %{$families{children}}){
509            $families{count}{$key} = @{$families{children}{$key}};
510    
511            my %saw;
512            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513            $families{children}{$key} = \@out;
514        }
515    
516        return \%families;
517    }
518    
519  =head1 Internal Methods  =head1 Internal Methods
520    
521  These methods are not meant to be used outside of this package.  These methods are not meant to be used outside of this package.
# Line 365  Line 524 
524    
525  =cut  =cut
526    
527  sub get_attribute_based_domain_observations{  sub get_taxcolor{
528        my ($evalue) = @_;
529        my $color;
530        if ($evalue == -1){            $color = "black";      }
531        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
532        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
533        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
534        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
535        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
536        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
537        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
538        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
539        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
540        else{        $color = "#6666FF";    }
541        return ($color);
542    }
543    
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$domain_classes,$datasets_ref) = (@_);  
544    
545      my $fig = new FIG;  sub get_attribute_based_domain_observations{
546    
547      foreach my $attr_ref ($fig->get_attributes($fid)) {      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
548        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
550        foreach my $attr_ref (@$attributes_ref) {
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $class = $parts[0];          my $class = $parts[0];
554            my $name = $parts[1];
555            next if ($seen->{$name});
556            $seen->{$name}++;
557            #next if (($class eq "PFAM") && ($name !~ /interpro/));
558    
559          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
560              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 384  Line 563 
563                  my $from = $2;                  my $from = $2;
564                  my $to = $3;                  my $to = $3;
565                  my $evalue;                  my $evalue;
566                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
567                        my $part2 = 1000 - $1;
568                        my $part1 = $2/100;
569                        $evalue = $part1."e-".$part2;
570                    }
571                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                        #$evalue=$raw_evalue;
573                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
574                      my $part1 = $2/100;                      my $part1 = $2/100;
575                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
576    
577                  }                  }
578                  else{                  else{
579                      $evalue = "0.0";                      $evalue = "0.0";
# Line 411  Line 597 
597    
598  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
599    
600      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
601      my $fig = new FIG;      #my $fig = new FIG;
602    
603      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
604    
605      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      my $dataset = {'type' => "loc",
606      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
607                       'fig_id' => $fid
608                       };
609    
610        foreach my $attr_ref (@$attributes_ref){
611          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
612            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
613          my @parts = split("::",$key);          my @parts = split("::",$key);
614          my $sub_class = $parts[0];          my $sub_class = $parts[0];
615          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 433  Line 624 
624                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
625              }              }
626          }          }
627    
628          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
629              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
630              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
631          }          }
632    
633            elsif($sub_class eq "Phobius"){
634                if($sub_key eq "transmembrane"){
635                    $dataset->{'phobius_tm_locations'} = $value;
636                }
637                elsif($sub_key eq "signal"){
638                    $dataset->{'phobius_signal_location'} = $value;
639                }
640            }
641    
642          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
643              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
644              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
645              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
646          }          }
# Line 455  Line 657 
657  =cut  =cut
658    
659  sub get_pdb_observations{  sub get_pdb_observations{
660      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
661    
662      my $fig = new FIG;      #my $fig = new FIG;
   
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
663    
664        foreach my $attr_ref (@$attributes_ref){
665          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
666            next if ( ($key !~ /PDB/));
667          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
668          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
669          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 513  Line 715 
715  =cut  =cut
716    
717  sub get_sims_observations{  sub get_sims_observations{
718        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
719    
720        my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
721        if ( (defined $parameters->{flag}) && ($parameters->{flag})){
722          $max_sims = $parameters->{max_sims};
723          $max_expand = $parameters->{max_expand};
724          $max_eval = $parameters->{max_eval};
725          $db_filter = $parameters->{db_filter};
726          $sim_filters->{ sort_by } = $parameters->{sim_order};
727          #$sim_order = $parameters->{sim_order};
728          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
729        }
730        elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
731          $max_sims = 50;
732          $max_expand = 5;
733          $max_eval = 1e-5;
734          $db_filter = "all";
735          $sim_filters->{ sort_by } = 'id';
736        }
737        else{
738          $max_sims = 50;
739          $max_expand = 5;
740          $max_eval = 1e-5;
741          $db_filter = "figx";
742          $sim_filters->{ sort_by } = 'id';
743          #$sim_order = "id";
744        }
745    
746      my ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
747      my $fig = new FIG;      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
748      my @sims= $fig->nsims($fid,100,1e-20,"all");      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
749      my ($dataset);      my ($dataset);
750      foreach my $sim (@sims){  
751        if ($group_by_genome){
752          #  Collect all sims from genome with the first occurance of the genome:
753          foreach $sim ( @tmp ){
754            $id = $sim->id2;
755            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
756            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
757            push @{ $sims{ $genome } }, $sim;
758          }
759          @tmp = map { @{ $sims{$_} } } @genomes;
760        }
761    
762        my $seen_sims={};
763        foreach my $sim (@tmp){
764          my $hit = $sim->[1];          my $hit = $sim->[1];
765            next if ($seen_sims->{$hit});
766            $seen_sims->{$hit}++;
767          my $percent = $sim->[2];          my $percent = $sim->[2];
768          my $evalue = $sim->[10];          my $evalue = $sim->[10];
769          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 530  Line 774 
774          my $hlength = $sim->[13];          my $hlength = $sim->[13];
775          my $db = get_database($hit);          my $db = get_database($hit);
776          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
777          my $organism = $fig->org_of($hit);          my $organism;
778            if ($fig->org_of($hit)){
779                $organism = $fig->org_of($hit);
780            }
781            else{
782                $organism = "Data not available";
783            }
784    
785          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
786                        'query' => $sim->[0],
787                      'acc' => $hit,                      'acc' => $hit,
788                      'identity' => $percent,                      'identity' => $percent,
789                      'type' => 'seq',                      'type' => 'seq',
# Line 562  Line 813 
813      my ($id) = (@_);      my ($id) = (@_);
814    
815      my ($db);      my ($db);
816      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
817      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
818        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
819      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
820        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
821      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
822      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
823      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
824      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
825      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
826      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
827      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
828      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
829        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
830        elsif ($id =~ /^img\|/)           { $db = "IMG" }
831        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
832        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
833    
834      return ($db);      return ($db);
835    
# Line 587  Line 844 
844    
845  sub get_identical_proteins{  sub get_identical_proteins{
846    
847      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
848      my $fig = new FIG;      #my $fig = new FIG;
849      my $funcs_ref;      my $funcs_ref;
850    
851      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);
   
852      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
853          my ($tmp, $who);          my ($tmp, $who);
854          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
# Line 601  Line 857 
857          }          }
858      }      }
859    
     my ($dataset);  
860      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
861                     'type' => 'seq',                     'type' => 'seq',
862                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 621  Line 876 
876    
877  sub get_functional_coupling{  sub get_functional_coupling{
878    
879      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
880      my $fig = new FIG;      #my $fig = new FIG;
881      my @funcs = ();      my @funcs = ();
882    
883      # initialize some variables      # initialize some variables
# Line 632  Line 887 
887      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
888    
889      # get the fc data      # get the fc data
890      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff);
891    
892      # retrieve data      # retrieve data
893      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
894                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
895                    } @fc_data;                    } @fc_data;
896    
     my ($dataset);  
897      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
898                     'type' => 'fc',                     'type' => 'fc',
899                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 750  Line 1004 
1004      return $self->{database};      return $self->{database};
1005  }  }
1006    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1007  ############################################################  ############################################################
1008  ############################################################  ############################################################
1009  package Observation::PDB;  package Observation::PDB;
# Line 781  Line 1029 
1029  =cut  =cut
1030    
1031  sub display{  sub display{
1032      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1033    
1034      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1035      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1036                                     -host     => $WebConfig::DBHOST,
1037                                     -user     => $WebConfig::DBUSER,
1038                                     -password => $WebConfig::DBPWD);
1039    
1040      my $acc = $self->acc;      my $acc = $self->acc;
1041    
     print STDERR "acc:$acc\n";  
1042      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
1043      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1044      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 806  Line 1056 
1056      my $lines = [];      my $lines = [];
1057      my $line_data = [];      my $line_data = [];
1058      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1059                            'hover_title' => 'PDB',
1060                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1061                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1062    
1063      my $fig = new FIG;      #my $fig = new FIG;
1064      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1065      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1066    
# Line 910  Line 1161 
1161    
1162    
1163  sub display_table{  sub display_table{
1164      my ($self) = @_;      my ($self,$fig) = @_;
1165    
1166      my $fig = new FIG;      #my $fig = new FIG;
1167      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1168      my $rows = $self->rows;      my $rows = $self->rows;
1169      my $cgi = new CGI;      my $cgi = new CGI;
# Line 923  Line 1174 
1174          my $id = $row->[0];          my $id = $row->[0];
1175          my $who = $row->[1];          my $who = $row->[1];
1176          my $assignment = $row->[2];          my $assignment = $row->[2];
1177          my $organism = $fig->org_of($fid);          my $organism = "Data not available";
1178            if ($fig->org_of($id)){
1179                $organism = $fig->org_of($id);
1180            }
1181          my $single_domain = [];          my $single_domain = [];
1182          push(@$single_domain,$who);          push(@$single_domain,$who);
1183          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1184          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1185          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1186          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 974  Line 1228 
1228    
1229  sub display_table {  sub display_table {
1230    
1231      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1232      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1233      my $rows = $self->rows;      my $rows = $self->rows;
1234      my $cgi = new CGI;      my $cgi = new CGI;
# Line 989  Line 1243 
1243          # construct the score link          # construct the score link
1244          my $score = $row->[0];          my $score = $row->[0];
1245          my $toid = $row->[1];          my $toid = $row->[1];
1246          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1247          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1248    
1249          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1250          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1031  Line 1285 
1285  sub display {  sub display {
1286      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1287      my $lines = [];      my $lines = [];
1288      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1289                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1290                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1291      my $color = "4";      my $color = "4";
1292    
1293      my $line_data = [];      my $line_data = [];
# Line 1043  Line 1297 
1297      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1298      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1299    
1300      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1301                                    -host     => $WebConfig::DBHOST,
1302                                    -user     => $WebConfig::DBUSER,
1303                                    -password => $WebConfig::DBPWD);
1304    
1305      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1306      if($db eq "CDD"){  
1307          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1308          if(!scalar(@$cdd_objs)){          my $new_id;
1309            if ($id =~ /_/){
1310                ($new_id) = ($id) =~ /(.*?)_/;
1311            }
1312            else{
1313                $new_id = $id;
1314            }
1315    
1316            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1317            if(!scalar(@$pfam_objs)){
1318              $name_title = "name";              $name_title = "name";
1319              $name_value = "not available";              $name_value = "not available";
1320              $description_title = "description";              $description_title = "description";
1321              $description_value = "not available";              $description_value = "not available";
1322          }          }
1323          else{          else{
1324              my $cdd_obj = $cdd_objs->[0];              my $pfam_obj = $pfam_objs->[0];
1325              $name_title = "name";              $name_title = "name";
1326              $name_value = $cdd_obj->term;              $name_value = $pfam_obj->term;
1327              $description_title = "description";              #$description_title = "description";
1328              $description_value = $cdd_obj->description;              #$description_value = $pfam_obj->description;
1329            }
1330          }          }
1331    
1332        my $short_title = $thing->acc;
1333        $short_title =~ s/::/ - /ig;
1334        my $new_short_title=$short_title;
1335        if ($short_title =~ /interpro/){
1336            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1337      }      }
1338        my $line_config = { 'title' => $name_value,
1339                            'hover_title', => 'Domain',
1340                            'short_title' => $new_short_title,
1341                            'basepair_offset' => '1' };
1342    
1343      my $name;      my $name;
1344      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1345               "value" => $name_value};      $name = {"title" => $db,
1346                 "value" => $new_id};
1347      push(@$descriptions,$name);      push(@$descriptions,$name);
1348    
1349      my $description;  #    my $description;
1350      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1351                               "value" => $description_value};  #                   "value" => $description_value};
1352      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1353    
1354      my $score;      my $score;
1355      $score = {"title" => "score",      $score = {"title" => "score",
1356                "value" => $thing->evalue};                "value" => $thing->evalue};
1357      push(@$descriptions,$score);      push(@$descriptions,$score);
1358    
1359        my $location;
1360        $location = {"title" => "location",
1361                     "value" => $thing->start . " - " . $thing->stop};
1362        push(@$descriptions,$location);
1363    
1364      my $link_id;      my $link_id;
1365      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1366          $link_id = $1;          $link_id = $1;
1367      }      }
1368    
1369      my $link;      my $link;
1370      my $link_url;      my $link_url;
1371      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"}  #    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"}
1372      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1373      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1374    
1375      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1094  Line 1377 
1377      push(@$links_list,$link);      push(@$links_list,$link);
1378    
1379      my $element_hash = {      my $element_hash = {
1380          "title" => $thing->type,          "title" => $name_value,
1381          "start" => $thing->start,          "start" => $thing->start,
1382          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1383          "color"=> $color,          "color"=> $color,
# Line 1109  Line 1392 
1392    
1393  }  }
1394    
1395    sub display_table {
1396        my ($self,$dataset) = @_;
1397        my $cgi = new CGI;
1398        my $data = [];
1399        my $count = 0;
1400        my $content;
1401        my $seen = {};
1402    
1403        foreach my $thing (@$dataset) {
1404            next if ($thing->type !~ /dom/);
1405            my $single_domain = [];
1406            $count++;
1407    
1408            my $db_and_id = $thing->acc;
1409            my ($db,$id) = split("::",$db_and_id);
1410    
1411            my $dbmaster = DBMaster->new(-database =>'Ontology',
1412                                    -host     => $WebConfig::DBHOST,
1413                                    -user     => $WebConfig::DBUSER,
1414                                    -password => $WebConfig::DBPWD);
1415    
1416            my ($name_title,$name_value,$description_title,$description_value);
1417    
1418            my $new_id;
1419            if($db =~ /PFAM/){
1420                if ($id =~ /_/){
1421                    ($new_id) = ($id) =~ /(.*?)_/;
1422                }
1423                else{
1424                    $new_id = $id;
1425                }
1426    
1427                next if ($seen->{$new_id});
1428                $seen->{$new_id}=1;
1429    
1430                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1431    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1432                if(!scalar(@$pfam_objs)){
1433                    $name_title = "name";
1434                    $name_value = "not available";
1435                    $description_title = "description";
1436                    $description_value = "not available";
1437                }
1438                else{
1439                    my $pfam_obj = $pfam_objs->[0];
1440                    $name_title = "name";
1441                    $name_value = $pfam_obj->term;
1442                    #$description_title = "description";
1443                    #$description_value = $pfam_obj->description;
1444                }
1445            }
1446    
1447            my $location =  $thing->start . " - " . $thing->stop;
1448    
1449            push(@$single_domain,$db);
1450            push(@$single_domain,$new_id);
1451            push(@$single_domain,$name_value);
1452            push(@$single_domain,$location);
1453            push(@$single_domain,$thing->evalue);
1454            push(@$single_domain,$description_value);
1455            push(@$data,$single_domain);
1456        }
1457    
1458        if ($count >0){
1459            $content = $data;
1460        }
1461        else
1462        {
1463            $content = "<p>This PEG does not have any similarities to domains</p>";
1464        }
1465    }
1466    
1467    
1468  #########################################  #########################################
1469  #########################################  #########################################
1470  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1482 
1482      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1483      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1484      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1485        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1486        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1487    
1488      bless($self,$class);      bless($self,$class);
1489      return $self;      return $self;
1490  }  }
1491    
1492    sub display_cello {
1493        my ($thing) = @_;
1494        my $html;
1495        my $cello_location = $thing->cello_location;
1496        my $cello_score = $thing->cello_score;
1497        if($cello_location){
1498            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1499            #$html .= "<p>CELLO score: $cello_score </p>";
1500        }
1501        return ($html);
1502    }
1503    
1504  sub display {  sub display {
1505      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1506    
1507      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1508      my $fig= new FIG;      #my $fig= new FIG;
1509      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1510    
1511      my $cleavage_prob;      my $cleavage_prob;
# Line 1147  Line 1517 
1517      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1518      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1519    
1520        my $phobius_signal_location = $thing->phobius_signal_location;
1521        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1522    
1523      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1524    
1525      #color is      #color is
1526      my $color = "5";      my $color = "6";
   
     my $line_data = [];  
   
     if($cello_location){  
         my $cello_descriptions = [];  
         my $description_cello_location = {"title" => 'Best Cello Location',  
                                           "value" => $cello_location};  
1527    
         push(@$cello_descriptions,$description_cello_location);  
1528    
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
1529    
1530          push(@$cello_descriptions,$description_cello_score);  #    if($cello_location){
1531    #       my $cello_descriptions = [];
1532    #       my $line_data =[];
1533    #
1534    #       my $line_config = { 'title' => 'Localization Evidence',
1535    #                           'short_title' => 'CELLO',
1536    #                            'hover_title' => 'Localization',
1537    #                           'basepair_offset' => '1' };
1538    #
1539    #       my $description_cello_location = {"title" => 'Best Cello Location',
1540    #                                         "value" => $cello_location};
1541    #
1542    #       push(@$cello_descriptions,$description_cello_location);
1543    #
1544    #       my $description_cello_score = {"title" => 'Cello Score',
1545    #                                      "value" => $cello_score};
1546    #
1547    #       push(@$cello_descriptions,$description_cello_score);
1548    #
1549    #       my $element_hash = {
1550    #           "title" => "CELLO",
1551    #           "color"=> $color,
1552    #           "start" => "1",
1553    #           "end" =>  $length + 1,
1554    #           "zlayer" => '1',
1555    #           "description" => $cello_descriptions};
1556    #
1557    #       push(@$line_data,$element_hash);
1558    #       $gd->add_line($line_data, $line_config);
1559    #    }
1560    #
1561    #    $color = "2";
1562    #    if($tmpred_score){
1563    #       my $line_data =[];
1564    #       my $line_config = { 'title' => 'Localization Evidence',
1565    #                           'short_title' => 'Transmembrane',
1566    #                           'basepair_offset' => '1' };
1567    #
1568    #       foreach my $tmpred (@tmpred_locations){
1569    #           my $descriptions = [];
1570    #           my ($begin,$end) =split("-",$tmpred);
1571    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1572    #                            "value" => $tmpred_score};
1573    #
1574    #           push(@$descriptions,$description_tmpred_score);
1575    #
1576    #           my $element_hash = {
1577    #           "title" => "transmembrane location",
1578    #           "start" => $begin + 1,
1579    #           "end" =>  $end + 1,
1580    #           "color"=> $color,
1581    #           "zlayer" => '5',
1582    #           "type" => 'box',
1583    #           "description" => $descriptions};
1584    #
1585    #           push(@$line_data,$element_hash);
1586    #
1587    #       }
1588    #       $gd->add_line($line_data, $line_config);
1589    #    }
1590    
         my $element_hash = {  
             "title" => "CELLO",  
             "start" => "1",  
             "end" =>  $length + 1,  
             "color"=> $color,  
             "type" => 'box',  
             "zlayer" => '2',  
             "description" => $cello_descriptions};  
1591    
1592          push(@$line_data,$element_hash);      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1593      }          my $line_data =[];
1594            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1595                                'short_title' => 'TM and SP',
1596                                'hover_title' => 'Localization',
1597                                'basepair_offset' => '1' };
1598    
1599      my $color = "6";          foreach my $tm_loc (@phobius_tm_locations){
     if($tmpred_score){  
         foreach my $tmpred (@tmpred_locations){  
1600              my $descriptions = [];              my $descriptions = [];
1601              my ($begin,$end) =split("-",$tmpred);              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1602              my $description_tmpred_score = {"title" => 'TMPRED score',                               "value" => $tm_loc};
1603                               "value" => $tmpred_score};              push(@$descriptions,$description_phobius_tm_locations);
1604    
1605              push(@$descriptions,$description_tmpred_score);              my ($begin,$end) =split("-",$tm_loc);
1606    
1607              my $element_hash = {              my $element_hash = {
1608              "title" => "transmembrane location",              "title" => "Phobius",
1609              "start" => $begin + 1,              "start" => $begin + 1,
1610              "end" =>  $end + 1,              "end" =>  $end + 1,
1611              "color"=> $color,              "color"=> '6',
1612              "zlayer" => '5',              "zlayer" => '4',
1613              "type" => 'smallbox',              "type" => 'bigbox',
1614              "description" => $descriptions};              "description" => $descriptions};
1615    
1616              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1617          }  
1618      }      }
1619    
1620      my $color = "1";          if($phobius_signal_location){
     if($signal_peptide_score){  
1621          my $descriptions = [];          my $descriptions = [];
1622          my $description_signal_peptide_score = {"title" => 'signal peptide score',              my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1623                                                  "value" => $signal_peptide_score};                               "value" => $phobius_signal_location};
1624                push(@$descriptions,$description_phobius_signal_location);
         push(@$descriptions,$description_signal_peptide_score);  
1625    
         my $description_cleavage_prob = {"title" => 'cleavage site probability',  
                                          "value" => $cleavage_prob};  
   
         push(@$descriptions,$description_cleavage_prob);  
1626    
1627                my ($begin,$end) =split("-",$phobius_signal_location);
1628          my $element_hash = {          my $element_hash = {
1629              "title" => "SignalP",              "title" => "phobius signal locations",
1630              "start" => $cleavage_loc_begin - 2,              "start" => $begin + 1,
1631              "end" =>  $cleavage_loc_end + 3,              "end" =>  $end + 1,
1632              "type" => 'bigbox',              "color"=> '1',
1633              "color"=> $color,              "zlayer" => '5',
1634              "zlayer" => '10',              "type" => 'box',
1635              "description" => $descriptions};              "description" => $descriptions};
   
1636          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1637      }      }
1638    
1639      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1640        }
1641    
1642    
1643    #    $color = "1";
1644    #    if($signal_peptide_score){
1645    #       my $line_data = [];
1646    #       my $descriptions = [];
1647    #
1648    #       my $line_config = { 'title' => 'Localization Evidence',
1649    #                           'short_title' => 'SignalP',
1650    #                            'hover_title' => 'Localization',
1651    #                           'basepair_offset' => '1' };
1652    #
1653    #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1654    #                                               "value" => $signal_peptide_score};
1655    #
1656    #       push(@$descriptions,$description_signal_peptide_score);
1657    #
1658    #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1659    #                                        "value" => $cleavage_prob};
1660    #
1661    #       push(@$descriptions,$description_cleavage_prob);
1662    #
1663    #       my $element_hash = {
1664    #           "title" => "SignalP",
1665    #           "start" => $cleavage_loc_begin - 2,
1666    #           "end" =>  $cleavage_loc_end + 1,
1667    #           "type" => 'bigbox',
1668    #           "color"=> $color,
1669    #           "zlayer" => '10',
1670    #           "description" => $descriptions};
1671    #
1672    #       push(@$line_data,$element_hash);
1673    #       $gd->add_line($line_data, $line_config);
1674    #    }
1675    
1676    
1677      return ($gd);      return ($gd);
1678    
# Line 1277  Line 1720 
1720    return $self->{cello_score};    return $self->{cello_score};
1721  }  }
1722    
1723    sub phobius_signal_location {
1724      my ($self) = @_;
1725      return $self->{phobius_signal_location};
1726    }
1727    
1728    sub phobius_tm_locations {
1729      my ($self) = @_;
1730      return $self->{phobius_tm_locations};
1731    }
1732    
1733    
1734    
1735  #########################################  #########################################
1736  #########################################  #########################################
# Line 1290  Line 1744 
1744      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1745      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1746      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1747        $self->{query} = $dataset->{'query'};
1748      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1749      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1750      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1305  Line 1760 
1760      return $self;      return $self;
1761  }  }
1762    
1763    =head3 display()
1764    
1765    If available use the function specified here to display a graphical observation.
1766    This code will display a graphical view of the similarities using the genome drawer object
1767    
1768    =cut
1769    
1770    sub display {
1771        my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1772    
1773        # declare variables
1774        my $window_size = $gd->window_size;
1775        my $peg = $thing->acc;
1776        my $query_id = $thing->query;
1777        my $organism = $thing->organism;
1778        my $abbrev_name = $fig->abbrev($organism);
1779        if (!$organism){
1780          $organism = $peg;
1781          $abbrev_name = $peg;
1782        }
1783        my $genome = $fig->genome_of($peg);
1784        my ($org_tax) = ($genome) =~ /(.*)\./;
1785        my $function = $thing->function;
1786        my $query_start = $thing->qstart;
1787        my $query_stop = $thing->qstop;
1788        my $hit_start = $thing->hstart;
1789        my $hit_stop = $thing->hstop;
1790        my $ln_query = $thing->qlength;
1791        my $ln_hit = $thing->hlength;
1792    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1793    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1794        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1795        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1796    
1797        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1798    
1799        # hit sequence title
1800        my $line_config = { 'title' => "$organism [$org_tax]",
1801                            'short_title' => "$abbrev_name",
1802                            'title_link' => '$tax_link',
1803                            'basepair_offset' => '0',
1804                            'no_middle_line' => '1'
1805                            };
1806    
1807        # query sequence title
1808        my $replace_id = $peg;
1809        $replace_id =~ s/\|/_/ig;
1810        my $anchor_name = "anchor_". $replace_id;
1811        my $query_config = { 'title' => "Query",
1812                             'short_title' => "Query",
1813                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1814                             'basepair_offset' => '0',
1815                             'no_middle_line' => '1'
1816                             };
1817        my $line_data = [];
1818        my $query_data = [];
1819    
1820        my $element_hash;
1821        my $hit_links_list = [];
1822        my $hit_descriptions = [];
1823        my $query_descriptions = [];
1824    
1825        # get sequence information
1826        # evidence link
1827        my $evidence_link;
1828        if ($peg =~ /^fig\|/){
1829          $evidence_link = "?page=Annotation&feature=".$peg;
1830        }
1831        else{
1832          my $db = &Observation::get_database($peg);
1833          my ($link_id) = ($peg) =~ /\|(.*)/;
1834          $evidence_link = &HTML::alias_url($link_id, $db);
1835          #print STDERR "LINK: $db    $evidence_link";
1836        }
1837        my $link = {"link_title" => $peg,
1838                    "link" => $evidence_link};
1839        push(@$hit_links_list,$link) if ($evidence_link);
1840    
1841        # subsystem link
1842        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1843        my @subsystems;
1844        foreach my $array (@$subs){
1845            my $subsystem = $$array[0];
1846            push(@subsystems,$subsystem);
1847            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1848                        "link_title" => $subsystem};
1849            push(@$hit_links_list,$link);
1850        }
1851    
1852        # blast alignment
1853        $link = {"link_title" => "view blast alignment",
1854                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1855        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1856    
1857        # description data
1858        my $description_function;
1859        $description_function = {"title" => "function",
1860                                 "value" => $function};
1861        push(@$hit_descriptions,$description_function);
1862    
1863        # subsystem description
1864        my $ss_string = join (",", @subsystems);
1865        $ss_string =~ s/_/ /ig;
1866        my $description_ss = {"title" => "subsystems",
1867                              "value" => $ss_string};
1868        push(@$hit_descriptions,$description_ss);
1869    
1870        # location description
1871        # hit
1872        my $description_loc;
1873        $description_loc = {"title" => "Hit Location",
1874                            "value" => $hit_start . " - " . $hit_stop};
1875        push(@$hit_descriptions, $description_loc);
1876    
1877        $description_loc = {"title" => "Sequence Length",
1878                            "value" => $ln_hit};
1879        push(@$hit_descriptions, $description_loc);
1880    
1881        # query
1882        $description_loc = {"title" => "Hit Location",
1883                            "value" => $query_start . " - " . $query_stop};
1884        push(@$query_descriptions, $description_loc);
1885    
1886        $description_loc = {"title" => "Sequence Length",
1887                            "value" => $ln_query};
1888        push(@$query_descriptions, $description_loc);
1889    
1890    
1891    
1892        # evalue score description
1893        my $evalue = $thing->evalue;
1894        while ($evalue =~ /-0/)
1895        {
1896            my ($chunk1, $chunk2) = split(/-/, $evalue);
1897            $chunk2 = substr($chunk2,1);
1898            $evalue = $chunk1 . "-" . $chunk2;
1899        }
1900    
1901        my $color = &color($evalue);
1902        my $description_eval = {"title" => "E-Value",
1903                                "value" => $evalue};
1904        push(@$hit_descriptions, $description_eval);
1905        push(@$query_descriptions, $description_eval);
1906    
1907        my $identity = $self->identity;
1908        my $description_identity = {"title" => "Identity",
1909                                    "value" => $identity};
1910        push(@$hit_descriptions, $description_identity);
1911        push(@$query_descriptions, $description_identity);
1912    
1913    
1914        my $number = $base_start + ($query_start-$hit_start);
1915        #print STDERR "START: $number";
1916        $element_hash = {
1917            "title" => $query_id,
1918            "start" => $base_start,
1919            "end" => $base_start+$ln_query,
1920            "type"=> 'box',
1921            "color"=> $color,
1922            "zlayer" => "2",
1923            "links_list" => $query_links_list,
1924            "description" => $query_descriptions
1925            };
1926        push(@$query_data,$element_hash);
1927    
1928        $element_hash = {
1929            "title" => $query_id . ': HIT AREA',
1930            "start" => $base_start + $query_start,
1931            "end" =>  $base_start + $query_stop,
1932            "type"=> 'smallbox',
1933            "color"=> $query_color,
1934            "zlayer" => "3",
1935            "links_list" => $query_links_list,
1936            "description" => $query_descriptions
1937            };
1938        push(@$query_data,$element_hash);
1939    
1940        $gd->add_line($query_data, $query_config);
1941    
1942    
1943        $element_hash = {
1944                    "title" => $peg,
1945                    "start" => $base_start + ($query_start-$hit_start),
1946                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1947                    "type"=> 'box',
1948                    "color"=> $color,
1949                    "zlayer" => "2",
1950                    "links_list" => $hit_links_list,
1951                    "description" => $hit_descriptions
1952                    };
1953        push(@$line_data,$element_hash);
1954    
1955        $element_hash = {
1956            "title" => $peg . ': HIT AREA',
1957            "start" => $base_start + $query_start,
1958            "end" =>  $base_start + $query_stop,
1959            "type"=> 'smallbox',
1960            "color"=> $hit_color,
1961            "zlayer" => "3",
1962            "links_list" => $hit_links_list,
1963            "description" => $hit_descriptions
1964            };
1965        push(@$line_data,$element_hash);
1966    
1967        $gd->add_line($line_data, $line_config);
1968    
1969        my $breaker = [];
1970        my $breaker_hash = {};
1971        my $breaker_config = { 'no_middle_line' => "1" };
1972    
1973        push (@$breaker, $breaker_hash);
1974        $gd->add_line($breaker, $breaker_config);
1975    
1976        return ($gd);
1977    }
1978    
1979    =head3 display_domain_composition()
1980    
1981    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
1982    
1983    =cut
1984    
1985    sub display_domain_composition {
1986        my ($self,$gd,$fig) = @_;
1987    
1988        #$fig = new FIG;
1989        my $peg = $self->acc;
1990    
1991        my $line_data = [];
1992        my $links_list = [];
1993        my $descriptions = [];
1994    
1995        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1996        #my @domain_query_results = ();
1997        foreach $dqr (@domain_query_results){
1998            my $key = @$dqr[1];
1999            my @parts = split("::",$key);
2000            my $db = $parts[0];
2001            my $id = $parts[1];
2002            my $val = @$dqr[2];
2003            my $from;
2004            my $to;
2005            my $evalue;
2006    
2007            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
2008                my $raw_evalue = $1;
2009                $from = $2;
2010                $to = $3;
2011                if($raw_evalue =~/(\d+)\.(\d+)/){
2012                    my $part2 = 1000 - $1;
2013                    my $part1 = $2/100;
2014                    $evalue = $part1."e-".$part2;
2015                }
2016                else{
2017                    $evalue = "0.0";
2018                }
2019            }
2020    
2021            my $dbmaster = DBMaster->new(-database =>'Ontology',
2022                                    -host     => $WebConfig::DBHOST,
2023                                    -user     => $WebConfig::DBUSER,
2024                                    -password => $WebConfig::DBPWD);
2025            my ($name_value,$description_value);
2026    
2027            if($db eq "CDD"){
2028                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
2029                if(!scalar(@$cdd_objs)){
2030                    $name_title = "name";
2031                    $name_value = "not available";
2032                    $description_title = "description";
2033                    $description_value = "not available";
2034                }
2035                else{
2036                    my $cdd_obj = $cdd_objs->[0];
2037                    $name_value = $cdd_obj->term;
2038                    $description_value = $cdd_obj->description;
2039                }
2040            }
2041    
2042            my $domain_name;
2043            $domain_name = {"title" => "name",
2044                            "value" => $name_value};
2045            push(@$descriptions,$domain_name);
2046    
2047            my $description;
2048            $description = {"title" => "description",
2049                            "value" => $description_value};
2050            push(@$descriptions,$description);
2051    
2052            my $score;
2053            $score = {"title" => "score",
2054                      "value" => $evalue};
2055            push(@$descriptions,$score);
2056    
2057            my $link_id = $id;
2058            my $link;
2059            my $link_url;
2060            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"}
2061            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2062            else{$link_url = "NO_URL"}
2063    
2064            $link = {"link_title" => $name_value,
2065                     "link" => $link_url};
2066            push(@$links_list,$link);
2067    
2068            my $domain_element_hash = {
2069                "title" => $peg,
2070                "start" => $from,
2071                "end" =>  $to,
2072                "type"=> 'box',
2073                "zlayer" => '4',
2074                "links_list" => $links_list,
2075                "description" => $descriptions
2076                };
2077    
2078            push(@$line_data,$domain_element_hash);
2079    
2080            #just one CDD domain for now, later will add option for multiple domains from selected DB
2081            last;
2082        }
2083    
2084        my $line_config = { 'title' => $peg,
2085                            'hover_title' => 'Domain',
2086                            'short_title' => $peg,
2087                            'basepair_offset' => '1' };
2088    
2089        $gd->add_line($line_data, $line_config);
2090    
2091        return ($gd);
2092    
2093    }
2094    
2095  =head3 display_table()  =head3 display_table()
2096    
2097  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
2098  This code will display a table for the similarities protein  This code will display a table for the similarities protein
2099    
2100  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.  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.
2101    
2102    =cut
2103    
2104    sub display_table {
2105        my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2106        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2107    
2108        my $scroll_list;
2109        foreach my $col (@$show_columns){
2110            push (@$scroll_list, $col->{key});
2111        }
2112    
2113        push (@ids, $query_fid);
2114        foreach my $thing (@$dataset) {
2115            next if ($thing->class ne "SIM");
2116            push (@ids, $thing->acc);
2117        }
2118    
2119        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2120        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2121    
2122        # get the column for the subsystems
2123        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2124    
2125        # get the column for the evidence codes
2126        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2127    
2128        # get the column for pfam_domain
2129        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2130    
2131        # get the column for molecular weight
2132        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2133    
2134        # get the column for organism's habitat
2135        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2136    
2137        # get the column for organism's temperature optimum
2138        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2139    
2140        # get the column for organism's temperature range
2141        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2142    
2143        # get the column for organism's oxygen requirement
2144        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2145    
2146        # get the column for organism's pathogenicity
2147        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2148    
2149        # get the column for organism's pathogenicity host
2150        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2151    
2152        # get the column for organism's salinity
2153        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2154    
2155        # get the column for organism's motility
2156        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2157    
2158        # get the column for organism's gram stain
2159        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2160    
2161        # get the column for organism's endospores
2162        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2163    
2164        # get the column for organism's shape
2165        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2166    
2167        # get the column for organism's disease
2168        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2169    
2170        # get the column for organism's disease
2171        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2172    
2173        # get the column for transmembrane domains
2174        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2175    
2176        # get the column for similar to human
2177        my $similar_to_human_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2178    
2179        # get the column for signal peptide
2180        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2181    
2182        # get the column for transmembrane domains
2183        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2184    
2185        # get the column for conserved neighborhood
2186        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2187    
2188        # get the column for cellular location
2189        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2190    
2191        # get the aliases
2192        my $alias_col;
2193        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2194             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2195             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2196             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2197             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2198            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2199        }
2200    
2201        # get the colors for the function cell
2202        my $functions = $fig->function_of_bulk(\@ids,1);
2203        $functional_color = &get_function_color_cell($functions, $fig);
2204        my $query_function = $fig->function_of($query_fid);
2205    
2206        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2207    
2208        my $figfam_data = &FIG::get_figfams_data();
2209        my $figfams = new FFs($figfam_data);
2210        my $same_genome_flag = 0;
2211    
2212        my $func_color_offset=0;
2213        unshift(@$dataset, $query_fid);
2214        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2215    #    foreach my $thing ( @$dataset){
2216            my $thing = $dataset->[$thing_count];
2217            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2218            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2219            if ($thing eq $query_fid){
2220                $id = $thing;
2221                $taxid   = $fig->genome_of($id);
2222                $organism = $fig->genus_species($taxid);
2223                $current_function = $fig->function_of($id);
2224            }
2225            else{
2226                next if ($thing->class ne "SIM");
2227    
2228                $id      = $thing->acc;
2229                $evalue  = $thing->evalue;
2230                $taxid   = $fig->genome_of($id);
2231                $iden    = $thing->identity;
2232                $organism= $thing->organism;
2233                $ln1     = $thing->qlength;
2234                $ln2     = $thing->hlength;
2235                $b1      = $thing->qstart;
2236                $e1      = $thing->qstop;
2237                $b2      = $thing->hstart;
2238                $e2      = $thing->hstop;
2239                $d1      = abs($e1 - $b1) + 1;
2240                $d2      = abs($e2 - $b2) + 1;
2241                $color1  = match_color( $b1, $e1, $ln1 );
2242                $color2  = match_color( $b2, $e2, $ln2 );
2243                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2244                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2245                $current_function = $thing->function;
2246                $next_org = $next_thing->organism if (defined $next_thing);
2247            }
2248    
2249            my $single_domain = [];
2250            $count++;
2251    
2252            # organisms cell
2253            my ($org, $org_color) = $fig->org_and_color_of($id);
2254    
2255            my $org_cell;
2256            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2257                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2258            }
2259            elsif ($next_org eq $organism){
2260                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2261                $same_genome_flag = 1;
2262            }
2263            elsif ($same_genome_flag == 1){
2264                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2265                $same_genome_flag = 0;
2266            }
2267    
2268            # checkbox cell
2269            my ($box_cell,$tax, $radio_cell);
2270            my $field_name = "tables_" . $id;
2271            my $pair_name = "visual_" . $id;
2272            my $cell_name = "cell_". $id;
2273            my $replace_id = $id;
2274            $replace_id =~ s/\|/_/ig;
2275            my $white = '#ffffff';
2276            $white = '#999966' if ($id eq $query_fid);
2277            $org_color = '#999966' if ($id eq $query_fid);
2278            my $anchor_name = "anchor_". $replace_id;
2279            my $checked = "";
2280            #$checked = "checked" if ($id eq $query_fid);
2281            if ($id =~ /^fig\|/){
2282              my $box = qq~<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>~;
2283              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2284              $tax = $fig->genome_of($id);
2285            }
2286            else{
2287              my $box = qq(<a name="$anchor_name"></a>);
2288              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2289            }
2290    
2291            # create the radio cell for any sequence, not just fig ids
2292            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2293            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2294    
2295            # get the linked fig id
2296            my $anchor_link = "graph_" . $replace_id;
2297    
2298            my $fig_data;
2299            if ($id =~ /^fig\|/)
2300            {
2301                $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2302            }
2303            else
2304            {
2305                my $url_link = &HTML::set_prot_links($cgi,$id);
2306                $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2307            }
2308            $fig_data .= qq(<td><img height='10px' width='20px' src='$FIG_Config::cgi_url/Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2309            my $fig_col = {'data'=> $fig_data,
2310                           'highlight'=>$white};
2311    
2312            $replace_id = $peg;
2313            $replace_id =~ s/\|/_/ig;
2314            $anchor_name = "anchor_". $replace_id;
2315            my $query_config = { 'title' => "Query",
2316                                 'short_title' => "Query",
2317                                 'title_link' => "changeSimsLocation('$replace_id')",
2318                                 'basepair_offset' => '0'
2319                                 };
2320    
2321            # function cell
2322            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2323                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2324                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2325    
2326            my $function_color;
2327            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2328                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2329            }
2330            else{
2331                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2332            }
2333            my $function_cell;
2334            if ($current_function){
2335              if ($current_function eq $query_function){
2336                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2337                $func_color_offset=1;
2338              }
2339              else{
2340                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2341              }
2342            }
2343            else{
2344              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2345            }
2346    
2347            if ($id eq $query_fid){
2348                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2349                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2350                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2351                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2352                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2353            }
2354            else{
2355                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2356                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2357                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2358                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2359    
2360            }
2361    
2362            if ( ( $application->session->user) ){
2363                my $user = $application->session->user;
2364                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2365                    push (@$single_domain,$radio_cell);
2366                }
2367            }
2368    
2369            my ($ff) = $figfams->families_containing_peg($id);
2370    
2371            foreach my $col (@$scroll_list){
2372                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2373                else { $highlight_color = "#ffffff"; }
2374    
2375                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2393                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2394                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2395                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2396                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2397                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2398                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2399                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2400                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2401                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2402                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2403                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2404                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2405                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2406                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2407            }
2408            push(@$data,$single_domain);
2409        }
2410        if ($count >0 ){
2411            $content = $data;
2412        }
2413        else{
2414            $content = "<p>This PEG does not have any similarities</p>";
2415        }
2416        shift(@$dataset);
2417        return ($content);
2418    }
2419    
2420    
2421    =head3 display_figfam_table()
2422    
2423    If available use the function specified here to display the "raw" observation.
2424    This code will display a table for the similarities protein
2425    
2426    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.
2427    
2428    =cut
2429    
2430    sub display_figfam_table {
2431      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2432      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2433    
2434      my $scroll_list;
2435      foreach my $col (@$show_columns){
2436        push (@$scroll_list, $col->{key});
2437      }
2438    
2439      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2440      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2441    
2442      # get the column for the subsystems
2443      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2444    
2445      # get the column for the evidence codes
2446      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2447    
2448      # get the column for pfam_domain
2449      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2450    
2451      # get the column for molecular weight
2452      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2453    
2454      # get the column for organism's habitat
2455      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2456    
2457      # get the column for organism's temperature optimum
2458      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2459    
2460      # get the column for organism's temperature range
2461      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2462    
2463      # get the column for organism's oxygen requirement
2464      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2465    
2466      # get the column for organism's pathogenicity
2467      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2468    
2469      # get the column for organism's pathogenicity host
2470      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2471    
2472      # get the column for organism's salinity
2473      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2474    
2475      # get the column for organism's motility
2476      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2477    
2478      # get the column for organism's gram stain
2479      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2480    
2481      # get the column for organism's endospores
2482      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2483    
2484      # get the column for organism's shape
2485      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2486    
2487      # get the column for organism's disease
2488      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2489    
2490      # get the column for organism's disease
2491      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2492    
2493      # get the column for transmembrane domains
2494      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2495    
2496      # get the column for similar to human
2497      my $similar_to_human_column = &get_attrb_column($ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2498    
2499      # get the column for signal peptide
2500      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2501    
2502      # get the column for transmembrane domains
2503      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2504    
2505      # get the column for conserved neighborhood
2506      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2507    
2508      # get the column for cellular location
2509      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2510    
2511      # get the aliases
2512      my $alias_col;
2513      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2514           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2515           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2516           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2517           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2518        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2519      }
2520    
2521      foreach my $id ( @$ids){
2522        my $current_function = $fig->function_of($id);
2523        my $organism = $fig->org_of($id);
2524        my $single_domain = [];
2525    
2526        # organisms cell comehere2
2527        my ($org, $org_color) = $fig->org_and_color_of($id);
2528        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2529    
2530        # get the linked fig id
2531        my $fig_data;
2532        if ($id =~ /^fig\|/)
2533        {
2534            $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2535        }
2536        else
2537        {
2538            my $url_link = &HTML::set_prot_links($cgi,$id);
2539            $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2540        }
2541    
2542        my $fig_col = {'data'=> $fig_data,
2543                       'highlight'=>"#ffffff"};
2544    
2545        # function cell
2546        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2547    
2548        # insert data
2549        push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2550    
2551        foreach my $col (@$scroll_list){
2552          my $highlight_color = "#ffffff";
2553    
2554          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2555          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2556          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2557          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2558          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2559          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2560          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2561          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2562          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2563          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2564          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2565          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2566          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2567          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2568          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2569          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2570          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2571          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2572          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2573          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2574          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2575          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2576          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2577          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2578          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2579          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2580          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2581          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2582          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2583          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2584          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2585          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2586          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2587        }
2588        push(@$data,$single_domain);
2589      }
2590    
2591      $content = $data;
2592      return ($content);
2593    }
2594    
2595    sub get_box_column{
2596        my ($ids) = @_;
2597        my %column;
2598        foreach my $id (@$ids){
2599            my $field_name = "tables_" . $id;
2600            my $pair_name = "visual_" . $id;
2601            my $cell_name = "cell_" . $id;
2602            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2603        }
2604        return (%column);
2605    }
2606    
2607    sub get_figfam_column{
2608        my ($ids, $fig, $cgi) = @_;
2609        my $column;
2610    
2611        my $figfam_data = &FIG::get_figfams_data();
2612        my $figfams = new FFs($figfam_data);
2613    
2614        foreach my $id (@$ids){
2615            my ($ff);
2616            if ($id =~ /\.peg\./){
2617                ($ff) =  $figfams->families_containing_peg($id);
2618            }
2619            if ($ff){
2620                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2621            }
2622            else{
2623                push (@$column, " ");
2624            }
2625        }
2626    
2627        return $column;
2628    }
2629    
2630    sub get_subsystems_column{
2631        my ($ids,$fig,$cgi,$returnType) = @_;
2632    
2633        my %in_subs  = $fig->subsystems_for_pegs($ids);
2634        my ($column, $ss);
2635        foreach my $id (@$ids){
2636            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2637            my @subsystems;
2638    
2639            if (@in_sub > 0) {
2640                foreach my $array(@in_sub){
2641                    my $ss = $array->[0];
2642                    $ss =~ s/_/ /ig;
2643                    push (@subsystems, "-" . $ss);
2644                }
2645                my $in_sub_line = join ("<br>", @subsystems);
2646                $ss->{$id} = $in_sub_line;
2647            } else {
2648                $ss->{$id} = "None added";
2649            }
2650            push (@$column, $ss->{$id});
2651        }
2652    
2653        if ($returnType eq 'hash') { return $ss; }
2654        elsif ($returnType eq 'array') { return $column; }
2655    }
2656    
2657    sub get_lineage_column{
2658        my ($ids, $fig, $cgi) = @_;
2659    
2660        my $lineages = $fig->taxonomy_list();
2661    
2662        foreach my $id (@$ids){
2663            my $genome = $fig->genome_of($id);
2664            if ($lineages->{$genome}){
2665    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2666                push (@$column, $lineages->{$genome});
2667            }
2668            else{
2669                push (@$column, " ");
2670            }
2671        }
2672        return $column;
2673    }
2674    
2675    sub match_color {
2676        my ( $b, $e, $n , $rgb) = @_;
2677        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2678        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2679        my $cov = ( $r - $l + 1 ) / $n;
2680        my $sat = 1 - 10 * $cov / 9;
2681        my $br  = 1;
2682        if ($rgb){
2683            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2684        }
2685        else{
2686            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2687        }
2688    }
2689    
2690    sub hsb2rgb {
2691        my ( $h, $s, $br ) = @_;
2692        $h = 6 * ($h - floor($h));
2693        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2694        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2695        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2696                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2697                                          :               ( 0,      1,      $h - 2 )
2698                                          )
2699                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2700                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2701                                          :               ( 1,      0,      6 - $h )
2702                                          );
2703        ( ( $r * $s + 1 - $s ) * $br,
2704          ( $g * $s + 1 - $s ) * $br,
2705          ( $b * $s + 1 - $s ) * $br
2706        )
2707    }
2708    
2709    sub html2rgb {
2710        my ($hex) = @_;
2711        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2712        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2713                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2714    
2715        my @R = split(//, $r);
2716        my @G = split(//, $g);
2717        my @B = split(//, $b);
2718    
2719        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2720        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2721        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2722    
2723        my $rgb = [$red, $green, $blue];
2724        return $rgb;
2725    
2726    }
2727    
2728    sub rgb2html {
2729        my ( $r, $g, $b ) = @_;
2730        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2731        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2732        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2733        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2734    }
2735    
2736    sub floor {
2737        my $x = $_[0];
2738        defined( $x ) || return undef;
2739        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2740    }
2741    
2742    sub get_function_color_cell{
2743      my ($functions, $fig) = @_;
2744    
2745      # figure out the quantity of each function
2746      my %hash;
2747      foreach my $key (keys %$functions){
2748        my $func = $functions->{$key};
2749        $hash{$func}++;
2750      }
2751    
2752      my %func_colors;
2753      my $count = 1;
2754      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2755        $func_colors{$key}=$count;
2756        $count++;
2757      }
2758    
2759      return \%func_colors;
2760    }
2761    
2762    sub get_essentially_identical{
2763        my ($fid,$dataset,$fig) = @_;
2764        #my $fig = new FIG;
2765    
2766        my %id_list;
2767        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2768    
2769        foreach my $thing (@$dataset){
2770            if($thing->class eq "IDENTICAL"){
2771                my $rows = $thing->rows;
2772                my $count_identical = 0;
2773                foreach my $row (@$rows) {
2774                    my $id = $row->[0];
2775                    if (($id ne $fid) && ($fig->function_of($id))) {
2776                        $id_list{$id} = 1;
2777                    }
2778                }
2779            }
2780        }
2781    
2782    #    foreach my $id (@maps_to) {
2783    #        if (($id ne $fid) && ($fig->function_of($id))) {
2784    #           $id_list{$id} = 1;
2785    #        }
2786    #    }
2787        return(%id_list);
2788    }
2789    
2790    
2791    sub get_evidence_column{
2792        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2793        my ($column, $code_attributes);
2794    
2795        if (! defined $attributes) {
2796            my @attributes_array = $fig->get_attributes($ids);
2797            $attributes = \@attributes_array;
2798        }
2799    
2800        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2801        foreach my $key (@codes){
2802            push (@{$code_attributes->{$key->[0]}}, $key);
2803        }
2804    
2805        foreach my $id (@$ids){
2806            # add evidence code with tool tip
2807            my $ev_codes=" &nbsp; ";
2808    
2809            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2810            my @ev_codes = ();
2811            foreach my $code (@codes) {
2812                my $pretty_code = $code->[2];
2813                if ($pretty_code =~ /;/) {
2814                    my ($cd, $ss) = split(";", $code->[2]);
2815                    if ($cd =~ /ilit|dlit/){
2816                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2817                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2818                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2819                    }
2820                    $ss =~ s/_/ /g;
2821                    $pretty_code = $cd;# . " in " . $ss;
2822                }
2823                push(@ev_codes, $pretty_code);
2824            }
2825    
2826            if (scalar(@ev_codes) && $ev_codes[0]) {
2827                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2828                $ev_codes = $cgi->a(
2829                                    {
2830                                        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));
2831            }
2832    
2833            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2834            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2835        }
2836        return $column;
2837    }
2838    
2839    sub get_attrb_column{
2840        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2841    
2842        my ($column, %code_attributes, %attribute_locations);
2843        my $dbmaster = DBMaster->new(-database =>'Ontology',
2844                                     -host     => $WebConfig::DBHOST,
2845                                     -user     => $WebConfig::DBUSER,
2846                                     -password => $WebConfig::DBPWD);
2847    
2848        if ($colName eq "pfam"){
2849            if (! defined $attributes) {
2850                my @attributes_array = $fig->get_attributes($ids);
2851                $attributes = \@attributes_array;
2852            }
2853    
2854            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2855            foreach my $key (@codes){
2856                my $name = $key->[1];
2857                if ($name =~ /_/){
2858                    ($name) = ($key->[1]) =~ /(.*?)_/;
2859                }
2860                push (@{$code_attributes{$key->[0]}}, $name);
2861                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2862            }
2863    
2864            foreach my $id (@$ids){
2865                # add pfam code
2866                my $pfam_codes=" &nbsp; ";
2867                my @pfam_codes = "";
2868                my %description_codes;
2869    
2870  =cut              if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2871                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2872                    @pfam_codes = ();
2873    
2874  sub display_table {                  # get only unique values
2875      my ($self,$dataset) = @_;                  my %saw;
2876                    foreach my $key (@ncodes) {$saw{$key}=1;}
2877                    @ncodes = keys %saw;
2878    
2879                    foreach my $code (@ncodes) {
2880                        my @parts = split("::",$code);
2881                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2882    
2883    #                   # get the locations for the domain
2884    #                   my @locs;
2885    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2886    #                       my ($loc) = ($part) =~ /\;(.*)/;
2887    #                       push (@locs,$loc);
2888    #                   }
2889    #                   my %locsaw;
2890    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2891    #                   @locs = keys %locsaw;
2892    #
2893    #                   my $locations = join (", ", @locs);
2894    #
2895                        if (defined ($description_codes{$parts[1]})){
2896                            push(@pfam_codes, "$parts[1]");
2897                        }
2898                        else {
2899                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2900                            $description_codes{$parts[1]} = $description->[0]->{term};
2901                            push(@pfam_codes, "$pfam_link");
2902                        }
2903                    }
2904    
2905      my $data = [];                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2906                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2907                }
2908            }
2909        }
2910        elsif ($colName eq 'cellular_location'){
2911            if (! defined $attributes) {
2912                my @attributes_array = $fig->get_attributes($ids);
2913                $attributes = \@attributes_array;
2914            }
2915    
2916            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2917            foreach my $key (@codes){
2918                my ($loc) = ($key->[1]) =~ /::(.*)/;
2919                my ($new_loc, @all);
2920                @all = split (//, $loc);
2921      my $count = 0;      my $count = 0;
2922      my $content;              foreach my $i (@all){
2923      my $fig = new FIG;                  if ( ($i eq uc($i)) && ($count > 0) ){
2924      my $cgi = new CGI;                      $new_loc .= " " . $i;
2925      foreach my $thing (@$dataset) {                  }
2926          my $single_domain = [];                  else{
2927          next if ($thing->class ne "SIM");                      $new_loc .= $i;
2928                    }
2929          $count++;          $count++;
2930                }
2931                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2932            }
2933    
2934            foreach my $id (@$ids){
2935                my (@values, $entry);
2936                #@values = (" ");
2937                if (defined @{$code_attributes{$id}}){
2938                    my @ncodes = @{$code_attributes{$id}};
2939                    foreach my $code (@ncodes){
2940                        push (@values, $code->[0] . ", " . $code->[1]);
2941                    }
2942                }
2943                else{
2944                    @values = ("Not available");
2945                }
2946    
2947          my $id = $thing->acc;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2948                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2949            }
2950        }
2951        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2952                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2953            if (! defined $attributes) {
2954                my @attributes_array = $fig->get_attributes($ids);
2955                $attributes = \@attributes_array;
2956            }
2957    
2958          # add the subsystem information          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2959          my @in_sub  = $fig->peg_to_subsystems($id);          foreach my $key (@codes){
2960          my $in_sub;              push (@{$code_attributes{$key->[0]}}, $key->[2]);
2961            }
2962    
2963          if (@in_sub > 0) {          foreach my $id (@$ids){
2964              $in_sub = @in_sub;              my (@values, $entry);
2965                #@values = (" ");
2966                if (defined @{$code_attributes{$id}}){
2967                    my @ncodes = @{$code_attributes{$id}};
2968                    foreach my $code (@ncodes){
2969                        push (@values, $code);
2970                    }
2971                }
2972                else{
2973                    @values = ("Not available");
2974                }
2975    
2976              # RAE: add a javascript popup with all the subsystems              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2977              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2978              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);          }
2979          } else {      }
2980              $in_sub = "&nbsp;";      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2981                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2982                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2983                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2984                ($colName eq 'gc_content') ) {
2985            if (! defined $attributes) {
2986                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2987                $attributes = \@attributes_array;
2988          }          }
2989    
2990          # add evidence code with tool tip          my $genomes_with_phenotype;
2991          my $ev_codes=" &nbsp; ";          foreach my $attribute (@$attributes){
2992          my @ev_codes = "";              my $genome = $attribute->[0];
2993          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {              $genomes_with_phenotype->{$genome} = $attribute->[2];
             my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
             @ev_codes = ();  
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
2994                  }                  }
2995                  push(@ev_codes, $pretty_code);  
2996            foreach my $id (@$ids){
2997                my $genome = $fig->genome_of($id);
2998                my @values = (' ');
2999                if (defined $genomes_with_phenotype->{$genome}){
3000                    push (@values, $genomes_with_phenotype->{$genome});
3001                }
3002                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
3003                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
3004              }              }
3005          }          }
3006    
3007          if (scalar(@ev_codes) && $ev_codes[0]) {      return $column;
             my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);  
             $ev_codes = $cgi->a(  
                                 {  
                                     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));  
3008          }          }
3009    
3010          # add the aliases  sub get_aclh_aliases {
3011          my $aliases = undef;      my ($ids,$fig,$db,$cgi,$returnType) = @_;
3012          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      my $db_array;
3013          $aliases = &HTML::set_prot_links( $cgi, $aliases );  
3014          $aliases ||= "&nbsp;";      my $id_line = join (",", @$ids);
3015        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
         my $iden    = $thing->identity;  
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
3016    
3017    
         push(@$single_domain,$thing->database);  
         push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));  
         push(@$single_domain,$thing->evalue);  
         push(@$single_domain,"$iden\%");  
         push(@$single_domain,$reg1);  
         push(@$single_domain,$reg2);  
         push(@$single_domain,$in_sub);  
         push(@$single_domain,$ev_codes);  
         push(@$single_domain,$thing->organism);  
         push(@$single_domain,$thing->function);  
         push(@$single_domain,$aliases);  
         push(@$data,$single_domain);  
3018      }      }
3019    
3020      if ($count >0){  sub get_id_aliases {
3021          $content = $data;      my ($id, $fig) = @_;
3022        my $aliases = {};
3023    
3024        my $org = $fig->org_of($id);
3025        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3026        if ( my $form = &LWP::Simple::get($url) ) {
3027            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3028            foreach my $line (split /\n/, $block){
3029                my @values = split /\t/, $line;
3030                next if ($values[3] eq "Expert");
3031                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3032                    $aliases->{$values[4]} = $values[0];
3033      }      }
     else  
     {  
         $content = "<p>This PEG does not have any similarities</p>";  
3034      }      }
     return ($content);  
3035  }  }
3036    
3037        return $aliases;
3038    }
3039    
3040    sub get_db_aliases {
3041        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3042        my $db_array;
3043        my $all_aliases = $fig->feature_aliases_bulk($ids);
3044        foreach my $id (@$ids){
3045    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3046            my $id_org = $fig->org_of($id);
3047    
3048            foreach my $alias (@{$$all_aliases{$id}}){
3049    #       foreach my $alias (@all_aliases){
3050                my $id_db = &Observation::get_database($alias);
3051                next if ( ($id_db ne $db) && ($db ne 'all') );
3052                next if ($aliases->{$id}->{$db});
3053                my $alias_org = $fig->org_of($alias);
3054    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3055                    #push(@funcs, [$id,$id_db,$tmp]);
3056                    $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3057    #           }
3058            }
3059            if (!defined( $aliases->{$id}->{$db})){
3060                $aliases->{$id}->{$db} = " ";
3061            }
3062            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3063            push (@$db_array, $aliases->{$id}->{$db});
3064        }
3065    
3066        if ($returnType eq 'hash') { return $aliases; }
3067        elsif ($returnType eq 'array') { return $db_array; }
3068    }
3069    
3070    
3071    
3072  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
3073    
3074    sub color {
3075        my ($evalue) = @_;
3076        my $palette = WebColors::get_palette('vitamins');
3077        my $color;
3078        if ($evalue <= 1e-170){        $color = $palette->[0];    }
3079        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3080        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3081        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3082        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3083        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3084        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3085        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3086        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3087        else{        $color = $palette->[9];    }
3088        return ($color);
3089    }
3090    
3091    
3092  ############################  ############################
# Line 1429  Line 3104 
3104  }  }
3105    
3106  sub display {  sub display {
3107      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3108    
3109        $taxes = $fig->taxonomy_list();
3110    
3111      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3112      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3113      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
3114      my $fig = new FIG;      my $range = $gd_window_size;
3115      my $all_regions = [];      my $all_regions = [];
3116        my $gene_associations={};
3117    
3118      #get the organism genome      #get the organism genome
3119      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
3120        $gene_associations->{$fid}->{"organism"} = $target_genome;
3121        $gene_associations->{$fid}->{"main_gene"} = $fid;
3122        $gene_associations->{$fid}->{"reverse_flag"} = 0;
3123    
3124      # get location of the gene      # get location of the gene
3125      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 3136 
3136      my ($region_start, $region_end);      my ($region_start, $region_end);
3137      if ($beg < $end)      if ($beg < $end)
3138      {      {
3139          $region_start = $beg - 4000;          $region_start = $beg - ($range);
3140          $region_end = $end+4000;          $region_end = $end+ ($range);
3141          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3142      }      }
3143      else      else
3144      {      {
3145          $region_start = $end-4000;          $region_start = $end-($range);
3146          $region_end = $beg+4000;          $region_end = $beg+($range);
3147          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3148          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
3149            $gene_associations->{$fid}->{"reverse_flag"} = 1;
3150      }      }
3151    
3152      # call genes in region      # call genes in region
3153      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
3154        #foreach my $feat (@$target_gene_features){
3155        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3156        #}
3157      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
3158      my (@start_array_region);      my (@start_array_region);
3159      push (@start_array_region, $offset);      push (@start_array_region, $offset);
3160    
3161      my %all_genes;      my %all_genes;
3162      my %all_genomes;      my %all_genomes;
3163      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
3164            #if ($feature =~ /peg/){
3165      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3166      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = 1;  
3167                  }                  }
3168    
3169                  push (@start_array_region, $offset);      my @selected_sims;
3170    
3171                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
3172                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
3173                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
3174                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
3175              }          # get the similarities and store only the ones that match the lineages selected
3176              $coup_count++;          if (@selected_taxonomy > 0){
3177                foreach my $sim (@$sims_array){
3178                    next if ($sim->class ne "SIM");
3179                    next if ($sim->acc !~ /fig\|/);
3180    
3181                    #my $genome = $fig->genome_of($sim->[1]);
3182                    my $genome = $fig->genome_of($sim->acc);
3183                    #my ($genome1) = ($genome) =~ /(.*)\./;
3184                    my $lineage = $taxes->{$genome};
3185                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3186                    foreach my $taxon(@selected_taxonomy){
3187                        if ($lineage =~ /$taxon/){
3188                            #push (@selected_sims, $sim->[1]);
3189                            push (@selected_sims, $sim->acc);
3190          }          }
3191      }      }
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
3192                      }                      }
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = 1;  
3193                      }                      }
3194            else{
3195                my $simcount = 0;
3196                foreach my $sim (@$sims_array){
3197                    next if ($sim->class ne "SIM");
3198                    next if ($sim->acc !~ /fig\|/);
3199    
3200                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
3201                      $all_genomes{$pair_genome} = 1;                  $simcount++;
3202                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  last if ($simcount > 4);
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
                 }  
3203              }              }
3204          }          }
3205    
3206            my %saw;
3207            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3208    
3209            # get the gene context for the sorted matches
3210            foreach my $sim_fid(@selected_sims){
3211                #get the organism genome
3212                my $sim_genome = $fig->genome_of($sim_fid);
3213                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
3214                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
3215                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
3216    
3217                # get location of the gene
3218                my $data = $fig->feature_location($sim_fid);
3219                my ($contig, $beg, $end);
3220    
3221                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3222                    $contig = $1;
3223                    $beg = $2;
3224                    $end = $3;
3225      }      }
3226    
3227      # get the PCH to each of the genes              my $offset;
3228      my $pch_sets = [];              my ($region_start, $region_end);
3229      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){next;};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
3230          {          {
3231              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
3232                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
3233                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
3234          }          }
3235          else          else
3236          {          {
3237              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
3238                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
3239              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3240                    $reverse_flag{$sim_genome} = $sim_fid;
3241                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3242          }          }
3243    
3244                # call genes in region
3245                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3246                push(@$all_regions,$sim_gene_features);
3247                push (@start_array_region, $offset);
3248                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3249                $all_genomes{$sim_genome} = 1;
3250      }      }
3251    
3252        }
3253    
3254  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3255  #    my %already;      # cluster the genes
3256  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
3257  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3258  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3259  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = 100;  
 #           }  
 #       }  
 #    }  
3260    
3261      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3262          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3263          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3264          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3265          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3266            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3267            my $lineage = $taxes->{$region_genome};
3268            #my $lineage = $fig->taxonomy_of($region_genome);
3269            #$region_gs .= "Lineage:$lineage";
3270          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3271                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3272                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 3274 
3274    
3275          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3276    
3277            my $second_line_config = { 'title' => "$lineage",
3278                                       'short_title' => "",
3279                                       'basepair_offset' => '0',
3280                                       'no_middle_line' => '1'
3281                                       };
3282    
3283          my $line_data = [];          my $line_data = [];
3284            my $second_line_data = [];
3285    
3286            # initialize variables to check for overlap in genes
3287            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3288            my $major_line_flag = 0;
3289            my $prev_second_flag = 0;
3290    
3291          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
3292                $second_line_flag = 0;
3293              my $element_hash;              my $element_hash;
3294              my $links_list = [];              my $links_list = [];
3295              my $descriptions = [];              my $descriptions = [];
3296    
3297              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3298    
3299              # get subsystem information              # get subsystem information
3300              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3301              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3302    
3303              my $link;              my $link;
3304              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3305                       "link" => $url_link};                       "link" => $url_link};
3306              push(@$links_list,$link);              push(@$links_list,$link);
3307    
3308              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3309              foreach my $subsystem (@subsystems){              my @subsystems;
3310                foreach my $array (@subs){
3311                    my $subsystem = $$array[0];
3312                    my $ss = $subsystem;
3313                    $ss =~ s/_/ /ig;
3314                    push (@subsystems, $ss);
3315                  my $link;                  my $link;
3316                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3317                           "link_title" => $subsystem};                           "link_title" => $ss};
3318                    push(@$links_list,$link);
3319                }
3320    
3321                if ($fid1 eq $fid){
3322                    my $link;
3323                    $link = {"link_title" => "Annotate this sequence",
3324                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3325                  push(@$links_list,$link);                  push(@$links_list,$link);
3326              }              }
3327    
# Line 1738  Line 3343 
3343                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
3344                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
3345    
3346                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
3347                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3348                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3349                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3350                            $second_line_flag = 1;
3351                            $major_line_flag = 1;
3352                        }
3353                    }
3354                    $prev_start = $start;
3355                    $prev_stop = $stop;
3356                    $prev_fig = $fid1;
3357    
3358                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3359                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3360                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3361                  }                  }
3362    
3363                    my $title = $fid1;
3364                    if ($fid1 eq $fid){
3365                        $title = "My query gene: $fid1";
3366                    }
3367    
3368                  $element_hash = {                  $element_hash = {
3369                      "title" => $fid1,                      "title" => $title,
3370                      "start" => $start,                      "start" => $start,
3371                      "end" =>  $stop,                      "end" =>  $stop,
3372                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 3375 
3375                      "links_list" => $links_list,                      "links_list" => $links_list,
3376                      "description" => $descriptions                      "description" => $descriptions
3377                  };                  };
3378                  push(@$line_data,$element_hash);  
3379                    # if there is an overlap, put into second line
3380                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3381                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3382    
3383                    if ($fid1 eq $fid){
3384                        $element_hash = {
3385                            "title" => 'Query',
3386                            "start" => $start,
3387                            "end" =>  $stop,
3388                            "type"=> 'bigbox',
3389                            "color"=> $color,
3390                            "zlayer" => "1"
3391                            };
3392    
3393                        # if there is an overlap, put into second line
3394                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3395                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3396                    }
3397              }              }
3398          }          }
3399          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3400            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3401      }      }
3402      return $gd;      return ($gd, \@selected_sims);
3403    }
3404    
3405    sub cluster_genes {
3406        my($fig,$all_pegs,$peg) = @_;
3407        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3408    
3409        my @color_sets = ();
3410    
3411        $conn = &get_connections_by_similarity($fig,$all_pegs);
3412    
3413        for ($i=0; ($i < @$all_pegs); $i++) {
3414            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3415            if (! $seen{$i}) {
3416                $cluster = [$i];
3417                $seen{$i} = 1;
3418                for ($j=0; ($j < @$cluster); $j++) {
3419                    $x = $conn->{$cluster->[$j]};
3420                    foreach $k (@$x) {
3421                        if (! $seen{$k}) {
3422                            push(@$cluster,$k);
3423                            $seen{$k} = 1;
3424                        }
3425                    }
3426                }
3427    
3428                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3429                    push(@color_sets,$cluster);
3430                }
3431            }
3432        }
3433        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3434        $red_set = $color_sets[$i];
3435        splice(@color_sets,$i,1);
3436        @color_sets = sort { @$b <=> @$a } @color_sets;
3437        unshift(@color_sets,$red_set);
3438    
3439        my $color_sets = {};
3440        for ($i=0; ($i < @color_sets); $i++) {
3441            foreach $x (@{$color_sets[$i]}) {
3442                $color_sets->{$all_pegs->[$x]} = $i;
3443            }
3444        }
3445        return $color_sets;
3446    }
3447    
3448    sub get_connections_by_similarity {
3449        my($fig,$all_pegs) = @_;
3450        my($i,$j,$tmp,$peg,%pos_of);
3451        my($sim,%conn,$x,$y);
3452    
3453        for ($i=0; ($i < @$all_pegs); $i++) {
3454            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3455            push(@{$pos_of{$tmp}},$i);
3456            if ($tmp ne $all_pegs->[$i]) {
3457                push(@{$pos_of{$all_pegs->[$i]}},$i);
3458            }
3459        }
3460    
3461        foreach $y (keys(%pos_of)) {
3462            $x = $pos_of{$y};
3463            for ($i=0; ($i < @$x); $i++) {
3464                for ($j=$i+1; ($j < @$x); $j++) {
3465                    push(@{$conn{$x->[$i]}},$x->[$j]);
3466                    push(@{$conn{$x->[$j]}},$x->[$i]);
3467                }
3468            }
3469        }
3470    
3471        for ($i=0; ($i < @$all_pegs); $i++) {
3472            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3473                if (defined($x = $pos_of{$sim->id2})) {
3474                    foreach $y (@$x) {
3475                        push(@{$conn{$i}},$y);
3476                    }
3477                }
3478            }
3479        }
3480        return \%conn;
3481    }
3482    
3483    sub in {
3484        my($x,$xL) = @_;
3485        my($i);
3486    
3487        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3488        return ($i < @$xL);
3489    }
3490    
3491    #############################################
3492    #############################################
3493    package Observation::Commentary;
3494    
3495    use base qw(Observation);
3496    
3497    =head3 display_protein_commentary()
3498    
3499    =cut
3500    
3501    sub display_protein_commentary {
3502        my ($self,$dataset,$mypeg,$fig) = @_;
3503    
3504        my $all_rows = [];
3505        my $content;
3506        #my $fig = new FIG;
3507        my $cgi = new CGI;
3508        my $count = 0;
3509        my $peg_array = [];
3510        my ($evidence_column, $subsystems_column,  %e_identical);
3511    
3512        if (@$dataset != 1){
3513            foreach my $thing (@$dataset){
3514                if ($thing->class eq "SIM"){
3515                    push (@$peg_array, $thing->acc);
3516                }
3517            }
3518            # get the column for the evidence codes
3519            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3520    
3521            # get the column for the subsystems
3522            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3523    
3524            # get essentially identical seqs
3525            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3526        }
3527        else{
3528            push (@$peg_array, @$dataset);
3529        }
3530    
3531        my $selected_sims = [];
3532        foreach my $id (@$peg_array){
3533            last if ($count > 10);
3534            my $row_data = [];
3535            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3536            if ($fig->org_of($id)){
3537                $org = $fig->org_of($id);
3538            }
3539            else{
3540                $org = "Data not available";
3541            }
3542            $function = $fig->function_of($id);
3543            if ($mypeg ne $id){
3544                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3545                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3546                if (defined($e_identical{$id})) { $id_cell .= "*";}
3547            }
3548            else{
3549                $function_cell = "&nbsp;&nbsp;$function";
3550                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3551                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3552            }
3553    
3554            push(@$row_data,$id_cell);
3555            push(@$row_data,$org);
3556            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3557            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3558            push(@$row_data, $fig->translation_length($id));
3559            push(@$row_data,$function_cell);
3560            push(@$all_rows,$row_data);
3561            push (@$selected_sims, $id);
3562            $count++;
3563        }
3564    
3565        if ($count >0){
3566            $content = $all_rows;
3567        }
3568        else{
3569            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3570        }
3571        return ($content,$selected_sims);
3572    }
3573    
3574    sub display_protein_history {
3575        my ($self, $id,$fig) = @_;
3576        my $all_rows = [];
3577        my $content;
3578    
3579        my $cgi = new CGI;
3580        my $count = 0;
3581        foreach my $feat ($fig->feature_annotations($id)){
3582            my $row = [];
3583            my $col1 = $feat->[2];
3584            my $col2 = $feat->[1];
3585            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3586            my $text = $feat->[3];
3587    
3588            push (@$row, $col1);
3589            push (@$row, $col2);
3590            push (@$row, $text);
3591            push (@$all_rows, $row);
3592            $count++;
3593        }
3594        if ($count > 0){
3595            $content = $all_rows;
3596        }
3597        else {
3598            $content = "There is no history for this PEG";
3599  }  }
3600    
3601        return($content);
3602    }
3603    

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.76

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3