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

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.71

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3