[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.40, Thu Sep 20 22:27:20 2007 UTC revision 1.74, Thu Feb 5 18:44:35 2009 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;  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 LWP::Simple;
15  #use strict;  #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
18    use FFs;
19    
20  1;  1;
21    
 # $Id$  
   
22  =head1 NAME  =head1 NAME
23    
24  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 317  Line 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$parameters,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
327    
328      # call function that fetches attribute based observations      # call function that fetches attribute based observations
329      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 332  Line 334 
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          #$domain_classes{'CDD'} = 1;
338          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
342          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
343          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 346  Line 349 
349          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
350              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
351          }          }
352          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
353              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
356              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
359              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
362              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
365              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
366          }          }
367          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
368              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
369          }          }
370    
# Line 372  Line 375 
375    
376  }  }
377    
378  =head3 display_housekeeping  =head3 get_attributes
379  This method returns the housekeeping data for a given peg in a table format      provides layer of abstraction between tools and underlying access method to Attribute Server
380    =cut
381    
382    sub get_attributes{
383        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
384        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
385        return @attributes;
386    }
387    
388    =head3 get_sims_objects()
389    
390    This is the B<REAL WORKHORSE> method of this Package.
391    
392  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
393    
394      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
395      my $org_id   = $fig->orgid_of_orgname($org_name);      my ($self,$fid,$fig,$parameters) = @_;
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
     my $function = $fig->function_of($fid);  
     my @aliases  = $fig->feature_aliases($fid);  
     my $taxonomy = $fig->taxonomy_of($org_id);  
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
396    
397      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
398      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
399      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
400      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
401      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
402      $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
403    
404      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
405          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
406          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
407              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
408          }          }
409            push (@$objects, $object);
410      }      }
411        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
412          }          }
413    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
414    
415    =head3 display_housekeeping
416    This method returns the housekeeping data for a given peg in a table format
417    
418          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
419          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
420              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
421          }      my $content = [];
422          $content .= qq(</td></tr></table>\n);      my $row = [];
423    
424        my $org_name = "Data not available";
425        if ( $fig->org_of($fid)){
426            $org_name = $fig->org_of($fid);
427      }      }
428        my $org_id = $fig->genome_of($fid);
429        my $function = $fig->function_of($fid);
430        #my $taxonomy = $fig->taxonomy_of($org_id);
431        my $length = $fig->translation_length($fid);
432    
433        push (@$row, $org_name);
434        push (@$row, $fid);
435        push (@$row, $length);
436        push (@$row, $function);
437    
438        # initialize the table for commentary and annotations
439        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
440        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
441        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
442        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
444        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
445        #$content .= qq(</table><p>\n);
446    
447      $content .= qq(</table><p>\n);      push(@$content, $row);
448    
449      return ($content);      return ($content);
450  }  }
# Line 447  Line 455 
455  =cut  =cut
456    
457  sub get_sims_summary {  sub get_sims_summary {
458      my ($observation, $fid, $taxes) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
459      my %families;      my %families;
460      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
461    
462        foreach my $thing (@$dataset) {
463            my ($id, $evalue);
464            if ($thing =~ /fig\|/){
465                $id = $thing;
466                $evalue = -1;
467            }
468            else{
469                next if ($thing->class ne "SIM");
470                $id      = $thing->acc;
471                $evalue  = $thing->evalue;
472            }
473            next if ($id !~ /fig\|/);
474            next if ($fig->is_deleted_fid($id));
475    
476      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
477          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
478          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my ($genome1) = ($genome) =~ /(.*)\./;  
         my $taxonomy = $taxes->{$genome1};  
         #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated  
479          my $parent_tax = "Root";          my $parent_tax = "Root";
480          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
481          foreach my $tax (split(/\; /, $taxonomy)){          push (@{$families{figs}{$parent_tax}}, $id);
482              push (@{$families{children}{$parent_tax}}, $tax);          my $level = 2;
483    
484            foreach my $tax (split(/\; /, $taxonomy),$id){
485              next if ($tax eq $parent_tax);
486              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
487              push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
488              $families{level}{$tax} = $level;
489              push (@currLineage, $tax);              push (@currLineage, $tax);
490              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
491              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
492              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
493                  if ($sim->[10] < $families{evalue}{$tax}){              if ($evalue < $families{evalue}{$tax}){
494                      $families{evalue}{$tax} = $sim->[10];                $families{evalue}{$tax} = $evalue;
495                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                $families{color}{$tax} = &get_taxcolor($evalue);
496                  }                  }
497              }              }
498              else{              else{
499                  $families{evalue}{$tax} = $sim->[10];              $families{evalue}{$tax} = $evalue;
500                  $families{color}{$tax} = &get_taxcolor($sim->[10]);              $families{color}{$tax} = &get_taxcolor($evalue);
501              }              }
502    
503              $parent_tax = $tax;              $parent_tax = $tax;
504              $level++;
505          }          }
506      }      }
507    
# Line 487  Line 512 
512          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
513          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
514      }      }
515      return (\%families);  
516        return \%families;
517  }  }
518    
519  =head1 Internal Methods  =head1 Internal Methods
# Line 501  Line 527 
527  sub get_taxcolor{  sub get_taxcolor{
528      my ($evalue) = @_;      my ($evalue) = @_;
529      my $color;      my $color;
530      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
531        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
532      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
533      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
534      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 518  Line 545 
545  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
546    
547      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
548      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
     my $fig = new FIG;  
   
550      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $class = $parts[0];          my $class = $parts[0];
554            my $name = $parts[1];
555            next if ($seen->{$name});
556            $seen->{$name}++;
557            #next if (($class eq "PFAM") && ($name !~ /interpro/));
558    
559          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
560              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 535  Line 563 
563                  my $from = $2;                  my $from = $2;
564                  my $to = $3;                  my $to = $3;
565                  my $evalue;                  my $evalue;
566                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
567                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
568                      my $part1 = $2/100;                      my $part1 = $2/100;
569                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
570                  }                  }
571                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                        $evalue=$raw_evalue;
573                    }
574                  else{                  else{
575                      $evalue = "0.0";                      $evalue = "0.0";
576                  }                  }
# Line 562  Line 593 
593    
594  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
595    
596      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
597      my $fig = new FIG;      #my $fig = new FIG;
598    
599      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
600    
# Line 573  Line 604 
604                     };                     };
605    
606      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
607          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
608          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
609          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 585  Line 615 
615                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
616                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
617                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
618              }              }
619              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
620                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 624  Line 653 
653  =cut  =cut
654    
655  sub get_pdb_observations{  sub get_pdb_observations{
656      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
657    
658      my $fig = new FIG;      #my $fig = new FIG;
659    
660      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
661          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
662          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
663          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 684  Line 711 
711  =cut  =cut
712    
713  sub get_sims_observations{  sub get_sims_observations{
714        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
715    
716      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
717      my $fig = new FIG;      if ( (defined $parameters->{flag}) && ($parameters->{flag})){
718      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
719      my ($dataset);        $max_expand = $parameters->{max_expand};
720          $max_eval = $parameters->{max_eval};
721      my %id_list;        $db_filter = $parameters->{db_filter};
722      foreach my $sim (@sims){        $sim_filters->{ sort_by } = $parameters->{sim_order};
723          my $hit = $sim->[1];        #$sim_order = $parameters->{sim_order};
724          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
725          next if ($hit !~ /^fig\|/);      }
726          my @aliases = $fig->feature_aliases($hit);      elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
727          foreach my $alias (@aliases){        $max_sims = 50;
728              $id_list{$alias} = 1;        $max_expand = 5;
729          $max_eval = 1e-5;
730          $db_filter = "all";
731          $sim_filters->{ sort_by } = 'id';
732          }          }
733        else{
734          $max_sims = 50;
735          $max_expand = 5;
736          $max_eval = 1e-5;
737          $db_filter = "figx";
738          $sim_filters->{ sort_by } = 'id';
739          #$sim_order = "id";
740      }      }
741    
742      my %already;      my($id, $genome, @genomes, %sims);
743      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
744      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
745          my $hit = $sim->[1];      my ($dataset);
746          my ($id) = ($hit) =~ /\|(.*)/;  
747          next if (defined($already{$id}));      if ($group_by_genome){
748          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
749          push (@new_sims, $sim);        foreach $sim ( @tmp ){
750          $already{$id} = 1;          $id = $sim->id2;
751            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
752            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
753            push @{ $sims{ $genome } }, $sim;
754          }
755          @tmp = map { @{ $sims{$_} } } @genomes;
756      }      }
757    
758      foreach my $sim (@new_sims){      my $seen_sims={};
759        foreach my $sim (@tmp){
760          my $hit = $sim->[1];          my $hit = $sim->[1];
761            next if ($seen_sims->{$hit});
762            $seen_sims->{$hit}++;
763          my $percent = $sim->[2];          my $percent = $sim->[2];
764          my $evalue = $sim->[10];          my $evalue = $sim->[10];
765          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 724  Line 770 
770          my $hlength = $sim->[13];          my $hlength = $sim->[13];
771          my $db = get_database($hit);          my $db = get_database($hit);
772          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
773          my $organism = $fig->org_of($hit);          my $organism;
774            if ($fig->org_of($hit)){
775                $organism = $fig->org_of($hit);
776            }
777            else{
778                $organism = "Data not available";
779            }
780    
781          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
782                      'query' => $sim->[0],                      'query' => $sim->[0],
# Line 757  Line 809 
809      my ($id) = (@_);      my ($id) = (@_);
810    
811      my ($db);      my ($db);
812      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
813      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
814        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
815      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
816        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
817      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
818      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
819      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 768  Line 822 
822      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
823      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
824      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
825        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
826        elsif ($id =~ /^img\|/)           { $db = "IMG" }
827        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
828        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
829    
830      return ($db);      return ($db);
831    
# Line 782  Line 840 
840    
841  sub get_identical_proteins{  sub get_identical_proteins{
842    
843      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
844      my $fig = new FIG;      #my $fig = new FIG;
845      my $funcs_ref;      my $funcs_ref;
846    
 #    my %id_list;  
847      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);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
848      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
849          my ($tmp, $who);          my ($tmp, $who);
850          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
851              $who = &get_database($id);              $who = &get_database($id);
852              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
853          }          }
854      }      }
855    
     my ($dataset);  
856      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
857                     'type' => 'seq',                     'type' => 'seq',
858                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 822  Line 872 
872    
873  sub get_functional_coupling{  sub get_functional_coupling{
874    
875      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
876      my $fig = new FIG;      #my $fig = new FIG;
877      my @funcs = ();      my @funcs = ();
878    
879      # initialize some variables      # initialize some variables
# Line 833  Line 883 
883      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
884    
885      # get the fc data      # get the fc data
886      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);
887    
888      # retrieve data      # retrieve data
889      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
890                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
891                    } @fc_data;                    } @fc_data;
892    
     my ($dataset);  
