[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.37, Tue Sep 4 18:34:13 2007 UTC revision 1.59, Mon Jun 2 05:05:35 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5  use Data::Dumper;  use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 86  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 305  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 360  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head3 get_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=();
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $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);  
     }  
388    
389      if ( @subsystems ) {      # call function that fetches attribute based observations
390          $content .= qq(<tr><td>Subsystems</td><td>);      # returns an array of arrays of hashes
391          foreach my $subsystem ( @subsystems ) {      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
392              $content .= join(" -- ", @$subsystem) . "<br>\n";  
393        foreach my $dataset (@matched_datasets) {
394            my $object;
395            if ($dataset->{'class'} eq "SIM"){
396                $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          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
408          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
409              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
410          }      my $content = [];
411          $content .= qq(</td></tr></table>\n);      my $row = [];
     }  
412    
413      $content .= qq(</table><p>\n);      my $org_name = $fig->org_of($fid);
414        my $org_id = $fig->genome_of($fid);
415        my $function = $fig->function_of($fid);
416        #my $taxonomy = $fig->taxonomy_of($org_id);
417        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        push(@$content, $row);
434    
435      return ($content);      return ($content);
436  }  }
# Line 435  Line 441 
441  =cut  =cut
442    
443  sub get_sims_summary {  sub get_sims_summary {
444      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
445      my %families;      my %families;
446      my @sims= $fig->nsims($fid,20000,10,"all");      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 $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));              $id = $thing;
452                $evalue = -1;
453            }
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);
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);
474              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
475                $families{lineage}{$tax} = join(";", @currLineage);
476                if (defined ($families{evalue}{$tax})){
477                    if ($evalue < $families{evalue}{$tax}){
478                        $families{evalue}{$tax} = $evalue;
479                        $families{color}{$tax} = &get_taxcolor($evalue);
480                    }
481                }
482                else{
483                    $families{evalue}{$tax} = $evalue;
484                    $families{color}{$tax} = &get_taxcolor($evalue);
485                }
486    
487              $parent_tax = $tax;              $parent_tax = $tax;
488                $level++;
489          }          }
490      }      }
491    
# Line 459  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 470  Line 508 
508    
509  =cut  =cut
510    
511    sub get_taxcolor{
512        my ($evalue) = @_;
513        my $color;
514        if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
519        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
520        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
521        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
522        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
523        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
524        else{        $color = "#6666FF";    }
525        return ($color);
526    }
527    
528    
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 490  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 517  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 528  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 540  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 579  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 639  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,1e-20,"all");        $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 682  Line 743 
743          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
744    
745          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
746                        'query' => $sim->[0],
747                      'acc' => $hit,                      'acc' => $hit,
748                      'identity' => $percent,                      'identity' => $percent,
749                      'type' => 'seq',                      'type' => 'seq',
# Line 711  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 722  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 736  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 776  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 794  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 905  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 936  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 960  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 1064  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 1128  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 1143  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 1197  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 1216  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 1252  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 1282  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 1301  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 1353  Line 1463 
1463      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1464      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1465      if($cello_location){      if($cello_location){
1466          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1467          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1468      }      }
1469      return ($html);      return ($html);
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 1383  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 1391  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 1415  Line 1526 
1526          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1527      }      }
1528    
 =cut  
   
