[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.60, Fri Jun 20 16:08:32 2008 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 strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 85  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 151  Line 166 
166  sub type {  sub type {
167    my ($self) = @_;    my ($self) = @_;
168    
169    return $self->{acc};    return $self->{type};
170  }  }
171    
172  =head3 start()  =head3 start()
# Line 304  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
# Line 317  Line 332 
332      }      }
333      else{      else{
334          my %domain_classes;          my %domain_classes;
335            my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 331  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 357  Line 374 
374    
375  }  }
376    
377    =head3 get_sims_objects()
378    
379    This is the B<REAL WORKHORSE> method of this Package.
380    
381    =cut
382    
383    sub get_sims_objects {
384        my ($self,$fid,$fig,$parameters) = @_;
385    
386        my $objects = [];
387        my @matched_datasets=();
388    
389        # call function that fetches attribute based observations
390        # returns an array of arrays of hashes
391        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
392    
393        foreach my $dataset (@matched_datasets) {
394            my $object;
395            if ($dataset->{'class'} eq "SIM"){
396                $object = Observation::Sims->new($dataset);
397            }
398            push (@$objects, $object);
399        }
400        return $objects;
401    }
402    
403    
404    =head3 display_housekeeping
405    This method returns the housekeeping data for a given peg in a table format
406    
407    =cut
408    sub display_housekeeping {
409        my ($self,$fid,$fig) = @_;
410        my $content = [];
411        my $row = [];
412    
413        my $org_name = $fig->org_of($fid);
414        my $org_id = $fig->genome_of($fid);
415        my $function = $fig->function_of($fid);
416        #my $taxonomy = $fig->taxonomy_of($org_id);
417        my $length = $fig->translation_length($fid);
418    
419        push (@$row, $org_name);
420        push (@$row, $fid);
421        push (@$row, $length);
422        push (@$row, $function);
423    
424        # initialize the table for commentary and annotations
425        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
426        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
427        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
428        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
429        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
430        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
431        #$content .= qq(</table><p>\n);
432    
433        push(@$content, $row);
434    
435        return ($content);
436    }
437    
438    =head3 get_sims_summary
439    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
440    
441    =cut
442    
443    sub get_sims_summary {
444        my ($observation, $dataset, $fig) = @_;
445        my %families;
446        my $taxes = $fig->taxonomy_list();
447    
448        foreach my $thing (@$dataset) {
449            my ($id, $evalue);
450            if ($thing =~ /fig\|/){
451                $id = $thing;
452                $evalue = -1;
453            }
454            else{
455                next if ($thing->class ne "SIM");
456                $id      = $thing->acc;
457                $evalue  = $thing->evalue;
458            }
459            next if ($id !~ /fig\|/);
460            next if ($fig->is_deleted_fid($id));
461    
462            my $genome = $fig->genome_of($id);
463            #my ($genome1) = ($genome) =~ /(.*)\./;
464            my $taxonomy = $taxes->{$genome};
465            my $parent_tax = "Root";
466            my @currLineage = ($parent_tax);
467            push (@{$families{figs}{$parent_tax}}, $id);
468            my $level = 2;
469            foreach my $tax (split(/\; /, $taxonomy)){
470                push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
471                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
472                $families{level}{$tax} = $level;
473                push (@currLineage, $tax);
474                $families{parent}{$tax} = $parent_tax;
475                $families{lineage}{$tax} = join(";", @currLineage);
476                if (defined ($families{evalue}{$tax})){
477                    if ($evalue < $families{evalue}{$tax}){
478                        $families{evalue}{$tax} = $evalue;
479                        $families{color}{$tax} = &get_taxcolor($evalue);
480                    }
481                }
482                else{
483                    $families{evalue}{$tax} = $evalue;
484                    $families{color}{$tax} = &get_taxcolor($evalue);
485                }
486    
487                $parent_tax = $tax;
488                $level++;
489            }
490        }
491    
492        foreach my $key (keys %{$families{children}}){
493            $families{count}{$key} = @{$families{children}{$key}};
494    
495            my %saw;
496            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
497            $families{children}{$key} = \@out;
498        }
499    
500        return \%families;
501    }
502    
503  =head1 Internal Methods  =head1 Internal Methods
504    
505  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 508 
508    
509  =cut  =cut
510    
511    sub get_taxcolor{
512        my ($evalue) = @_;
513        my $color;
514        if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
519        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
520        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
521        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
522        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
523        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
524        else{        $color = "#6666FF";    }
525        return ($color);
526    }
527    
528    
529  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
530    
531      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
532      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
533    
534      my $fig = new FIG;      foreach my $attr_ref (@$attributes_ref) {
   
     foreach my $attr_ref ($fig->get_attributes($fid)) {  
535          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
536          my @parts = split("::",$key);          my @parts = split("::",$key);
537          my $class = $parts[0];          my $class = $parts[0];
538            my $name = $parts[1];
539            #next if (($class eq "PFAM") && ($name !~ /interpro/));
540    
541          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
542              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 384  Line 545 
545                  my $from = $2;                  my $from = $2;
546                  my $to = $3;                  my $to = $3;
547                  my $evalue;                  my $evalue;
548                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
549                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
550                      my $part1 = $2/100;                      my $part1 = $2/100;
551                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
552                  }                  }
553                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
554                        $evalue=$raw_evalue;
555                    }
556                  else{                  else{
557                      $evalue = "0.0";                      $evalue = "0.0";
558                  }                  }
# Line 411  Line 575 
575    
576  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
577    
578      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
579      my $fig = new FIG;      #my $fig = new FIG;
580    
581        my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
582    
583      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $dataset = {'type' => "loc",
584                       'class' => 'SIGNALP_CELLO_TMPRED',
585                       'fig_id' => $fid
586                       };
587    
588      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      foreach my $attr_ref (@$attributes_ref){
     foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
591          my @parts = split("::",$key);          my @parts = split("::",$key);
592          my $sub_class = $parts[0];          my $sub_class = $parts[0];
593          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 433  Line 602 
602                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
603              }              }
604          }          }
605    
606          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
607              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
608              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
609          }          }
610    
611            elsif($sub_class eq "Phobius"){
612                if($sub_key eq "transmembrane"){
613                    $dataset->{'phobius_tm_locations'} = $value;
614                }
615                elsif($sub_key eq "signal"){
616                    $dataset->{'phobius_signal_location'} = $value;
617                }
618            }
619    
620          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
621              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
622              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
623              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
624          }          }
# Line 455  Line 635 
635  =cut  =cut
636    
637  sub get_pdb_observations{  sub get_pdb_observations{
638      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
639    
640      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      #my $fig = new FIG;
641    
642        foreach my $attr_ref (@$attributes_ref){
643          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
644            next if ( ($key !~ /PDB/));
645          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
646          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
647          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 513  Line 693 
693  =cut  =cut
694    
695  sub get_sims_observations{  sub get_sims_observations{
696        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
697    
698        my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
699        if ($parameters->{flag}){
700          $max_sims = $parameters->{max_sims};
701          $max_expand = $parameters->{max_expand};
702          $max_eval = $parameters->{max_eval};
703          $db_filter = $parameters->{db_filter};
704          $sim_order = $parameters->{sim_order};
705          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
706        }
707        else{
708          $max_sims = 50;
709          $max_expand = 5;
710          $max_eval = 1e-5;
711          $db_filter = "figx";
712          $sim_order = "id";
713        }
714    
715      my ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
716      my $fig = new FIG;      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
717      my @sims= $fig->nsims($fid,100,1e-20,"all");      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
718      my ($dataset);      my ($dataset);
719      foreach my $sim (@sims){  
720        if ($group_by_genome){
721          #  Collect all sims from genome with the first occurance of the genome:
722          foreach $sim ( @tmp ){
723            $id = $sim->id2;
724            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
725            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
726            push @{ $sims{ $genome } }, $sim;
727          }
728          @tmp = map { @{ $sims{$_} } } @genomes;
729        }
730    
731        foreach my $sim (@tmp){
732          my $hit = $sim->[1];          my $hit = $sim->[1];
733          my $percent = $sim->[2];          my $percent = $sim->[2];
734          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 533  Line 743 
743          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
744    
745          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
746                        'query' => $sim->[0],
747                      'acc' => $hit,                      'acc' => $hit,
748                      'identity' => $percent,                      'identity' => $percent,
749                      'type' => 'seq',                      'type' => 'seq',
# Line 562  Line 773 
773      my ($id) = (@_);      my ($id) = (@_);
774    
775      my ($db);      my ($db);
776      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
777      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
778        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
779      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
780        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
781      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
782      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
783      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
784      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
785      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
786      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
787      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
788      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
789        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
790        elsif ($id =~ /^img\|/)           { $db = "IMG" }
791        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
792        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
793    
794      return ($db);      return ($db);
795    
# Line 587  Line 804 
804    
805  sub get_identical_proteins{  sub get_identical_proteins{
806    
807      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
808      my $fig = new FIG;      #my $fig = new FIG;
809      my $funcs_ref;      my $funcs_ref;
810    
811      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);
   
812      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
813          my ($tmp, $who);          my ($tmp, $who);
814          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
# Line 601  Line 817 
817          }          }
818      }      }
819    
     my ($dataset);  
820      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
821                     'type' => 'seq',                     'type' => 'seq',
822                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 621  Line 836 
836    
837  sub get_functional_coupling{  sub get_functional_coupling{
838    
839      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
840      my $fig = new FIG;      #my $fig = new FIG;
841      my @funcs = ();      my @funcs = ();
842    
843      # initialize some variables      # initialize some variables
# Line 639  Line 854 
854                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
855                    } @fc_data;                    } @fc_data;
856    
     my ($dataset);  
857      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
858                     'type' => 'fc',                     'type' => 'fc',
859                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 750  Line 964 
964      return $self->{database};      return $self->{database};
965  }  }
966    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
967  ############################################################  ############################################################
968  ############################################################  ############################################################
969  package Observation::PDB;  package Observation::PDB;
# Line 781  Line 989 
989  =cut  =cut
990    
991  sub display{  sub display{
992      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
993    
994      my $fid = $self->fig_id;      my $fid = $self->fig_id;
995      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
996                                    -host     => $WebConfig::DBHOST,
997                                    -user     => $WebConfig::DBUSER,
998                                    -password => $WebConfig::DBPWD);
999    
1000      my $acc = $self->acc;      my $acc = $self->acc;
1001    
     print STDERR "acc:$acc\n";  
1002      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
1003      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1004      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 806  Line 1016 
1016      my $lines = [];      my $lines = [];
1017      my $line_data = [];      my $line_data = [];
1018      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1019                            'hover_title' => 'PDB',
1020                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1021                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1022    
1023      my $fig = new FIG;      #my $fig = new FIG;
1024      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1025      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1026    
# Line 910  Line 1121 
1121    
1122    
1123  sub display_table{  sub display_table{
1124      my ($self) = @_;      my ($self,$fig) = @_;
1125    
1126      my $fig = new FIG;      #my $fig = new FIG;
1127      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1128      my $rows = $self->rows;      my $rows = $self->rows;
1129      my $cgi = new CGI;      my $cgi = new CGI;
# Line 923  Line 1134 
1134          my $id = $row->[0];          my $id = $row->[0];
1135          my $who = $row->[1];          my $who = $row->[1];
1136          my $assignment = $row->[2];          my $assignment = $row->[2];
1137          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1138          my $single_domain = [];          my $single_domain = [];
1139          push(@$single_domain,$who);          push(@$single_domain,$who);
1140          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 974  Line 1185 
1185    
1186  sub display_table {  sub display_table {
1187    
1188      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1189      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1190      my $rows = $self->rows;      my $rows = $self->rows;
1191      my $cgi = new CGI;      my $cgi = new CGI;
# Line 989  Line 1200 
1200          # construct the score link          # construct the score link
1201          my $score = $row->[0];          my $score = $row->[0];
1202          my $toid = $row->[1];          my $toid = $row->[1];
1203          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";
1204          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1205    
1206          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1207          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1031  Line 1242 
1242  sub display {  sub display {
1243      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1244      my $lines = [];      my $lines = [];
1245      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1246                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1247                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1248      my $color = "4";      my $color = "4";
1249    
1250      my $line_data = [];      my $line_data = [];
# Line 1043  Line 1254 
1254      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1255      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1256    
1257      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1258                                    -host     => $WebConfig::DBHOST,
1259                                    -user     => $WebConfig::DBUSER,
1260                                    -password => $WebConfig::DBPWD);
1261    
1262      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1263      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1062  Line 1276 
1276              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1277          }          }
1278      }      }
1279        elsif($db =~ /PFAM/){
1280            my ($new_id) = ($id) =~ /(.*?)_/;
1281            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1282            if(!scalar(@$pfam_objs)){
1283                $name_title = "name";
1284                $name_value = "not available";
1285                $description_title = "description";
1286                $description_value = "not available";
1287            }
1288            else{
1289                my $pfam_obj = $pfam_objs->[0];
1290                $name_title = "name";
1291                $name_value = $pfam_obj->term;
1292                #$description_title = "description";
1293                #$description_value = $pfam_obj->description;
1294            }
1295        }
1296    
1297        my $short_title = $thing->acc;
1298        $short_title =~ s/::/ - /ig;
1299        my $new_short_title=$short_title;
1300        if ($short_title =~ /interpro/){
1301            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1302        }
1303        my $line_config = { 'title' => $name_value,
1304                            'hover_title', => 'Domain',
1305                            'short_title' => $new_short_title,
1306                            'basepair_offset' => '1' };
1307    
1308      my $name;      my $name;
1309      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1310               "value" => $name_value};      $name = {"title" => $db,
1311                 "value" => $new_id};
1312      push(@$descriptions,$name);      push(@$descriptions,$name);
1313    
1314      my $description;  #    my $description;
1315      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1316                               "value" => $description_value};  #                   "value" => $description_value};
1317      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1318    
1319      my $score;      my $score;
1320      $score = {"title" => "score",      $score = {"title" => "score",
1321                "value" => $thing->evalue};                "value" => $thing->evalue};
1322      push(@$descriptions,$score);      push(@$descriptions,$score);
1323    
1324        my $location;
1325        $location = {"title" => "location",
1326                     "value" => $thing->start . " - " . $thing->stop};
1327        push(@$descriptions,$location);
1328    
1329      my $link_id;      my $link_id;
1330      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1331          $link_id = $1;          $link_id = $1;
1332      }      }
1333    
1334      my $link;      my $link;
1335      my $link_url;      my $link_url;
1336      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"}
1337      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1338      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1339    
1340      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1094  Line 1342 
1342      push(@$links_list,$link);      push(@$links_list,$link);
1343    
1344      my $element_hash = {      my $element_hash = {
1345          "title" => $thing->type,          "title" => $name_value,
1346          "start" => $thing->start,          "start" => $thing->start,
1347          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1348          "color"=> $color,          "color"=> $color,
# Line 1109  Line 1357 
1357    
1358  }  }
1359    
1360    sub display_table {
1361        my ($self,$dataset) = @_;
1362        my $cgi = new CGI;
1363        my $data = [];
1364        my $count = 0;
1365        my $content;
1366    
1367        foreach my $thing (@$dataset) {
1368            next if ($thing->type !~ /dom/);
1369            my $single_domain = [];
1370            $count++;
1371    
1372            my $db_and_id = $thing->acc;
1373            my ($db,$id) = split("::",$db_and_id);
1374    
1375            my $dbmaster = DBMaster->new(-database =>'Ontology',
1376                                    -host     => $WebConfig::DBHOST,
1377                                    -user     => $WebConfig::DBUSER,
1378                                    -password => $WebConfig::DBPWD);
1379    
1380            my ($name_title,$name_value,$description_title,$description_value);
1381            if($db eq "CDD"){
1382                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1383                if(!scalar(@$cdd_objs)){
1384                    $name_title = "name";
1385                    $name_value = "not available";
1386                    $description_title = "description";
1387                    $description_value = "not available";
1388                }
1389                else{
1390                    my $cdd_obj = $cdd_objs->[0];
1391                    $name_title = "name";
1392                    $name_value = $cdd_obj->term;
1393                    $description_title = "description";
1394                    $description_value = $cdd_obj->description;
1395                }
1396            }
1397            elsif($db =~ /PFAM/){
1398                my ($new_id) = ($id) =~ /(.*?)_/;
1399                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1400                if(!scalar(@$pfam_objs)){
1401                    $name_title = "name";
1402                    $name_value = "not available";
1403                    $description_title = "description";
1404                    $description_value = "not available";
1405                }
1406                else{
1407                    my $pfam_obj = $pfam_objs->[0];
1408                    $name_title = "name";
1409                    $name_value = $pfam_obj->term;
1410                    #$description_title = "description";
1411                    #$description_value = $pfam_obj->description;
1412                }
1413            }
1414    
1415            my $location =  $thing->start . " - " . $thing->stop;
1416    
1417            push(@$single_domain,$db);
1418            push(@$single_domain,$thing->acc);
1419            push(@$single_domain,$name_value);
1420            push(@$single_domain,$location);
1421            push(@$single_domain,$thing->evalue);
1422            push(@$single_domain,$description_value);
1423            push(@$data,$single_domain);
1424        }
1425    
1426        if ($count >0){
1427            $content = $data;
1428        }
1429        else
1430        {
1431            $content = "<p>This PEG does not have any similarities to domains</p>";
1432        }
1433    }
1434    
1435    
1436  #########################################  #########################################
1437  #########################################  #########################################
1438  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1450 
1450      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1451      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1452      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1453        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1454        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1455    
1456      bless($self,$class);      bless($self,$class);
1457      return $self;      return $self;
1458  }  }
1459    
1460    sub display_cello {
1461        my ($thing) = @_;
1462        my $html;
1463        my $cello_location = $thing->cello_location;
1464        my $cello_score = $thing->cello_score;
1465        if($cello_location){
1466            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1467            #$html .= "<p>CELLO score: $cello_score </p>";
1468        }
1469        return ($html);
1470    }
1471    
1472  sub display {  sub display {
1473      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1474    
1475      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1476      my $fig= new FIG;      #my $fig= new FIG;
1477      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1478    
1479      my $cleavage_prob;      my $cleavage_prob;
# Line 1147  Line 1485 
1485      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1486      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1487    
1488        my $phobius_signal_location = $thing->phobius_signal_location;
1489        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1490    
1491      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1492    
1493      #color is      #color is
1494      my $color = "5";      my $color = "6";
1495    
1496      my $line_data = [];  =head3
1497    
1498      if($cello_location){      if($cello_location){
1499          my $cello_descriptions = [];          my $cello_descriptions = [];
1500            my $line_data =[];
1501    
1502            my $line_config = { 'title' => 'Localization Evidence',
1503                                'short_title' => 'CELLO',
1504                                'hover_title' => 'Localization',
1505                                'basepair_offset' => '1' };
1506    
1507          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1508                                            "value" => $cello_location};                                            "value" => $cello_location};
1509    
# Line 1171  Line 1516 
1516    
1517          my $element_hash = {          my $element_hash = {
1518              "title" => "CELLO",              "title" => "CELLO",
1519                "color"=> $color,
1520              "start" => "1",              "start" => "1",
1521              "end" =>  $length + 1,              "end" =>  $length + 1,
1522              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1523              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1524    
1525          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1526            $gd->add_line($line_data, $line_config);
1527      }      }
1528    
1529      my $color = "6";      $color = "2";
1530      if($tmpred_score){      if($tmpred_score){
1531            my $line_data =[];
1532            my $line_config = { 'title' => 'Localization Evidence',
1533                                'short_title' => 'Transmembrane',
1534                                'basepair_offset' => '1' };
1535    
1536          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1537              my $descriptions = [];              my $descriptions = [];
1538              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1547 
1547              "end" =>  $end + 1,              "end" =>  $end + 1,
1548              "color"=> $color,              "color"=> $color,
1549              "zlayer" => '5',              "zlayer" => '5',
1550              "type" => 'smallbox',              "type" => 'box',
1551                "description" => $descriptions};
1552    
1553                push(@$line_data,$element_hash);
1554    
1555            }
1556            $gd->add_line($line_data, $line_config);
1557        }
1558    =cut
1559    
1560        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1561            my $line_data =[];
1562            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                                'short_title' => 'TM and SP',
1564                                'hover_title' => 'Localization',
1565                                'basepair_offset' => '1' };
1566    
1567            foreach my $tm_loc (@phobius_tm_locations){
1568                my $descriptions = [];
1569                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1570                                 "value" => $tm_loc};
1571                push(@$descriptions,$description_phobius_tm_locations);
1572    
1573                my ($begin,$end) =split("-",$tm_loc);
1574    
1575                my $element_hash = {
1576                "title" => "Phobius",
1577                "start" => $begin + 1,
1578                "end" =>  $end + 1,
1579                "color"=> '6',
1580                "zlayer" => '4',
1581                "type" => 'bigbox',
1582              "description" => $descriptions};              "description" => $descriptions};
1583    
1584              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1585    
1586            }
1587    
1588            if($phobius_signal_location){
1589                my $descriptions = [];
1590                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1591                                 "value" => $phobius_signal_location};
1592                push(@$descriptions,$description_phobius_signal_location);
1593    
1594    
1595                my ($begin,$end) =split("-",$phobius_signal_location);
1596                my $element_hash = {
1597                "title" => "phobius signal locations",
1598                "start" => $begin + 1,
1599                "end" =>  $end + 1,
1600                "color"=> '1',
1601                "zlayer" => '5',
1602                "type" => 'box',
1603                "description" => $descriptions};
1604                push(@$line_data,$element_hash);
1605          }          }
1606    
1607            $gd->add_line($line_data, $line_config);
1608      }      }
1609    
1610      my $color = "1";  =head3
1611        $color = "1";
1612      if($signal_peptide_score){      if($signal_peptide_score){
1613            my $line_data = [];
1614          my $descriptions = [];          my $descriptions = [];
1615    
1616            my $line_config = { 'title' => 'Localization Evidence',
1617                                'short_title' => 'SignalP',
1618                                'hover_title' => 'Localization',
1619                                'basepair_offset' => '1' };
1620    
1621          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1622                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1623    
# Line 1220  Line 1631 
1631          my $element_hash = {          my $element_hash = {
1632              "title" => "SignalP",              "title" => "SignalP",
1633              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1634              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1635              "type" => 'bigbox',              "type" => 'bigbox',
1636              "color"=> $color,              "color"=> $color,
1637              "zlayer" => '10',              "zlayer" => '10',
1638              "description" => $descriptions};              "description" => $descriptions};
1639    
1640          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1641      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1642        }
1643    =cut
1644    
1645      return ($gd);      return ($gd);
1646    
# Line 1277  Line 1688 
1688    return $self->{cello_score};    return $self->{cello_score};
1689  }  }
1690    
1691    sub phobius_signal_location {
1692      my ($self) = @_;
1693      return $self->{phobius_signal_location};
1694    }
1695    
1696    sub phobius_tm_locations {
1697      my ($self) = @_;
1698      return $self->{phobius_tm_locations};
1699    }
1700    
1701    
1702    
1703  #########################################  #########################################
1704  #########################################  #########################################
# Line 1290  Line 1712 
1712      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1713      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1714      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1715        $self->{query} = $dataset->{'query'};
1716      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1717      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1718      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1305  Line 1728 
1728      return $self;      return $self;
1729  }  }
1730    
1731    =head3 display()
1732    
1733    If available use the function specified here to display a graphical observation.
1734    This code will display a graphical view of the similarities using the genome drawer object
1735    
1736    =cut
1737    
1738    sub display {
1739        my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1740    
1741        # declare variables
1742        my $window_size = $gd->window_size;
1743        my $peg = $thing->acc;
1744        my $query_id = $thing->query;
1745        my $organism = $thing->organism;
1746        my $abbrev_name = $fig->abbrev($organism);
1747        if (!$organism){
1748          $organism = $peg;
1749          $abbrev_name = $peg;
1750        }
1751        my $genome = $fig->genome_of($peg);
1752        my ($org_tax) = ($genome) =~ /(.*)\./;
1753        my $function = $thing->function;
1754        my $query_start = $thing->qstart;
1755        my $query_stop = $thing->qstop;
1756        my $hit_start = $thing->hstart;
1757        my $hit_stop = $thing->hstop;
1758        my $ln_query = $thing->qlength;
1759        my $ln_hit = $thing->hlength;
1760    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1761    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1762        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1763        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1764    
1765        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1766    
1767        # hit sequence title
1768        my $line_config = { 'title' => "$organism [$org_tax]",
1769                            'short_title' => "$abbrev_name",
1770                            'title_link' => '$tax_link',
1771                            'basepair_offset' => '0',
1772                            'no_middle_line' => '1'
1773                            };
1774    
1775        # query sequence title
1776        my $replace_id = $peg;
1777        $replace_id =~ s/\|/_/ig;
1778        my $anchor_name = "anchor_". $replace_id;
1779        my $query_config = { 'title' => "Query",
1780                             'short_title' => "Query",
1781                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1782                             'basepair_offset' => '0',
1783                             'no_middle_line' => '1'
1784                             };
1785        my $line_data = [];
1786        my $query_data = [];
1787    
1788        my $element_hash;
1789        my $hit_links_list = [];
1790        my $hit_descriptions = [];
1791        my $query_descriptions = [];
1792    
1793        # get sequence information
1794        # evidence link
1795        my $evidence_link;
1796        if ($peg =~ /^fig\|/){
1797          $evidence_link = "?page=Evidence&feature=".$peg;
1798        }
1799        else{
1800          my $db = &Observation::get_database($peg);
1801          my ($link_id) = ($peg) =~ /\|(.*)/;
1802          $evidence_link = &HTML::alias_url($link_id, $db);
1803          #print STDERR "LINK: $db    $evidence_link";
1804        }
1805        my $link = {"link_title" => $peg,
1806                    "link" => $evidence_link};
1807        push(@$hit_links_list,$link) if ($evidence_link);
1808    
1809        # subsystem link
1810        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1811        my @subsystems;
1812        foreach my $array (@$subs){
1813            my $subsystem = $$array[0];
1814            push(@subsystems,$subsystem);
1815            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1816                        "link_title" => $subsystem};
1817            push(@$hit_links_list,$link);
1818        }
1819    
1820        # blast alignment
1821        $link = {"link_title" => "view blast alignment",
1822                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1823        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1824    
1825        # description data
1826        my $description_function;
1827        $description_function = {"title" => "function",
1828                                 "value" => $function};
1829        push(@$hit_descriptions,$description_function);
1830    
1831        # subsystem description
1832        my $ss_string = join (",", @subsystems);
1833        $ss_string =~ s/_/ /ig;
1834        my $description_ss = {"title" => "subsystems",
1835                              "value" => $ss_string};
1836        push(@$hit_descriptions,$description_ss);
1837    
1838        # location description
1839        # hit
1840        my $description_loc;
1841        $description_loc = {"title" => "Hit Location",
1842                            "value" => $hit_start . " - " . $hit_stop};
1843        push(@$hit_descriptions, $description_loc);
1844    
1845        $description_loc = {"title" => "Sequence Length",
1846                            "value" => $ln_hit};
1847        push(@$hit_descriptions, $description_loc);
1848    
1849        # query
1850        $description_loc = {"title" => "Hit Location",
1851                            "value" => $query_start . " - " . $query_stop};
1852        push(@$query_descriptions, $description_loc);
1853    
1854        $description_loc = {"title" => "Sequence Length",
1855                            "value" => $ln_query};
1856        push(@$query_descriptions, $description_loc);
1857    
1858    
1859    
1860        # evalue score description
1861        my $evalue = $thing->evalue;
1862        while ($evalue =~ /-0/)
1863        {
1864            my ($chunk1, $chunk2) = split(/-/, $evalue);
1865            $chunk2 = substr($chunk2,1);
1866            $evalue = $chunk1 . "-" . $chunk2;
1867        }
1868    
1869        my $color = &color($evalue);
1870        my $description_eval = {"title" => "E-Value",
1871                                "value" => $evalue};
1872        push(@$hit_descriptions, $description_eval);
1873        push(@$query_descriptions, $description_eval);
1874    
1875        my $identity = $self->identity;
1876        my $description_identity = {"title" => "Identity",
1877                                    "value" => $identity};
1878        push(@$hit_descriptions, $description_identity);
1879        push(@$query_descriptions, $description_identity);
1880    
1881    
1882        my $number = $base_start + ($query_start-$hit_start);
1883        #print STDERR "START: $number";
1884        $element_hash = {
1885            "title" => $query_id,
1886            "start" => $base_start,
1887            "end" => $base_start+$ln_query,
1888            "type"=> 'box',
1889            "color"=> $color,
1890            "zlayer" => "2",
1891            "links_list" => $query_links_list,
1892            "description" => $query_descriptions
1893            };
1894        push(@$query_data,$element_hash);
1895    
1896        $element_hash = {
1897            "title" => $query_id . ': HIT AREA',
1898            "start" => $base_start + $query_start,
1899            "end" =>  $base_start + $query_stop,
1900            "type"=> 'smallbox',
1901            "color"=> $query_color,
1902            "zlayer" => "3",
1903            "links_list" => $query_links_list,
1904            "description" => $query_descriptions
1905            };
1906        push(@$query_data,$element_hash);
1907    
1908        $gd->add_line($query_data, $query_config);
1909    
1910    
1911        $element_hash = {
1912                    "title" => $peg,
1913                    "start" => $base_start + ($query_start-$hit_start),
1914                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1915                    "type"=> 'box',
1916                    "color"=> $color,
1917                    "zlayer" => "2",
1918                    "links_list" => $hit_links_list,
1919                    "description" => $hit_descriptions
1920                    };
1921        push(@$line_data,$element_hash);
1922    
1923        $element_hash = {
1924            "title" => $peg . ': HIT AREA',
1925            "start" => $base_start + $query_start,
1926            "end" =>  $base_start + $query_stop,
1927            "type"=> 'smallbox',
1928            "color"=> $hit_color,
1929            "zlayer" => "3",
1930            "links_list" => $hit_links_list,
1931            "description" => $hit_descriptions
1932            };
1933        push(@$line_data,$element_hash);
1934    
1935        $gd->add_line($line_data, $line_config);
1936    
1937        my $breaker = [];
1938        my $breaker_hash = {};
1939        my $breaker_config = { 'no_middle_line' => "1" };
1940    
1941        push (@$breaker, $breaker_hash);
1942        $gd->add_line($breaker, $breaker_config);
1943    
1944        return ($gd);
1945    }
1946    
1947    =head3 display_domain_composition()
1948    
1949    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
1950    
1951    =cut
1952    
1953    sub display_domain_composition {
1954        my ($self,$gd,$fig) = @_;
1955    
1956        #$fig = new FIG;
1957        my $peg = $self->acc;
1958    
1959        my $line_data = [];
1960        my $links_list = [];
1961        my $descriptions = [];
1962    
1963        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1964        #my @domain_query_results = ();
1965        foreach $dqr (@domain_query_results){
1966            my $key = @$dqr[1];
1967            my @parts = split("::",$key);
1968            my $db = $parts[0];
1969            my $id = $parts[1];
1970            my $val = @$dqr[2];
1971            my $from;
1972            my $to;
1973            my $evalue;
1974    
1975            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1976                my $raw_evalue = $1;
1977                $from = $2;
1978                $to = $3;
1979                if($raw_evalue =~/(\d+)\.(\d+)/){
1980                    my $part2 = 1000 - $1;
1981                    my $part1 = $2/100;
1982                    $evalue = $part1."e-".$part2;
1983                }
1984                else{
1985                    $evalue = "0.0";
1986                }
1987            }
1988    
1989            my $dbmaster = DBMaster->new(-database =>'Ontology',
1990                                    -host     => $WebConfig::DBHOST,
1991                                    -user     => $WebConfig::DBUSER,
1992                                    -password => $WebConfig::DBPWD);
1993            my ($name_value,$description_value);
1994    
1995            if($db eq "CDD"){
1996                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1997                if(!scalar(@$cdd_objs)){
1998                    $name_title = "name";
1999                    $name_value = "not available";
2000                    $description_title = "description";
2001                    $description_value = "not available";
2002                }
2003                else{
2004                    my $cdd_obj = $cdd_objs->[0];
2005                    $name_value = $cdd_obj->term;
2006                    $description_value = $cdd_obj->description;
2007                }
2008            }
2009    
2010            my $domain_name;
2011            $domain_name = {"title" => "name",
2012                            "value" => $name_value};
2013            push(@$descriptions,$domain_name);
2014    
2015            my $description;
2016            $description = {"title" => "description",
2017                            "value" => $description_value};
2018            push(@$descriptions,$description);
2019    
2020            my $score;
2021            $score = {"title" => "score",
2022                      "value" => $evalue};
2023            push(@$descriptions,$score);
2024    
2025            my $link_id = $id;
2026            my $link;
2027            my $link_url;
2028            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"}
2029            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2030            else{$link_url = "NO_URL"}
2031    
2032            $link = {"link_title" => $name_value,
2033                     "link" => $link_url};
2034            push(@$links_list,$link);
2035    
2036            my $domain_element_hash = {
2037                "title" => $peg,
2038                "start" => $from,
2039                "end" =>  $to,
2040                "type"=> 'box',
2041                "zlayer" => '4',
2042                "links_list" => $links_list,
2043                "description" => $descriptions
2044                };
2045    
2046            push(@$line_data,$domain_element_hash);
2047    
2048            #just one CDD domain for now, later will add option for multiple domains from selected DB
2049            last;
2050        }
2051    
2052        my $line_config = { 'title' => $peg,
2053                            'hover_title' => 'Domain',
2054                            'short_title' => $peg,
2055                            'basepair_offset' => '1' };
2056    
2057        $gd->add_line($line_data, $line_config);
2058    
2059        return ($gd);
2060    
2061    }
2062    
2063  =head3 display_table()  =head3 display_table()
2064    
2065  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
# Line 1315  Line 2070 
2070  =cut  =cut
2071    
2072  sub display_table {  sub display_table {
2073      my ($self,$dataset) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2074        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2075    
2076        my $scroll_list;
2077        foreach my $col (@$show_columns){
2078            push (@$scroll_list, $col->{key});
2079        }
2080    
2081        push (@ids, $query_fid);
2082        foreach my $thing (@$dataset) {
2083            next if ($thing->class ne "SIM");
2084            push (@ids, $thing->acc);
2085        }
2086    
2087        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2088        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2089    
2090        # get the column for the subsystems
2091        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2092    
2093        # get the column for the evidence codes
2094        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2095    
2096        # get the column for pfam_domain
2097        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2098    
2099        # get the column for molecular weight
2100        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2101    
2102        # get the column for organism's habitat
2103        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2104    
2105        # get the column for organism's temperature optimum
2106        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2107    
2108        # get the column for organism's temperature range
2109        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2110    
2111        # get the column for organism's oxygen requirement
2112        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2113    
2114        # get the column for organism's pathogenicity
2115        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2116    
2117        # get the column for organism's pathogenicity host
2118        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2119    
2120        # get the column for organism's salinity
2121        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2122    
2123        # get the column for organism's motility
2124        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2125    
2126        # get the column for organism's gram stain
2127        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2128    
2129        # get the column for organism's endospores
2130        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2131    
2132        # get the column for organism's shape
2133        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2134    
2135        # get the column for organism's disease
2136        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2137    
2138        # get the column for organism's disease
2139        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2140    
2141        # get the column for transmembrane domains
2142        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2143    
2144        # get the column for similar to human
2145        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);
2146    
2147        # get the column for signal peptide
2148        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2149    
2150        # get the column for transmembrane domains
2151        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2152    
2153        # get the column for conserved neighborhood
2154        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2155    
2156        # get the column for cellular location
2157        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2158    
2159        # get the aliases
2160        my $alias_col;
2161        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2162             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2163             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2164             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2165             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2166            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2167        }
2168    
2169        # get the colors for the function cell
2170        my $functions = $fig->function_of_bulk(\@ids,1);
2171        $functional_color = &get_function_color_cell($functions, $fig);
2172        my $query_function = $fig->function_of($query_fid);
2173    
2174        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2175    
2176        my $figfam_data = &FIG::get_figfams_data();
2177        my $figfams = new FFs($figfam_data);
2178    
2179        my $func_color_offset=0;
2180        unshift(@$dataset, $query_fid);
2181        foreach my $thing ( @$dataset){
2182            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2183            if ($thing eq $query_fid){
2184                $id = $thing;
2185                $taxid   = $fig->genome_of($id);
2186                $organism = $fig->genus_species($taxid);
2187                $current_function = $fig->function_of($id);
2188            }
2189            else{
2190                next if ($thing->class ne "SIM");
2191    
2192                $id      = $thing->acc;
2193                $evalue  = $thing->evalue;
2194                $taxid   = $fig->genome_of($id);
2195                $iden    = $thing->identity;
2196                $organism= $thing->organism;
2197                $ln1     = $thing->qlength;
2198                $ln2     = $thing->hlength;
2199                $b1      = $thing->qstart;
2200                $e1      = $thing->qstop;
2201                $b2      = $thing->hstart;
2202                $e2      = $thing->hstop;
2203                $d1      = abs($e1 - $b1) + 1;
2204                $d2      = abs($e2 - $b2) + 1;
2205                $color1  = match_color( $b1, $e1, $ln1 );
2206                $color2  = match_color( $b2, $e2, $ln2 );
2207                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2208                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2209                $current_function = $thing->function;
2210            }
2211    
2212            my $single_domain = [];
2213            $count++;
2214    
2215            # organisms cell
2216            my ($org, $org_color) = $fig->org_and_color_of($id);
2217            my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2218    
2219            # checkbox cell
2220            my ($box_cell,$tax, $radio_cell);
2221            my $field_name = "tables_" . $id;
2222            my $pair_name = "visual_" . $id;
2223            my $cell_name = "cell_". $id;
2224            my $replace_id = $id;
2225            $replace_id =~ s/\|/_/ig;
2226            my $white = '#ffffff';
2227            $white = '#999966' if ($id eq $query_fid);
2228            $org_color = '#999966' if ($id eq $query_fid);
2229            my $anchor_name = "anchor_". $replace_id;
2230            if ($id =~ /^fig\|/){
2231              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');">);
2232              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2233              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2234              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2235              $tax = $fig->genome_of($id);
2236            }
2237            else{
2238              my $box = qq(<a name="$anchor_name"></a>);
2239              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2240            }
2241    
2242            # get the linked fig id
2243            my $anchor_link = "graph_" . $replace_id;
2244            my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2245            $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2246            my $fig_col = {'data'=> $fig_data,
2247                           'highlight'=>$white};
2248    
2249            $replace_id = $peg;
2250            $replace_id =~ s/\|/_/ig;
2251            $anchor_name = "anchor_". $replace_id;
2252            my $query_config = { 'title' => "Query",
2253                                 'short_title' => "Query",
2254                                 'title_link' => "changeSimsLocation('$replace_id')",
2255                                 'basepair_offset' => '0'
2256                                 };
2257    
2258            # function cell
2259            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2260                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2261                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2262    
2263            my $function_color;
2264            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2265                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2266            }
2267            else{
2268                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2269            }
2270            my $function_cell;
2271            if ($current_function){
2272              if ($current_function eq $query_function){
2273                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2274                $func_color_offset=1;
2275              }
2276              else{
2277                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2278              }
2279            }
2280            else{
2281              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2282            }
2283    
2284            if ($id eq $query_fid){
2285                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2286                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2287                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2288            }
2289            else{
2290                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2291                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2292            }
2293    
2294            if ( ( $application->session->user) ){
2295                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2296                    push (@$single_domain,$radio_cell);
2297                }
2298            }
2299    
2300            my ($ff) = $figfams->families_containing_peg($id);
2301    
2302            foreach my $col (@$scroll_list){
2303                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2304                else { $highlight_color = "#ffffff"; }
2305    
2306                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2307                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2308                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2309                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2310                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2311                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2312                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2313                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2314                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2315                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2316                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2317                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2318                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2319                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2340            }
2341            push(@$data,$single_domain);
2342        }
2343        if ($count >0 ){
2344            $content = $data;
2345        }
2346        else{
2347            $content = "<p>This PEG does not have any similarities</p>";
2348        }
2349        shift(@$dataset);
2350        return ($content);
2351    }
2352    
2353    sub get_box_column{
2354        my ($ids) = @_;
2355        my %column;
2356        foreach my $id (@$ids){
2357            my $field_name = "tables_" . $id;
2358            my $pair_name = "visual_" . $id;
2359            my $cell_name = "cell_" . $id;
2360            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2361        }
2362        return (%column);
2363    }
2364    
2365    sub get_figfam_column{
2366        my ($ids, $fig, $cgi) = @_;
2367        my $column;
2368    
2369        my $figfam_data = &FIG::get_figfams_data();
2370        my $figfams = new FFs($figfam_data);
2371    
2372        foreach my $id (@$ids){
2373            my ($ff) =  $figfams->families_containing_peg($id);
2374            if ($ff){
2375                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2376            }
2377            else{
2378                push (@$column, " ");
2379            }
2380        }
2381    
2382        return $column;
2383    }
2384    
2385    sub get_subsystems_column{
2386        my ($ids,$fig,$cgi,$returnType) = @_;
2387    
2388        my %in_subs  = $fig->subsystems_for_pegs($ids);
2389        my ($column, $ss);
2390        foreach my $id (@$ids){
2391            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2392            my @subsystems;
2393    
2394            if (@in_sub > 0) {
2395                foreach my $array(@in_sub){
2396                    my $ss = $array->[0];
2397                    $ss =~ s/_/ /ig;
2398                    push (@subsystems, "-" . $ss);
2399                }
2400                my $in_sub_line = join ("<br>", @subsystems);
2401                $ss->{$id} = $in_sub_line;
2402            } else {
2403                $ss->{$id} = "None added";
2404            }
2405            push (@$column, $ss->{$id});
2406        }
2407    
2408        if ($returnType eq 'hash') { return $ss; }
2409        elsif ($returnType eq 'array') { return $column; }
2410    }
2411    
2412    sub get_lineage_column{
2413        my ($ids, $fig, $cgi) = @_;
2414    
2415        my $lineages = $fig->taxonomy_list();
2416    
2417        foreach my $id (@$ids){
2418            my $genome = $fig->genome_of($id);
2419            if ($lineages->{$genome}){
2420    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2421                push (@$column, $lineages->{$genome});
2422            }
2423            else{
2424                push (@$column, " ");
2425            }
2426        }
2427        return $column;
2428    }
2429    
2430    sub match_color {
2431        my ( $b, $e, $n , $rgb) = @_;
2432        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2433        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2434        my $cov = ( $r - $l + 1 ) / $n;
2435        my $sat = 1 - 10 * $cov / 9;
2436        my $br  = 1;
2437        if ($rgb){
2438            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2439        }
2440        else{
2441            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2442        }
2443    }
2444    
2445    sub hsb2rgb {
2446        my ( $h, $s, $br ) = @_;
2447        $h = 6 * ($h - floor($h));
2448        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2449        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2450        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2451                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2452                                          :               ( 0,      1,      $h - 2 )
2453                                          )
2454                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2455                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2456                                          :               ( 1,      0,      6 - $h )
2457                                          );
2458        ( ( $r * $s + 1 - $s ) * $br,
2459          ( $g * $s + 1 - $s ) * $br,
2460          ( $b * $s + 1 - $s ) * $br
2461        )
2462    }
2463    
2464    sub html2rgb {
2465        my ($hex) = @_;
2466        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2467        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2468                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2469    
2470        my @R = split(//, $r);
2471        my @G = split(//, $g);
2472        my @B = split(//, $b);
2473    
2474        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2475        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2476        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2477    
2478        my $rgb = [$red, $green, $blue];
2479        return $rgb;
2480    
2481    }
2482    
2483    sub rgb2html {
2484        my ( $r, $g, $b ) = @_;
2485        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2486        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2487        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2488        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2489    }
2490    
2491    sub floor {
2492        my $x = $_[0];
2493        defined( $x ) || return undef;
2494        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2495    }
2496    
2497    sub get_function_color_cell{
2498      my ($functions, $fig) = @_;
2499    
2500      # figure out the quantity of each function
2501      my %hash;
2502      foreach my $key (keys %$functions){
2503        my $func = $functions->{$key};
2504        $hash{$func}++;
2505      }
2506    
2507      my %func_colors;
2508      my $count = 1;
2509      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2510        $func_colors{$key}=$count;
2511        $count++;
2512      }
2513    
2514      return \%func_colors;
2515    }
2516    
2517    sub get_essentially_identical{
2518        my ($fid,$dataset,$fig) = @_;
2519        #my $fig = new FIG;
2520    
2521        my %id_list;
2522        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2523    
     my $data = [];  
     my $count = 0;  
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
2524      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2525          my $single_domain = [];          if($thing->class eq "IDENTICAL"){
2526          next if ($thing->class ne "SIM");              my $rows = $thing->rows;
2527          $count++;              my $count_identical = 0;
2528                foreach my $row (@$rows) {
2529                    my $id = $row->[0];
2530                    if (($id ne $fid) && ($fig->function_of($id))) {
2531                        $id_list{$id} = 1;
2532                    }
2533                }
2534            }
2535        }
2536    
2537          my $id = $thing->acc;  #    foreach my $id (@maps_to) {
2538    #        if (($id ne $fid) && ($fig->function_of($id))) {
2539    #           $id_list{$id} = 1;
2540    #        }
2541    #    }
2542        return(%id_list);
2543    }
2544    
         # add the subsystem information  
         my @in_sub  = $fig->peg_to_subsystems($id);  
         my $in_sub;  
2545    
2546          if (@in_sub > 0) {  sub get_evidence_column{
2547              $in_sub = @in_sub;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2548        my ($column, $code_attributes);
2549    
2550              # RAE: add a javascript popup with all the subsystems      if (! defined $attributes) {
2551              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;          my @attributes_array = $fig->get_attributes($ids);
2552              $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);          $attributes = \@attributes_array;
         } else {  
             $in_sub = "&nbsp;";  
2553          }          }
2554    
2555        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2556        foreach my $key (@codes){
2557            push (@{$code_attributes->{$key->[0]}}, $key);
2558        }
2559    
2560        foreach my $id (@$ids){
2561          # add evidence code with tool tip          # add evidence code with tool tip
2562          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
2563          my @ev_codes = "";  
2564          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2565              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);          my @ev_codes = ();
             @ev_codes = ();  