893      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
894                     'type' => 'fc',                     'type' => 'fc',
895                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 951  Line 1000 
1000      return $self->{database};      return $self->{database};
1001  }  }
1002    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1003  ############################################################  ############################################################
1004  ############################################################  ############################################################
1005  package Observation::PDB;  package Observation::PDB;
# Line 982  Line 1025 
1025  =cut  =cut
1026    
1027  sub display{  sub display{
1028      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1029    
1030      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1031      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1032                                     -host     => $WebConfig::DBHOST,
1033                                     -user     => $WebConfig::DBUSER,
1034                                     -password => $WebConfig::DBPWD);
1035    
1036      my $acc = $self->acc;      my $acc = $self->acc;
1037    
# Line 1006  Line 1052 
1052      my $lines = [];      my $lines = [];
1053      my $line_data = [];      my $line_data = [];
1054      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1055                            'hover_title' => 'PDB',
1056                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1057                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1058    
1059      my $fig = new FIG;      #my $fig = new FIG;
1060      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1061      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1062    
# Line 1110  Line 1157 
1157    
1158    
1159  sub display_table{  sub display_table{
1160      my ($self) = @_;      my ($self,$fig) = @_;
1161    
1162      my $fig = new FIG;      #my $fig = new FIG;
1163      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1164      my $rows = $self->rows;      my $rows = $self->rows;
1165      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1123  Line 1170 
1170          my $id = $row->[0];          my $id = $row->[0];
1171          my $who = $row->[1];          my $who = $row->[1];
1172          my $assignment = $row->[2];          my $assignment = $row->[2];
1173          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1174            if ($fig->org_of($id)){
1175                $organism = $fig->org_of($id);
1176            }
1177          my $single_domain = [];          my $single_domain = [];
1178          push(@$single_domain,$who);          push(@$single_domain,$who);
1179          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1180          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1181          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1182          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1174  Line 1224 
1224    
1225  sub display_table {  sub display_table {
1226    
1227      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1228      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1229      my $rows = $self->rows;      my $rows = $self->rows;
1230      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1189  Line 1239 
1239          # construct the score link          # construct the score link
1240          my $score = $row->[0];          my $score = $row->[0];
1241          my $toid = $row->[1];          my $toid = $row->[1];
1242          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";
1243          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1244    
1245          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1246          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1243  Line 1293 
1293      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1294      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1295    
1296      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1297                                    -host     => $WebConfig::DBHOST,
1298                                    -user     => $WebConfig::DBUSER,
1299                                    -password => $WebConfig::DBPWD);
1300    
1301      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1302      if($db eq "CDD"){  
1303          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1304          if(!scalar(@$cdd_objs)){          my $new_id;
1305            if ($id =~ /_/){
1306                ($new_id) = ($id) =~ /(.*?)_/;
1307            }
1308            else{
1309                $new_id = $id;
1310            }
1311    
1312            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1313            if(!scalar(@$pfam_objs)){
1314              $name_title = "name";              $name_title = "name";
1315              $name_value = "not available";              $name_value = "not available";
1316              $description_title = "description";              $description_title = "description";
1317              $description_value = "not available";              $description_value = "not available";
1318          }          }
1319          else{          else{
1320              my $cdd_obj = $cdd_objs->[0];              my $pfam_obj = $pfam_objs->[0];
1321              $name_title = "name";              $name_title = "name";
1322              $name_value = $cdd_obj->term;              $name_value = $pfam_obj->term;
1323              $description_title = "description";              #$description_title = "description";
1324              $description_value = $cdd_obj->description;              #$description_value = $pfam_obj->description;
1325          }          }
1326      }      }
1327    
1328      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1329                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1330        my $new_short_title=$short_title;
1331        if ($short_title =~ /interpro/){
1332            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1333        }
1334        my $line_config = { 'title' => $name_value,
1335                            'hover_title', => 'Domain',
1336                            'short_title' => $new_short_title,
1337                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1338    
1339      my $name;      my $name;
1340      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1341               "value" => $name_value};      $name = {"title" => $db,
1342                 "value" => $new_id};
1343      push(@$descriptions,$name);      push(@$descriptions,$name);
1344    
1345      my $description;  #    my $description;
1346      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1347                               "value" => $description_value};  #                   "value" => $description_value};
1348      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1349    
1350      my $score;      my $score;
1351      $score = {"title" => "score",      $score = {"title" => "score",
1352                "value" => $thing->evalue};                "value" => $thing->evalue};
1353      push(@$descriptions,$score);      push(@$descriptions,$score);
1354    
1355        my $location;
1356        $location = {"title" => "location",
1357                     "value" => $thing->start . " - " . $thing->stop};
1358        push(@$descriptions,$location);
1359    
1360      my $link_id;      my $link_id;
1361      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1362          $link_id = $1;          $link_id = $1;
1363      }      }
1364    
1365      my $link;      my $link;
1366      my $link_url;      my $link_url;
1367      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"}
1368      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1369      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1370    
1371      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1298  Line 1373 
1373      push(@$links_list,$link);      push(@$links_list,$link);
1374    
1375      my $element_hash = {      my $element_hash = {
1376          "title" => $thing->type,          "title" => $name_value,
1377          "start" => $thing->start,          "start" => $thing->start,
1378          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1379          "color"=> $color,          "color"=> $color,
# Line 1319  Line 1394 
1394      my $data = [];      my $data = [];
1395      my $count = 0;      my $count = 0;
1396      my $content;      my $content;
1397        my $seen = {};
1398    
1399      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1400          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1328  Line 1404 
1404          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1405          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1406    
1407          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1408                                    -host     => $WebConfig::DBHOST,
1409                                    -user     => $WebConfig::DBUSER,
1410                                    -password => $WebConfig::DBPWD);
1411    
1412          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1413          if($db eq "CDD"){  
1414              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1415              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1416                if ($id =~ /_/){
1417                    ($new_id) = ($id) =~ /(.*?)_/;
1418                }
1419                else{
1420                    $new_id = $id;
1421                }
1422    
1423                next if ($seen->{$new_id});
1424                $seen->{$new_id}=1;
1425    
1426                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1427    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1428                if(!scalar(@$pfam_objs)){
1429                  $name_title = "name";                  $name_title = "name";
1430                  $name_value = "not available";                  $name_value = "not available";
1431                  $description_title = "description";                  $description_title = "description";
1432                  $description_value = "not available";                  $description_value = "not available";
1433              }              }
1434              else{              else{
1435                  my $cdd_obj = $cdd_objs->[0];                  my $pfam_obj = $pfam_objs->[0];
1436                  $name_title = "name";                  $name_title = "name";
1437                  $name_value = $cdd_obj->term;                  $name_value = $pfam_obj->term;
1438                  $description_title = "description";                  #$description_title = "description";
1439                  $description_value = $cdd_obj->description;                  #$description_value = $pfam_obj->description;
1440              }              }
1441          }          }
1442    
1443          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1444    
1445          push(@$single_domain,$db);          push(@$single_domain,$db);
1446          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1447          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1448          push(@$single_domain,$location);          push(@$single_domain,$location);
1449          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 1406  Line 1498 
1498  }  }
1499    
1500  sub display {  sub display {
1501      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1502    
1503      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1504      my $fig= new FIG;      #my $fig= new FIG;
1505      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1506    
1507      my $cleavage_prob;      my $cleavage_prob;
# Line 1429  Line 1521 
1521      #color is      #color is
1522      my $color = "6";      my $color = "6";
1523    
 =pod=  
   
     if($cello_location){  
         my $cello_descriptions = [];  
         my $line_data =[];  
   
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'CELLO',  
                             'basepair_offset' => '1' };  
   
         my $description_cello_location = {"title" => 'Best Cello Location',  
                                           "value" => $cello_location};  
   
         push(@$cello_descriptions,$description_cello_location);  
   
         my $description_cello_score = {"title" => 'Cello Score',  
                                        "value" => $cello_score};  
   
         push(@$cello_descriptions,$description_cello_score);  
   
         my $element_hash = {  
             "title" => "CELLO",  
             "color"=> $color,  
             "start" => "1",  
             "end" =>  $length + 1,  
             "zlayer" => '1',  
             "description" => $cello_descriptions};  
   
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
   
     $color = "2";  
     if($tmpred_score){  
         my $line_data =[];  
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'Transmembrane',  
                             'basepair_offset' => '1' };  
   
         foreach my $tmpred (@tmpred_locations){  
             my $descriptions = [];  
             my ($begin,$end) =split("-",$tmpred);  
             my $description_tmpred_score = {"title" => 'TMPRED score',  
                              "value" => $tmpred_score};  
   
             push(@$descriptions,$description_tmpred_score);  
1524    
             my $element_hash = {  
             "title" => "transmembrane location",  
             "start" => $begin + 1,  
             "end" =>  $end + 1,  
             "color"=> $color,  
             "zlayer" => '5',  
             "type" => 'box',  
             "description" => $descriptions};  
1525    
1526              push(@$line_data,$element_hash);  #    if($cello_location){
1527    #       my $cello_descriptions = [];
1528    #       my $line_data =[];
1529    #
1530    #       my $line_config = { 'title' => 'Localization Evidence',
1531    #                           'short_title' => 'CELLO',
1532    #                            'hover_title' => 'Localization',
1533    #                           'basepair_offset' => '1' };
1534    #
1535    #       my $description_cello_location = {"title" => 'Best Cello Location',
1536    #                                         "value" => $cello_location};
1537    #
1538    #       push(@$cello_descriptions,$description_cello_location);
1539    #
1540    #       my $description_cello_score = {"title" => 'Cello Score',
1541    #                                      "value" => $cello_score};
1542    #
1543    #       push(@$cello_descriptions,$description_cello_score);
1544    #
1545    #       my $element_hash = {
1546    #           "title" => "CELLO",
1547    #           "color"=> $color,
1548    #           "start" => "1",
1549    #           "end" =>  $length + 1,
1550    #           "zlayer" => '1',
1551    #           "description" => $cello_descriptions};
1552    #
1553    #       push(@$line_data,$element_hash);
1554    #       $gd->add_line($line_data, $line_config);
1555    #    }
1556    #
1557    #    $color = "2";
1558    #    if($tmpred_score){
1559    #       my $line_data =[];
1560    #       my $line_config = { 'title' => 'Localization Evidence',
1561    #                           'short_title' => 'Transmembrane',
1562    #                           'basepair_offset' => '1' };
1563    #
1564    #       foreach my $tmpred (@tmpred_locations){
1565    #           my $descriptions = [];
1566    #           my ($begin,$end) =split("-",$tmpred);
1567    #           my $description_tmpred_score = {"title" => 'TMPRED score',
1568    #                            "value" => $tmpred_score};
1569    #
1570    #           push(@$descriptions,$description_tmpred_score);
1571    #
1572    #           my $element_hash = {
1573    #           "title" => "transmembrane location",
1574    #           "start" => $begin + 1,
1575    #           "end" =>  $end + 1,
1576    #           "color"=> $color,
1577    #           "zlayer" => '5',
1578    #           "type" => 'box',
1579    #           "description" => $descriptions};
1580    #
1581    #           push(@$line_data,$element_hash);
1582    #
1583    #       }
1584    #       $gd->add_line($line_data, $line_config);
1585    #    }
1586    
         }  
         $gd->add_line($line_data, $line_config);  
     }  
 =cut  
1587    
1588      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1589          my $line_data =[];          my $line_data =[];
1590          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1591                              'short_title' => 'TM and SP',                              'short_title' => 'TM and SP',
1592                                'hover_title' => 'Localization',
1593                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1594    
1595          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
# Line 1541  Line 1635 
1635          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1636      }      }
1637    
 =head3  
     $color = "1";  
     if($signal_peptide_score){  
         my $line_data = [];  
         my $descriptions = [];  
   
         my $line_config = { 'title' => 'Localization Evidence',  
                             'short_title' => 'SignalP',  
                             'basepair_offset' => '1' };  
   
         my $description_signal_peptide_score = {"title" => 'signal peptide score',  
                                                 "value" => $signal_peptide_score};  
1638    
1639          push(@$descriptions,$description_signal_peptide_score);  #    $color = "1";
1640    #    if($signal_peptide_score){
1641          my $description_cleavage_prob = {"title" => 'cleavage site probability',  #       my $line_data = [];
1642                                           "value" => $cleavage_prob};  #       my $descriptions = [];
1643    #
1644          push(@$descriptions,$description_cleavage_prob);  #       my $line_config = { 'title' => 'Localization Evidence',
1645    #                           'short_title' => 'SignalP',
1646          my $element_hash = {  #                            'hover_title' => 'Localization',
1647              "title" => "SignalP",  #                           'basepair_offset' => '1' };
1648              "start" => $cleavage_loc_begin - 2,  #
1649              "end" =>  $cleavage_loc_end + 1,  #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1650              "type" => 'bigbox',  #                                               "value" => $signal_peptide_score};
1651              "color"=> $color,  #
1652              "zlayer" => '10',  #       push(@$descriptions,$description_signal_peptide_score);
1653              "description" => $descriptions};  #
1654    #       my $description_cleavage_prob = {"title" => 'cleavage site probability',
1655    #                                        "value" => $cleavage_prob};
1656    #
1657    #       push(@$descriptions,$description_cleavage_prob);
1658    #
1659    #       my $element_hash = {
1660    #           "title" => "SignalP",
1661    #           "start" => $cleavage_loc_begin - 2,
1662    #           "end" =>  $cleavage_loc_end + 1,
1663    #           "type" => 'bigbox',
1664    #           "color"=> $color,
1665    #           "zlayer" => '10',
1666    #           "description" => $descriptions};
1667    #
1668    #       push(@$line_data,$element_hash);
1669    #       $gd->add_line($line_data, $line_config);
1670    #    }
1671    
         push(@$line_data,$element_hash);  
         $gd->add_line($line_data, $line_config);  
     }  
 =cut  