1529      $color = "2";      $color = "2";
1530      if($tmpred_score){      if($tmpred_score){
1531          my $line_data =[];          my $line_data =[];
# Line 1446  Line 1555 
1555          }          }
1556          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1557      }      }
1558    =cut
1559    
1560      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1561          my $line_data =[];          my $line_data =[];
1562          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                              'short_title' => 'Phobius',                              '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){
1568              my $descriptions = [];              my $descriptions = [];
1569              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1570                               "value" => $tm_loc};                               "value" => $tm_loc};
1571              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1572    
1573              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1574    
1575              my $element_hash = {              my $element_hash = {
1576              "title" => "phobius transmembrane location",              "title" => "Phobius",
1577              "start" => $begin + 1,              "start" => $begin + 1,
1578              "end" =>  $end + 1,              "end" =>  $end + 1,
1579              "color"=> '6',              "color"=> '6',
# Line 1496  Line 1607 
1607          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1608      }      }
1609    
1610    =head3
1611      $color = "1";      $color = "1";
1612      if($signal_peptide_score){      if($signal_peptide_score){
1613          my $line_data = [];          my $line_data = [];
# Line 1504  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 1528  Line 1640 
1640          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1641          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1642      }      }
1643    =cut
1644    
1645      return ($gd);      return ($gd);
1646    
# Line 1599  Line 1712 
1712      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1713      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1714      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1715        $self->{query} = $dataset->{'query'};
1716      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1717      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1718      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1622  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) = @_;
1740    
1741      my $fig = new FIG;      # declare variables
1742      my $peg = $self->acc;      my $window_size = $gd->window_size;
1743        my $peg = $thing->acc;
1744      my $organism = $self->organism;      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    
1763      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;
1764    
1765        # hit sequence title
1766      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1767                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1768                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1769                          'basepair_offset' => '0'                          'basepair_offset' => '0'
1770                          };                          };
1771    
1772        # query sequence title
1773        my $replace_id = $peg;
1774        $replace_id =~ s/\|/_/ig;
1775        my $anchor_name = "anchor_". $replace_id;
1776        my $query_config = { 'title' => "Query",
1777                             'short_title' => "Query",
1778                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1779                             'basepair_offset' => '0'
1780                             };
1781      my $line_data = [];      my $line_data = [];
1782        my $query_data = [];
1783    
1784      my $element_hash;      my $element_hash;
1785      my $links_list = [];      my $hit_links_list = [];
1786      my $descriptions = [];      my $hit_descriptions = [];
1787        my $query_descriptions = [];
1788      # get subsystem information  
1789      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1790        # evidence link
1791      my $link;      my $evidence_link;
1792      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1793               "link" => $url_link};        $evidence_link = "?page=Evidence&feature=".$peg;
1794      push(@$links_list,$link);      }
1795        else{
1796          my $db = &Observation::get_database($peg);
1797          my ($link_id) = ($peg) =~ /\|(.*)/;
1798          $evidence_link = &HTML::alias_url($link_id, $db);
1799          #print STDERR "LINK: $db    $evidence_link";
1800        }
1801        my $link = {"link_title" => $peg,
1802                    "link" => $evidence_link};
1803        push(@$hit_links_list,$link) if ($evidence_link);
1804    
1805      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1806      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1807          my $link;      my @subsystems;
1808          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1809            my $subsystem = $$array[0];
1810            push(@subsystems,$subsystem);
1811            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1812                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1813          push(@$links_list,$link);          push(@$hit_links_list,$link);
1814      }      }
1815    
1816        # blast alignment
1817        $link = {"link_title" => "view blast alignment",
1818                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1819        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1820    
1821        # description data
1822      my $description_function;      my $description_function;
1823      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1824                               "value" => $function};                               "value" => $function};
1825      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1826    
1827      my ($description_ss, $ss_string);      # subsystem description
1828      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1829      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1830        my $description_ss = {"title" => "subsystems",
1831                         "value" => $ss_string};                         "value" => $ss_string};
1832      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1833    
1834        # location description
1835        # hit
1836      my $description_loc;      my $description_loc;
1837      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1838                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1839      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
   
     $description_loc = {"title" => "location stop",  
                         "value" => $hit_stop};  
     push(@$descriptions, $description_loc);  
1840    
1841      my $evalue = $self->evalue;      $description_loc = {"title" => "Sequence Length",
1842                            "value" => $ln_hit};
1843        push(@$hit_descriptions, $description_loc);
1844    
1845        # query
1846        $description_loc = {"title" => "Hit Location",
1847                            "value" => $query_start . " - " . $query_stop};
1848        push(@$query_descriptions, $description_loc);
1849    
1850        $description_loc = {"title" => "Sequence Length",
1851                            "value" => $ln_query};
1852        push(@$query_descriptions, $description_loc);
1853    
1854    
1855    
1856        # evalue score description
1857        my $evalue = $thing->evalue;
1858      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1859      {      {
1860          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1696  Line 1863 
1863      }      }
1864    
1865      my $color = &color($evalue);      my $color = &color($evalue);
   
