[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.29, Thu Aug 16 16:49:16 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;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  use strict;  use LWP::Simple;
15    #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 85  Line 89 
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92    =head3 query()
93    
94    The query id
95    
96    =cut
97    
98    sub query {
99        my ($self) = @_;
100        return $self->{query};
101    }
102    
103    
104  =head3 class()  =head3 class()
105    
106  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 304  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 319  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 333  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 359  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 434  Line 455 
455  =cut  =cut
456    
457  sub get_sims_summary {  sub get_sims_summary {
458      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
459      my %families;      my %families;
460      my @sims= $fig->nsims($fid,20000,10,"all");      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 $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
479          my $parent_tax = "Root";          my $parent_tax = "Root";
480          foreach my $tax (split(/\; /, $taxonomy)){          my @currLineage = ($parent_tax);
481              push (@{$families{children}{$parent_tax}}, $tax);          push (@{$families{figs}{$parent_tax}}, $id);
482            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);
490              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
491              $families{lineage}{$tax} = join(";", @currLineage);
492              if (defined ($families{evalue}{$tax})){
493                if ($evalue < $families{evalue}{$tax}){
494                  $families{evalue}{$tax} = $evalue;
495                  $families{color}{$tax} = &get_taxcolor($evalue);
496                }
497              }
498              else{
499                $families{evalue}{$tax} = $evalue;
500                $families{color}{$tax} = &get_taxcolor($evalue);
501              }
502    
503              $parent_tax = $tax;              $parent_tax = $tax;
504              $level++;
505          }          }
506      }      }
507    
# Line 458  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 469  Line 524 
524    
525  =cut  =cut
526    
527  sub get_attribute_based_domain_observations{  sub get_taxcolor{
528        my ($evalue) = @_;
529        my $color;
530        if ($evalue == -1){            $color = "black";      }
531        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
532        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
533        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
534        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
535        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
536        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
537        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
538        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
539        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
540        else{        $color = "#6666FF";    }
541        return ($color);
542    }
543    
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);  
544    
545      my $fig = new FIG;  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)
548        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
549        my $seen = {};
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 489  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 516  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'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
600    
601      my $dataset = {'type' => "loc",      my $dataset = {'type' => "loc",
602                     'class' => 'SIGNALP_CELLO_TMPRED',                     'class' => 'SIGNALP_CELLO_TMPRED',
# Line 527  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/));          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
609          my @parts = split("::",$key);          my @parts = split("::",$key);
610          my $sub_class = $parts[0];          my $sub_class = $parts[0];
611          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 539  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;
621              }              }
622          }          }
623    
624          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
625              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
626              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
627          }          }
628    
629            elsif($sub_class eq "Phobius"){
630                if($sub_key eq "transmembrane"){
631                    $dataset->{'phobius_tm_locations'} = $value;
632                }
633                elsif($sub_key eq "signal"){
634                    $dataset->{'phobius_signal_location'} = $value;
635                }
636            }
637    
638          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
639              my @value_parts = split(/\;/,$value);              my @value_parts = split(/\;/,$value);
640              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
# Line 567  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 627  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,1e-20,"all");        $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 667  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],
783                      'acc' => $hit,                      'acc' => $hit,
784                      'identity' => $percent,                      'identity' => $percent,
785                      'type' => 'seq',                      'type' => 'seq',
# Line 699  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 710  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 724  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)) && (! defined ($id_list{$id}))) {          if (($id ne $fid) && ($tmp = $fig->function_of($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 763  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 774  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 892  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 923  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 947  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 1051  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 1064  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 1115  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 1130  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 1184  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 1239  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 1260  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 1269  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 1327  Line 1478 
1478      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1479      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1480      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1481        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1482        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1483    
1484      bless($self,$class);      bless($self,$class);
1485      return $self;      return $self;
1486  }  }
1487    
1488    sub display_cello {
1489        my ($thing) = @_;
1490        my $html;
1491        my $cello_location = $thing->cello_location;
1492        my $cello_score = $thing->cello_score;
1493        if($cello_location){
1494            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1495            #$html .= "<p>CELLO score: $cello_score </p>";
1496        }
1497        return ($html);
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 1348  Line 1513 
1513      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1514      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1515    
1516        my $phobius_signal_location = $thing->phobius_signal_location;
1517        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1518    
1519      my $lines = [];      my $lines = [];
1520    
1521      #color is      #color is
1522      my $color = "6";      my $color = "6";
1523    
     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);  