1672    
1673      return ($gd);      return ($gd);
1674    
# Line 1669  Line 1764 
1764  =cut  =cut
1765    
1766  sub display {  sub display {
1767      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
     my $query = $self->query;  
1768    
1769      my $organism = $self->organism;      # declare variables
1770        my $window_size = $gd->window_size;
1771        my $peg = $thing->acc;
1772        my $query_id = $thing->query;
1773        my $organism = $thing->organism;
1774        my $abbrev_name = $fig->abbrev($organism);
1775        if (!$organism){
1776          $organism = $peg;
1777          $abbrev_name = $peg;
1778        }
1779      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1780      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1781      my $function = $self->function;      my $function = $thing->function;
1782      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1783      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1784      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1785      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1786      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1787        my $ln_hit = $thing->hlength;
1788    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1789    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1790        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1791        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1792    
1793      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1794    
1795        # hit sequence title
1796      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1797                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1798                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1799                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1800                            'no_middle_line' => '1'
1801                          };                          };
1802    
1803        # query sequence title
1804        my $replace_id = $peg;
1805        $replace_id =~ s/\|/_/ig;
1806        my $anchor_name = "anchor_". $replace_id;
1807        my $query_config = { 'title' => "Query",
1808                             'short_title' => "Query",
1809                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1810                             'basepair_offset' => '0',
1811                             'no_middle_line' => '1'
1812                             };
1813      my $line_data = [];      my $line_data = [];
1814        my $query_data = [];
1815    
1816      my $element_hash;      my $element_hash;
1817      my $links_list = [];      my $hit_links_list = [];
1818      my $descriptions = [];      my $hit_descriptions = [];
1819        my $query_descriptions = [];
1820      # get subsystem information  
1821      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1822        # evidence link
1823      my $link;      my $evidence_link;
1824      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1825               "link" => $url_link};        $evidence_link = "?page=Annotation&feature=".$peg;
1826      push(@$links_list,$link);      }
1827        else{
1828          my $db = &Observation::get_database($peg);
1829          my ($link_id) = ($peg) =~ /\|(.*)/;
1830          $evidence_link = &HTML::alias_url($link_id, $db);
1831          #print STDERR "LINK: $db    $evidence_link";
1832        }
1833        my $link = {"link_title" => $peg,
1834                    "link" => $evidence_link};
1835        push(@$hit_links_list,$link) if ($evidence_link);
1836    
1837      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1838      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1839          my $link;      my @subsystems;
1840          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1841            my $subsystem = $$array[0];
1842            push(@subsystems,$subsystem);
1843            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1844                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1845          push(@$links_list,$link);          push(@$hit_links_list,$link);
1846      }      }
1847    
1848      $link = {"link_title" => "blast against query",      # blast alignment
1849               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=tool_result&tool=bl2seq&peg1=$query&peg2=$peg"};      $link = {"link_title" => "view blast alignment",
1850      push (@$links_list,$link);               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1851        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1852    
1853        # description data
1854      my $description_function;      my $description_function;
1855      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1856                               "value" => $function};                               "value" => $function};
1857      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1858    
1859      my ($description_ss, $ss_string);      # subsystem description
1860      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1861      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1862        my $description_ss = {"title" => "subsystems",
1863                         "value" => $ss_string};                         "value" => $ss_string};
1864      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1865    
1866        # location description
1867        # hit
1868      my $description_loc;      my $description_loc;
1869      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1870                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1871      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1872    
1873      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1874                          "value" => $hit_stop};                          "value" => $ln_hit};
1875      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1876    
1877        # query
1878        $description_loc = {"title" => "Hit Location",
1879                            "value" => $query_start . " - " . $query_stop};
1880        push(@$query_descriptions, $description_loc);
1881    
1882      my $evalue = $self->evalue;      $description_loc = {"title" => "Sequence Length",
1883                            "value" => $ln_query};
1884        push(@$query_descriptions, $description_loc);
1885    
1886    
1887    
1888        # evalue score description
1889        my $evalue = $thing->evalue;
1890      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1891      {      {
1892          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1748  Line 1895 
1895      }      }
1896    
1897      my $color = &color($evalue);      my $color = &color($evalue);
   