1866      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1867                              "value" => $evalue};                              "value" => $evalue};
1868      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1869        push(@$query_descriptions, $description_eval);
1870    
1871      my $identity = $self->identity;      my $identity = $self->identity;
1872      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1873                                  "value" => $identity};                                  "value" => $identity};
1874      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1875        push(@$query_descriptions, $description_identity);
1876    
1877    
1878        my $number = $base_start + ($query_start-$hit_start);
1879        #print STDERR "START: $number";
1880        $element_hash = {
1881            "title" => $query_id,
1882            "start" => $base_start,
1883            "end" => $base_start+$ln_query,
1884            "type"=> 'box',
1885            "color"=> $color,
1886            "zlayer" => "2",
1887            "links_list" => $query_links_list,
1888            "description" => $query_descriptions
1889            };
1890        push(@$query_data,$element_hash);
1891    
1892        $element_hash = {
1893            "title" => $query_id . ': HIT AREA',
1894            "start" => $base_start + $query_start,
1895            "end" =>  $base_start + $query_stop,
1896            "type"=> 'smallbox',
1897            "color"=> $query_color,
1898            "zlayer" => "3",
1899            "links_list" => $query_links_list,
1900            "description" => $query_descriptions
1901            };
1902        push(@$query_data,$element_hash);
1903    
1904        $gd->add_line($query_data, $query_config);
1905    
1906    
1907      $element_hash = {      $element_hash = {
1908          "title" => $peg,          "title" => $peg,
1909          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1910          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1911          "type"=> 'box',          "type"=> 'box',
1912          "color"=> $color,          "color"=> $color,
1913          "zlayer" => "2",          "zlayer" => "2",
1914          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1915          "description" => $descriptions                  "description" => $hit_descriptions
1916          };          };
1917      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1918    
1919        $element_hash = {
1920            "title" => $peg . ': HIT AREA',
1921            "start" => $base_start + $query_start,
1922            "end" =>  $base_start + $query_stop,
1923            "type"=> 'smallbox',
1924            "color"=> $hit_color,
1925            "zlayer" => "3",
1926            "links_list" => $hit_links_list,
1927            "description" => $hit_descriptions
1928            };
1929        push(@$line_data,$element_hash);
1930    
1931      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1932    
1933      return ($gd);      my $breaker = [];
1934        my $breaker_hash = {};
1935        my $breaker_config = { 'no_middle_line' => "1" };
1936    
1937        push (@$breaker, $breaker_hash);
1938        $gd->add_line($breaker, $breaker_config);
1939    
1940        return ($gd);
1941  }  }
1942    
1943  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1730  Line 1947 
1947  =cut  =cut
1948    
1949  sub display_domain_composition {  sub display_domain_composition {
1950      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1951    
1952      my $fig = new FIG;      #$fig = new FIG;
1953      my $peg = $self->acc;      my $peg = $self->acc;
1954    
1955      my $line_data = [];      my $line_data = [];
# Line 1740  Line 1957 
1957      my $descriptions = [];      my $descriptions = [];
1958    
1959      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1960        #my @domain_query_results = ();
1961      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1962          my $key = @$dqr[1];          my $key = @$dqr[1];
1963          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1765  Line 1982 
1982              }              }
1983          }          }
1984    
1985          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1986                                    -host     => $WebConfig::DBHOST,
1987                                    -user     => $WebConfig::DBUSER,
1988                                    -password => $WebConfig::DBPWD);
1989          my ($name_value,$description_value);          my ($name_value,$description_value);
1990    
1991          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1802  Line 2022 
2022          my $link;          my $link;
2023          my $link_url;          my $link_url;
2024          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"}
2025          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"}
2026          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2027    
2028          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1826  Line 2046 
2046      }      }
2047    
2048      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2049                            'hover_title' => 'Domain',
2050                          'short_title' => $peg,                          'short_title' => $peg,
2051                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2052    
# Line 1845  Line 2066 
2066  =cut  =cut
2067    
2068  sub display_table {  sub display_table {
2069      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
2070    
2071      my $data = [];      my $data = [];
2072      my $count = 0;      my $count = 0;
2073      my $content;      my $content;
     my $fig = new FIG;  
2074      my $cgi = new CGI;      my $cgi = new CGI;
2075      my @ids;      my @ids;
2076        $lineages = $fig->taxonomy_list();
2077    
2078      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2079          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2080          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2081      }      }
2082    
2083      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical, $function_color);
2084        my @attributes = $fig->get_attributes(\@ids);
2085    
2086      # get the column for the subsystems      # get the column for the subsystems
2087      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
2088    
2089      # get the column for the evidence codes      # get the column for the evidence codes
2090      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
2091    
2092      # get the column for pfam_domain      # get the column for pfam_domain
2093      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
2094    
2095        # get the colors for the function cell
2096        my $functions = $fig->function_of_bulk(\@ids,1);
2097        $function_color = &get_function_color_cell($functions, $fig);
2098        my $query_function = $fig->function_of($query_fid);
2099    
2100      my %e_identical = &get_essentially_identical($query_fid);      %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2101      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
2102        #my $alias_col = {};
2103    
2104        my $figfam_data = &FIG::get_figfams_data();
2105        my $figfams = new FFs($figfam_data);
2106    
2107        my $func_color_offset=0;
2108      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2109          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2110          my $single_domain = [];          my $single_domain = [];
2111          $count++;          $count++;
2112    
2113          my $id = $thing->acc;          my $id = $thing->acc;
2114            my $taxid   = $fig->genome_of($id);
2115          my $iden    = $thing->identity;          my $iden    = $thing->identity;
2116          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
2117          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1888  Line 2121 
2121          my $e2      = $thing->hstop;          my $e2      = $thing->hstop;
2122          my $d1      = abs($e1 - $b1) + 1;          my $d1      = abs($e1 - $b1) + 1;
2123          my $d2      = abs($e2 - $b2) + 1;          my $d2      = abs($e2 - $b2) + 1;
2124          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $color1  = match_color( $b1, $e1, $ln1 );
2125          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $color2  = match_color( $b2, $e2, $ln2 );
2126            my $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2127            my $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2128    
2129            # organisms cell
2130            my ($org, $org_color) = $fig->org_and_color_of($id);
2131            my $org_cell = { 'data' =>  $thing->organism, 'highlight' => $org_color};
2132    
2133          # checkbox column          # checkbox cell
2134            my ($box_cell,$tax);
2135          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2136          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2137          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;
2138            my $replace_id = $id;
2139            $replace_id =~ s/\|/_/ig;
2140            my $anchor_name = "anchor_". $replace_id;
2141            if ($id =~ /^fig\|/){
2142              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');">);
2143              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2144              ($tax) = ($id) =~ /fig\|(.*?)\./;
2145            }
2146            else{
2147              my $box = qq(<a name="$anchor_name"></a>);
2148              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2149            }
2150    
2151          # get the linked fig id          # get the linked fig id
2152          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2153          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2154              $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>);
2155          }          my $fig_col = {'data'=> $fig_data,
2156          else{                         'highlight'=>"#ffffff"};
2157              $fig_col = &HTML::set_prot_links($cgi,$id);  
2158          }      $replace_id = $peg;
2159        $replace_id =~ s/\|/_/ig;
2160          push(@$single_domain,$box_col);                        # permanent column      $anchor_name = "anchor_". $replace_id;
2161          push(@$single_domain,$fig_col);                        # permanent column      my $query_config = { 'title' => "Query",
2162          push(@$single_domain,$thing->evalue);                  # permanent column                           'short_title' => "Query",
2163          push(@$single_domain,"$iden\%");                       # permanent column                           'title_link' => "changeSimsLocation('$replace_id')",
2164          push(@$single_domain,$reg1);                           # permanent column                           'basepair_offset' => '0'
2165          push(@$single_domain,$reg2);                           # permanent column                           };
2166          push(@$single_domain,$thing->organism);                # permanent column          # function cell
2167          push(@$single_domain,$thing->function);                # permanent column          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2168                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2169                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2170            my $current_function =  $thing->function;
2171            my $function_color = $function_cell_colors->{ $function_color->{$current_function} - $func_color_offset};
2172            my $function_cell;
2173            if ($current_function){
2174              if ($current_function eq $query_function){
2175                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2176                $func_color_offset=1;
2177              }
2178              else{
2179                $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2180              }
2181            }
2182            else{
2183              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2184            }
2185    
2186            push (@$single_domain, $box_cell, $fig_col, {'data'=> $thing->evalue, 'highlight'=>"#ffffff"},
2187                   {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);   # permanent columns
2188    
2189            my ($ff) = $figfams->families_containing_peg($id);
2190    
2191          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
2192              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,{'data'=>$subsystems_column{$id},'highlight'=>"#ffffff"});}
2193              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column{$id},'highlight'=>"#ffffff"});}
2194              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,{'data'=>$pfam_column{$id},'highlight'=>"#ffffff"});}
2195              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>"#ffffff"});}
2196              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>"#ffffff"});}
2197              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>"#ffffff"});}
2198              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>"#ffffff"});}
2199              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>"#ffffff"});}
2200              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>"#ffffff"});}
2201              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>"#ffffff"});}
2202              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>"#ffffff"});}
2203              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>"#ffffff"});}
2204              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>"#ffffff"});}
2205                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>"#ffffff"});}
2206                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2207                #elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2208                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>"#ffffff"});}
2209          }          }
2210          push(@$data,$single_domain);          push(@$data,$single_domain);
2211      }      }
   