2566              foreach my $code (@codes) {              foreach my $code (@codes) {
2567                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2568                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 1358  Line 2572 
2572                  }                  }
2573                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2574              }              }
         }  
2575    
2576          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2577              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 1367  Line 2580 
2580                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2581          }          }
2582    
2583          # add the aliases          if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2584          my $aliases = undef;          elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2585          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      }
2586          $aliases = &HTML::set_prot_links( $cgi, $aliases );      return $column;
2587          $aliases ||= "&nbsp;";  }
   
         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>)";  
2588    
2589    sub get_attrb_column{
2590        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2591    
2592          push(@$single_domain,$thing->database);      my ($column, %code_attributes, %attribute_locations);
2593          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));      my $dbmaster = DBMaster->new(-database =>'Ontology',
2594          push(@$single_domain,$thing->evalue);                                   -host     => $WebConfig::DBHOST,
2595          push(@$single_domain,"$iden\%");                                   -user     => $WebConfig::DBUSER,
2596          push(@$single_domain,$reg1);                                   -password => $WebConfig::DBPWD);
2597          push(@$single_domain,$reg2);  
2598          push(@$single_domain,$in_sub);      if ($colName eq "pfam"){
2599          push(@$single_domain,$ev_codes);          if (! defined $attributes) {
2600          push(@$single_domain,$thing->organism);              my @attributes_array = $fig->get_attributes($ids);
2601          push(@$single_domain,$thing->function);              $attributes = \@attributes_array;
         push(@$single_domain,$aliases);  
         push(@$data,$single_domain);  
2602      }      }
2603    
2604      if ($count >0){          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2605          $content = $data;          foreach my $key (@codes){
2606                my $name = $key->[1];
2607                if ($name =~ /_/){
2608                    ($name) = ($key->[1]) =~ /(.*?)_/;
2609      }      }
2610      else              push (@{$code_attributes{$key->[0]}}, $name);
2611      {              push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2612          $content = "<p>This PEG does not have any similarities</p>";          }
2613    
2614            foreach my $id (@$ids){
2615                # add pfam code
2616                my $pfam_codes=" &nbsp; ";
2617                my @pfam_codes = "";
2618                my %description_codes;
2619    
2620                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2621                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2622                    @pfam_codes = ();
2623    
2624                    # get only unique values
2625                    my %saw;
2626                    foreach my $key (@ncodes) {$saw{$key}=1;}
2627                    @ncodes = keys %saw;
2628    
2629                    foreach my $code (@ncodes) {
2630                        my @parts = split("::",$code);
2631                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2632    
2633                        # get the locations for the domain
2634                        my @locs;
2635                        foreach my $part (@{$attribute_location{$id}{$code}}){
2636                            my ($loc) = ($part) =~ /\;(.*)/;
2637                            push (@locs,$loc);
2638                        }
2639                        my %locsaw;
2640                        foreach my $key (@locs) {$locsaw{$key}=1;}
2641                        @locs = keys %locsaw;
2642    
2643                        my $locations = join (", ", @locs);
2644    
2645                        if (defined ($description_codes{$parts[1]})){
2646                            push(@pfam_codes, "$parts[1] ($locations)");
2647                        }
2648                        else {
2649                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2650                            $description_codes{$parts[1]} = $description->[0]->{term};
2651                            push(@pfam_codes, "$pfam_link ($locations)");
2652                        }
2653                    }
2654    
2655                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2656                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2657                }
2658            }
2659        }
2660        elsif ($colName eq 'cellular_location'){
2661            if (! defined $attributes) {
2662                my @attributes_array = $fig->get_attributes($ids);
2663                $attributes = \@attributes_array;
2664            }
2665    
2666            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2667            foreach my $key (@codes){
2668                my ($loc) = ($key->[1]) =~ /::(.*)/;
2669                my ($new_loc, @all);
2670                @all = split (//, $loc);
2671                my $count = 0;
2672                foreach my $i (@all){
2673                    if ( ($i eq uc($i)) && ($count > 0) ){
2674                        $new_loc .= " " . $i;
2675                    }
2676                    else{
2677                        $new_loc .= $i;
2678                    }
2679                    $count++;
2680                }
2681                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2682            }
2683    
2684            foreach my $id (@$ids){
2685                my (@values, $entry);
2686                #@values = (" ");
2687                if (defined @{$code_attributes{$id}}){
2688                    my @ncodes = @{$code_attributes{$id}};
2689                    foreach my $code (@ncodes){
2690                        push (@values, $code->[0] . ", " . $code->[1]);
2691                    }
2692                }
2693                else{
2694                    @values = ("Not available");
2695                }
2696    
2697                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2698                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2699            }
2700        }
2701        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2702                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2703            if (! defined $attributes) {
2704                my @attributes_array = $fig->get_attributes($ids);
2705                $attributes = \@attributes_array;
2706            }
2707    
2708            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2709            foreach my $key (@codes){
2710                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2711            }
2712    
2713            foreach my $id (@$ids){
2714                my (@values, $entry);
2715                #@values = (" ");
2716                if (defined @{$code_attributes{$id}}){
2717                    my @ncodes = @{$code_attributes{$id}};
2718                    foreach my $code (@ncodes){
2719                        push (@values, $code);
2720                    }
2721                }
2722                else{
2723                    @values = ("Not available");
2724                }
2725    
2726                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2727                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2728            }
2729        }
2730        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2731                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2732                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2733                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2734                ($colName eq 'gc_content') ) {
2735            if (! defined $attributes) {
2736                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2737                $attributes = \@attributes_array;
2738            }
2739    
2740            my $genomes_with_phenotype;
2741            foreach my $attribute (@$attributes){
2742                my $genome = $attribute->[0];
2743                $genomes_with_phenotype->{$genome} = $attribute->[2];
2744            }
2745    
2746            foreach my $id (@$ids){
2747                my $genome = $fig->genome_of($id);
2748                my @values = (' ');
2749                if (defined $genomes_with_phenotype->{$genome}){
2750                    push (@values, $genomes_with_phenotype->{$genome});
2751                }
2752                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2753                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2754      }      }
     return ($content);  
