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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3