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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3