2755  }  }
2756    
2757        return $column;
2758    }
2759    
2760    
2761    sub get_db_aliases {
2762        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2763    
2764        my $db_array;
2765        my $all_aliases = $fig->feature_aliases_bulk($ids);
2766        foreach my $id (@$ids){
2767            foreach my $alias (@{$$all_aliases{$id}}){
2768                my $id_db = &Observation::get_database($alias);
2769                next if ( ($id_db ne $db) && ($db ne 'all') );
2770                next if ($aliases->{$id}->{$db});
2771                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2772            }
2773            if (!defined( $aliases->{$id}->{$db})){
2774                $aliases->{$id}->{$db} = " ";
2775            }
2776            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2777            push (@$db_array, $aliases->{$id}->{$db});
2778        }
2779    
2780        if ($returnType eq 'hash') { return $aliases; }
2781        elsif ($returnType eq 'array') { return $db_array; }
2782    }
2783    
2784    
2785    
2786  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; $_ }
2787    
2788    sub color {
2789        my ($evalue) = @_;
2790        my $palette = WebColors::get_palette('vitamins');
2791        my $color;
2792        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2793        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2794        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2795        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2796        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2797        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2798        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2799        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2800        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2801        else{        $color = $palette->[9];    }
2802        return ($color);
2803    }
2804    
2805    
2806  ############################  ############################
# Line 1429  Line 2818 
2818  }  }
2819    
2820  sub display {  sub display {
2821      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2822    
2823        $taxes = $fig->taxonomy_list();
2824    
2825      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2826      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2827      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2828      my $fig = new FIG;      my $range = $gd_window_size;
2829      my $all_regions = [];      my $all_regions = [];
2830        my $gene_associations={};
2831    
2832      #get the organism genome      #get the organism genome
2833      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2834        $gene_associations->{$fid}->{"organism"} = $target_genome;
2835        $gene_associations->{$fid}->{"main_gene"} = $fid;
2836        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2837    
2838      # get location of the gene      # get location of the gene
2839      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 2850 
2850      my ($region_start, $region_end);      my ($region_start, $region_end);
2851      if ($beg < $end)      if ($beg < $end)
2852      {      {
2853          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2854          $region_end = $end+4000;          $region_end = $end+ ($range);
2855          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2856      }      }
2857      else      else
2858      {      {
2859          $region_start = $end-4000;          $region_start = $end-($range);
2860          $region_end = $beg+4000;          $region_end = $beg+($range);
2861          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2862          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2863            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2864      }      }
2865    
2866      # call genes in region      # call genes in region
2867      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);
2868        #foreach my $feat (@$target_gene_features){
2869        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2870        #}
2871      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2872      my (@start_array_region);      my (@start_array_region);
2873      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2874    
2875      my %all_genes;      my %all_genes;
2876      my %all_genomes;      my %all_genomes;
2877      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2878            #if ($feature =~ /peg/){
2879      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2880      {          #}
         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;  
2881                  }                  }
2882    
2883                  push (@start_array_region, $offset);      my @selected_sims;
2884    
2885                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2886                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2887                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2888                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2889              }          # get the similarities and store only the ones that match the lineages selected
2890              $coup_count++;          if (@selected_taxonomy > 0){
2891                foreach my $sim (@$sims_array){
2892                    next if ($sim->class ne "SIM");
2893                    next if ($sim->acc !~ /fig\|/);
2894    
2895                    #my $genome = $fig->genome_of($sim->[1]);
2896                    my $genome = $fig->genome_of($sim->acc);
2897                    #my ($genome1) = ($genome) =~ /(.*)\./;
2898                    my $lineage = $taxes->{$genome};
2899                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2900                    foreach my $taxon(@selected_taxonomy){
2901                        if ($lineage =~ /$taxon/){
2902                            #push (@selected_sims, $sim->[1]);
2903                            push (@selected_sims, $sim->acc);
2904          }          }
2905      }      }
   
     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);  