2212      if ($count >0 ){      if ($count >0 ){
2213          $content = $data;          $content = $data;
2214      }      }
# Line 1946  Line 2224 
2224      foreach my $id (@$ids){      foreach my $id (@$ids){
2225          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2226          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2227          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2228            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2229      }      }
2230      return (%column);      return (%column);
2231  }  }
2232    
2233  sub get_subsystems_column{  sub get_subsystems_column{
2234      my ($ids) = @_;      my ($ids,$fig) = @_;
2235    
2236      my $fig = new FIG;      #my $fig = new FIG;
2237      my $cgi = new CGI;      my $cgi = new CGI;
2238      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2239      my %column;      my %column;
# Line 1963  Line 2242 
2242          my @subsystems;          my @subsystems;
2243    
2244          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2245              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2246                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2247                  $count++;                  $ss =~ s/_/ /ig;
2248                    push (@subsystems, "-" . $ss);
2249              }              }
2250              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2251              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1977  Line 2256 
2256      return (%column);      return (%column);
2257  }  }
2258    
2259    sub match_color {
2260        my ( $b, $e, $n , $rgb) = @_;
2261        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2262        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2263        my $cov = ( $r - $l + 1 ) / $n;
2264        my $sat = 1 - 10 * $cov / 9;
2265        my $br  = 1;
2266        if ($rgb){
2267            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2268        }
2269        else{
2270            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2271        }
2272    }
2273    
2274    sub hsb2rgb {
2275        my ( $h, $s, $br ) = @_;
2276        $h = 6 * ($h - floor($h));
2277        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2278        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2279        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2280                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2281                                          :               ( 0,      1,      $h - 2 )
2282                                          )
2283                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2284                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2285                                          :               ( 1,      0,      6 - $h )
2286                                          );
2287        ( ( $r * $s + 1 - $s ) * $br,
2288          ( $g * $s + 1 - $s ) * $br,
2289          ( $b * $s + 1 - $s ) * $br
2290        )
2291    }
2292    
2293    sub html2rgb {
2294        my ($hex) = @_;
2295        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2296        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2297                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2298    
2299        my @R = split(//, $r);
2300        my @G = split(//, $g);
2301        my @B = split(//, $b);
2302    
2303        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2304        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2305        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2306    
2307        my $rgb = [$red, $green, $blue];
2308        return $rgb;
2309    
2310    }
2311    
2312    sub rgb2html {
2313        my ( $r, $g, $b ) = @_;
2314        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2315        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2316        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2317        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2318    }
2319    
2320    sub floor {
2321        my $x = $_[0];
2322        defined( $x ) || return undef;
2323        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2324    }
2325    
2326    sub get_function_color_cell{
2327      my ($functions, $fig) = @_;
2328    
2329      # figure out the quantity of each function
2330      my %hash;
2331      foreach my $key (keys %$functions){
2332        my $func = $functions->{$key};
2333        $hash{$func}++;
2334      }
2335    
2336      my %func_colors;
2337      my $count = 1;
2338      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2339        $func_colors{$key}=$count;
2340        $count++;
2341      }
2342    
2343      return \%func_colors;
2344    }
2345    
2346  sub get_essentially_identical{  sub get_essentially_identical{
2347      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2348      my $fig = new FIG;      #my $fig = new FIG;
2349    
2350      my %id_list;      my %id_list;
2351      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);
2352    
2353      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2354            if($thing->class eq "IDENTICAL"){
2355                my $rows = $thing->rows;
2356                my $count_identical = 0;
2357                foreach my $row (@$rows) {
2358                    my $id = $row->[0];
2359          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2360              $id_list{$id} = 1;              $id_list{$id} = 1;
2361          }          }
2362      }      }
2363            }
2364        }
2365    
2366    #    foreach my $id (@maps_to) {
2367    #        if (($id ne $fid) && ($fig->function_of($id))) {
2368    #           $id_list{$id} = 1;
2369    #        }
2370    #    }
2371      return(%id_list);      return(%id_list);
2372  }  }
2373    
2374    
2375  sub get_evidence_column{  sub get_evidence_column{
2376      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2377      my $fig = new FIG;      #my $fig = new FIG;
2378      my $cgi = new CGI;      my $cgi = new CGI;
2379      my (%column, %code_attributes);      my (%column, %code_attributes);
2380    
2381      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2382      foreach my $key (@codes){      foreach my $key (@codes){
2383          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2384      }      }
# Line 2007  Line 2386 
2386      foreach my $id (@$ids){      foreach my $id (@$ids){
2387          # add evidence code with tool tip          # add evidence code with tool tip
2388          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2389    
2390          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2391              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2392              foreach my $code (@codes) {              foreach my $code (@codes) {
2393                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2394                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2022  Line 2398 
2398                  }                  }
2399                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2400              }              }
         }  
2401    
2402          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2403              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 2036  Line 2411 
2411  }  }
2412    
2413  sub get_pfam_column{  sub get_pfam_column{
2414      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2415      my $fig = new FIG;      #my $fig = new FIG;
2416      my $cgi = new CGI;      my $cgi = new CGI;
2417      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2418      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2419                                    -host     => $WebConfig::DBHOST,
2420                                    -user     => $WebConfig::DBUSER,
2421                                    -password => $WebConfig::DBPWD);
2422    
2423      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2424      foreach my $key (@codes){      foreach my $key (@codes){
2425          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2426            if ($name =~ /_/){
2427                ($name) = ($key->[1]) =~ /(.*?)_/;
2428            }
2429            push (@{$code_attributes{$key->[0]}}, $name);
2430            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2431      }      }
2432    
2433      foreach my $id (@$ids){      foreach my $id (@$ids){
2434          # add evidence code with tool tip          # add evidence code
2435          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2436          my @pfam_codes = "";          my @pfam_codes = "";
2437          my %description_codes;          my %description_codes;
2438    
2439          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2440              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2441              @pfam_codes = ();              @pfam_codes = ();
2442              foreach my $code (@codes) {  
2443                # get only unique values
2444                my %saw;
2445                foreach my $key (@ncodes) {$saw{$key}=1;}
2446                @ncodes = keys %saw;
2447    
2448                foreach my $code (@ncodes) {
2449                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2450                  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>";
2451    
2452                    # get the locations for the domain
2453                    my @locs;
2454                    foreach my $part (@{$attribute_location{$id}{$code}}){
2455                        my ($loc) = ($part) =~ /\;(.*)/;
2456                        push (@locs,$loc);
2457                    }
2458                    my %locsaw;
2459                    foreach my $key (@locs) {$locsaw{$key}=1;}
2460                    @locs = keys %locsaw;
2461    
2462                    my $locations = join (", ", @locs);
2463    
2464                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2465                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2466                  }                  }
2467                  else {                  else {
2468                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2469                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2470                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2471                  }                  }
2472              }              }
2473          }          }
# Line 2077  Line 2478 
2478    
2479  }  }
2480    
2481  sub get_prefer {  sub get_aliases {
2482      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2483    
2484      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2485        foreach my $id (@$ids){
2486            foreach my $alias (@{$$all_aliases{$id}}){
2487          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2488          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2489              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2490          }          }
2491      }      }
2492      return (" ");      return ($aliases);
2493  }  }
2494    
2495  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; $_ }
2496    
2497  sub color {  sub color {
2498      my ($evalue) = @_;      my ($evalue) = @_;
2499        my $palette = WebColors::get_palette('vitamins');
2500      my $color;      my $color;
2501      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2502          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2503      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2504      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2505          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2506      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2507      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2508          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2509      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2510      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){      else{        $color = $palette->[9];    }
         $color = 54;  
     }  
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
     }  
     elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){  
         $color = 56;  
     }  
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
     }  
     elsif (($evalue <= 1) && ($evalue > 1e-5)){  
         $color = 58;  
     }  
     elsif (($evalue <= 10) && ($evalue > 1)){  
         $color = 59;  
     }  
     else{  
         $color = 60;  
     }  
   
   