1898      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1899                              "value" => $evalue};                              "value" => $evalue};
1900      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1901        push(@$query_descriptions, $description_eval);
1902    
1903      my $identity = $self->identity;      my $identity = $self->identity;
1904      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1905                                  "value" => $identity};                                  "value" => $identity};
1906      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1907        push(@$query_descriptions, $description_identity);
1908    
1909    
1910        my $number = $base_start + ($query_start-$hit_start);
1911        #print STDERR "START: $number";
1912        $element_hash = {
1913            "title" => $query_id,
1914            "start" => $base_start,
1915            "end" => $base_start+$ln_query,
1916            "type"=> 'box',
1917            "color"=> $color,
1918            "zlayer" => "2",
1919            "links_list" => $query_links_list,
1920            "description" => $query_descriptions
1921            };
1922        push(@$query_data,$element_hash);
1923    
1924        $element_hash = {
1925            "title" => $query_id . ': HIT AREA',
1926            "start" => $base_start + $query_start,
1927            "end" =>  $base_start + $query_stop,
1928            "type"=> 'smallbox',
1929            "color"=> $query_color,
1930            "zlayer" => "3",
1931            "links_list" => $query_links_list,
1932            "description" => $query_descriptions
1933            };
1934        push(@$query_data,$element_hash);
1935    
1936        $gd->add_line($query_data, $query_config);
1937    
1938    
1939      $element_hash = {      $element_hash = {
1940          "title" => $peg,          "title" => $peg,
1941          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1942          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1943          "type"=> 'box',          "type"=> 'box',
1944          "color"=> $color,          "color"=> $color,
1945          "zlayer" => "2",          "zlayer" => "2",
1946          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1947          "description" => $descriptions                  "description" => $hit_descriptions
1948                    };
1949        push(@$line_data,$element_hash);
1950    
1951        $element_hash = {
1952            "title" => $peg . ': HIT AREA',
1953            "start" => $base_start + $query_start,
1954            "end" =>  $base_start + $query_stop,
1955            "type"=> 'smallbox',
1956            "color"=> $hit_color,
1957            "zlayer" => "3",
1958            "links_list" => $hit_links_list,
1959            "description" => $hit_descriptions
1960          };          };
1961      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1962    
1963      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1964    
1965      return ($gd);      my $breaker = [];
1966        my $breaker_hash = {};
1967        my $breaker_config = { 'no_middle_line' => "1" };
1968    
1969        push (@$breaker, $breaker_hash);
1970        $gd->add_line($breaker, $breaker_config);
1971    
1972        return ($gd);
1973  }  }
1974    
1975  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1782  Line 1979 
1979  =cut  =cut
1980    
1981  sub display_domain_composition {  sub display_domain_composition {
1982      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1983    
1984      my $fig = new FIG;      #$fig = new FIG;
1985      my $peg = $self->acc;      my $peg = $self->acc;
1986    
1987      my $line_data = [];      my $line_data = [];
# Line 1792  Line 1989 
1989      my $descriptions = [];      my $descriptions = [];
1990    
1991      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1992        #my @domain_query_results = ();
1993      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1994          my $key = @$dqr[1];          my $key = @$dqr[1];
1995          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1817  Line 2014 
2014              }              }
2015          }          }
2016    
2017          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2018                                    -host     => $WebConfig::DBHOST,
2019                                    -user     => $WebConfig::DBUSER,
2020                                    -password => $WebConfig::DBPWD);
2021          my ($name_value,$description_value);          my ($name_value,$description_value);
2022    
2023          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1854  Line 2054 
2054          my $link;          my $link;
2055          my $link_url;          my $link_url;
2056          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"}          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"}
2057          elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}          elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2058          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2059    
2060          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1878  Line 2078 
2078      }      }
2079    
2080      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2081                            'hover_title' => 'Domain',
2082                          'short_title' => $peg,                          'short_title' => $peg,
2083                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2084    
# Line 1897  Line 2098 
2098  =cut  =cut
2099    
2100  sub display_table {  sub display_table {
2101      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2102        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2103    
2104      my $data = [];      my $scroll_list;
2105      my $count = 0;      foreach my $col (@$show_columns){
2106      my $content;          push (@$scroll_list, $col->{key});
2107      my $fig = new FIG;      }
2108      my $cgi = new CGI;  
2109      my @ids;      push (@ids, $query_fid);
2110      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2111          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2112          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2113      }      }
2114    
2115      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2116        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2117    
2118      # get the column for the subsystems      # get the column for the subsystems
2119      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2120    
2121      # get the column for the evidence codes      # get the column for the evidence codes
2122      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2123    
2124      # get the column for pfam_domain      # get the column for pfam_domain
2125      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2126    
2127      my %e_identical = &get_essentially_identical($query_fid);      # get the column for molecular weight
2128      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2129    
2130      foreach my $thing (@$dataset) {      # get the column for organism's habitat
2131          next if ($thing->class ne "SIM");      my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
         my $single_domain = [];  
         $count++;  
2132    
2133          my $id = $thing->acc;      # get the column for organism's temperature optimum
2134        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2135    
2136          my $iden    = $thing->identity;      # get the column for organism's temperature range
2137          my $ln1     = $thing->qlength;      my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
         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>)";  
2138    
2139          # checkbox column      # get the column for organism's oxygen requirement
2140          my $field_name = "tables_" . $id;      my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
         my $pair_name = "visual_" . $id;  
         my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);  
         my ($tax) = ($id) =~ /fig\|(.*?)\./;  
2141    
2142          # get the linked fig id      # get the column for organism's pathogenicity
2143          my $fig_col;      my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
         if (defined ($e_identical{$id})){  
             $fig_col = &HTML::set_prot_links($cgi,$id) . "*";  
         }  
         else{  
             $fig_col = &HTML::set_prot_links($cgi,$id);  
         }  
   
         push(@$single_domain,$box_col);                        # permanent column  
         push(@$single_domain,$fig_col);                        # permanent column  
         push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
         foreach my $col (sort keys %$scroll_list){  
             if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}  
             elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}  
             elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
             elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}  
             elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}  
             elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}  
             elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}  
             elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}  
             elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}  
             elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}  
             elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}  
             elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}  
             elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}  
             elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}  
         }  
         push(@$data,$single_domain);  
     }  
