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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3