2511      return ($color);      return ($color);
2512  }  }
2513    
# Line 2149  Line 2527 
2527  }  }
2528    
2529  sub display {  sub display {
2530      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2531    
2532        $taxes = $fig->taxonomy_list();
2533    
2534      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2535      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2536      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2537      my $fig = new FIG;      my $range = $gd_window_size;
2538      my $all_regions = [];      my $all_regions = [];
2539        my $gene_associations={};
2540    
2541      #get the organism genome      #get the organism genome
2542      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2543        $gene_associations->{$fid}->{"organism"} = $target_genome;
2544        $gene_associations->{$fid}->{"main_gene"} = $fid;
2545        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2546    
2547      # get location of the gene      # get location of the gene
2548      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 2175  Line 2559 
2559      my ($region_start, $region_end);      my ($region_start, $region_end);
2560      if ($beg < $end)      if ($beg < $end)
2561      {      {
2562          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2563          $region_end = $end+4000;          $region_end = $end+ ($range);
2564          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2565      }      }
2566      else      else
2567      {      {
2568          $region_start = $end-4000;          $region_start = $end-($range);
2569          $region_end = $beg+4000;          $region_end = $beg+($range);
2570          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2571          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2572            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2573      }      }
2574    
2575      # call genes in region      # call genes in region
2576      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);
2577        #foreach my $feat (@$target_gene_features){
2578        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2579        #}
2580      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2581      my (@start_array_region);      my (@start_array_region);
2582      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2583    
2584      my %all_genes;      my %all_genes;
2585      my %all_genomes;      my %all_genomes;
2586      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}      foreach my $feature (@$target_gene_features){
2587            #if ($feature =~ /peg/){
2588      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2589      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
2590                  }                  }
2591    
2592                  push (@start_array_region, $offset);      my @selected_sims;
2593    
2594                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
2595          # get the selected boxes          # get the selected boxes
2596          my @selected_taxonomoy = ("Deltaproteobacteria", "Vibrionales", "Viridiplantae");          my @selected_taxonomy = @$selected_taxonomies;
2597    
2598          # 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
2599          my @selected_sims;          if (@selected_taxonomy > 0){
2600          my @sims= $fig->nsims($fid,20000,10,"all");              foreach my $sim (@$sims_array){
2601                    next if ($sim->class ne "SIM");
2602          foreach my $sim (@sims){                  next if ($sim->acc !~ /fig\|/);
2603              next if ($sim->[1] !~ /fig\|/);  
2604              my $genome = $fig->genome_of($sim->[1]);                  #my $genome = $fig->genome_of($sim->[1]);
2605              my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
2606                    #my ($genome1) = ($genome) =~ /(.*)\./;
2607                    my $lineage = $taxes->{$genome};
2608                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2609              foreach my $taxon(@selected_taxonomy){              foreach my $taxon(@selected_taxonomy){
2610                  if ($lineage =~ /$taxon/){                  if ($lineage =~ /$taxon/){
2611                      push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2612                            push (@selected_sims, $sim->acc);
2613                        }
2614                    }
2615                }
2616            }
2617            else{
2618                my $simcount = 0;
2619                foreach my $sim (@$sims_array){
2620                    next if ($sim->class ne "SIM");
2621                    next if ($sim->acc !~ /fig\|/);
2622    
2623                    push (@selected_sims, $sim->acc);
2624                    $simcount++;
2625                    last if ($simcount > 4);
2626                  }                  }
2627              }              }
2628    
2629              my %saw;              my %saw;
2630              @selected_sims = grep(!$saw{$_}++, @selected_sims);              @selected_sims = grep(!$saw{$_}++, @selected_sims);
         }  