1524    
         my $element_hash = {  
             "title" => "CELLO",  
             "start" => "1",  
             "end" =>  $length + 1,  
             "color"=> $color,  
             "type" => 'box',  
             "zlayer" => '1',  
             "description" => $cello_descriptions};  
1525    
1526          push(@$line_data,$element_hash);  #    if($cello_location){
1527          $gd->add_line($line_data, $line_config);  #       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    
1587    
1588      $color = "2";      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
     if($tmpred_score){  
1589          my $line_data =[];          my $line_data =[];
1590          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1591                              'short_title' => 'Transmembrane',                              '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 $tmpred (@tmpred_locations){  
1596              my $descriptions = [];              my $descriptions = [];
1597              my ($begin,$end) =split("-",$tmpred);              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1598              my $description_tmpred_score = {"title" => 'TMPRED score',                               "value" => $tm_loc};
1599                               "value" => $tmpred_score};              push(@$descriptions,$description_phobius_tm_locations);
1600    
1601              push(@$descriptions,$description_tmpred_score);              my ($begin,$end) =split("-",$tm_loc);
1602    
1603              my $element_hash = {              my $element_hash = {
1604              "title" => "transmembrane location",              "title" => "Phobius",
1605              "start" => $begin + 1,              "start" => $begin + 1,
1606              "end" =>  $end + 1,              "end" =>  $end + 1,
1607              "color"=> $color,              "color"=> '6',
1608              "zlayer" => '5',              "zlayer" => '4',
1609              "type" => 'smallbox',              "type" => 'bigbox',
1610              "description" => $descriptions};              "description" => $descriptions};
1611    
1612              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1613    
1614          }          }
         $gd->add_line($line_data, $line_config);  
     }  
1615    
1616      $color = "1";          if($phobius_signal_location){
     if($signal_peptide_score){  
         my $line_data = [];  
1617          my $descriptions = [];          my $descriptions = [];
1618                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1619                                 "value" => $phobius_signal_location};
1620                push(@$descriptions,$description_phobius_signal_location);
1621    
         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};  
   
         push(@$descriptions,$description_signal_peptide_score);  
   
         my $description_cleavage_prob = {"title" => 'cleavage site probability',  
                                          "value" => $cleavage_prob};  
   
         push(@$descriptions,$description_cleavage_prob);  
1622    
1623                my ($begin,$end) =split("-",$phobius_signal_location);
1624          my $element_hash = {          my $element_hash = {
1625              "title" => "SignalP",              "title" => "phobius signal locations",
1626              "start" => $cleavage_loc_begin - 2,              "start" => $begin + 1,
1627              "end" =>  $cleavage_loc_end + 1,              "end" =>  $end + 1,
1628              "type" => 'bigbox',              "color"=> '1',
1629              "color"=> $color,              "zlayer" => '5',
1630              "zlayer" => '10',              "type" => 'box',
1631              "description" => $descriptions};              "description" => $descriptions};
   
