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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3