[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.40, Thu Sep 20 22:27:20 2007 UTC revision 1.60, Fri Jun 20 16:08:32 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 317  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$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 333  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);
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 346  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 372  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head3 get_sims_objects()
378  This method returns the housekeeping data for a given peg in a table format  
379    This is the B<REAL WORKHORSE> method of this Package.
380    
381  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
382    
383      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
384      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);  
385    
386      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
387      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
388      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
389      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      # call function that fetches attribute based observations
390      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);      # returns an array of arrays of hashes
391      $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);  
     }  
392    
393      if ( @subsystems ) {      foreach my $dataset (@matched_datasets) {
394          $content .= qq(<tr><td>Subsystems</td><td>);          my $object;
395          foreach my $subsystem ( @subsystems ) {          if ($dataset->{'class'} eq "SIM"){
396              $content .= join(" -- ", @$subsystem) . "<br>\n";              $object = Observation::Sims->new($dataset);
397          }          }
398            push (@$objects, $object);
399      }      }
400        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
401          }          }
402    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
403    
404    =head3 display_housekeeping
405    This method returns the housekeeping data for a given peg in a table format
406    
407    =cut
408    sub display_housekeeping {
409        my ($self,$fid,$fig) = @_;
410        my $content = [];
411        my $row = [];
412    
413          $content .= qq(<tr><td>Aliases</td><td><table border="0">);      my $org_name = $fig->org_of($fid);
414          foreach my $key (sort keys %db_aliases){      my $org_id = $fig->genome_of($fid);
415              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my $function = $fig->function_of($fid);
416          }      #my $taxonomy = $fig->taxonomy_of($org_id);
417          $content .= qq(</td></tr></table>\n);      my $length = $fig->translation_length($fid);
418      }  
419        push (@$row, $org_name);
420        push (@$row, $fid);
421        push (@$row, $length);
422        push (@$row, $function);
423    
424        # initialize the table for commentary and annotations
425        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
426        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
427        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
428        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
429        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
430        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
431        #$content .= qq(</table><p>\n);
432    
433      $content .= qq(</table><p>\n);      push(@$content, $row);
434    
435      return ($content);      return ($content);
436  }  }
# Line 447  Line 441 
441  =cut  =cut
442    
443  sub get_sims_summary {  sub get_sims_summary {
444      my ($observation, $fid, $taxes) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
445      my %families;      my %families;
446      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
447    
448      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
449          next if ($sim->[1] !~ /fig\|/);          my ($id, $evalue);
450          my $genome = $fig->genome_of($sim->[1]);          if ($thing =~ /fig\|/){
451          my ($genome1) = ($genome) =~ /(.*)\./;              $id = $thing;
452          my $taxonomy = $taxes->{$genome1};              $evalue = -1;
453          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated          }
454            else{
455                next if ($thing->class ne "SIM");
456                $id      = $thing->acc;
457                $evalue  = $thing->evalue;
458            }
459            next if ($id !~ /fig\|/);
460            next if ($fig->is_deleted_fid($id));
461    
462            my $genome = $fig->genome_of($id);
463            #my ($genome1) = ($genome) =~ /(.*)\./;
464            my $taxonomy = $taxes->{$genome};
465          my $parent_tax = "Root";          my $parent_tax = "Root";
466          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
467            push (@{$families{figs}{$parent_tax}}, $id);
468            my $level = 2;
469          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
470              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
471                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
472                $families{level}{$tax} = $level;
473              push (@currLineage, $tax);              push (@currLineage, $tax);
474              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
475              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
476              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
477                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($evalue < $families{evalue}{$tax}){
478                      $families{evalue}{$tax} = $sim->[10];                      $families{evalue}{$tax} = $evalue;
479                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                      $families{color}{$tax} = &get_taxcolor($evalue);
480                  }                  }
481              }              }
482              else{              else{
483                  $families{evalue}{$tax} = $sim->[10];                  $families{evalue}{$tax} = $evalue;
484                  $families{color}{$tax} = &get_taxcolor($sim->[10]);                  $families{color}{$tax} = &get_taxcolor($evalue);
485              }              }
486    
487              $parent_tax = $tax;              $parent_tax = $tax;
488                $level++;
489          }          }
490      }      }
491    
# Line 487  Line 496 
496          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
497          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
498      }      }
499      return (\%families);  
500        return \%families;
501  }  }
502    
503  =head1 Internal Methods  =head1 Internal Methods
# Line 501  Line 511 
511  sub get_taxcolor{  sub get_taxcolor{
512      my ($evalue) = @_;      my ($evalue) = @_;
513      my $color;      my $color;
514      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 518  Line 529 
529  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
530    
531      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
532      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
533    
534      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
535          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
536          my @parts = split("::",$key);          my @parts = split("::",$key);
537          my $class = $parts[0];          my $class = $parts[0];
538            my $name = $parts[1];
539            #next if (($class eq "PFAM") && ($name !~ /interpro/));
540    
541          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
542              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 535  Line 545 
545                  my $from = $2;                  my $from = $2;
546                  my $to = $3;                  my $to = $3;
547                  my $evalue;                  my $evalue;
548                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
549                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
550                      my $part1 = $2/100;                      my $part1 = $2/100;
551                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
552                  }                  }
553                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
554                        $evalue=$raw_evalue;
555                    }
556                  else{                  else{
557                      $evalue = "0.0";                      $evalue = "0.0";
558                  }                  }
# Line 562  Line 575 
575    
576  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
577    
578      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
579      my $fig = new FIG;      #my $fig = new FIG;
580    
581      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
582    
# Line 573  Line 586 
586                     };                     };
587    
588      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
591          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 585  Line 597 
597                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
598                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
599                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
600              }              }
601              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
602                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 624  Line 635 
635  =cut  =cut
636    
637  sub get_pdb_observations{  sub get_pdb_observations{
638      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
639    
640      my $fig = new FIG;      #my $fig = new FIG;
641    
642      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
643          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
644          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
645          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 684  Line 693 
693  =cut  =cut
694    
695  sub get_sims_observations{  sub get_sims_observations{
696        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
697    
698      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
699      my $fig = new FIG;      if ($parameters->{flag}){
700      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
701      my ($dataset);        $max_expand = $parameters->{max_expand};
702          $max_eval = $parameters->{max_eval};
703      my %id_list;        $db_filter = $parameters->{db_filter};
704      foreach my $sim (@sims){        $sim_order = $parameters->{sim_order};
705          my $hit = $sim->[1];        $group_by_genome = 1 if (defined ($parameters->{group_genome}));
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
706          }          }
707        else{
708          $max_sims = 50;
709          $max_expand = 5;
710          $max_eval = 1e-5;
711          $db_filter = "figx";
712          $sim_order = "id";
713      }      }
714    
715      my %already;      my($id, $genome, @genomes, %sims);
716      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
717      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
718          my $hit = $sim->[1];      my ($dataset);
719          my ($id) = ($hit) =~ /\|(.*)/;  
720          next if (defined($already{$id}));      if ($group_by_genome){
721          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
722          push (@new_sims, $sim);        foreach $sim ( @tmp ){
723          $already{$id} = 1;          $id = $sim->id2;
724            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
725            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
726            push @{ $sims{ $genome } }, $sim;
727          }
728          @tmp = map { @{ $sims{$_} } } @genomes;
729      }      }
730    
731      foreach my $sim (@new_sims){      foreach my $sim (@tmp){
732          my $hit = $sim->[1];          my $hit = $sim->[1];
733          my $percent = $sim->[2];          my $percent = $sim->[2];
734          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 757  Line 773 
773      my ($id) = (@_);      my ($id) = (@_);
774    
775      my ($db);      my ($db);
776      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
777      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
778        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
779      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
780        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
781      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
782      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
783      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 768  Line 786 
786      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
787      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
788      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
789        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
790        elsif ($id =~ /^img\|/)           { $db = "IMG" }
791        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
792        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
793    
794      return ($db);      return ($db);
795    
# Line 782  Line 804 
804    
805  sub get_identical_proteins{  sub get_identical_proteins{
806    
807      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
808      my $fig = new FIG;      #my $fig = new FIG;
809      my $funcs_ref;      my $funcs_ref;
810    
 #    my %id_list;  
811      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;  
 #    }  
   
812      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
813          my ($tmp, $who);          my ($tmp, $who);
814          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}))) {  
815              $who = &get_database($id);              $who = &get_database($id);
816              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
817          }          }
818      }      }
819    
     my ($dataset);  