1632          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1633            }
1634    
1635          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1636      }      }
1637    
1638    
1639    #    $color = "1";
1640    #    if($signal_peptide_score){
1641    #       my $line_data = [];
1642    #       my $descriptions = [];
1643    #
1644    #       my $line_config = { 'title' => 'Localization Evidence',
1645    #                           'short_title' => 'SignalP',
1646    #                            'hover_title' => 'Localization',
1647    #                           'basepair_offset' => '1' };
1648    #
1649    #       my $description_signal_peptide_score = {"title" => 'signal peptide score',
1650    #                                               "value" => $signal_peptide_score};
1651    #
1652    #       push(@$descriptions,$description_signal_peptide_score);
1653    #
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    
1672    
1673      return ($gd);      return ($gd);
1674    
1675  }  }
# Line 1494  Line 1716 
1716    return $self->{cello_score};    return $self->{cello_score};
1717  }  }
1718    
1719    sub phobius_signal_location {
1720      my ($self) = @_;
1721      return $self->{phobius_signal_location};
1722    }
1723    
1724    sub phobius_tm_locations {
1725      my ($self) = @_;
1726      return $self->{phobius_tm_locations};
1727    }
1728    
1729    
1730    
1731  #########################################  #########################################
1732  #########################################  #########################################
# Line 1507  Line 1740 
1740      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1741      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1742      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1743        $self->{query} = $dataset->{'query'};
1744      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1745      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1746      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1530  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;  
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 @subsystems = $fig->peg_to_subsystems($peg);        my $db = &Observation::get_database($peg);
1829      foreach my $subsystem (@subsystems){        my ($link_id) = ($peg) =~ /\|(.*)/;
1830          my $link;        $evidence_link = &HTML::alias_url($link_id, $db);
1831          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",        #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        # subsystem link
1838        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1839        my @subsystems;
1840        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        # blast alignment
1849        $link = {"link_title" => "view blast alignment",
1850                 "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);
   
     $description_loc = {"title" => "location stop",  
                         "value" => $hit_stop};  
     push(@$descriptions, $description_loc);  
1872    
1873      my $evalue = $self->evalue;      $description_loc = {"title" => "Sequence Length",
1874                            "value" => $ln_hit};
1875        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        $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 1604  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 = {      $element_hash = {
1913          "title" => $peg,          "title" => $query_id,
1914          "start" => $align_start,          "start" => $base_start,
1915          "end" =>  $align_stop,          "end" => $base_start+$ln_query,
1916          "type"=> 'box',          "type"=> 'box',
1917          "color"=> $color,          "color"=> $color,
1918          "zlayer" => "2",          "zlayer" => "2",
1919          "links_list" => $links_list,          "links_list" => $query_links_list,
1920          "description" => $descriptions          "description" => $query_descriptions
1921          };          };
1922      push(@$line_data,$element_hash);      push(@$query_data,$element_hash);
     $gd->add_line($line_data, $line_config);  
1923    
1924      return ($gd);      $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 = {
1940                    "title" => $peg,
1941                    "start" => $base_start + ($query_start-$hit_start),
1942                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1943                    "type"=> 'box',
1944                    "color"=> $color,
1945                    "zlayer" => "2",
1946                    "links_list" => $hit_links_list,
1947                    "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);
1962    
1963        $gd->add_line($line_data, $line_config);
1964    
1965        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()
1976    
1977    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1978    
1979    =cut
1980    
1981    sub display_domain_composition {
1982        my ($self,$gd,$fig) = @_;
1983    
1984        #$fig = new FIG;
1985        my $peg = $self->acc;
1986    
1987        my $line_data = [];
1988        my $links_list = [];
1989        my $descriptions = [];
1990    
1991        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1992        #my @domain_query_results = ();
1993        foreach $dqr (@domain_query_results){
1994            my $key = @$dqr[1];
1995            my @parts = split("::",$key);
1996            my $db = $parts[0];
1997            my $id = $parts[1];
1998            my $val = @$dqr[2];
1999            my $from;
2000            my $to;
2001            my $evalue;
2002    
2003            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
2004                my $raw_evalue = $1;
2005                $from = $2;
2006                $to = $3;
2007                if($raw_evalue =~/(\d+)\.(\d+)/){
2008                    my $part2 = 1000 - $1;
2009                    my $part1 = $2/100;
2010                    $evalue = $part1."e-".$part2;
2011                }
2012                else{
2013                    $evalue = "0.0";
2014                }
2015            }
2016    
2017            my $dbmaster = DBMaster->new(-database =>'Ontology',
2018                                    -host     => $WebConfig::DBHOST,
2019                                    -user     => $WebConfig::DBUSER,
2020                                    -password => $WebConfig::DBPWD);
2021            my ($name_value,$description_value);
2022    
2023            if($db eq "CDD"){
2024                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
2025                if(!scalar(@$cdd_objs)){
2026                    $name_title = "name";
2027                    $name_value = "not available";
2028                    $description_title = "description";
2029                    $description_value = "not available";
2030                }
2031                else{
2032                    my $cdd_obj = $cdd_objs->[0];
2033                    $name_value = $cdd_obj->term;
2034                    $description_value = $cdd_obj->description;
2035                }
2036            }
2037    
2038            my $domain_name;
2039            $domain_name = {"title" => "name",
2040                            "value" => $name_value};
2041            push(@$descriptions,$domain_name);
2042    
2043            my $description;
2044            $description = {"title" => "description",
2045                            "value" => $description_value};
2046            push(@$descriptions,$description);
2047    
2048            my $score;
2049            $score = {"title" => "score",
2050                      "value" => $evalue};
2051            push(@$descriptions,$score);
2052    
2053            my $link_id = $id;
2054            my $link;
2055            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"}
2057            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2058            else{$link_url = "NO_URL"}
2059    
2060            $link = {"link_title" => $name_value,
2061                     "link" => $link_url};
2062            push(@$links_list,$link);
2063    
2064            my $domain_element_hash = {
2065                "title" => $peg,
2066                "start" => $from,
2067                "end" =>  $to,
2068                "type"=> 'box',
2069                "zlayer" => '4',
2070                "links_list" => $links_list,
2071                "description" => $descriptions
2072                };
2073    
2074            push(@$line_data,$domain_element_hash);
2075    
2076            #just one CDD domain for now, later will add option for multiple domains from selected DB
2077            last;
2078        }
2079    
2080        my $line_config = { 'title' => $peg,
2081                            'hover_title' => 'Domain',
2082                            'short_title' => $peg,
2083                            'basepair_offset' => '1' };
2084    
2085        $gd->add_line($line_data, $line_config);
2086    
2087        return ($gd);
2088    
2089  }  }
2090    
# Line 1641  Line 2098 
2098  =cut  =cut
2099    
2100  sub display_table {  sub display_table {
2101      my ($self,$dataset, $preference, $columns) = @_;      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, %code_attributes);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2116      foreach my $col (@$columns){      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          if ($col eq "subsystem"){      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash');
2120              %subsystems_column = &get_subsystems_column(\@ids);  
         }  
2121          # get the column for the evidence codes          # get the column for the evidence codes
2122          elsif ($col eq "evidence"){      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash');
2123              %evidence_column = &get_evidence_column(\@ids);  
2124          }      # get the column for pfam_domain
2125        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2126    
2127        # get the column for molecular weight
2128        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2129    
2130        # get the column for organism's habitat
2131        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2132    
2133        # 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        # get the column for organism's temperature range
2137        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2138    
2139        # get the column for organism's oxygen requirement
2140        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2141    
2142        # get the column for organism's pathogenicity
2143        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2144    
2145        # get the column for organism's pathogenicity host
2146        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2147    
2148        # get the column for organism's salinity
2149        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2150    
2151        # 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      foreach my $thing (@$dataset) {      # 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");          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 = [];          my $single_domain = [];
2246          $count++;          $count++;
2247    
2248          my $id = $thing->acc;          # organisms cell
2249            my ($org, $org_color) = $fig->org_and_color_of($id);
2250    
2251          my $iden    = $thing->identity;          my $org_cell;
2252          my $ln1     = $thing->qlength;          if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2253          my $ln2     = $thing->hlength;              $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2254          my $b1      = $thing->qstart;          }
2255          my $e1      = $thing->qstop;          elsif ($next_org eq $organism){
2256          my $b2      = $thing->hstart;              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2257          my $e2      = $thing->hstop;              $same_genome_flag = 1;
2258          my $d1      = abs($e1 - $b1) + 1;          }
2259          my $d2      = abs($e2 - $b2) + 1;          elsif ($same_genome_flag == 1){
2260          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2261          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";              $same_genome_flag = 0;
2262            }
2263    
2264          # checkbox column          # checkbox cell
2265            my ($box_cell,$tax, $radio_cell);
2266          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2267          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2268          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          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          my $prefer_id = &get_prefer($thing->acc, $preference);          # create the radio cell for any sequence, not just fig ids
2288          my $acc_col .= &HTML::set_prot_links($cgi,$prefer_id);          my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2289          my $db = $thing->database;          $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2290          if ($preference ne "FIG"){  
2291              $db = &Observation::get_database($prefer_id);          # 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          push(@$single_domain,$box_col);                        # permanent column          $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          push(@$single_domain,$acc_col);                        # permanent column          my $fig_col = {'data'=> $fig_data,
2296          push(@$single_domain,$thing->evalue);                  # permanent column                         'highlight'=>$white};
2297          push(@$single_domain,"$iden\%");                       # permanent column  
2298          push(@$single_domain,$reg1);                           # permanent column          $replace_id = $peg;
2299          push(@$single_domain,$reg2);                           # permanent column          $replace_id =~ s/\|/_/ig;
2300          push(@$single_domain,$thing->organism);                # permanent column          $anchor_name = "anchor_". $replace_id;
2301          push(@$single_domain,$thing->function);                # permanent column          my $query_config = { 'title' => "Query",
2302          push(@$single_domain,$subsystems_column{$id}) if (grep (/subsystem/, @$columns));                               'short_title' => "Query",
2303          push(@$single_domain,$evidence_column{$id}) if (grep (/evidence/, @$columns));                               'title_link' => "changeSimsLocation('$replace_id')",
2304          push(@$data,$single_domain);                               '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 ){      if ($count >0 ){
2397          $content = $data;          $content = $data;
2398      }      }
2399      else{      else{
2400          $content = "<p>This PEG does not have any similarities</p>";          $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);      return ($content);
2569  }  }
2570    
# Line 1725  Line 2574 
2574      foreach my $id (@$ids){      foreach my $id (@$ids){
2575          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2576          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2577          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          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);      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{  sub get_subsystems_column{
2607      my ($ids) = @_;      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 $in_sub;          my @subsystems;
2614    
2615          if (@in_sub > 0) {          if (@in_sub > 0) {
2616              $in_sub = @in_sub;              foreach my $array(@in_sub){
2617                    my $ss = $array->[0];
2618              # RAE: add a javascript popup with all the subsystems                  $ss =~ s/_/ /ig;
2619              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;                  push (@subsystems, "-" . $ss);
2620              $column{$id} = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              }
2621                my $in_sub_line = join ("<br>", @subsystems);
2622                $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        }
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{
2739        my ($fid,$dataset,$fig) = @_;
2740        #my $fig = new FIG;
2741    
2742        my %id_list;
2743        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2744    
2745        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))) {
2752                        $id_list{$id} = 1;
2753          }          }
2754      }      }
2755      return (%column);          }
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);
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 1791  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 html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub get_attrb_column{
2816        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2817    
2818        my ($column, %code_attributes, %attribute_locations);
2819        my $dbmaster = DBMaster->new(-database =>'Ontology',
2820                                     -host     => $WebConfig::DBHOST,
2821                                     -user     => $WebConfig::DBUSER,
2822                                     -password => $WebConfig::DBPWD);
2823    
2824  sub get_prefer {      if ($colName eq "pfam"){
2825      my ($fid, $db) = @_;          if (! defined $attributes) {
2826      my $fig = new FIG;              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){
2832                my $name = $key->[1];
2833                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      my @aliases = $fig->feature_aliases($fid);          foreach my $id (@$ids){
2841                # add pfam code
2842                my $pfam_codes=" &nbsp; ";
2843                my @pfam_codes = "";
2844                my %description_codes;
2845    
2846      foreach my $alias (@aliases){              if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2847          my $id_db = &Observation::get_database($alias);                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2848          if ($id_db eq $db){                  @pfam_codes = ();
2849              return ($alias);  
2850                    # get only unique values
2851                    my %saw;
2852                    foreach my $key (@ncodes) {$saw{$key}=1;}
2853                    @ncodes = keys %saw;
2854    
2855                    foreach my $code (@ncodes) {
2856                        my @parts = split("::",$code);
2857                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
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]})){
2872                            push(@pfam_codes, "$parts[1]");
2873          }          }
2874                        else {
2875                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2876                            $description_codes{$parts[1]} = $description->[0]->{term};
2877                            push(@pfam_codes, "$pfam_link");
2878      }      }
     return ($fid);  
2879  }  }
2880    
2881  sub color {                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2882      my ($evalue) = @_;                  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      my $color;          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2893      if ($evalue <= 1e-170){          foreach my $key (@codes){
2894          $color = 51;              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            }
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      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2918      }      }
2919      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){              else{
2920          $color = 53;                  @values = ("Not available");
2921      }      }
2922      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2923          $color = 54;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2924                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2925      }      }
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
2926      }      }
2927      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2928          $color = 56;              ($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      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
2934          $color = 57;          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2935            foreach my $key (@codes){
2936                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2937      }      }
2938      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2939          $color = 58;          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      }      }
     elsif (($evalue <= 10) && ($evalue > 1)){  
         $color = 59;  
2947      }      }
2948      else{      else{
2949          $color = 60;                  @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        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);
3027                next if ( ($id_db ne $db) && ($db ne 'all') );
3028                next if ($aliases->{$id}->{$db});
3029                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            #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; $_ }
3049    
3050    sub color {
3051        my ($evalue) = @_;
3052        my $palette = WebColors::get_palette('vitamins');
3053        my $color;
3054        if ($evalue <= 1e-170){        $color = $palette->[0];    }
3055        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
3056        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
3057        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
3058        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
3059        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
3060        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
3061        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
3062        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
3063        else{        $color = $palette->[9];    }
3064      return ($color);      return ($color);
3065  }  }
3066    
# Line 1868  Line 3080 
3080  }  }
3081    
3082  sub display {  sub display {
3083      my ($self,$gd) = @_;      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={};
3093    
3094      #get the organism genome      #get the organism genome
3095      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
3096        $gene_associations->{$fid}->{"organism"} = $target_genome;
3097        $gene_associations->{$fid}->{"main_gene"} = $fid;
3098        $gene_associations->{$fid}->{"reverse_flag"} = 0;
3099    
3100      # get location of the gene      # get location of the gene
3101      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1894  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;
3126      }      }
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;}      foreach my $feature (@$target_gene_features){
3140            #if ($feature =~ /peg/){
3141      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
3142      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
3143                  }                  }
3144    
3145                  push (@start_array_region, $offset);      my @selected_sims;
3146    
3147                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
3148                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
3149                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
3150                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
3151              }          # get the similarities and store only the ones that match the lineages selected
3152              $coup_count++;          if (@selected_taxonomy > 0){
3153                foreach my $sim (@$sims_array){
3154                    next if ($sim->class ne "SIM");
3155                    next if ($sim->acc !~ /fig\|/);
3156    
3157                    #my $genome = $fig->genome_of($sim->[1]);
3158                    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){
3163                        if ($lineage =~ /$taxon/){
3164                            #push (@selected_sims, $sim->[1]);
3165                            push (@selected_sims, $sim->acc);
3166          }          }
3167      }      }
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                     }  
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = $peg1;  
3168                      }                      }
   
                     push (@start_array_region, $offset);  
                     $all_genomes{$pair_genome} = 1;  
                     my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