2631    
2632          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2633          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2634              #get the organism genome              #get the organism genome
2635              my $sim_genome = $fig->genome_of($sim_fid);              my $sim_genome = $fig->genome_of($sim_fid);
2636                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2637                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2638                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2639    
2640              # get location of the gene              # get location of the gene
2641              my $data = $fig->feature_location($sim_fid);              my $data = $fig->feature_location($sim_fid);
2642              my ($contig, $beg, $end);              my ($contig, $beg, $end);
             my %reverse_flag;  
2643    
2644              if ($data =~ /(.*)_(\d+)_(\d+)$/){              if ($data =~ /(.*)_(\d+)_(\d+)$/){
2645                  $contig = $1;                  $contig = $1;
# Line 2280  Line 2651 
2651              my ($region_start, $region_end);              my ($region_start, $region_end);
2652              if ($beg < $end)              if ($beg < $end)
2653              {              {
2654                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2655                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2656                  $offset = ($2+(($3-$2)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2657              }              }
2658              else              else
2659              {              {
2660                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2661                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2662                  $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2663                  $reverse_flag{$target_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2664                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2665              }              }
2666    
2667              # call genes in region              # call genes in region
2668              my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);              my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2669              push(@$all_regions,$sim_gene_features);              push(@$all_regions,$sim_gene_features);
             my (@start_array_region);  
             push (@start_array_region, $offset);  
   
             my %all_genes;  
             my %all_genomes;  
             foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;}  
         }  
     }  
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                     }  
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = $peg1;  
                     }  
   