2144    
2145      if ($count >0 ){      # get the column for organism's pathogenicity host
2146          $content = $data;      my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
     }  
     else{  
         $content = "<p>This PEG does not have any similarities</p>";  
     }  
     return ($content);  
 }  
2147    
2148  sub get_box_column{      # get the column for organism's salinity
2149      my ($ids) = @_;      my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
     my %column;  
     foreach my $id (@$ids){  
         my $field_name = "tables_" . $id;  
         my $pair_name = "visual_" . $id;  
         $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);  
     }  
     return (%column);  
 }  
2150    
2151  sub get_subsystems_column{      # get the column for organism's motility
2152        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2153    
2154        # get the column for organism's gram stain
2155        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2156    
2157        # get the column for organism's endospores
2158        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2159    
2160        # get the column for organism's shape
2161        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2162    
2163        # get the column for organism's disease
2164        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2165    
2166        # get the column for organism's disease
2167        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2168    
2169        # get the column for transmembrane domains
2170        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2171    
2172        # get the column for similar to human
2173        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);
2174    
2175        # get the column for signal peptide
2176        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2177    
2178        # get the column for transmembrane domains
2179        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2180    
2181        # get the column for conserved neighborhood
2182        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2183    
2184        # get the column for cellular location
2185        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2186    
2187        # get the aliases
2188        my $alias_col;
2189        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2190             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2191             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2192             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2193             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2194            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2195        }
2196    
2197        # get the colors for the function cell
2198        my $functions = $fig->function_of_bulk(\@ids,1);
2199        $functional_color = &get_function_color_cell($functions, $fig);
2200        my $query_function = $fig->function_of($query_fid);
2201    
2202        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2203    
2204        my $figfam_data = &FIG::get_figfams_data();
2205        my $figfams = new FFs($figfam_data);
2206        my $same_genome_flag = 0;
2207    
2208        my $func_color_offset=0;
2209        unshift(@$dataset, $query_fid);
2210        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2211    #    foreach my $thing ( @$dataset){
2212            my $thing = $dataset->[$thing_count];
2213            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2214            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2215            if ($thing eq $query_fid){
2216                $id = $thing;
2217                $taxid   = $fig->genome_of($id);
2218                $organism = $fig->genus_species($taxid);
2219                $current_function = $fig->function_of($id);
2220            }
2221            else{
2222                next if ($thing->class ne "SIM");
2223    
2224                $id      = $thing->acc;
2225                $evalue  = $thing->evalue;
2226                $taxid   = $fig->genome_of($id);
2227                $iden    = $thing->identity;
2228                $organism= $thing->organism;
2229                $ln1     = $thing->qlength;
2230                $ln2     = $thing->hlength;
2231                $b1      = $thing->qstart;
2232                $e1      = $thing->qstop;
2233                $b2      = $thing->hstart;
2234                $e2      = $thing->hstop;
2235                $d1      = abs($e1 - $b1) + 1;
2236                $d2      = abs($e2 - $b2) + 1;
2237                $color1  = match_color( $b1, $e1, $ln1 );
2238                $color2  = match_color( $b2, $e2, $ln2 );
2239                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2240                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2241                $current_function = $thing->function;
2242                $next_org = $next_thing->organism if (defined $next_thing);
2243            }
2244    
2245            my $single_domain = [];
2246            $count++;
2247    
2248            # organisms cell
2249            my ($org, $org_color) = $fig->org_and_color_of($id);
2250    
2251            my $org_cell;
2252            if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2253                $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2254            }
2255            elsif ($next_org eq $organism){
2256                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2257                $same_genome_flag = 1;
2258            }
2259            elsif ($same_genome_flag == 1){
2260                $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2261                $same_genome_flag = 0;
2262            }
2263    
2264            # checkbox cell
2265            my ($box_cell,$tax, $radio_cell);
2266            my $field_name = "tables_" . $id;
2267            my $pair_name = "visual_" . $id;
2268            my $cell_name = "cell_". $id;
2269            my $replace_id = $id;
2270            $replace_id =~ s/\|/_/ig;
2271            my $white = '#ffffff';
2272            $white = '#999966' if ($id eq $query_fid);
2273            $org_color = '#999966' if ($id eq $query_fid);
2274            my $anchor_name = "anchor_". $replace_id;
2275            my $checked = "";
2276            #$checked = "checked" if ($id eq $query_fid);
2277            if ($id =~ /^fig\|/){
2278              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>~;
2279              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2280              $tax = $fig->genome_of($id);
2281            }
2282            else{
2283              my $box = qq(<a name="$anchor_name"></a>);
2284              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2285            }
2286    
2287            # create the radio cell for any sequence, not just fig ids
2288            my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2289            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2290    
2291            # get the linked fig id
2292            my $anchor_link = "graph_" . $replace_id;
2293            my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2294            $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>);
2295            my $fig_col = {'data'=> $fig_data,
2296                           'highlight'=>$white};
2297    
2298            $replace_id = $peg;
2299            $replace_id =~ s/\|/_/ig;
2300            $anchor_name = "anchor_". $replace_id;
2301            my $query_config = { 'title' => "Query",
2302                                 'short_title' => "Query",
2303                                 'title_link' => "changeSimsLocation('$replace_id')",
2304                                 'basepair_offset' => '0'
2305                                 };
2306    
2307            # function cell
2308            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2309                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2310                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2311    
2312            my $function_color;
2313            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2314                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2315            }
2316            else{
2317                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2318            }
2319            my $function_cell;
2320            if ($current_function){
2321              if ($current_function eq $query_function){
2322                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2323                $func_color_offset=1;
2324              }
2325              else{
2326                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2327              }
2328            }
2329            else{
2330              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2331            }
2332    
2333            if ($id eq $query_fid){
2334                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2335                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2336                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white},
2337                      {'data'=>$subsystems_column->{$id},'highlight'=>$white},
2338                      {'data'=>$evidence_column->{$id},'highlight'=>$white});  # permanent columns
2339            }
2340            else{
2341                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2342                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell,
2343                      {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"},
2344                      {'data'=>$evidence_column->{$id},'highlight'=>"#ffffff"});  # permanent columns
2345    
2346            }
2347    
2348            if ( ( $application->session->user) ){
2349                my $user = $application->session->user;
2350                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2351                    push (@$single_domain,$radio_cell);
2352                }
2353            }
2354    
2355            my ($ff) = $figfams->families_containing_peg($id);
2356    
2357            foreach my $col (@$scroll_list){
2358                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2359                else { $highlight_color = "#ffffff"; }
2360    
2361                if ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2362                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2363                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2364                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2393            }
2394            push(@$data,$single_domain);
2395        }
2396        if ($count >0 ){
2397            $content = $data;
2398        }
2399        else{
2400            $content = "<p>This PEG does not have any similarities</p>";
2401        }
2402        shift(@$dataset);
2403        return ($content);
2404    }
2405    
2406    
2407    =head3 display_figfam_table()
2408    
2409    If available use the function specified here to display the "raw" observation.
2410    This code will display a table for the similarities protein
2411    
2412    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.
2413    
2414    =cut
2415    
2416    sub display_figfam_table {
2417      my ($self,$ids, $show_columns, $fig, $application, $cgi) = @_;
2418      my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2419    
2420      my $scroll_list;
2421      foreach my $col (@$show_columns){
2422        push (@$scroll_list, $col->{key});
2423      }
2424    
2425      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2426      my @attributes = $fig->get_attributes($ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2427    
2428      # get the column for the subsystems
2429      $subsystems_column = &get_subsystems_column($ids,$fig,$cgi,'hash');
2430    
2431      # get the column for the evidence codes
2432      $evidence_column = &get_evidence_column($ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2433    
2434      # get the column for pfam_domain
2435      $pfam_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2436    
2437      # get the column for molecular weight
2438      $mw_column = &get_attrb_column($ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2439    
2440      # get the column for organism's habitat
2441      my $habitat_column = &get_attrb_column($ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2442    
2443      # get the column for organism's temperature optimum
2444      my $temperature_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2445    
2446      # get the column for organism's temperature range
2447      my $temperature_range_column = &get_attrb_column($ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2448    
2449      # get the column for organism's oxygen requirement
2450      my $oxygen_req_column = &get_attrb_column($ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2451    
2452      # get the column for organism's pathogenicity
2453      my $pathogenic_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2454    
2455      # get the column for organism's pathogenicity host
2456      my $pathogenic_in_column = &get_attrb_column($ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2457    
2458      # get the column for organism's salinity
2459      my $salinity_column = &get_attrb_column($ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2460    
2461      # get the column for organism's motility
2462      my $motility_column = &get_attrb_column($ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2463    
2464      # get the column for organism's gram stain
2465      my $gram_stain_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2466    
2467      # get the column for organism's endospores
2468      my $endospores_column = &get_attrb_column($ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2469    
2470      # get the column for organism's shape
2471      my $shape_column = &get_attrb_column($ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2472    
2473      # get the column for organism's disease
2474      my $disease_column = &get_attrb_column($ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2475    
2476      # get the column for organism's disease
2477      my $gc_content_column = &get_attrb_column($ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2478    
2479      # get the column for transmembrane domains
2480      my $transmembrane_column = &get_attrb_column($ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2481    
2482      # get the column for similar to human
2483      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);
2484    
2485      # get the column for signal peptide
2486      my $signal_peptide_column = &get_attrb_column($ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2487    
2488      # get the column for transmembrane domains
2489      my $isoelectric_column = &get_attrb_column($ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2490    
2491      # get the column for conserved neighborhood
2492      my $cons_neigh_column = &get_attrb_column($ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2493    
2494      # get the column for cellular location
2495      my $cell_location_column = &get_attrb_column($ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2496    
2497      # get the aliases
2498      my $alias_col;
2499      if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2500           (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2501           (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2502           (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2503           (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2504        $alias_col = &get_db_aliases($ids,$fig,'all',$cgi,'hash');
2505      }
2506    
2507      foreach my $id ( @$ids){
2508        my $current_function = $fig->function_of($id);
2509        my $organism = $fig->org_of($id);
2510        my $single_domain = [];
2511    
2512        # organisms cell
2513        my ($org, $org_color) = $fig->org_and_color_of($id);
2514        my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2515    
2516        # get the linked fig id
2517        my $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2518        my $fig_col = {'data'=> $fig_data,
2519                       'highlight'=>"#ffffff"};
2520    
2521        # function cell
2522        $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2523    
2524        # insert data
2525        push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2526    
2527        foreach my $col (@$scroll_list){
2528          my $highlight_color = "#ffffff";
2529    
2530          if ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2531          elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2532          elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2533          elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2534          elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2535          elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2536          elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2537          elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2538          elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2539          elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2540          elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2541          elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2542          elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2543          elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2544          elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2545          elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2546          elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2547          elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2548          elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2549          elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2550          elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2551          elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2552          elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2553          elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2554          elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2555          elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2556          elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2557          elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2558          elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2559          elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2560          elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2561          elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2562          elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2563        }
2564        push(@$data,$single_domain);
2565      }
2566    
2567      $content = $data;
2568      return ($content);
2569    }
2570    
2571    sub get_box_column{
2572      my ($ids) = @_;      my ($ids) = @_;
2573        my %column;
2574        foreach my $id (@$ids){
2575            my $field_name = "tables_" . $id;
2576            my $pair_name = "visual_" . $id;
2577            my $cell_name = "cell_" . $id;
2578            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2579        }
2580        return (%column);
2581    }
2582    
2583    sub get_figfam_column{
2584        my ($ids, $fig, $cgi) = @_;
2585        my $column;
2586    
2587        my $figfam_data = &FIG::get_figfams_data();
2588        my $figfams = new FFs($figfam_data);
2589    
2590        foreach my $id (@$ids){
2591            my ($ff);
2592            if ($id =~ /\.peg\./){
2593                ($ff) =  $figfams->families_containing_peg($id);
2594            }
2595            if ($ff){
2596                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2597            }
2598            else{
2599                push (@$column, " ");
2600            }
2601        }
2602    
2603        return $column;
2604    }
2605    
2606    sub get_subsystems_column{
2607        my ($ids,$fig,$cgi,$returnType) = @_;
2608    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2609      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2610      my %column;      my ($column, $ss);
2611      foreach my $id (@$ids){      foreach my $id (@$ids){
2612          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2613          my @subsystems;          my @subsystems;
2614    
2615          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2616              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2617                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2618                  $count++;                  $ss =~ s/_/ /ig;
2619                    push (@subsystems, "-" . $ss);
2620              }              }
2621              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2622              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2623          } else {          } else {
2624              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2625          }          }
2626            push (@$column, $ss->{$id});
2627        }
2628    
2629        if ($returnType eq 'hash') { return $ss; }
2630        elsif ($returnType eq 'array') { return $column; }
2631    }
2632    
2633    sub get_lineage_column{
2634        my ($ids, $fig, $cgi) = @_;
2635    
2636        my $lineages = $fig->taxonomy_list();
2637    
2638        foreach my $id (@$ids){
2639            my $genome = $fig->genome_of($id);
2640            if ($lineages->{$genome}){
2641    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2642                push (@$column, $lineages->{$genome});
2643            }
2644            else{
2645                push (@$column, " ");
2646      }      }
2647      return (%column);      }
2648        return $column;
2649    }
2650    
2651    sub match_color {
2652        my ( $b, $e, $n , $rgb) = @_;
2653        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2654        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2655        my $cov = ( $r - $l + 1 ) / $n;
2656        my $sat = 1 - 10 * $cov / 9;
2657        my $br  = 1;
2658        if ($rgb){
2659            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2660        }
2661        else{
2662            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2663        }
2664    }
2665    
2666    sub hsb2rgb {
2667        my ( $h, $s, $br ) = @_;
2668        $h = 6 * ($h - floor($h));
2669        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2670        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2671        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2672                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2673                                          :               ( 0,      1,      $h - 2 )
2674                                          )
2675                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2676                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2677                                          :               ( 1,      0,      6 - $h )
2678                                          );
2679        ( ( $r * $s + 1 - $s ) * $br,
2680          ( $g * $s + 1 - $s ) * $br,
2681          ( $b * $s + 1 - $s ) * $br
2682        )
2683    }
2684    
2685    sub html2rgb {
2686        my ($hex) = @_;
2687        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2688        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2689                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2690    
2691        my @R = split(//, $r);
2692        my @G = split(//, $g);
2693        my @B = split(//, $b);
2694    
2695        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2696        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2697        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2698    
2699        my $rgb = [$red, $green, $blue];
2700        return $rgb;
2701    
2702    }
2703    
2704    sub rgb2html {
2705        my ( $r, $g, $b ) = @_;
2706        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2707        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2708        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2709        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2710    }
2711    
2712    sub floor {
2713        my $x = $_[0];
2714        defined( $x ) || return undef;
2715        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2716    }
2717    
2718    sub get_function_color_cell{
2719      my ($functions, $fig) = @_;
2720    
2721      # figure out the quantity of each function
2722      my %hash;
2723      foreach my $key (keys %$functions){
2724        my $func = $functions->{$key};
2725        $hash{$func}++;
2726      }
2727    
2728      my %func_colors;
2729      my $count = 1;
2730      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2731        $func_colors{$key}=$count;
2732        $count++;
2733      }
2734    
2735      return \%func_colors;
2736  }  }
2737    
2738  sub get_essentially_identical{  sub get_essentially_identical{
2739      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2740      my $fig = new FIG;      #my $fig = new FIG;
2741    
2742      my %id_list;      my %id_list;
2743      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);
2744    
2745      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2746            if($thing->class eq "IDENTICAL"){
2747                my $rows = $thing->rows;
2748                my $count_identical = 0;
2749                foreach my $row (@$rows) {
2750                    my $id = $row->[0];
2751          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2752              $id_list{$id} = 1;              $id_list{$id} = 1;
2753          }          }
2754      }      }
2755            }
2756        }
2757    
2758    #    foreach my $id (@maps_to) {
2759    #        if (($id ne $fid) && ($fig->function_of($id))) {
2760    #           $id_list{$id} = 1;
2761    #        }
2762    #    }
2763      return(%id_list);      return(%id_list);
2764  }  }
2765    
2766    
2767  sub get_evidence_column{  sub get_evidence_column{
2768      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2769      my $fig = new FIG;      my ($column, $code_attributes);
2770      my $cgi = new CGI;  
2771      my (%column, %code_attributes);      if (! defined $attributes) {
2772            my @attributes_array = $fig->get_attributes($ids);
2773            $attributes = \@attributes_array;
2774        }
2775    
2776      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2777      foreach my $key (@codes){      foreach my $key (@codes){
2778          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2779      }      }
2780    
2781      foreach my $id (@$ids){      foreach my $id (@$ids){
2782          # add evidence code with tool tip          # add evidence code with tool tip
2783          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2784    
2785          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2786              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2787              foreach my $code (@codes) {              foreach my $code (@codes) {
2788                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2789                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
2790                      my ($cd, $ss) = split(";", $code->[2]);                      my ($cd, $ss) = split(";", $code->[2]);
2791                    if ($cd =~ /ilit|dlit/){
2792                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2793                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2794                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2795                    }
2796                      $ss =~ s/_/ /g;                      $ss =~ s/_/ /g;
2797                      $pretty_code = $cd;# . " in " . $ss;                      $pretty_code = $cd;# . " in " . $ss;
2798                  }                  }
2799                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2800              }              }
         }  
2801    
2802          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2803              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 2084  Line 2805 
2805                                  {                                  {
2806                                      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));
2807          }          }
2808          $column{$id}=$ev_codes;  
2809            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2810            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2811      }      }
2812      return (%column);      return $column;
2813  }  }
2814    
2815  sub get_pfam_column{  sub get_attrb_column{
2816      my ($ids) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2817      my $fig = new FIG;  
2818      my $cgi = new CGI;      my ($column, %code_attributes, %attribute_locations);
2819      my (%column, %code_attributes, %attribute_locations);      my $dbmaster = DBMaster->new(-database =>'Ontology',
2820      my $dbmaster = DBMaster->new(-database =>'Ontology');                                   -host     => $WebConfig::DBHOST,
2821                                     -user     => $WebConfig::DBUSER,
2822                                     -password => $WebConfig::DBPWD);
2823    
2824      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      if ($colName eq "pfam"){
2825            if (! defined $attributes) {
2826                my @attributes_array = $fig->get_attributes($ids);
2827                $attributes = \@attributes_array;
2828            }
2829    
2830            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2831      foreach my $key (@codes){      foreach my $key (@codes){
2832          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2833          push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);              if ($name =~ /_/){
2834                    ($name) = ($key->[1]) =~ /(.*?)_/;
2835                }
2836                push (@{$code_attributes{$key->[0]}}, $name);
2837                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2838      }      }
2839    
2840      foreach my $id (@$ids){      foreach my $id (@$ids){
2841          # add evidence code with tool tip              # add pfam code
2842          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2843          my @pfam_codes = "";          my @pfam_codes = "";
2844          my %description_codes;          my %description_codes;
# Line 2119  Line 2854 
2854    
2855              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2856                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2857                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
   
                 # get the locations for the domain  
                 my @locs;  
                 foreach my $part (@{$attribute_location{$id}{$code}}){  
                     my ($loc) = ($part) =~ /\;(.*)/;  
                     push (@locs,$loc);  
                 }  
                 my $locations = join (", ", @locs);  
2858    
2859    #                   # get the locations for the domain
2860    #                   my @locs;
2861    #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2862    #                       my ($loc) = ($part) =~ /\;(.*)/;
2863    #                       push (@locs,$loc);
2864    #                   }
2865    #                   my %locsaw;
2866    #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2867    #                   @locs = keys %locsaw;
2868    #
2869    #                   my $locations = join (", ", @locs);
2870    #
2871                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2872                      push(@pfam_codes, "$parts[1] ($locations)");                          push(@pfam_codes, "$parts[1]");
2873                  }                  }
2874                  else {                  else {
2875                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2876                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2877                      push(@pfam_codes, "$pfam_link ($locations)");                          push(@pfam_codes, "$pfam_link");
2878                        }
2879                  }                  }
2880    
2881                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2882                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2883              }              }
2884          }          }
2885        }
2886        elsif ($colName eq 'cellular_location'){
2887            if (! defined $attributes) {
2888                my @attributes_array = $fig->get_attributes($ids);
2889                $attributes = \@attributes_array;
2890            }
2891    
2892          $column{$id}=join("<br><br>", @pfam_codes);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2893            foreach my $key (@codes){
2894                my ($loc) = ($key->[1]) =~ /::(.*)/;
2895                my ($new_loc, @all);
2896                @all = split (//, $loc);
2897                my $count = 0;
2898                foreach my $i (@all){
2899                    if ( ($i eq uc($i)) && ($count > 0) ){
2900                        $new_loc .= " " . $i;
2901                    }
2902                    else{
2903                        $new_loc .= $i;
2904                    }
2905                    $count++;
2906                }
2907                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2908      }      }
     return (%column);  
2909    
2910            foreach my $id (@$ids){
2911                my (@values, $entry);
2912                #@values = (" ");
2913                if (defined @{$code_attributes{$id}}){
2914                    my @ncodes = @{$code_attributes{$id}};
2915                    foreach my $code (@ncodes){
2916                        push (@values, $code->[0] . ", " . $code->[1]);
2917                    }
2918                }
2919                else{
2920                    @values = ("Not available");
2921  }  }
2922    
2923  sub get_prefer {              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2924      my ($fid, $db, $all_aliases) = @_;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2925      my $fig = new FIG;          }
2926      my $cgi = new CGI;      }
2927        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2928                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2929            if (! defined $attributes) {
2930                my @attributes_array = $fig->get_attributes($ids);
2931                $attributes = \@attributes_array;
2932            }
2933    
2934            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2935            foreach my $key (@codes){
2936                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2937            }
2938    
2939            foreach my $id (@$ids){
2940                my (@values, $entry);
2941                #@values = (" ");
2942                if (defined @{$code_attributes{$id}}){
2943                    my @ncodes = @{$code_attributes{$id}};
2944                    foreach my $code (@ncodes){
2945                        push (@values, $code);
2946                    }
2947                }
2948                else{
2949                    @values = ("Not available");
2950                }
2951    
2952                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2953                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2954            }
2955        }
2956        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2957                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2958                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2959                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2960                ($colName eq 'gc_content') ) {
2961            if (! defined $attributes) {
2962                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2963                $attributes = \@attributes_array;
2964            }
2965    
2966            my $genomes_with_phenotype;
2967            foreach my $attribute (@$attributes){
2968                my $genome = $attribute->[0];
2969                $genomes_with_phenotype->{$genome} = $attribute->[2];
2970            }
2971    
2972            foreach my $id (@$ids){
2973                my $genome = $fig->genome_of($id);
2974                my @values = (' ');
2975                if (defined $genomes_with_phenotype->{$genome}){
2976                    push (@values, $genomes_with_phenotype->{$genome});
2977                }
2978                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2979                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2980            }
2981        }
2982    
2983      foreach my $alias (@{$$all_aliases{$fid}}){      return $column;
2984    }
2985    
2986    sub get_aclh_aliases {
2987        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2988        my $db_array;
2989    
2990        my $id_line = join (",", @$ids);
2991        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
2992    
2993    
2994    }
2995    
2996    sub get_id_aliases {
2997        my ($id, $fig) = @_;
2998        my $aliases = {};
2999    
3000        my $org = $fig->org_of($id);
3001        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3002        if ( my $form = &LWP::Simple::get($url) ) {
3003            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3004            foreach my $line (split /\n/, $block){
3005                my @values = split /\t/, $line;
3006                next if ($values[3] eq "Expert");
3007                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3008                    $aliases->{$values[4]} = $values[0];
3009                }
3010            }
3011        }
3012    
3013        return $aliases;
3014    }
3015    
3016    sub get_db_aliases {
3017        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3018        my $db_array;
3019        my $all_aliases = $fig->feature_aliases_bulk($ids);
3020        foreach my $id (@$ids){
3021    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3022            my $id_org = $fig->org_of($id);
3023    
3024            foreach my $alias (@{$$all_aliases{$id}}){
3025    #       foreach my $alias (@all_aliases){
3026          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
3027          if ($id_db eq $db){              next if ( ($id_db ne $db) && ($db ne 'all') );
3028              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              next if ($aliases->{$id}->{$db});
3029              return ($acc_col);              my $alias_org = $fig->org_of($alias);
3030    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3031                    #push(@funcs, [$id,$id_db,$tmp]);
3032                    $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3033    #           }
3034          }          }
3035            if (!defined( $aliases->{$id}->{$db})){
3036                $aliases->{$id}->{$db} = " ";
3037      }      }
3038      return (" ");          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
3039            push (@$db_array, $aliases->{$id}->{$db});
3040  }  }
3041    
3042        if ($returnType eq 'hash') { return $aliases; }
3043        elsif ($returnType eq 'array') { return $db_array; }
3044    }
3045    
3046    
3047    
3048  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; $_ }
3049    
3050  sub color {  sub color {
3051      my ($evalue) = @_;      my ($evalue) = @_;
3052        my $palette = WebColors::get_palette('vitamins');
3053      my $color;      my $color;
3054      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
3055      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3056      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3057      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3058      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3059      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3060      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3061      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3062      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3063      else{        $color = 60;    }      else{        $color = $palette->[9];    }
3064      return ($color);      return ($color);
3065  }  }
3066    
# Line 2195  Line 3080 
3080  }  }
3081    
3082  sub display {  sub display {
3083      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
3084    
3085        $taxes = $fig->taxonomy_list();
3086    
3087      my $fid = $self->fig_id;      my $fid = $self->fig_id;
3088      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
3089      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
3090      my $fig = new FIG;      my $range = $gd_window_size;
3091      my $all_regions = [];      my $all_regions = [];
3092      my $gene_associations={};      my $gene_associations={};
3093    
# Line 2225  Line 3112 
3112      my ($region_start, $region_end);      my ($region_start, $region_end);
3113      if ($beg < $end)      if ($beg < $end)
3114      {      {
3115          $region_start = $beg - 4000;          $region_start = $beg - ($range);
3116          $region_end = $end+4000;          $region_end = $end+ ($range);
3117          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
3118      }      }
3119      else      else
3120      {      {
3121          $region_start = $end-4000;          $region_start = $end-($range);
3122          $region_end = $beg+4000;          $region_end = $beg+($range);
3123          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
3124          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
3125          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2240  Line 3127 
3127    
3128      # call genes in region      # call genes in region
3129      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);
3130        #foreach my $feat (@$target_gene_features){
3131        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
3132        #}
3133      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
3134      my (@start_array_region);      my (@start_array_region);
3135      push (@start_array_region, $offset);      push (@start_array_region, $offset);
3136    
3137      my %all_genes;      my %all_genes;
3138      my %all_genomes;      my %all_genomes;
3139      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
3140            #if ($feature =~ /peg/){
3141                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3142            #}
3143        }
3144    
3145        my @selected_sims;
3146    
3147      if ($compare_or_coupling eq "sims"){      if ($compare_or_coupling eq "sims"){
3148          # get the selected boxes          # get the selected boxes
3149          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
3150    
3151          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
3152          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
3153              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
3154                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
3155                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
3156                  my ($genome1) = ($genome) =~ /(.*)\./;  
3157                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
3158                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
3159                    #my ($genome1) = ($genome) =~ /(.*)\./;
3160                    my $lineage = $taxes->{$genome};
3161                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
3162                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
3163                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
3164                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
3165                            push (@selected_sims, $sim->acc);
3166                      }                      }
3167                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
3168              }              }
3169          }          }
3170          else{          else{
3171              my $simcount = 0;              my $simcount = 0;
3172              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
3173                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
3174                  push (@selected_sims, $sim->[1]);                  next if ($sim->acc !~ /fig\|/);
3175    
3176                    push (@selected_sims, $sim->acc);
3177                  $simcount++;                  $simcount++;
3178                  last if ($simcount > 4);                  last if ($simcount > 4);
3179              }              }
3180          }          }
3181    
3182            my %saw;
3183            @selected_sims = grep(!$saw{$_}++, @selected_sims);
3184    
3185          # get the gene context for the sorted matches          # get the gene context for the sorted matches
3186          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
3187              #get the organism genome              #get the organism genome
# Line 2304  Line 3204 
3204              my ($region_start, $region_end);              my ($region_start, $region_end);
3205              if ($beg < $end)              if ($beg < $end)
3206              {              {
3207                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
3208                  $region_end = $end+4000;                  $region_end = $end+($range/2);
3209                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3210              }              }
3211              else              else
3212              {              {
3213                  $region_start = $end-4000;                  $region_start = $end-($range/2);
3214                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
3215                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3216                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
3217                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2327  Line 3227 
3227    
3228      }      }
3229    
3230        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3231      # cluster the genes      # cluster the genes
3232      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3233      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3234        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3235        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
3236    
3237      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3238          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3239          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3240          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3241          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3242          my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3243          my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
3244            #my $lineage = $fig->taxonomy_of($region_genome);
3245          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
3246          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3247                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2370  Line 3274 
3274    
3275              # get subsystem information              # get subsystem information
3276              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3277              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3278    
3279              my $link;              my $link;
3280              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3281                       "link" => $url_link};                       "link" => $url_link};
3282              push(@$links_list,$link);              push(@$links_list,$link);
3283    
3284              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3285              foreach my $subsystem (@subsystems){              my @subsystems;
3286                foreach my $array (@subs){
3287                    my $subsystem = $$array[0];
3288                    my $ss = $subsystem;
3289                    $ss =~ s/_/ /ig;
3290                    push (@subsystems, $ss);
3291                  my $link;                  my $link;
3292                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3293                           "link_title" => $subsystem};                           "link_title" => $ss};
3294                    push(@$links_list,$link);
3295                }
3296    
3297                if ($fid1 eq $fid){
3298                    my $link;
3299                    $link = {"link_title" => "Annotate this sequence",
3300                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3301                  push(@$links_list,$link);                  push(@$links_list,$link);
3302              }              }
3303    
# Line 2415  Line 3331 
3331                  $prev_stop = $stop;                  $prev_stop = $stop;
3332                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3333    
3334                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3335                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3336                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3337                  }                  }
3338    
3339                    my $title = $fid1;
3340                    if ($fid1 eq $fid){
3341                        $title = "My query gene: $fid1";
3342                    }
3343    
3344                  $element_hash = {                  $element_hash = {
3345                      "title" => $fid1,                      "title" => $title,
3346                      "start" => $start,                      "start" => $start,
3347                      "end" =>  $stop,                      "end" =>  $stop,
3348                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2434  Line 3355 
3355                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3356                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3357                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3358    
3359                    if ($fid1 eq $fid){
3360                        $element_hash = {
3361                            "title" => 'Query',
3362                            "start" => $start,
3363                            "end" =>  $stop,
3364                            "type"=> 'bigbox',
3365                            "color"=> $color,
3366                            "zlayer" => "1"
3367                            };
3368    
3369                        # if there is an overlap, put into second line
3370                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3371                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3372                    }
3373              }              }
3374          }          }
3375          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3376          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3377      }      }
3378      return $gd;      return ($gd, \@selected_sims);
3379  }  }
3380    
3381  sub cluster_genes {  sub cluster_genes {
# Line 2509  Line 3445 
3445      }      }
3446    
3447      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3448          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3449              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3450                  foreach $y (@$x) {                  foreach $y (@$x) {
3451                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2527  Line 3463 
3463      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3464      return ($i < @$xL);      return ($i < @$xL);
3465  }  }
3466    
3467    #############################################
3468    #############################################
3469    package Observation::Commentary;
3470    
3471    use base qw(Observation);
3472    
3473    =head3 display_protein_commentary()
3474    
3475    =cut
3476    
3477    sub display_protein_commentary {
3478        my ($self,$dataset,$mypeg,$fig) = @_;
3479    
3480        my $all_rows = [];
3481        my $content;
3482        #my $fig = new FIG;
3483        my $cgi = new CGI;
3484        my $count = 0;
3485        my $peg_array = [];
3486        my ($evidence_column, $subsystems_column,  %e_identical);
3487    
3488        if (@$dataset != 1){
3489            foreach my $thing (@$dataset){
3490                if ($thing->class eq "SIM"){
3491                    push (@$peg_array, $thing->acc);
3492                }
3493            }
3494            # get the column for the evidence codes
3495            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3496    
3497            # get the column for the subsystems
3498            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3499    
3500            # get essentially identical seqs
3501            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3502        }
3503        else{
3504            push (@$peg_array, @$dataset);
3505        }
3506    
3507        my $selected_sims = [];
3508        foreach my $id (@$peg_array){
3509            last if ($count > 10);
3510            my $row_data = [];
3511            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3512            if ($fig->org_of($id)){
3513                $org = $fig->org_of($id);
3514            }
3515            else{
3516                $org = "Data not available";
3517            }
3518            $function = $fig->function_of($id);
3519            if ($mypeg ne $id){
3520                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3521                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3522                if (defined($e_identical{$id})) { $id_cell .= "*";}
3523            }
3524            else{
3525                $function_cell = "&nbsp;&nbsp;$function";
3526                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3527                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3528            }
3529    
3530            push(@$row_data,$id_cell);
3531            push(@$row_data,$org);
3532            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3533            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3534            push(@$row_data, $fig->translation_length($id));
3535            push(@$row_data,$function_cell);
3536            push(@$all_rows,$row_data);
3537            push (@$selected_sims, $id);
3538            $count++;
3539        }
3540    
3541        if ($count >0){
3542            $content = $all_rows;
3543        }
3544        else{
3545            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3546        }
3547        return ($content,$selected_sims);
3548    }
3549    
3550    sub display_protein_history {
3551        my ($self, $id,$fig) = @_;
3552        my $all_rows = [];
3553        my $content;
3554    
3555        my $cgi = new CGI;
3556        my $count = 0;
3557        foreach my $feat ($fig->feature_annotations($id)){
3558            my $row = [];
3559            my $col1 = $feat->[2];
3560            my $col2 = $feat->[1];
3561            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3562            my $text = $feat->[3];
3563    
3564            push (@$row, $col1);
3565            push (@$row, $col2);
3566            push (@$row, $text);
3567            push (@$all_rows, $row);
3568            $count++;
3569        }
3570        if ($count > 0){
3571            $content = $all_rows;
3572        }
3573        else {
3574            $content = "There is no history for this PEG";
3575        }
3576    
3577        return($content);
3578    }
3579    

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3