820      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
821                     'type' => 'seq',                     'type' => 'seq',
822                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 822  Line 836 
836    
837  sub get_functional_coupling{  sub get_functional_coupling{
838    
839      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
840      my $fig = new FIG;      #my $fig = new FIG;
841      my @funcs = ();      my @funcs = ();
842    
843      # initialize some variables      # initialize some variables
# Line 840  Line 854 
854                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
855                    } @fc_data;                    } @fc_data;
856    
     my ($dataset);  
857      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
858                     'type' => 'fc',                     'type' => 'fc',
859                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 951  Line 964 
964      return $self->{database};      return $self->{database};
965  }  }
966    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
967  ############################################################  ############################################################
968  ############################################################  ############################################################
969  package Observation::PDB;  package Observation::PDB;
# Line 982  Line 989 
989  =cut  =cut
990    
991  sub display{  sub display{
992      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
993    
994      my $fid = $self->fig_id;      my $fid = $self->fig_id;
995      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
996                                    -host     => $WebConfig::DBHOST,
997                                    -user     => $WebConfig::DBUSER,
998                                    -password => $WebConfig::DBPWD);
999    
1000      my $acc = $self->acc;      my $acc = $self->acc;
1001    
# Line 1006  Line 1016 
1016      my $lines = [];      my $lines = [];
1017      my $line_data = [];      my $line_data = [];
1018      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1019                            'hover_title' => 'PDB',
1020                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1021                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1022    
1023      my $fig = new FIG;      #my $fig = new FIG;
1024      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1025      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1026    
# Line 1110  Line 1121 
1121    
1122    
1123  sub display_table{  sub display_table{
1124      my ($self) = @_;      my ($self,$fig) = @_;
1125    
1126      my $fig = new FIG;      #my $fig = new FIG;
1127      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1128      my $rows = $self->rows;      my $rows = $self->rows;
1129      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1174  Line 1185 
1185    
1186  sub display_table {  sub display_table {
1187    
1188      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1189      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1190      my $rows = $self->rows;      my $rows = $self->rows;
1191      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1189  Line 1200 
1200          # construct the score link          # construct the score link
1201          my $score = $row->[0];          my $score = $row->[0];
1202          my $toid = $row->[1];          my $toid = $row->[1];
1203          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";
1204          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1205    
1206          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1207          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1243  Line 1254 
1254      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1255      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1256    
1257      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1258                                    -host     => $WebConfig::DBHOST,
1259                                    -user     => $WebConfig::DBUSER,
1260                                    -password => $WebConfig::DBPWD);
1261    
1262      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1263      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1262  Line 1276 
1276              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1277          }          }
1278      }      }
1279        elsif($db =~ /PFAM/){
1280            my ($new_id) = ($id) =~ /(.*?)_/;
1281            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1282            if(!scalar(@$pfam_objs)){
1283                $name_title = "name";
1284                $name_value = "not available";
1285                $description_title = "description";
1286                $description_value = "not available";
1287            }
1288            else{
1289                my $pfam_obj = $pfam_objs->[0];
1290                $name_title = "name";
1291                $name_value = $pfam_obj->term;
1292                #$description_title = "description";
1293                #$description_value = $pfam_obj->description;
1294            }
1295        }
1296    
1297      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1298                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1299        my $new_short_title=$short_title;
1300        if ($short_title =~ /interpro/){
1301            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1302        }
1303        my $line_config = { 'title' => $name_value,
1304                            'hover_title', => 'Domain',
1305                            'short_title' => $new_short_title,
1306                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1307    
1308      my $name;      my $name;
1309      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1310               "value" => $name_value};      $name = {"title" => $db,
1311                 "value" => $new_id};
1312      push(@$descriptions,$name);      push(@$descriptions,$name);
1313    
1314      my $description;  #    my $description;
1315      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1316                               "value" => $description_value};  #                   "value" => $description_value};
1317      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1318    
1319      my $score;      my $score;
1320      $score = {"title" => "score",      $score = {"title" => "score",
1321                "value" => $thing->evalue};                "value" => $thing->evalue};
1322      push(@$descriptions,$score);      push(@$descriptions,$score);
1323    
1324        my $location;
1325        $location = {"title" => "location",
1326                     "value" => $thing->start . " - " . $thing->stop};
1327        push(@$descriptions,$location);
1328    
1329      my $link_id;      my $link_id;
1330      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1331          $link_id = $1;          $link_id = $1;
1332      }      }
1333    
1334      my $link;      my $link;
1335      my $link_url;      my $link_url;
1336      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"}
1337      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"}
1338      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1339    
1340      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1298  Line 1342 
1342      push(@$links_list,$link);      push(@$links_list,$link);
1343    
1344      my $element_hash = {      my $element_hash = {
1345          "title" => $thing->type,          "title" => $name_value,
1346          "start" => $thing->start,          "start" => $thing->start,
1347          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1348          "color"=> $color,          "color"=> $color,
# Line 1328  Line 1372 
1372          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1373          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1374    
1375          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1376                                    -host     => $WebConfig::DBHOST,
1377                                    -user     => $WebConfig::DBUSER,
1378                                    -password => $WebConfig::DBPWD);
1379    
1380          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1381          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1347  Line 1394 
1394                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1395              }              }
1396          }          }
1397            elsif($db =~ /PFAM/){
1398                my ($new_id) = ($id) =~ /(.*?)_/;
1399                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1400                if(!scalar(@$pfam_objs)){
1401                    $name_title = "name";
1402                    $name_value = "not available";
1403                    $description_title = "description";
1404                    $description_value = "not available";
1405                }
1406                else{
1407                    my $pfam_obj = $pfam_objs->[0];
1408                    $name_title = "name";
1409                    $name_value = $pfam_obj->term;
1410                    #$description_title = "description";
1411                    #$description_value = $pfam_obj->description;
1412                }
1413            }
1414    
1415          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1416    
# Line 1406  Line 1470 
1470  }  }
1471    
1472  sub display {  sub display {
1473      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1474    
1475      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1476      my $fig= new FIG;      #my $fig= new FIG;
1477      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1478    
1479      my $cleavage_prob;      my $cleavage_prob;
# Line 1429  Line 1493 
1493      #color is      #color is
1494      my $color = "6";      my $color = "6";
1495    
1496  =pod=  =head3
1497    
1498      if($cello_location){      if($cello_location){
1499          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1437  Line 1501 
1501    
1502          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1503                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1504                                'hover_title' => 'Localization',
1505                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1506    
1507          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1496  Line 1561 
1561          my $line_data =[];          my $line_data =[];
1562          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                              'short_title' => 'TM and SP',                              'short_title' => 'TM and SP',
1564                                'hover_title' => 'Localization',
1565                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1566    
1567          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
# Line 1549  Line 1615 
1615    
1616          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1617                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1618                                'hover_title' => 'Localization',
1619                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1620    
1621          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1669  Line 1736 
1736  =cut  =cut
1737    
1738  sub display {  sub display {
1739      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
     my $query = $self->query;  
1740    
1741      my $organism = $self->organism;      # declare variables
1742        my $window_size = $gd->window_size;
1743        my $peg = $thing->acc;
1744        my $query_id = $thing->query;
1745        my $organism = $thing->organism;
1746        my $abbrev_name = $fig->abbrev($organism);
1747        if (!$organism){
1748          $organism = $peg;
1749          $abbrev_name = $peg;
1750        }
1751      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1752      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1753      my $function = $self->function;      my $function = $thing->function;
1754      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1755      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1756      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1757      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1758      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1759        my $ln_hit = $thing->hlength;
1760    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1761    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1762        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1763        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1764    
1765      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;
1766    
1767        # hit sequence title
1768      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1769                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1770                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1771                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1772                            'no_middle_line' => '1'
1773                          };                          };
1774    
1775        # query sequence title
1776        my $replace_id = $peg;
1777        $replace_id =~ s/\|/_/ig;
1778        my $anchor_name = "anchor_". $replace_id;
1779        my $query_config = { 'title' => "Query",
1780                             'short_title' => "Query",
1781                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1782                             'basepair_offset' => '0',
1783                             'no_middle_line' => '1'
1784                             };
1785      my $line_data = [];      my $line_data = [];
1786        my $query_data = [];
1787    
1788      my $element_hash;      my $element_hash;
1789      my $links_list = [];      my $hit_links_list = [];
1790      my $descriptions = [];      my $hit_descriptions = [];
1791        my $query_descriptions = [];
1792      # get subsystem information  
1793      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1794        # evidence link
1795      my $link;      my $evidence_link;
1796      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1797               "link" => $url_link};        $evidence_link = "?page=Evidence&feature=".$peg;
1798      push(@$links_list,$link);      }
1799        else{
1800          my $db = &Observation::get_database($peg);
1801          my ($link_id) = ($peg) =~ /\|(.*)/;
1802          $evidence_link = &HTML::alias_url($link_id, $db);
1803          #print STDERR "LINK: $db    $evidence_link";
1804        }
1805        my $link = {"link_title" => $peg,
1806                    "link" => $evidence_link};
1807        push(@$hit_links_list,$link) if ($evidence_link);
1808    
1809      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1810      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1811          my $link;      my @subsystems;
1812          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1813            my $subsystem = $$array[0];
1814            push(@subsystems,$subsystem);
1815            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1816                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1817          push(@$links_list,$link);          push(@$hit_links_list,$link);
1818      }      }
1819    
1820      $link = {"link_title" => "blast against query",      # blast alignment
1821               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=tool_result&tool=bl2seq&peg1=$query&peg2=$peg"};      $link = {"link_title" => "view blast alignment",
1822      push (@$links_list,$link);               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1823        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1824    
1825        # description data
1826      my $description_function;      my $description_function;
1827      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1828                               "value" => $function};                               "value" => $function};
1829      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1830    
1831      my ($description_ss, $ss_string);      # subsystem description
1832      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1833      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1834        my $description_ss = {"title" => "subsystems",
1835                         "value" => $ss_string};                         "value" => $ss_string};
1836      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1837    
1838        # location description
1839        # hit
1840      my $description_loc;      my $description_loc;
1841      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1842                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1843      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1844    
1845      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1846                          "value" => $hit_stop};                          "value" => $ln_hit};
1847      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1848    
1849        # query
1850        $description_loc = {"title" => "Hit Location",
1851                            "value" => $query_start . " - " . $query_stop};
1852        push(@$query_descriptions, $description_loc);
1853    
1854        $description_loc = {"title" => "Sequence Length",
1855                            "value" => $ln_query};
1856        push(@$query_descriptions, $description_loc);
1857    
1858    
1859      my $evalue = $self->evalue;  
1860        # evalue score description
1861        my $evalue = $thing->evalue;
1862      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1863      {      {
1864          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1748  Line 1867 
1867      }      }
1868    
1869      my $color = &color($evalue);      my $color = &color($evalue);
   