3169                  }                  }
3170            else{
3171                my $simcount = 0;
3172                foreach my $sim (@$sims_array){
3173                    next if ($sim->class ne "SIM");
3174                    next if ($sim->acc !~ /fig\|/);
3175    
3176                    push (@selected_sims, $sim->acc);
3177                    $simcount++;
3178                    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
3186            foreach my $sim_fid(@selected_sims){
3187                #get the organism genome
3188                my $sim_genome = $fig->genome_of($sim_fid);
3189                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
3190                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
3191                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
3192    
3193                # get location of the gene
3194                my $data = $fig->feature_location($sim_fid);
3195                my ($contig, $beg, $end);
3196    
3197                if ($data =~ /(.*)_(\d+)_(\d+)$/){
3198                    $contig = $1;
3199                    $beg = $2;
3200                    $end = $3;
3201      }      }
3202    
3203      # get the PCH to each of the genes              my $offset;
3204      my $pch_sets = [];              my ($region_start, $region_end);
3205      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){next;};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
3206          {          {
3207              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
3208                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
3209                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
3210          }          }
3211          else          else
3212          {          {
3213              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
3214                  $peg_rank{$peg} = "20";                  $region_end = $beg+($range/2);
3215              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3216                    $reverse_flag{$sim_genome} = $sim_fid;
3217                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
3218          }          }
3219    
3220                # call genes in region
3221                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
3222                push(@$all_regions,$sim_gene_features);
3223                push (@start_array_region, $offset);
3224                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
3225                $all_genomes{$sim_genome} = 1;
3226      }      }
3227    
3228        }
3229    
3230  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3231  #    my %already;      # cluster the genes
3232  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
3233  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3234  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3235  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = "20";  
 #           }  
 #       }  
 #    }  
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) =~ /(.*?)\./;
3243            my $lineage = $taxes->{$region_genome};
3244            #my $lineage = $fig->taxonomy_of($region_genome);
3245            #$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,
3248                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2134  Line 3250 
3250    
3251          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3252    
3253          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3254                                     'short_title' => "",                                     'short_title' => "",
3255                                     'basepair_offset' => '0'                                     'basepair_offset' => '0',
3256                                       'no_middle_line' => '1'
3257                                     };                                     };
3258    
3259          my $line_data = [];          my $line_data = [];
# Line 2153  Line 3270 
3270              my $links_list = [];              my $links_list = [];
3271              my $descriptions = [];              my $descriptions = [];
3272    
3273              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
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 2202  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 2222  Line 3356 
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, \@selected_sims);
3379    }
3380    
3381    sub cluster_genes {
3382        my($fig,$all_pegs,$peg) = @_;
3383        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3384    
3385        my @color_sets = ();
3386    
3387        $conn = &get_connections_by_similarity($fig,$all_pegs);
3388    
3389        for ($i=0; ($i < @$all_pegs); $i++) {
3390            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3391            if (! $seen{$i}) {
3392                $cluster = [$i];
3393                $seen{$i} = 1;
3394                for ($j=0; ($j < @$cluster); $j++) {
3395                    $x = $conn->{$cluster->[$j]};
3396                    foreach $k (@$x) {
3397                        if (! $seen{$k}) {
3398                            push(@$cluster,$k);
3399                            $seen{$k} = 1;
3400                        }
3401                    }
3402                }
3403    
3404                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3405                    push(@color_sets,$cluster);
3406                }
3407            }
3408        }
3409        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3410        $red_set = $color_sets[$i];
3411        splice(@color_sets,$i,1);
3412        @color_sets = sort { @$b <=> @$a } @color_sets;
3413        unshift(@color_sets,$red_set);
3414    
3415        my $color_sets = {};
3416        for ($i=0; ($i < @color_sets); $i++) {
3417            foreach $x (@{$color_sets[$i]}) {
3418                $color_sets->{$all_pegs->[$x]} = $i;
3419            }
3420        }
3421        return $color_sets;
3422    }
3423    
3424    sub get_connections_by_similarity {
3425        my($fig,$all_pegs) = @_;
3426        my($i,$j,$tmp,$peg,%pos_of);
3427        my($sim,%conn,$x,$y);
3428    
3429        for ($i=0; ($i < @$all_pegs); $i++) {
3430            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3431            push(@{$pos_of{$tmp}},$i);
3432            if ($tmp ne $all_pegs->[$i]) {
3433                push(@{$pos_of{$all_pegs->[$i]}},$i);
3434      }      }
     return $gd;  
3435  }  }
3436    
3437        foreach $y (keys(%pos_of)) {
3438            $x = $pos_of{$y};
3439            for ($i=0; ($i < @$x); $i++) {
3440                for ($j=$i+1; ($j < @$x); $j++) {
3441                    push(@{$conn{$x->[$i]}},$x->[$j]);
3442                    push(@{$conn{$x->[$j]}},$x->[$i]);
3443                }
3444            }
3445        }
3446    
3447        for ($i=0; ($i < @$all_pegs); $i++) {
3448            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3449                if (defined($x = $pos_of{$sim->id2})) {
3450                    foreach $y (@$x) {
3451                        push(@{$conn{$i}},$y);
3452                    }
3453                }
3454            }
3455        }
3456        return \%conn;
3457    }
3458    
3459    sub in {
3460        my($x,$xL) = @_;
3461        my($i);
3462    
3463        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3464        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.29  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3