2906                      }                      }
                     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;  
2907                      }                      }
2908            else{
2909                my $simcount = 0;
2910                foreach my $sim (@$sims_array){
2911                    next if ($sim->class ne "SIM");
2912                    next if ($sim->acc !~ /fig\|/);
2913    
2914                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2915                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2916                      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;}  
                 }  
2917              }              }
2918          }          }
2919    
2920            my %saw;
2921            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2922    
2923            # get the gene context for the sorted matches
2924            foreach my $sim_fid(@selected_sims){
2925                #get the organism genome
2926                my $sim_genome = $fig->genome_of($sim_fid);
2927                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2928                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2929                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2930    
2931                # get location of the gene
2932                my $data = $fig->feature_location($sim_fid);
2933                my ($contig, $beg, $end);
2934    
2935                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2936                    $contig = $1;
2937                    $beg = $2;
2938                    $end = $3;
2939      }      }
2940    
2941      # get the PCH to each of the genes              my $offset;
2942      my $pch_sets = [];              my ($region_start, $region_end);
2943      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)  
2944          {          {
2945              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2946                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2947                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2948          }          }
2949          else          else
2950          {          {
2951              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2952                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2953              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2954                    $reverse_flag{$sim_genome} = $sim_fid;
2955                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2956          }          }
2957    
2958                # call genes in region
2959                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2960                push(@$all_regions,$sim_gene_features);
2961                push (@start_array_region, $offset);
2962                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2963                $all_genomes{$sim_genome} = 1;
2964      }      }
2965    
2966        }
2967    
2968  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2969  #    my %already;      # cluster the genes
2970  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
2971  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2972  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2973  #      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;  
 #           }  
 #       }  
 #    }  