1870      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1871                              "value" => $evalue};                              "value" => $evalue};
1872      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1873        push(@$query_descriptions, $description_eval);
1874    
1875      my $identity = $self->identity;      my $identity = $self->identity;
1876      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1877                                  "value" => $identity};                                  "value" => $identity};
1878      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1879        push(@$query_descriptions, $description_identity);
1880    
1881    
1882        my $number = $base_start + ($query_start-$hit_start);
1883        #print STDERR "START: $number";
1884        $element_hash = {
1885            "title" => $query_id,
1886            "start" => $base_start,
1887            "end" => $base_start+$ln_query,
1888            "type"=> 'box',
1889            "color"=> $color,
1890            "zlayer" => "2",
1891            "links_list" => $query_links_list,
1892            "description" => $query_descriptions
1893            };
1894        push(@$query_data,$element_hash);
1895    
1896        $element_hash = {
1897            "title" => $query_id . ': HIT AREA',
1898            "start" => $base_start + $query_start,
1899            "end" =>  $base_start + $query_stop,
1900            "type"=> 'smallbox',
1901            "color"=> $query_color,
1902            "zlayer" => "3",
1903            "links_list" => $query_links_list,
1904            "description" => $query_descriptions
1905            };
1906        push(@$query_data,$element_hash);
1907    
1908        $gd->add_line($query_data, $query_config);
1909    
1910    
1911      $element_hash = {      $element_hash = {
1912          "title" => $peg,          "title" => $peg,
1913          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1914          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1915          "type"=> 'box',          "type"=> 'box',
1916          "color"=> $color,          "color"=> $color,
1917          "zlayer" => "2",          "zlayer" => "2",
1918          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1919          "description" => $descriptions                  "description" => $hit_descriptions
1920                    };
1921        push(@$line_data,$element_hash);
1922    
1923        $element_hash = {
1924            "title" => $peg . ': HIT AREA',
1925            "start" => $base_start + $query_start,
1926            "end" =>  $base_start + $query_stop,
1927            "type"=> 'smallbox',
1928            "color"=> $hit_color,
1929            "zlayer" => "3",
1930            "links_list" => $hit_links_list,
1931            "description" => $hit_descriptions
1932          };          };
1933      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1934    
1935      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1936    
1937      return ($gd);      my $breaker = [];
1938        my $breaker_hash = {};
1939        my $breaker_config = { 'no_middle_line' => "1" };
1940    
1941        push (@$breaker, $breaker_hash);
1942        $gd->add_line($breaker, $breaker_config);
1943    
1944        return ($gd);
1945  }  }
1946    
1947  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1782  Line 1951 
1951  =cut  =cut
1952    
1953  sub display_domain_composition {  sub display_domain_composition {
1954      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1955    
1956      my $fig = new FIG;      #$fig = new FIG;
1957      my $peg = $self->acc;      my $peg = $self->acc;
1958    
1959      my $line_data = [];      my $line_data = [];
# Line 1792  Line 1961 
1961      my $descriptions = [];      my $descriptions = [];
1962    
1963      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1964        #my @domain_query_results = ();
1965      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1966          my $key = @$dqr[1];          my $key = @$dqr[1];
1967          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1817  Line 1986 
1986              }              }
1987          }          }
1988    
1989          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1990                                    -host     => $WebConfig::DBHOST,
1991                                    -user     => $WebConfig::DBUSER,
1992                                    -password => $WebConfig::DBPWD);
1993          my ($name_value,$description_value);          my ($name_value,$description_value);
1994    
1995          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1854  Line 2026 
2026          my $link;          my $link;
2027          my $link_url;          my $link_url;
2028          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"}
2029          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"}
2030          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2031    
2032          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1878  Line 2050 
2050      }      }
2051    
2052      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2053                            'hover_title' => 'Domain',
2054                          'short_title' => $peg,                          'short_title' => $peg,
2055                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2056    
# Line 1897  Line 2070 
2070  =cut  =cut
2071    
2072  sub display_table {  sub display_table {
2073      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2074        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2075    
2076      my $data = [];      my $scroll_list;
2077      my $count = 0;      foreach my $col (@$show_columns){
2078      my $content;          push (@$scroll_list, $col->{key});
2079      my $fig = new FIG;      }
2080      my $cgi = new CGI;  
2081      my @ids;      push (@ids, $query_fid);
2082      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2083          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2084          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2085      }      }
2086    
2087      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2088        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2089    
2090      # get the column for the subsystems      # get the column for the subsystems
2091      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2092    
2093      # get the column for the evidence codes      # get the column for the evidence codes
2094      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2095    
2096      # get the column for pfam_domain      # get the column for pfam_domain
2097      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2098    
2099        # get the column for molecular weight
2100        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2101    
2102        # get the column for organism's habitat
2103        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2104    
2105      my %e_identical = &get_essentially_identical($query_fid);      # get the column for organism's temperature optimum
2106      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2107    
2108        # get the column for organism's temperature range
2109        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2110    
2111        # get the column for organism's oxygen requirement
2112        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2113    
2114        # get the column for organism's pathogenicity
2115        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2116    
2117        # get the column for organism's pathogenicity host
2118        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2119    
2120        # get the column for organism's salinity
2121        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2122    
2123        # get the column for organism's motility
2124        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2125    
2126        # get the column for organism's gram stain
2127        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2128    
2129        # get the column for organism's endospores
2130        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2131    
2132        # get the column for organism's shape
2133        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2134    
2135        # get the column for organism's disease
2136        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2137    
2138        # get the column for organism's disease
2139        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2140    
2141        # get the column for transmembrane domains
2142        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2143    
2144        # get the column for similar to human
2145        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);
2146    
2147        # get the column for signal peptide
2148        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2149    
2150        # get the column for transmembrane domains
2151        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2152    
2153        # get the column for conserved neighborhood
2154        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2155    
2156        # get the column for cellular location
2157        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2158    
2159        # get the aliases
2160        my $alias_col;
2161        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2162             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2163             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2164             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2165             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2166            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2167        }
2168    
2169        # get the colors for the function cell
2170        my $functions = $fig->function_of_bulk(\@ids,1);
2171        $functional_color = &get_function_color_cell($functions, $fig);
2172        my $query_function = $fig->function_of($query_fid);
2173    
2174        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2175    
2176        my $figfam_data = &FIG::get_figfams_data();
2177        my $figfams = new FFs($figfam_data);
2178    
2179        my $func_color_offset=0;
2180        unshift(@$dataset, $query_fid);
2181      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2182            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2183            if ($thing eq $query_fid){
2184                $id = $thing;
2185                $taxid   = $fig->genome_of($id);
2186                $organism = $fig->genus_species($taxid);
2187                $current_function = $fig->function_of($id);
2188            }
2189            else{
2190          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2191    
2192                $id      = $thing->acc;
2193                $evalue  = $thing->evalue;
2194                $taxid   = $fig->genome_of($id);
2195                $iden    = $thing->identity;
2196                $organism= $thing->organism;
2197                $ln1     = $thing->qlength;
2198                $ln2     = $thing->hlength;
2199                $b1      = $thing->qstart;
2200                $e1      = $thing->qstop;
2201                $b2      = $thing->hstart;
2202                $e2      = $thing->hstop;
2203                $d1      = abs($e1 - $b1) + 1;
2204                $d2      = abs($e2 - $b2) + 1;
2205                $color1  = match_color( $b1, $e1, $ln1 );
2206                $color2  = match_color( $b2, $e2, $ln2 );
2207                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2208                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2209                $current_function = $thing->function;
2210            }
2211    
2212          my $single_domain = [];          my $single_domain = [];
2213          $count++;          $count++;
2214    
2215          my $id = $thing->acc;          # organisms cell
2216            my ($org, $org_color) = $fig->org_and_color_of($id);
2217            my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2218    
2219          my $iden    = $thing->identity;          # checkbox cell
2220          my $ln1     = $thing->qlength;          my ($box_cell,$tax, $radio_cell);
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
   
         # checkbox column  