2670                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
2671                      $all_genomes{$pair_genome} = 1;              foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2672                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);              $all_genomes{$sim_genome} = 1;
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
                 }  
             }  
         }  
2673      }      }
2674    
     # get the PCH to each of the genes  
     my $pch_sets = [];  
     my %pch_already;  
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){(next);};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
         {  
             foreach my $peg (@$good_set){  
                 if ((!$peg_rank{$peg})){  
                     $peg_rank{$peg} = $counter;  
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
         }  
         else  
         {  
             foreach my $peg (@$good_set){  
                 $peg_rank{$peg} = "20";  
             }  
         }  
2675      }      }
2676    
2677        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2678  #    my $bbh_sets = [];      # cluster the genes
2679  #    my %already;      my @all_pegs = keys %all_genes;
2680  #    foreach my $gene_key (keys(%all_genes)){      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2681  #       if($already{$gene_key}){(next);}      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2682  #       my $gene_set = [$gene_key];      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #  
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #(next) if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = "20";  
 #           }  
 #       }  
 #    }  
2683    
2684      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2685          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2686          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2687          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2688          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2689            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2690            my $lineage = $taxes->{$region_genome};
2691            #my $lineage = $fig->taxonomy_of($region_genome);
2692            #$region_gs .= "Lineage:$lineage";
2693          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2694                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2695                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2479  Line 2697 
2697    
2698          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2699    
2700          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2701                                     'short_title' => "",                                     'short_title' => "",
2702                                     'basepair_offset' => '0'                                     'basepair_offset' => '0',
2703                                       'no_middle_line' => '1'
2704                                     };                                     };
2705    
2706          my $line_data = [];          my $line_data = [];
# Line 2498  Line 2717 
2717              my $links_list = [];              my $links_list = [];
2718              my $descriptions = [];              my $descriptions = [];
2719    
2720              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2721    
2722              # get subsystem information              # get subsystem information
2723              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2724              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2725    
2726              my $link;              my $link;
2727              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2728                       "link" => $url_link};                       "link" => $url_link};
2729              push(@$links_list,$link);              push(@$links_list,$link);
2730    
2731              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2732              foreach my $subsystem (@subsystems){              my @subsystems;
2733                foreach my $array (@subs){
2734                    my $subsystem = $$array[0];
2735                    my $ss = $subsystem;
2736                    $ss =~ s/_/ /ig;
2737                    push (@subsystems, $ss);
2738                  my $link;                  my $link;
2739                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2740                           "link_title" => $subsystem};                           "link_title" => $ss};
2741                    push(@$links_list,$link);
2742                }
2743    
2744                if ($fid1 eq $fid){
2745                    my $link;
2746                    $link = {"link_title" => "Annotate this sequence",
2747                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2748                  push(@$links_list,$link);                  push(@$links_list,$link);
2749              }              }
2750    
# Line 2547  Line 2778 
2778                  $prev_stop = $stop;                  $prev_stop = $stop;
2779                  $prev_fig = $fid1;                  $prev_fig = $fid1;
2780    
2781                  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})){
2782                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2783                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2784                  }                  }
2785    
2786                    my $title = $fid1;
2787                    if ($fid1 eq $fid){
2788                        $title = "My query gene: $fid1";
2789                    }
2790    
2791                  $element_hash = {                  $element_hash = {
2792                      "title" => $fid1,                      "title" => $title,
2793                      "start" => $start,                      "start" => $start,
2794                      "end" =>  $stop,                      "end" =>  $stop,
2795                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2567  Line 2803 
2803                  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;}
2804                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2805    
2806                    if ($fid1 eq $fid){
2807                        $element_hash = {
2808                            "title" => 'Query',
2809                            "start" => $start,
2810                            "end" =>  $stop,
2811                            "type"=> 'bigbox',
2812                            "color"=> $color,
2813                            "zlayer" => "1"
2814                            };
2815    
2816                        # if there is an overlap, put into second line
2817                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2818                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2819                    }
2820              }              }
2821          }          }
2822          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2823          $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);
2824        }
2825        return ($gd, \@selected_sims);
2826    }
2827    
2828    sub cluster_genes {
2829        my($fig,$all_pegs,$peg) = @_;
2830        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2831    
2832        my @color_sets = ();
2833    
2834        $conn = &get_connections_by_similarity($fig,$all_pegs);
2835    
2836        for ($i=0; ($i < @$all_pegs); $i++) {
2837            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2838            if (! $seen{$i}) {
2839                $cluster = [$i];
2840                $seen{$i} = 1;
2841                for ($j=0; ($j < @$cluster); $j++) {
2842                    $x = $conn->{$cluster->[$j]};
2843                    foreach $k (@$x) {
2844                        if (! $seen{$k}) {
2845                            push(@$cluster,$k);
2846                            $seen{$k} = 1;
2847                        }
2848                    }
2849                }
2850    
2851                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2852                    push(@color_sets,$cluster);
2853                }
2854            }
2855        }
2856        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2857        $red_set = $color_sets[$i];
2858        splice(@color_sets,$i,1);
2859        @color_sets = sort { @$b <=> @$a } @color_sets;
2860        unshift(@color_sets,$red_set);
2861    
2862        my $color_sets = {};
2863        for ($i=0; ($i < @color_sets); $i++) {
2864            foreach $x (@{$color_sets[$i]}) {
2865                $color_sets->{$all_pegs->[$x]} = $i;
2866            }
2867        }
2868        return $color_sets;
2869    }
2870    
2871    sub get_connections_by_similarity {
2872        my($fig,$all_pegs) = @_;
2873        my($i,$j,$tmp,$peg,%pos_of);
2874        my($sim,%conn,$x,$y);
2875    
2876        for ($i=0; ($i < @$all_pegs); $i++) {
2877            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2878            push(@{$pos_of{$tmp}},$i);
2879            if ($tmp ne $all_pegs->[$i]) {
2880                push(@{$pos_of{$all_pegs->[$i]}},$i);
2881            }
2882        }
2883    
2884        foreach $y (keys(%pos_of)) {
2885            $x = $pos_of{$y};
2886            for ($i=0; ($i < @$x); $i++) {
2887                for ($j=$i+1; ($j < @$x); $j++) {
2888                    push(@{$conn{$x->[$i]}},$x->[$j]);
2889                    push(@{$conn{$x->[$j]}},$x->[$i]);
2890                }
2891            }
2892        }
2893    
2894        for ($i=0; ($i < @$all_pegs); $i++) {
2895            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2896                if (defined($x = $pos_of{$sim->id2})) {
2897                    foreach $y (@$x) {
2898                        push(@{$conn{$i}},$y);
2899      }      }
2900      return $gd;              }
2901            }
2902        }
2903        return \%conn;
2904    }
2905    
2906    sub in {
2907        my($x,$xL) = @_;
2908        my($i);
2909    
2910        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2911        return ($i < @$xL);
2912    }
2913    
2914    #############################################
2915    #############################################
2916    package Observation::Commentary;
2917    
2918    use base qw(Observation);
2919    
2920    =head3 display_protein_commentary()
2921    
2922    =cut
2923    
2924    sub display_protein_commentary {
2925        my ($self,$dataset,$mypeg,$fig) = @_;
2926    
2927        my $all_rows = [];
2928        my $content;
2929        #my $fig = new FIG;
2930        my $cgi = new CGI;
2931        my $count = 0;
2932        my $peg_array = [];
2933        my (%evidence_column, %subsystems_column,  %e_identical);
2934    
2935        if (@$dataset != 1){
2936            foreach my $thing (@$dataset){
2937                if ($thing->class eq "SIM"){
2938                    push (@$peg_array, $thing->acc);
2939                }
2940            }
2941            # get the column for the evidence codes
2942            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2943    
2944            # get the column for the subsystems
2945            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2946    
2947            # get essentially identical seqs
2948            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2949        }
2950        else{
2951            push (@$peg_array, @$dataset);
2952        }
2953    
2954        my $selected_sims = [];
2955        foreach my $id (@$peg_array){
2956            last if ($count > 10);
2957            my $row_data = [];
2958            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2959            $org = $fig->org_of($id);
2960            $function = $fig->function_of($id);
2961            if ($mypeg ne $id){
2962                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2963                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2964                if (defined($e_identical{$id})) { $id_cell .= "*";}
2965            }
2966            else{
2967                $function_cell = "&nbsp;&nbsp;$function";
2968                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2969                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2970            }
2971    
2972            push(@$row_data,$id_cell);
2973            push(@$row_data,$org);
2974            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2975            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2976            push(@$row_data, $fig->translation_length($id));
2977            push(@$row_data,$function_cell);
2978            push(@$all_rows,$row_data);
2979            push (@$selected_sims, $id);
2980            $count++;
2981        }
2982    
2983        if ($count >0){
2984            $content = $all_rows;
2985        }
2986        else{
2987            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2988        }
2989        return ($content,$selected_sims);
2990  }  }
2991    
2992    sub display_protein_history {
2993        my ($self, $id,$fig) = @_;
2994        my $all_rows = [];
2995        my $content;
2996    
2997        my $cgi = new CGI;
2998        my $count = 0;
2999        foreach my $feat ($fig->feature_annotations($id)){
3000            my $row = [];
3001            my $col1 = $feat->[2];
3002            my $col2 = $feat->[1];
3003            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3004            my $text = $feat->[3];
3005    
3006            push (@$row, $col1);
3007            push (@$row, $col2);
3008            push (@$row, $text);
3009            push (@$all_rows, $row);
3010            $count++;
3011        }
3012        if ($count > 0){
3013            $content = $all_rows;
3014        }
3015        else {
3016            $content = "There is no history for this PEG";
3017        }
3018    
3019        return($content);
3020    }
3021    

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.59

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3