2974    
2975      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2976          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2977          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2978          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2979          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2980            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2981            my $lineage = $taxes->{$region_genome};
2982            #my $lineage = $fig->taxonomy_of($region_genome);
2983            #$region_gs .= "Lineage:$lineage";
2984          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2985                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2986                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 2988 
2988    
2989          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2990    
2991            my $second_line_config = { 'title' => "$lineage",
2992                                       'short_title' => "",
2993                                       'basepair_offset' => '0',
2994                                       'no_middle_line' => '1'
2995                                       };
2996    
2997          my $line_data = [];          my $line_data = [];
2998            my $second_line_data = [];
2999    
3000            # initialize variables to check for overlap in genes
3001            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3002            my $major_line_flag = 0;
3003            my $prev_second_flag = 0;
3004    
3005          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
3006                $second_line_flag = 0;
3007              my $element_hash;              my $element_hash;
3008              my $links_list = [];              my $links_list = [];
3009              my $descriptions = [];              my $descriptions = [];
3010    
3011              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3012    
3013              # get subsystem information              # get subsystem information
3014              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3015              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3016    
3017              my $link;              my $link;
3018              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3019                       "link" => $url_link};                       "link" => $url_link};
3020              push(@$links_list,$link);              push(@$links_list,$link);
3021    
3022              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3023              foreach my $subsystem (@subsystems){              my @subsystems;
3024                foreach my $array (@subs){
3025                    my $subsystem = $$array[0];
3026                    my $ss = $subsystem;
3027                    $ss =~ s/_/ /ig;
3028                    push (@subsystems, $ss);
3029                  my $link;                  my $link;
3030                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3031                           "link_title" => $subsystem};                           "link_title" => $ss};
3032                    push(@$links_list,$link);
3033                }
3034    
3035                if ($fid1 eq $fid){
3036                    my $link;
3037                    $link = {"link_title" => "Annotate this sequence",
3038                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3039                  push(@$links_list,$link);                  push(@$links_list,$link);
3040              }              }
3041    
# Line 1738  Line 3057 
3057                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
3058                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
3059    
3060                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
3061                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3062                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3063                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3064                            $second_line_flag = 1;
3065                            $major_line_flag = 1;
3066                        }
3067                    }
3068                    $prev_start = $start;
3069                    $prev_stop = $stop;
3070                    $prev_fig = $fid1;
3071    
3072                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3073                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3074                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3075                  }                  }
3076    
3077                    my $title = $fid1;
3078                    if ($fid1 eq $fid){
3079                        $title = "My query gene: $fid1";
3080                    }
3081    
3082                  $element_hash = {                  $element_hash = {
3083                      "title" => $fid1,                      "title" => $title,
3084                      "start" => $start,                      "start" => $start,
3085                      "end" =>  $stop,                      "end" =>  $stop,
3086                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 3089 
3089                      "links_list" => $links_list,                      "links_list" => $links_list,
3090                      "description" => $descriptions                      "description" => $descriptions
3091                  };                  };
3092                  push(@$line_data,$element_hash);  
3093                    # if there is an overlap, put into second line
3094                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3095                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3096    
3097                    if ($fid1 eq $fid){
3098                        $element_hash = {
3099                            "title" => 'Query',
3100                            "start" => $start,
3101                            "end" =>  $stop,
3102                            "type"=> 'bigbox',
3103                            "color"=> $color,
3104                            "zlayer" => "1"
3105                            };
3106    
3107                        # if there is an overlap, put into second line
3108                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3109                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3110                    }
3111              }              }
3112          }          }
3113          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3114            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3115        }
3116        return ($gd, \@selected_sims);
3117    }
3118    
3119    sub cluster_genes {
3120        my($fig,$all_pegs,$peg) = @_;
3121        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3122    
3123        my @color_sets = ();
3124    
3125        $conn = &get_connections_by_similarity($fig,$all_pegs);
3126    
3127        for ($i=0; ($i < @$all_pegs); $i++) {
3128            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3129            if (! $seen{$i}) {
3130                $cluster = [$i];
3131                $seen{$i} = 1;
3132                for ($j=0; ($j < @$cluster); $j++) {
3133                    $x = $conn->{$cluster->[$j]};
3134                    foreach $k (@$x) {
3135                        if (! $seen{$k}) {
3136                            push(@$cluster,$k);
3137                            $seen{$k} = 1;
3138                        }
3139                    }
3140                }
3141    
3142                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3143                    push(@color_sets,$cluster);
3144                }
3145            }
3146        }
3147        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3148        $red_set = $color_sets[$i];
3149        splice(@color_sets,$i,1);
3150        @color_sets = sort { @$b <=> @$a } @color_sets;
3151        unshift(@color_sets,$red_set);
3152    
3153        my $color_sets = {};
3154        for ($i=0; ($i < @color_sets); $i++) {
3155            foreach $x (@{$color_sets[$i]}) {
3156                $color_sets->{$all_pegs->[$x]} = $i;
3157      }      }
3158      return $gd;      }
3159        return $color_sets;
3160    }
3161    
3162    sub get_connections_by_similarity {
3163        my($fig,$all_pegs) = @_;
3164        my($i,$j,$tmp,$peg,%pos_of);
3165        my($sim,%conn,$x,$y);
3166    
3167        for ($i=0; ($i < @$all_pegs); $i++) {
3168            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3169            push(@{$pos_of{$tmp}},$i);
3170            if ($tmp ne $all_pegs->[$i]) {
3171                push(@{$pos_of{$all_pegs->[$i]}},$i);
3172            }
3173        }
3174    
3175        foreach $y (keys(%pos_of)) {
3176            $x = $pos_of{$y};
3177            for ($i=0; ($i < @$x); $i++) {
3178                for ($j=$i+1; ($j < @$x); $j++) {
3179                    push(@{$conn{$x->[$i]}},$x->[$j]);
3180                    push(@{$conn{$x->[$j]}},$x->[$i]);
3181                }
3182            }
3183        }
3184    
3185        for ($i=0; ($i < @$all_pegs); $i++) {
3186            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3187                if (defined($x = $pos_of{$sim->id2})) {
3188                    foreach $y (@$x) {
3189                        push(@{$conn{$i}},$y);
3190                    }
3191                }
3192            }
3193        }
3194        return \%conn;
3195    }
3196    
3197    sub in {
3198        my($x,$xL) = @_;
3199        my($i);
3200    
3201        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3202        return ($i < @$xL);
3203    }
3204    
3205    #############################################
3206    #############################################
3207    package Observation::Commentary;
3208    
3209    use base qw(Observation);
3210    
3211    =head3 display_protein_commentary()
3212    
3213    =cut
3214    
3215    sub display_protein_commentary {
3216        my ($self,$dataset,$mypeg,$fig) = @_;
3217    
3218        my $all_rows = [];
3219        my $content;
3220        #my $fig = new FIG;
3221        my $cgi = new CGI;
3222        my $count = 0;
3223        my $peg_array = [];
3224        my ($evidence_column, $subsystems_column,  %e_identical);
3225    
3226        if (@$dataset != 1){
3227            foreach my $thing (@$dataset){
3228                if ($thing->class eq "SIM"){
3229                    push (@$peg_array, $thing->acc);
3230                }
3231            }
3232            # get the column for the evidence codes
3233            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3234    
3235            # get the column for the subsystems
3236            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3237    
3238            # get essentially identical seqs
3239            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3240        }
3241        else{
3242            push (@$peg_array, @$dataset);
3243        }
3244    
3245        my $selected_sims = [];
3246        foreach my $id (@$peg_array){
3247            last if ($count > 10);
3248            my $row_data = [];
3249            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3250            $org = $fig->org_of($id);
3251            $function = $fig->function_of($id);
3252            if ($mypeg ne $id){
3253                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3254                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3255                if (defined($e_identical{$id})) { $id_cell .= "*";}
3256            }
3257            else{
3258                $function_cell = "&nbsp;&nbsp;$function";
3259                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3260                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3261            }
3262    
3263            push(@$row_data,$id_cell);
3264            push(@$row_data,$org);
3265            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3266            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3267            push(@$row_data, $fig->translation_length($id));
3268            push(@$row_data,$function_cell);
3269            push(@$all_rows,$row_data);
3270            push (@$selected_sims, $id);
3271            $count++;
3272        }
3273    
3274        if ($count >0){
3275            $content = $all_rows;
3276        }
3277        else{
3278            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3279        }
3280        return ($content,$selected_sims);
3281    }
3282    
3283    sub display_protein_history {
3284        my ($self, $id,$fig) = @_;
3285        my $all_rows = [];
3286        my $content;
3287    
3288        my $cgi = new CGI;
3289        my $count = 0;
3290        foreach my $feat ($fig->feature_annotations($id)){
3291            my $row = [];
3292            my $col1 = $feat->[2];
3293            my $col2 = $feat->[1];
3294            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3295            my $text = $feat->[3];
3296    
3297            push (@$row, $col1);
3298            push (@$row, $col2);
3299            push (@$row, $text);
3300            push (@$all_rows, $row);
3301            $count++;
3302        }
3303        if ($count > 0){
3304            $content = $all_rows;
3305        }
3306        else {
3307            $content = "There is no history for this PEG";
3308  }  }
3309    
3310        return($content);
3311    }
3312    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3