2221          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2222          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2223          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;
2224          my ($tax) = ($id) =~ /fig\|(.*?)\./;          my $replace_id = $id;
2225            $replace_id =~ s/\|/_/ig;
2226            my $white = '#ffffff';
2227            $white = '#999966' if ($id eq $query_fid);
2228            $org_color = '#999966' if ($id eq $query_fid);
2229            my $anchor_name = "anchor_". $replace_id;
2230            if ($id =~ /^fig\|/){
2231              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');">);
2232              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2233              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2234              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2235              $tax = $fig->genome_of($id);
2236            }
2237            else{
2238              my $box = qq(<a name="$anchor_name"></a>);
2239              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2240            }
2241    
2242          # get the linked fig id          # get the linked fig id
2243          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2244          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2245              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";          $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2246          }          my $fig_col = {'data'=> $fig_data,
2247          else{                         'highlight'=>$white};
2248              $fig_col = &HTML::set_prot_links($cgi,$id);  
2249          }          $replace_id = $peg;
2250            $replace_id =~ s/\|/_/ig;
2251          push(@$single_domain,$box_col);                        # permanent column          $anchor_name = "anchor_". $replace_id;
2252          push(@$single_domain,$fig_col);                        # permanent column          my $query_config = { 'title' => "Query",
2253          push(@$single_domain,$thing->evalue);                  # permanent column                               'short_title' => "Query",
2254          push(@$single_domain,"$iden\%");                       # permanent column                               'title_link' => "changeSimsLocation('$replace_id')",
2255          push(@$single_domain,$reg1);                           # permanent column                               'basepair_offset' => '0'
2256          push(@$single_domain,$reg2);                           # permanent column                               };
2257          push(@$single_domain,$thing->organism);                # permanent column  
2258          push(@$single_domain,$thing->function);                # permanent column          # function cell
2259          foreach my $col (sort keys %$scroll_list){          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2260              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2261              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2262              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2263              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}          my $function_color;
2264              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}          if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2265              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2266              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2267              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2268              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2269              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2270              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2271              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2272              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            if ($current_function eq $query_function){
2273              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2274                $func_color_offset=1;
2275              }
2276              else{
2277                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2278          }          }
2279          push(@$data,$single_domain);          }
2280            else{
2281              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2282      }      }
2283    
2284            if ($id eq $query_fid){
2285                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2286                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2287                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2288            }
2289            else{
2290                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2291                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2292            }
2293    
2294            if ( ( $application->session->user) ){
2295                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2296                    push (@$single_domain,$radio_cell);
2297                }
2298            }
2299    
2300            my ($ff) = $figfams->families_containing_peg($id);
2301    
2302            foreach my $col (@$scroll_list){
2303                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2304                else { $highlight_color = "#ffffff"; }
2305    
2306                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2307                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2308                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2309                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2310                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2311                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2312                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2313                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2314                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2315                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2316                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2317                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2318                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2319                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2340            }
2341            push(@$data,$single_domain);
2342        }
2343      if ($count >0 ){      if ($count >0 ){
2344          $content = $data;          $content = $data;
2345      }      }
2346      else{      else{
2347          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2348      }      }
2349        shift(@$dataset);
2350      return ($content);      return ($content);
2351  }  }
2352    
# Line 2000  Line 2356 
2356      foreach my $id (@$ids){      foreach my $id (@$ids){
2357          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2358          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2359          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2360            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2361      }      }
2362      return (%column);      return (%column);
2363  }  }
2364    
2365    sub get_figfam_column{
2366        my ($ids, $fig, $cgi) = @_;
2367        my $column;
2368    
2369        my $figfam_data = &FIG::get_figfams_data();
2370        my $figfams = new FFs($figfam_data);
2371    
2372        foreach my $id (@$ids){
2373            my ($ff) =  $figfams->families_containing_peg($id);
2374            if ($ff){
2375                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2376            }
2377            else{
2378                push (@$column, " ");
2379            }
2380        }
2381    
2382        return $column;
2383    }
2384    
2385  sub get_subsystems_column{  sub get_subsystems_column{
2386      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2387    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2388      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2389      my %column;      my ($column, $ss);
2390      foreach my $id (@$ids){      foreach my $id (@$ids){
2391          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2392          my @subsystems;          my @subsystems;
2393    
2394          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2395              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2396                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2397                  $count++;                  $ss =~ s/_/ /ig;
2398                    push (@subsystems, "-" . $ss);
2399              }              }
2400              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2401              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2402          } else {          } else {
2403              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2404          }          }
2405            push (@$column, $ss->{$id});
2406      }      }
2407      return (%column);  
2408        if ($returnType eq 'hash') { return $ss; }
2409        elsif ($returnType eq 'array') { return $column; }
2410    }
2411    
2412    sub get_lineage_column{
2413        my ($ids, $fig, $cgi) = @_;
2414    
2415        my $lineages = $fig->taxonomy_list();
2416    
2417        foreach my $id (@$ids){
2418            my $genome = $fig->genome_of($id);
2419            if ($lineages->{$genome}){
2420    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2421                push (@$column, $lineages->{$genome});
2422            }
2423            else{
2424                push (@$column, " ");
2425            }
2426        }
2427        return $column;
2428    }
2429    
2430    sub match_color {
2431        my ( $b, $e, $n , $rgb) = @_;
2432        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2433        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2434        my $cov = ( $r - $l + 1 ) / $n;
2435        my $sat = 1 - 10 * $cov / 9;
2436        my $br  = 1;
2437        if ($rgb){
2438            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2439        }
2440        else{
2441            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2442        }
2443    }
2444    
2445    sub hsb2rgb {
2446        my ( $h, $s, $br ) = @_;
2447        $h = 6 * ($h - floor($h));
2448        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2449        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2450        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2451                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2452                                          :               ( 0,      1,      $h - 2 )
2453                                          )
2454                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2455                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2456                                          :               ( 1,      0,      6 - $h )
2457                                          );
2458        ( ( $r * $s + 1 - $s ) * $br,
2459          ( $g * $s + 1 - $s ) * $br,
2460          ( $b * $s + 1 - $s ) * $br
2461        )
2462    }
2463    
2464    sub html2rgb {
2465        my ($hex) = @_;
2466        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2467        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2468                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2469    
2470        my @R = split(//, $r);
2471        my @G = split(//, $g);
2472        my @B = split(//, $b);
2473    
2474        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2475        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2476        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2477    
2478        my $rgb = [$red, $green, $blue];
2479        return $rgb;
2480    
2481    }
2482    
2483    sub rgb2html {
2484        my ( $r, $g, $b ) = @_;
2485        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2486        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2487        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2488        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2489    }
2490    
2491    sub floor {
2492        my $x = $_[0];
2493        defined( $x ) || return undef;
2494        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2495    }
2496    
2497    sub get_function_color_cell{
2498      my ($functions, $fig) = @_;
2499    
2500      # figure out the quantity of each function
2501      my %hash;
2502      foreach my $key (keys %$functions){
2503        my $func = $functions->{$key};
2504        $hash{$func}++;
2505      }
2506    
2507      my %func_colors;
2508      my $count = 1;
2509      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2510        $func_colors{$key}=$count;
2511        $count++;
2512      }
2513    
2514      return \%func_colors;
2515  }  }
2516    
2517  sub get_essentially_identical{  sub get_essentially_identical{
2518      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2519      my $fig = new FIG;      #my $fig = new FIG;
2520    
2521      my %id_list;      my %id_list;
2522      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);
2523    
2524      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2525            if($thing->class eq "IDENTICAL"){
2526                my $rows = $thing->rows;
2527                my $count_identical = 0;
2528                foreach my $row (@$rows) {
2529                    my $id = $row->[0];
2530          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2531              $id_list{$id} = 1;              $id_list{$id} = 1;
2532          }          }
2533      }      }
2534            }
2535        }
2536    
2537    #    foreach my $id (@maps_to) {
2538    #        if (($id ne $fid) && ($fig->function_of($id))) {
2539    #           $id_list{$id} = 1;
2540    #        }
2541    #    }
2542      return(%id_list);      return(%id_list);
2543  }  }
2544    
2545    
2546  sub get_evidence_column{  sub get_evidence_column{
2547      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2548      my $fig = new FIG;      my ($column, $code_attributes);
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
2549    
2550      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      if (! defined $attributes) {
2551            my @attributes_array = $fig->get_attributes($ids);
2552            $attributes = \@attributes_array;
2553        }
2554    
2555        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2556      foreach my $key (@codes){      foreach my $key (@codes){
2557          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2558      }      }
2559    
2560      foreach my $id (@$ids){      foreach my $id (@$ids){
2561          # add evidence code with tool tip          # add evidence code with tool tip
2562          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2563    
2564          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2565              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2566              foreach my $code (@codes) {              foreach my $code (@codes) {
2567                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2568                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2076  Line 2572 
2572                  }                  }
2573                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2574              }              }
         }  
2575    
2576          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2577              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2084  Line 2579 
2579                                  {                                  {
2580                                      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));
2581          }          }
2582          $column{$id}=$ev_codes;  
2583            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2584            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2585      }      }
2586      return (%column);      return $column;
2587  }  }
2588    
2589  sub get_pfam_column{  sub get_attrb_column{
2590      my ($ids) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2591      my $fig = new FIG;  
2592      my $cgi = new CGI;      my ($column, %code_attributes, %attribute_locations);
2593      my (%column, %code_attributes, %attribute_locations);      my $dbmaster = DBMaster->new(-database =>'Ontology',
2594      my $dbmaster = DBMaster->new(-database =>'Ontology');                                   -host     => $WebConfig::DBHOST,
2595                                     -user     => $WebConfig::DBUSER,
2596                                     -password => $WebConfig::DBPWD);
2597    
2598        if ($colName eq "pfam"){
2599            if (! defined $attributes) {
2600                my @attributes_array = $fig->get_attributes($ids);
2601                $attributes = \@attributes_array;
2602            }
2603    
2604      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2605      foreach my $key (@codes){      foreach my $key (@codes){
2606          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2607          push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);              if ($name =~ /_/){
2608                    ($name) = ($key->[1]) =~ /(.*?)_/;
2609                }
2610                push (@{$code_attributes{$key->[0]}}, $name);
2611                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2612      }      }
2613    
2614      foreach my $id (@$ids){      foreach my $id (@$ids){
2615          # add evidence code with tool tip              # add pfam code
2616          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2617          my @pfam_codes = "";          my @pfam_codes = "";
2618          my %description_codes;          my %description_codes;
# Line 2119  Line 2628 
2628    
2629              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2630                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2631                  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>";
2632    
2633                  # get the locations for the domain                  # get the locations for the domain
2634                  my @locs;                  my @locs;
# Line 2127  Line 2636 
2636                      my ($loc) = ($part) =~ /\;(.*)/;                      my ($loc) = ($part) =~ /\;(.*)/;
2637                      push (@locs,$loc);                      push (@locs,$loc);
2638                  }                  }
2639                        my %locsaw;
2640                        foreach my $key (@locs) {$locsaw{$key}=1;}
2641                        @locs = keys %locsaw;
2642    
2643                  my $locations = join (", ", @locs);                  my $locations = join (", ", @locs);
2644    
2645                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
# Line 2134  Line 2647 
2647                  }                  }
2648                  else {                  else {
2649                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2650                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2651                      push(@pfam_codes, "$pfam_link ($locations)");                      push(@pfam_codes, "$pfam_link ($locations)");
2652                  }                  }
2653              }              }
2654    
2655                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2656                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2657                }
2658            }
2659        }
2660        elsif ($colName eq 'cellular_location'){
2661            if (! defined $attributes) {
2662                my @attributes_array = $fig->get_attributes($ids);
2663                $attributes = \@attributes_array;
2664          }          }
2665    
2666          $column{$id}=join("<br><br>", @pfam_codes);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2667            foreach my $key (@codes){
2668                my ($loc) = ($key->[1]) =~ /::(.*)/;
2669                my ($new_loc, @all);
2670                @all = split (//, $loc);
2671                my $count = 0;
2672                foreach my $i (@all){
2673                    if ( ($i eq uc($i)) && ($count > 0) ){
2674                        $new_loc .= " " . $i;
2675                    }
2676                    else{
2677                        $new_loc .= $i;
2678                    }
2679                    $count++;
2680                }
2681                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2682            }
2683    
2684            foreach my $id (@$ids){
2685                my (@values, $entry);
2686                #@values = (" ");
2687                if (defined @{$code_attributes{$id}}){
2688                    my @ncodes = @{$code_attributes{$id}};
2689                    foreach my $code (@ncodes){
2690                        push (@values, $code->[0] . ", " . $code->[1]);
2691                    }
2692                }
2693                else{
2694                    @values = ("Not available");
2695      }      }
     return (%column);  
2696    
2697                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2698                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2699            }
2700        }
2701        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2702                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2703            if (! defined $attributes) {
2704                my @attributes_array = $fig->get_attributes($ids);
2705                $attributes = \@attributes_array;
2706  }  }
2707    
2708  sub get_prefer {          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2709      my ($fid, $db, $all_aliases) = @_;          foreach my $key (@codes){
2710      my $fig = new FIG;              push (@{$code_attributes{$key->[0]}}, $key->[2]);
2711      my $cgi = new CGI;          }
2712    
2713            foreach my $id (@$ids){
2714                my (@values, $entry);
2715                #@values = (" ");
2716                if (defined @{$code_attributes{$id}}){
2717                    my @ncodes = @{$code_attributes{$id}};
2718                    foreach my $code (@ncodes){
2719                        push (@values, $code);
2720                    }
2721                }
2722                else{
2723                    @values = ("Not available");
2724                }
2725    
2726                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2727                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2728            }
2729        }
2730        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2731                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2732                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2733                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2734                ($colName eq 'gc_content') ) {
2735            if (! defined $attributes) {
2736                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2737                $attributes = \@attributes_array;
2738            }
2739    
2740            my $genomes_with_phenotype;
2741            foreach my $attribute (@$attributes){
2742                my $genome = $attribute->[0];
2743                $genomes_with_phenotype->{$genome} = $attribute->[2];
2744            }
2745    
2746      foreach my $alias (@{$$all_aliases{$fid}}){          foreach my $id (@$ids){
2747                my $genome = $fig->genome_of($id);
2748                my @values = (' ');
2749                if (defined $genomes_with_phenotype->{$genome}){
2750                    push (@values, $genomes_with_phenotype->{$genome});
2751                }
2752                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2753                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2754            }
2755        }
2756    
2757        return $column;
2758    }
2759    
2760    
2761    sub get_db_aliases {
2762        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2763    
2764        my $db_array;
2765        my $all_aliases = $fig->feature_aliases_bulk($ids);
2766        foreach my $id (@$ids){
2767            foreach my $alias (@{$$all_aliases{$id}}){
2768          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2769          if ($id_db eq $db){              next if ( ($id_db ne $db) && ($db ne 'all') );
2770              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              next if ($aliases->{$id}->{$db});
2771              return ($acc_col);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2772          }          }
2773            if (!defined( $aliases->{$id}->{$db})){
2774                $aliases->{$id}->{$db} = " ";
2775      }      }
2776      return (" ");          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2777            push (@$db_array, $aliases->{$id}->{$db});
2778  }  }
2779    
2780        if ($returnType eq 'hash') { return $aliases; }
2781        elsif ($returnType eq 'array') { return $db_array; }
2782    }
2783    
2784    
2785    
2786  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2787    
2788  sub color {  sub color {
2789      my ($evalue) = @_;      my ($evalue) = @_;
2790        my $palette = WebColors::get_palette('vitamins');
2791      my $color;      my $color;
2792      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2793      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2794      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2795      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2796      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2797      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2798      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2799      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2800      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2801      else{        $color = 60;    }      else{        $color = $palette->[9];    }
2802      return ($color);      return ($color);
2803  }  }
2804    
# Line 2195  Line 2818 
2818  }  }
2819    
2820  sub display {  sub display {
2821      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2822    
2823        $taxes = $fig->taxonomy_list();
2824    
2825      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2826      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2827      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2828      my $fig = new FIG;      my $range = $gd_window_size;
2829      my $all_regions = [];      my $all_regions = [];
2830      my $gene_associations={};      my $gene_associations={};
2831    
# Line 2225  Line 2850 
2850      my ($region_start, $region_end);      my ($region_start, $region_end);
2851      if ($beg < $end)      if ($beg < $end)
2852      {      {
2853          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2854          $region_end = $end+4000;          $region_end = $end+ ($range);
2855          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2856      }      }
2857      else      else
2858      {      {
2859          $region_start = $end-4000;          $region_start = $end-($range);
2860          $region_end = $beg+4000;          $region_end = $beg+($range);
2861          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2862          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2863          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2240  Line 2865 
2865    
2866      # call genes in region      # call genes in region
2867      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);
2868        #foreach my $feat (@$target_gene_features){
2869        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2870        #}
2871      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2872      my (@start_array_region);      my (@start_array_region);
2873      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2874    
2875      my %all_genes;      my %all_genes;
2876      my %all_genomes;      my %all_genomes;
2877      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2878            #if ($feature =~ /peg/){
2879                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2880            #}
2881        }
2882    
2883        my @selected_sims;
2884    
2885      if ($compare_or_coupling eq "sims"){      if ($compare_or_coupling eq "sims"){
2886          # get the selected boxes          # get the selected boxes
2887          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2888    
2889          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
2890          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2891              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2892                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2893                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2894                  my ($genome1) = ($genome) =~ /(.*)\./;  
2895                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
2896                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
2897                    #my ($genome1) = ($genome) =~ /(.*)\./;
2898                    my $lineage = $taxes->{$genome};
2899                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2900                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2901                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2902                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2903                            push (@selected_sims, $sim->acc);
2904                      }                      }
2905                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2906              }              }
2907          }          }
2908          else{          else{
2909              my $simcount = 0;              my $simcount = 0;
2910              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2911                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2912                  push (@selected_sims, $sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2913    
2914                    push (@selected_sims, $sim->acc);
2915                  $simcount++;                  $simcount++;
2916                  last if ($simcount > 4);                  last if ($simcount > 4);
2917              }              }
2918          }          }
2919    
2920            my %saw;
2921            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2922    
2923          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2924          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2925              #get the organism genome              #get the organism genome
# Line 2304  Line 2942 
2942              my ($region_start, $region_end);              my ($region_start, $region_end);
2943              if ($beg < $end)              if ($beg < $end)
2944              {              {
2945                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2946                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2947                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2948              }              }
2949              else              else
2950              {              {
2951                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2952                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2953                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2954                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2955                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2327  Line 2965 
2965    
2966      }      }
2967    
2968        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2969      # cluster the genes      # cluster the genes
2970      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2971      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2972        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2973        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2974    
2975      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2976          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2977          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2978          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2979          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2980          my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2981          my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
2982            #my $lineage = $fig->taxonomy_of($region_genome);
2983          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2984          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2985                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2370  Line 3012 
3012    
3013              # get subsystem information              # get subsystem information
3014              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3015              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3016    
3017              my $link;              my $link;
3018              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3019                       "link" => $url_link};                       "link" => $url_link};
3020              push(@$links_list,$link);              push(@$links_list,$link);
3021    
3022              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3023              foreach my $subsystem (@subsystems){              my @subsystems;
3024                foreach my $array (@subs){
3025                    my $subsystem = $$array[0];
3026                    my $ss = $subsystem;
3027                    $ss =~ s/_/ /ig;
3028                    push (@subsystems, $ss);
3029                  my $link;                  my $link;
3030                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3031                           "link_title" => $subsystem};                           "link_title" => $ss};
3032                    push(@$links_list,$link);
3033                }
3034    
3035                if ($fid1 eq $fid){
3036                    my $link;
3037                    $link = {"link_title" => "Annotate this sequence",
3038                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3039                  push(@$links_list,$link);                  push(@$links_list,$link);
3040              }              }
3041    
# Line 2415  Line 3069 
3069                  $prev_stop = $stop;                  $prev_stop = $stop;
3070                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3071    
3072                  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})){
3073                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3074                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3075                  }                  }
3076    
3077                    my $title = $fid1;
3078                    if ($fid1 eq $fid){
3079                        $title = "My query gene: $fid1";
3080                    }
3081    
3082                  $element_hash = {                  $element_hash = {
3083                      "title" => $fid1,                      "title" => $title,
3084                      "start" => $start,                      "start" => $start,
3085                      "end" =>  $stop,                      "end" =>  $stop,
3086                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2434  Line 3093 
3093                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3094                  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;}
3095                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3096    
3097                    if ($fid1 eq $fid){
3098                        $element_hash = {
3099                            "title" => 'Query',
3100                            "start" => $start,
3101                            "end" =>  $stop,
3102                            "type"=> 'bigbox',
3103                            "color"=> $color,
3104                            "zlayer" => "1"
3105                            };
3106    
3107                        # if there is an overlap, put into second line
3108                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3109                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3110                    }
3111              }              }
3112          }          }
3113          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3114          $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);
3115      }      }
3116      return $gd;      return ($gd, \@selected_sims);
3117  }  }
3118    
3119  sub cluster_genes {  sub cluster_genes {
# Line 2509  Line 3183 
3183      }      }
3184    
3185      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3186          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3187              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3188                  foreach $y (@$x) {                  foreach $y (@$x) {
3189                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2527  Line 3201 
3201      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3202      return ($i < @$xL);      return ($i < @$xL);
3203  }  }
3204    
3205    #############################################
3206    #############################################
3207    package Observation::Commentary;
3208    
3209    use base qw(Observation);
3210    
3211    =head3 display_protein_commentary()
3212    
3213    =cut
3214    
3215    sub display_protein_commentary {
3216        my ($self,$dataset,$mypeg,$fig) = @_;
3217    
3218        my $all_rows = [];
3219        my $content;
3220        #my $fig = new FIG;
3221        my $cgi = new CGI;
3222        my $count = 0;
3223        my $peg_array = [];
3224        my ($evidence_column, $subsystems_column,  %e_identical);
3225    
3226        if (@$dataset != 1){
3227            foreach my $thing (@$dataset){
3228                if ($thing->class eq "SIM"){
3229                    push (@$peg_array, $thing->acc);
3230                }
3231            }
3232            # get the column for the evidence codes
3233            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3234    
3235            # get the column for the subsystems
3236            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3237    
3238            # get essentially identical seqs
3239            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3240        }
3241        else{
3242            push (@$peg_array, @$dataset);
3243        }
3244    
3245        my $selected_sims = [];
3246        foreach my $id (@$peg_array){
3247            last if ($count > 10);
3248            my $row_data = [];
3249            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3250            $org = $fig->org_of($id);
3251            $function = $fig->function_of($id);
3252            if ($mypeg ne $id){
3253                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3254                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3255                if (defined($e_identical{$id})) { $id_cell .= "*";}
3256            }
3257            else{
3258                $function_cell = "&nbsp;&nbsp;$function";
3259                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3260                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3261            }
3262    
3263            push(@$row_data,$id_cell);
3264            push(@$row_data,$org);
3265            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3266            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3267            push(@$row_data, $fig->translation_length($id));
3268            push(@$row_data,$function_cell);
3269            push(@$all_rows,$row_data);
3270            push (@$selected_sims, $id);
3271            $count++;
3272        }
3273    
3274        if ($count >0){
3275            $content = $all_rows;
3276        }
3277        else{
3278            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3279        }
3280        return ($content,$selected_sims);
3281    }
3282    
3283    sub display_protein_history {
3284        my ($self, $id,$fig) = @_;
3285        my $all_rows = [];
3286        my $content;
3287    
3288        my $cgi = new CGI;
3289        my $count = 0;
3290        foreach my $feat ($fig->feature_annotations($id)){
3291            my $row = [];
3292            my $col1 = $feat->[2];
3293            my $col2 = $feat->[1];
3294            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3295            my $text = $feat->[3];
3296    
3297            push (@$row, $col1);
3298            push (@$row, $col2);
3299            push (@$row, $text);
3300            push (@$all_rows, $row);
3301            $count++;
3302        }
3303        if ($count > 0){
3304            $content = $all_rows;
3305        }
3306        else {
3307            $content = "There is no history for this PEG";
3308        }
3309    
3310        return($content);
3311    }
3312    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3