[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.24, Tue Jul 10 20:11:38 2007 UTC revision 1.53, Mon Feb 18 20:29:09 2008 UTC
# Line 2  Line 2 
2    
3  use lib '/vol/ontologies';  use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
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 FigFams;
18    
19  1;  1;
20    
# Line 85  Line 90 
90    return $self->{acc};    return $self->{acc};
91  }  }
92    
93    =head3 query()
94    
95    The query id
96    
97    =cut
98    
99    sub query {
100        my ($self) = @_;
101        return $self->{query};
102    }
103    
104    
105  =head3 class()  =head3 class()
106    
107  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 151  Line 168 
168  sub type {  sub type {
169    my ($self) = @_;    my ($self) = @_;
170    
171    return $self->{acc};    return $self->{type};
172  }  }
173    
174  =head3 start()  =head3 start()
# Line 304  Line 321 
321  =cut  =cut
322    
323  sub get_objects {  sub get_objects {
324      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
325    
326      my $objects = [];      my $objects = [];
327      my @matched_datasets=();      my @matched_datasets=();
# Line 317  Line 334 
334      }      }
335      else{      else{
336          my %domain_classes;          my %domain_classes;
337            my @attributes = $fig->get_attributes($fid);
338          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
339          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
340          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets,$fig);
341          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
342          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
343          get_attribute_based_location_observations($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
344          get_pdb_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
345            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
346      }      }
347    
348      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 331  Line 350 
350          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
351              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
352          }          }
353          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
354              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
355          }          }
356          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
357              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
358          }          }
359          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
360              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
361          }          }
362          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
363              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
364          }          }
365          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
366              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
367          }          }
368          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
369              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
370          }          }
371    
# Line 357  Line 376 
376    
377  }  }
378    
379    =head3 display_housekeeping
380    This method returns the housekeeping data for a given peg in a table format
381    
382    =cut
383    sub display_housekeeping {
384        my ($self,$fid,$fig) = @_;
385        my $content = [];
386        my $row = [];
387    
388        my $org_name = $fig->org_of($fid);
389        my $org_id = $fig->genome_of($fid);
390        my $function = $fig->function_of($fid);
391        #my $taxonomy = $fig->taxonomy_of($org_id);
392        my $length = $fig->translation_length($fid);
393    
394        push (@$row, $org_name);
395        push (@$row, $fid);
396        push (@$row, $length);
397        push (@$row, $function);
398    
399        # initialize the table for commentary and annotations
400        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
401        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
402        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
403        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
404        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
405        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
406        #$content .= qq(</table><p>\n);
407    
408        push(@$content, $row);
409    
410        return ($content);
411    }
412    
413    =head3 get_sims_summary
414    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
415    
416    =cut
417    
418    sub get_sims_summary {
419        my ($observation, $dataset, $fig) = @_;
420        my %families;
421        my $taxes = $fig->taxonomy_list();
422    
423        foreach my $thing (@$dataset) {
424            my ($id, $evalue);
425            if ($thing =~ /fig\|/){
426                $id = $thing;
427                $evalue = -1;
428            }
429            else{
430                next if ($thing->class ne "SIM");
431                $id      = $thing->acc;
432                $evalue  = $thing->evalue;
433            }
434            next if ($id !~ /fig\|/);
435            next if ($fig->is_deleted_fid($id));
436    
437            my $genome = $fig->genome_of($id);
438            #my ($genome1) = ($genome) =~ /(.*)\./;
439            my $taxonomy = $taxes->{$genome};
440            my $parent_tax = "Root";
441            my @currLineage = ($parent_tax);
442            push (@{$families{figs}{$parent_tax}}, $id);
443            my $level = 2;
444            foreach my $tax (split(/\; /, $taxonomy)){
445                push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
446                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
447                $families{level}{$tax} = $level;
448                push (@currLineage, $tax);
449                $families{parent}{$tax} = $parent_tax;
450                $families{lineage}{$tax} = join(";", @currLineage);
451                if (defined ($families{evalue}{$tax})){
452                    if ($evalue < $families{evalue}{$tax}){
453                        $families{evalue}{$tax} = $evalue;
454                        $families{color}{$tax} = &get_taxcolor($evalue);
455                    }
456                }
457                else{
458                    $families{evalue}{$tax} = $evalue;
459                    $families{color}{$tax} = &get_taxcolor($evalue);
460                }
461    
462                $parent_tax = $tax;
463                $level++;
464            }
465        }
466    
467        foreach my $key (keys %{$families{children}}){
468            $families{count}{$key} = @{$families{children}{$key}};
469    
470            my %saw;
471            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
472            $families{children}{$key} = \@out;
473        }
474    
475        return \%families;
476    }
477    
478  =head1 Internal Methods  =head1 Internal Methods
479    
480  These methods are not meant to be used outside of this package.  These methods are not meant to be used outside of this package.
# Line 365  Line 483 
483    
484  =cut  =cut
485    
486    sub get_taxcolor{
487        my ($evalue) = @_;
488        my $color;
489        if ($evalue == -1){            $color = "black";      }
490        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
491        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
492        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
493        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
494        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
495        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
496        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
497        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
498        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
499        else{        $color = "#6666FF";    }
500        return ($color);
501    }
502    
503    
504  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
505    
506      # 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)
507      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
508    
509      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
510          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
511          my @parts = split("::",$key);          my @parts = split("::",$key);
512          my $class = $parts[0];          my $class = $parts[0];
513            my $name = $parts[1];
514            next if (($class eq "PFAM") && ($name !~ /interpro/));
515    
516          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
517              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 384  Line 520 
520                  my $from = $2;                  my $from = $2;
521                  my $to = $3;                  my $to = $3;
522                  my $evalue;                  my $evalue;
523                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
524                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
525                      my $part1 = $2/100;                      my $part1 = $2/100;
526                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
527                  }                  }
528                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
529                        $evalue=$raw_evalue;
530                    }
531                  else{                  else{
532                      $evalue = "0.0";                      $evalue = "0.0";
533                  }                  }
# Line 411  Line 550 
550    
551  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
552    
553      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
554      my $fig = new FIG;      #my $fig = new FIG;
555    
556      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
557    
558        my $dataset = {'type' => "loc",
559                       'class' => 'SIGNALP_CELLO_TMPRED',
560                       'fig_id' => $fid
561                       };
562    
563      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      foreach my $attr_ref (@$attributes_ref){
     foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
564          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
565            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
566          my @parts = split("::",$key);          my @parts = split("::",$key);
567          my $sub_class = $parts[0];          my $sub_class = $parts[0];
568          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 433  Line 577 
577                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
578              }              }
579          }          }
580    
581          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
582              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
583              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
584          }          }
585    
586            elsif($sub_class eq "Phobius"){
587                if($sub_key eq "transmembrane"){
588                    $dataset->{'phobius_tm_locations'} = $value;
589                }
590                elsif($sub_key eq "signal"){
591                    $dataset->{'phobius_signal_location'} = $value;
592                }
593            }
594    
595          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
596              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
597              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
598              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
599          }          }
# Line 455  Line 610 
610  =cut  =cut
611    
612  sub get_pdb_observations{  sub get_pdb_observations{
613      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
614    
615      my $fig = new FIG;      #my $fig = new FIG;
   
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
616    
617        foreach my $attr_ref (@$attributes_ref){
618          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
619            next if ( ($key !~ /PDB/));
620          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
621          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
622          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 514  Line 669 
669    
670  sub get_sims_observations{  sub get_sims_observations{
671    
672      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
673      my $fig = new FIG;      #my $fig = new FIG;
674      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->sims($fid,500,10,"fig");
675      my ($dataset);      my ($dataset);
676    
677      foreach my $sim (@sims){      foreach my $sim (@sims){
678            next if ($fig->is_deleted_fid($sim->[1]));
679          my $hit = $sim->[1];          my $hit = $sim->[1];
680          my $percent = $sim->[2];          my $percent = $sim->[2];
681          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 533  Line 690 
690          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
691    
692          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
693                        'query' => $sim->[0],
694                      'acc' => $hit,                      'acc' => $hit,
695                      'identity' => $percent,                      'identity' => $percent,
696                      'type' => 'seq',                      'type' => 'seq',
# Line 569  Line 727 
727      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
728      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
729      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
730      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
731      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
732      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
733      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 587  Line 745 
745    
746  sub get_identical_proteins{  sub get_identical_proteins{
747    
748      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
749      my $fig = new FIG;      #my $fig = new FIG;
750      my $funcs_ref;      my $funcs_ref;
751    
752      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);
   
753      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
754          my ($tmp, $who);          my ($tmp, $who);
755          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
# Line 601  Line 758 
758          }          }
759      }      }
760    
     my ($dataset);  
761      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
762                     'type' => 'seq',                     'type' => 'seq',
763                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 621  Line 777 
777    
778  sub get_functional_coupling{  sub get_functional_coupling{
779    
780      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
781      my $fig = new FIG;      #my $fig = new FIG;
782      my @funcs = ();      my @funcs = ();
783    
784      # initialize some variables      # initialize some variables
# Line 639  Line 795 
795                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
796                    } @fc_data;                    } @fc_data;
797    
     my ($dataset);  
798      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
799                     'type' => 'fc',                     'type' => 'fc',
800                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 750  Line 905 
905      return $self->{database};      return $self->{database};
906  }  }
907    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
908  ############################################################  ############################################################
909  ############################################################  ############################################################
910  package Observation::PDB;  package Observation::PDB;
# Line 781  Line 930 
930  =cut  =cut
931    
932  sub display{  sub display{
933      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
934    
935      my $fid = $self->fig_id;      my $fid = $self->fig_id;
936      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
937                                    -host     => $WebConfig::DBHOST,
938                                    -user     => $WebConfig::DBUSER,
939                                    -password => $WebConfig::DBPWD);
940    
941      my $acc = $self->acc;      my $acc = $self->acc;
942    
     print STDERR "acc:$acc\n";  
943      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
944      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
945      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 806  Line 957 
957      my $lines = [];      my $lines = [];
958      my $line_data = [];      my $line_data = [];
959      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
960                            'hover_title' => 'PDB',
961                          'short_title' => "best PDB",                          'short_title' => "best PDB",
962                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
963    
964      my $fig = new FIG;      #my $fig = new FIG;
965      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
966      my $fid_stop = length($seq);      my $fid_stop = length($seq);
967    
# Line 910  Line 1062 
1062    
1063    
1064  sub display_table{  sub display_table{
1065      my ($self) = @_;      my ($self,$fig) = @_;
1066    
1067      my $fig = new FIG;      #my $fig = new FIG;
1068      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1069      my $rows = $self->rows;      my $rows = $self->rows;
1070      my $cgi = new CGI;      my $cgi = new CGI;
# Line 923  Line 1075 
1075          my $id = $row->[0];          my $id = $row->[0];
1076          my $who = $row->[1];          my $who = $row->[1];
1077          my $assignment = $row->[2];          my $assignment = $row->[2];
1078          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1079          my $single_domain = [];          my $single_domain = [];
1080          push(@$single_domain,$who);          push(@$single_domain,$who);
1081          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 974  Line 1126 
1126    
1127  sub display_table {  sub display_table {
1128    
1129      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1130      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1131      my $rows = $self->rows;      my $rows = $self->rows;
1132      my $cgi = new CGI;      my $cgi = new CGI;
# Line 989  Line 1141 
1141          # construct the score link          # construct the score link
1142          my $score = $row->[0];          my $score = $row->[0];
1143          my $toid = $row->[1];          my $toid = $row->[1];
1144          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";
1145          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1146    
1147          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1148          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1031  Line 1183 
1183  sub display {  sub display {
1184      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1185      my $lines = [];      my $lines = [];
1186      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1187                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1188                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1189      my $color = "4";      my $color = "4";
1190    
1191      my $line_data = [];      my $line_data = [];
# Line 1043  Line 1195 
1195      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1196      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1197    
1198      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1199                                    -host     => $WebConfig::DBHOST,
1200                                    -user     => $WebConfig::DBUSER,
1201                                    -password => $WebConfig::DBPWD);
1202    
1203      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1204      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1062  Line 1217 
1217              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1218          }          }
1219      }      }
1220        elsif($db =~ /PFAM/){
1221            my ($new_id) = ($id) =~ /(.*?)_/;
1222            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1223            if(!scalar(@$pfam_objs)){
1224                $name_title = "name";
1225                $name_value = "not available";
1226                $description_title = "description";
1227                $description_value = "not available";
1228            }
1229            else{
1230                my $pfam_obj = $pfam_objs->[0];
1231                $name_title = "name";
1232                $name_value = $pfam_obj->term;
1233                #$description_title = "description";
1234                #$description_value = $pfam_obj->description;
1235            }
1236        }
1237    
1238        my $short_title = $thing->acc;
1239        $short_title =~ s/::/ - /ig;
1240        my $new_short_title=$short_title;
1241        if ($short_title =~ /interpro/){
1242            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1243        }
1244        my $line_config = { 'title' => $name_value,
1245                            'hover_title', => 'Domain',
1246                            'short_title' => $new_short_title,
1247                            'basepair_offset' => '1' };
1248    
1249      my $name;      my $name;
1250      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1251               "value" => $name_value};      $name = {"title" => $db,
1252                 "value" => $new_id};
1253      push(@$descriptions,$name);      push(@$descriptions,$name);
1254    
1255      my $description;  #    my $description;
1256      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1257                               "value" => $description_value};  #                   "value" => $description_value};
1258      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1259    
1260      my $score;      my $score;
1261      $score = {"title" => "score",      $score = {"title" => "score",
1262                "value" => $thing->evalue};                "value" => $thing->evalue};
1263      push(@$descriptions,$score);      push(@$descriptions,$score);
1264    
1265        my $location;
1266        $location = {"title" => "location",
1267                     "value" => $thing->start . " - " . $thing->stop};
1268        push(@$descriptions,$location);
1269    
1270      my $link_id;      my $link_id;
1271      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1272          $link_id = $1;          $link_id = $1;
1273      }      }
1274    
1275      my $link;      my $link;
1276      my $link_url;      my $link_url;
1277      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"}
1278      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"}
1279      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1280    
1281      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1094  Line 1283 
1283      push(@$links_list,$link);      push(@$links_list,$link);
1284    
1285      my $element_hash = {      my $element_hash = {
1286          "title" => $thing->type,          "title" => $name_value,
1287          "start" => $thing->start,          "start" => $thing->start,
1288          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1289          "color"=> $color,          "color"=> $color,
# Line 1109  Line 1298 
1298    
1299  }  }
1300    
1301    sub display_table {
1302        my ($self,$dataset) = @_;
1303        my $cgi = new CGI;
1304        my $data = [];
1305        my $count = 0;
1306        my $content;
1307    
1308        foreach my $thing (@$dataset) {
1309            next if ($thing->type !~ /dom/);
1310            my $single_domain = [];
1311            $count++;
1312    
1313            my $db_and_id = $thing->acc;
1314            my ($db,$id) = split("::",$db_and_id);
1315    
1316            my $dbmaster = DBMaster->new(-database =>'Ontology',
1317                                    -host     => $WebConfig::DBHOST,
1318                                    -user     => $WebConfig::DBUSER,
1319                                    -password => $WebConfig::DBPWD);
1320    
1321            my ($name_title,$name_value,$description_title,$description_value);
1322            if($db eq "CDD"){
1323                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1324                if(!scalar(@$cdd_objs)){
1325                    $name_title = "name";
1326                    $name_value = "not available";
1327                    $description_title = "description";
1328                    $description_value = "not available";
1329                }
1330                else{
1331                    my $cdd_obj = $cdd_objs->[0];
1332                    $name_title = "name";
1333                    $name_value = $cdd_obj->term;
1334                    $description_title = "description";
1335                    $description_value = $cdd_obj->description;
1336                }
1337            }
1338            elsif($db =~ /PFAM/){
1339                my ($new_id) = ($id) =~ /(.*?)_/;
1340                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1341                if(!scalar(@$pfam_objs)){
1342                    $name_title = "name";
1343                    $name_value = "not available";
1344                    $description_title = "description";
1345                    $description_value = "not available";
1346                }
1347                else{
1348                    my $pfam_obj = $pfam_objs->[0];
1349                    $name_title = "name";
1350                    $name_value = $pfam_obj->term;
1351                    #$description_title = "description";
1352                    #$description_value = $pfam_obj->description;
1353                }
1354            }
1355    
1356            my $location =  $thing->start . " - " . $thing->stop;
1357    
1358            push(@$single_domain,$db);
1359            push(@$single_domain,$thing->acc);
1360            push(@$single_domain,$name_value);
1361            push(@$single_domain,$location);
1362            push(@$single_domain,$thing->evalue);
1363            push(@$single_domain,$description_value);
1364            push(@$data,$single_domain);
1365        }
1366    
1367        if ($count >0){
1368            $content = $data;
1369        }
1370        else
1371        {
1372            $content = "<p>This PEG does not have any similarities to domains</p>";
1373        }
1374    }
1375    
1376    
1377  #########################################  #########################################
1378  #########################################  #########################################
1379  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1391 
1391      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1392      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1393      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1394        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1395        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1396    
1397      bless($self,$class);      bless($self,$class);
1398      return $self;      return $self;
1399  }  }
1400    
1401    sub display_cello {
1402        my ($thing) = @_;
1403        my $html;
1404        my $cello_location = $thing->cello_location;
1405        my $cello_score = $thing->cello_score;
1406        if($cello_location){
1407            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1408            #$html .= "<p>CELLO score: $cello_score </p>";
1409        }
1410        return ($html);
1411    }
1412    
1413  sub display {  sub display {
1414      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1415    
1416      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1417      my $fig= new FIG;      #my $fig= new FIG;
1418      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1419    
1420      my $cleavage_prob;      my $cleavage_prob;
# Line 1147  Line 1426 
1426      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1427      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1428    
1429        my $phobius_signal_location = $thing->phobius_signal_location;
1430        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1431    
1432      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1433    
1434      #color is      #color is
1435      my $color = "5";      my $color = "6";
1436    
1437      my $line_data = [];  =pod=
1438    
1439      if($cello_location){      if($cello_location){
1440          my $cello_descriptions = [];          my $cello_descriptions = [];
1441            my $line_data =[];
1442    
1443            my $line_config = { 'title' => 'Localization Evidence',
1444                                'short_title' => 'CELLO',
1445                                'hover_title' => 'Localization',
1446                                'basepair_offset' => '1' };
1447    
1448          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1449                                            "value" => $cello_location};                                            "value" => $cello_location};
1450    
# Line 1171  Line 1457 
1457    
1458          my $element_hash = {          my $element_hash = {
1459              "title" => "CELLO",              "title" => "CELLO",
1460                "color"=> $color,
1461              "start" => "1",              "start" => "1",
1462              "end" =>  $length + 1,              "end" =>  $length + 1,
1463              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1464              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1465    
1466          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1467            $gd->add_line($line_data, $line_config);
1468      }      }
1469    
1470      my $color = "6";      $color = "2";
1471      if($tmpred_score){      if($tmpred_score){
1472            my $line_data =[];
1473            my $line_config = { 'title' => 'Localization Evidence',
1474                                'short_title' => 'Transmembrane',
1475                                'basepair_offset' => '1' };
1476    
1477          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1478              my $descriptions = [];              my $descriptions = [];
1479              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1488 
1488              "end" =>  $end + 1,              "end" =>  $end + 1,
1489              "color"=> $color,              "color"=> $color,
1490              "zlayer" => '5',              "zlayer" => '5',
1491              "type" => 'smallbox',              "type" => 'box',
1492                "description" => $descriptions};
1493    
1494                push(@$line_data,$element_hash);
1495    
1496            }
1497            $gd->add_line($line_data, $line_config);
1498        }
1499    =cut
1500    
1501        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1502            my $line_data =[];
1503            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1504                                'short_title' => 'TM and SP',
1505                                'hover_title' => 'Localization',
1506                                'basepair_offset' => '1' };
1507    
1508            foreach my $tm_loc (@phobius_tm_locations){
1509                my $descriptions = [];
1510                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1511                                 "value" => $tm_loc};
1512                push(@$descriptions,$description_phobius_tm_locations);
1513    
1514                my ($begin,$end) =split("-",$tm_loc);
1515    
1516                my $element_hash = {
1517                "title" => "Phobius",
1518                "start" => $begin + 1,
1519                "end" =>  $end + 1,
1520                "color"=> '6',
1521                "zlayer" => '4',
1522                "type" => 'bigbox',
1523              "description" => $descriptions};              "description" => $descriptions};
1524    
1525              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1526    
1527            }
1528    
1529            if($phobius_signal_location){
1530                my $descriptions = [];
1531                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1532                                 "value" => $phobius_signal_location};
1533                push(@$descriptions,$description_phobius_signal_location);
1534    
1535    
1536                my ($begin,$end) =split("-",$phobius_signal_location);
1537                my $element_hash = {
1538                "title" => "phobius signal locations",
1539                "start" => $begin + 1,
1540                "end" =>  $end + 1,
1541                "color"=> '1',
1542                "zlayer" => '5',
1543                "type" => 'box',
1544                "description" => $descriptions};
1545                push(@$line_data,$element_hash);
1546          }          }
1547    
1548            $gd->add_line($line_data, $line_config);
1549      }      }
1550    
1551      my $color = "1";  =head3
1552        $color = "1";
1553      if($signal_peptide_score){      if($signal_peptide_score){
1554            my $line_data = [];
1555          my $descriptions = [];          my $descriptions = [];
1556    
1557            my $line_config = { 'title' => 'Localization Evidence',
1558                                'short_title' => 'SignalP',
1559                                'hover_title' => 'Localization',
1560                                'basepair_offset' => '1' };
1561    
1562          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1563                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1564    
# Line 1220  Line 1572 
1572          my $element_hash = {          my $element_hash = {
1573              "title" => "SignalP",              "title" => "SignalP",
1574              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1575              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1576              "type" => 'bigbox',              "type" => 'bigbox',
1577              "color"=> $color,              "color"=> $color,
1578              "zlayer" => '10',              "zlayer" => '10',
1579              "description" => $descriptions};              "description" => $descriptions};
1580    
1581          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1582      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1583        }
1584    =cut
1585    
1586      return ($gd);      return ($gd);
1587    
# Line 1277  Line 1629 
1629    return $self->{cello_score};    return $self->{cello_score};
1630  }  }
1631    
1632    sub phobius_signal_location {
1633      my ($self) = @_;
1634      return $self->{phobius_signal_location};
1635    }
1636    
1637    sub phobius_tm_locations {
1638      my ($self) = @_;
1639      return $self->{phobius_tm_locations};
1640    }
1641    
1642    
1643    
1644  #########################################  #########################################
1645  #########################################  #########################################
# Line 1290  Line 1653 
1653      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1654      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1655      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1656        $self->{query} = $dataset->{'query'};
1657      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1658      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1659      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1305  Line 1669 
1669      return $self;      return $self;
1670  }  }
1671    
1672  =head3 display_table()  =head3 display()
   
 If available use the function specified here to display the "raw" observation.  
 This code will display a table for the similarities protein  
1673    
1674  B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  If available use the function specified here to display a graphical observation.
1675    This code will display a graphical view of the similarities using the genome drawer object
1676    
1677  =cut  =cut
1678    
1679  sub display_table {  sub display {
1680      my ($self,$dataset) = @_;      my ($self,$gd,$array,$fig) = @_;
1681        #my $fig = new FIG;
1682    
1683      my $data = [];      my @ids;
1684      my $count = 0;      foreach my $thing(@$array){
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
1685          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1686          $count++;          push (@ids, $thing->acc);
1687        }
1688    
1689          my $id = $thing->acc;      my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1690    
1691          # add the subsystem information      foreach my $thing (@$array){
1692          my @in_sub  = $fig->peg_to_subsystems($id);          if ($thing->class eq "SIM"){
         my $in_sub;  
1693    
1694          if (@in_sub > 0) {              my $peg = $thing->acc;
1695              $in_sub = @in_sub;              my $query = $thing->query;
1696    
1697              # RAE: add a javascript popup with all the subsystems              my $organism = $thing->organism;
1698              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $genome = $fig->genome_of($peg);
1699              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              my ($org_tax) = ($genome) =~ /(.*)\./;
1700          } else {              my $function = $thing->function;
1701              $in_sub = "&nbsp;";              my $abbrev_name = $fig->abbrev($organism);
1702          }              my $align_start = $thing->qstart;
1703                my $align_stop = $thing->qstop;
1704                my $hit_start = $thing->hstart;
1705                my $hit_stop = $thing->hstop;
1706    
1707          # add evidence code with tool tip              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1708          my $ev_codes=" &nbsp; ";  
1709          my @ev_codes = "";              my $line_config = { 'title' => "$organism [$org_tax]",
1710          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {                                  'short_title' => "$abbrev_name",
1711              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);                                  'title_link' => '$tax_link',
1712              @ev_codes = ();                                  'basepair_offset' => '0'
1713              foreach my $code (@codes) {                                  };
1714                  my $pretty_code = $code->[2];  
1715                  if ($pretty_code =~ /;/) {              my $line_data = [];
1716                      my ($cd, $ss) = split(";", $code->[2]);  
1717                      $ss =~ s/_/ /g;              my $element_hash;
1718                      $pretty_code = $cd;# . " in " . $ss;              my $links_list = [];
1719                  }              my $descriptions = [];
1720                  push(@ev_codes, $pretty_code);  
1721              }              # get subsystem information
1722                my $url_link = "?page=Annotation&feature=".$peg;
1723                my $link;
1724                $link = {"link_title" => $peg,
1725                         "link" => $url_link};
1726                push(@$links_list,$link);
1727    
1728                #my @subsystems = $fig->peg_to_subsystems($peg);
1729                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1730                my @subsystems;
1731    
1732                foreach my $array (@subs){
1733                    my $subsystem = $$array[0];
1734                    push(@subsystems,$subsystem);
1735                    my $link;
1736                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1737                             "link_title" => $subsystem};
1738                    push(@$links_list,$link);
1739          }          }
1740    
1741          if (scalar(@ev_codes) && $ev_codes[0]) {              $link = {"link_title" => "view blast alignment",
1742              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);                       "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1743              $ev_codes = $cgi->a(              push (@$links_list,$link);
1744    
1745                my $description_function;
1746                $description_function = {"title" => "function",
1747                                         "value" => $function};
1748                push(@$descriptions,$description_function);
1749    
1750                my ($description_ss, $ss_string);
1751                $ss_string = join (",", @subsystems);
1752                $description_ss = {"title" => "subsystems",
1753                                   "value" => $ss_string};
1754                push(@$descriptions,$description_ss);
1755    
1756                my $description_loc;
1757                $description_loc = {"title" => "location start",
1758                                    "value" => $hit_start};
1759                push(@$descriptions, $description_loc);
1760    
1761                $description_loc = {"title" => "location stop",
1762                                    "value" => $hit_stop};
1763                push(@$descriptions, $description_loc);
1764    
1765                my $evalue = $thing->evalue;
1766                while ($evalue =~ /-0/)
1767                                  {                                  {
1768                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                  my ($chunk1, $chunk2) = split(/-/, $evalue);
1769                    $chunk2 = substr($chunk2,1);
1770                    $evalue = $chunk1 . "-" . $chunk2;
1771                }
1772    
1773                my $color = &color($evalue);
1774    
1775                my $description_eval = {"title" => "E-Value",
1776                                        "value" => $evalue};
1777                push(@$descriptions, $description_eval);
1778    
1779                my $identity = $self->identity;
1780                my $description_identity = {"title" => "Identity",
1781                                            "value" => $identity};
1782                push(@$descriptions, $description_identity);
1783    
1784                $element_hash = {
1785                    "title" => $peg,
1786                    "start" => $align_start,
1787                    "end" =>  $align_stop,
1788                    "type"=> 'box',
1789                    "color"=> $color,
1790                    "zlayer" => "2",
1791                    "links_list" => $links_list,
1792                    "description" => $descriptions
1793                    };
1794                push(@$line_data,$element_hash);
1795                $gd->add_line($line_data, $line_config);
1796            }
1797        }
1798        return ($gd);
1799          }          }
1800    
1801          # add the aliases  =head3 display_domain_composition()
         my $aliases = undef;  
         $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );  
         $aliases = &HTML::set_prot_links( $cgi, $aliases );  
         $aliases ||= "&nbsp;";  
1802    
1803    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1804    
1805    =cut
1806    
1807    sub display_domain_composition {
1808        my ($self,$gd,$fig) = @_;
1809    
1810        #$fig = new FIG;
1811        my $peg = $self->acc;
1812    
1813        my $line_data = [];
1814        my $links_list = [];
1815        my $descriptions = [];
1816    
1817        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1818        #my @domain_query_results = ();
1819        foreach $dqr (@domain_query_results){
1820            my $key = @$dqr[1];
1821            my @parts = split("::",$key);
1822            my $db = $parts[0];
1823            my $id = $parts[1];
1824            my $val = @$dqr[2];
1825            my $from;
1826            my $to;
1827            my $evalue;
1828    
1829            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1830                my $raw_evalue = $1;
1831                $from = $2;
1832                $to = $3;
1833                if($raw_evalue =~/(\d+)\.(\d+)/){
1834                    my $part2 = 1000 - $1;
1835                    my $part1 = $2/100;
1836                    $evalue = $part1."e-".$part2;
1837                }
1838                else{
1839                    $evalue = "0.0";
1840                }
1841            }
1842    
1843            my $dbmaster = DBMaster->new(-database =>'Ontology',
1844                                    -host     => $WebConfig::DBHOST,
1845                                    -user     => $WebConfig::DBUSER,
1846                                    -password => $WebConfig::DBPWD);
1847            my ($name_value,$description_value);
1848    
1849            if($db eq "CDD"){
1850                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1851                if(!scalar(@$cdd_objs)){
1852                    $name_title = "name";
1853                    $name_value = "not available";
1854                    $description_title = "description";
1855                    $description_value = "not available";
1856                }
1857                else{
1858                    my $cdd_obj = $cdd_objs->[0];
1859                    $name_value = $cdd_obj->term;
1860                    $description_value = $cdd_obj->description;
1861                }
1862            }
1863    
1864            my $domain_name;
1865            $domain_name = {"title" => "name",
1866                            "value" => $name_value};
1867            push(@$descriptions,$domain_name);
1868    
1869            my $description;
1870            $description = {"title" => "description",
1871                            "value" => $description_value};
1872            push(@$descriptions,$description);
1873    
1874            my $score;
1875            $score = {"title" => "score",
1876                      "value" => $evalue};
1877            push(@$descriptions,$score);
1878    
1879            my $link_id = $id;
1880            my $link;
1881            my $link_url;
1882            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"}
1883            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1884            else{$link_url = "NO_URL"}
1885    
1886            $link = {"link_title" => $name_value,
1887                     "link" => $link_url};
1888            push(@$links_list,$link);
1889    
1890            my $domain_element_hash = {
1891                "title" => $peg,
1892                "start" => $from,
1893                "end" =>  $to,
1894                "type"=> 'box',
1895                "zlayer" => '4',
1896                "links_list" => $links_list,
1897                "description" => $descriptions
1898                };
1899    
1900            push(@$line_data,$domain_element_hash);
1901    
1902            #just one CDD domain for now, later will add option for multiple domains from selected DB
1903            last;
1904        }
1905    
1906        my $line_config = { 'title' => $peg,
1907                            'hover_title' => 'Domain',
1908                            'short_title' => $peg,
1909                            'basepair_offset' => '1' };
1910    
1911        $gd->add_line($line_data, $line_config);
1912    
1913        return ($gd);
1914    
1915    }
1916    
1917    =head3 display_table()
1918    
1919    If available use the function specified here to display the "raw" observation.
1920    This code will display a table for the similarities protein
1921    
1922    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
1923    
1924    =cut
1925    
1926    sub display_table {
1927        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1928    
1929        my $data = [];
1930        my $count = 0;
1931        my $content;
1932        #my $fig = new FIG;
1933        my $cgi = new CGI;
1934        my @ids;
1935        $lineages = $fig->taxonomy_list();
1936    
1937        foreach my $thing (@$dataset) {
1938            next if ($thing->class ne "SIM");
1939            push (@ids, $thing->acc);
1940        }
1941    
1942        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1943        my @attributes = $fig->get_attributes(\@ids);
1944    
1945        # get the column for the subsystems
1946        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1947    
1948        # get the column for the evidence codes
1949        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1950    
1951        # get the column for pfam_domain
1952        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1953    
1954        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1955        my $alias_col = &get_aliases(\@ids,$fig);
1956        #my $alias_col = {};
1957    
1958        my $figfam_data = "$FIG_Config::FigfamsData";
1959        my $figfams = new FigFams($fig,$figfam_data);
1960        my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1961    
1962        foreach my $thing (@$dataset) {
1963            next if ($thing->class ne "SIM");
1964            my $single_domain = [];
1965            $count++;
1966    
1967            my $id      = $thing->acc;
1968            my $taxid   = $fig->genome_of($id);
1969          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1970          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1971          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1385  Line 1978 
1978          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1979          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1980    
1981            # checkbox column
1982            my $field_name = "tables_" . $id;
1983            my $pair_name = "visual_" . $id;
1984            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1985            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1986    
1987            # get the linked fig id
1988            my $fig_col;
1989            if (defined ($e_identical{$id})){
1990                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1991            }
1992            else{
1993                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1994            }
1995    
1996          push(@$single_domain,$thing->database);          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1997          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1998          push(@$single_domain,$thing->evalue);  
1999          push(@$single_domain,"$iden\%");          foreach my $col (sort keys %$scroll_list){
2000          push(@$single_domain,$reg1);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
2001          push(@$single_domain,$reg2);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2002          push(@$single_domain,$in_sub);              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2003          push(@$single_domain,$ev_codes);              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
2004          push(@$single_domain,$thing->organism);              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
2005          push(@$single_domain,$thing->function);              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
2006          push(@$single_domain,$aliases);              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
2007                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
2008                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
2009                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
2010                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2011                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2012                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2013                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2014                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2015                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2016            }
2017          push(@$data,$single_domain);          push(@$data,$single_domain);
2018      }      }
   
2019      if ($count >0){      if ($count >0){
2020          $content = $data;          $content = $data;
2021      }      }
2022      else      else{
     {  
2023          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2024      }      }
2025      return ($content);      return ($content);
2026  }  }
2027    
2028    sub get_box_column{
2029        my ($ids) = @_;
2030        my %column;
2031        foreach my $id (@$ids){
2032            my $field_name = "tables_" . $id;
2033            my $pair_name = "visual_" . $id;
2034            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2035        }
2036        return (%column);
2037    }
2038    
2039    sub get_subsystems_column{
2040        my ($ids,$fig) = @_;
2041    
2042        #my $fig = new FIG;
2043        my $cgi = new CGI;
2044        my %in_subs  = $fig->subsystems_for_pegs($ids);
2045        my %column;
2046        foreach my $id (@$ids){
2047            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2048            my @subsystems;
2049    
2050            if (@in_sub > 0) {
2051                foreach my $array(@in_sub){
2052                    my $ss = $$array[0];
2053                    $ss =~ s/_/ /ig;
2054                    push (@subsystems, "-" . $ss);
2055                }
2056                my $in_sub_line = join ("<br>", @subsystems);
2057                $column{$id} = $in_sub_line;
2058            } else {
2059                $column{$id} = "&nbsp;";
2060            }
2061        }
2062        return (%column);
2063    }
2064    
2065    sub get_essentially_identical{
2066        my ($fid,$dataset,$fig) = @_;
2067        #my $fig = new FIG;
2068    
2069        my %id_list;
2070        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2071    
2072        foreach my $thing (@$dataset){
2073            if($thing->class eq "IDENTICAL"){
2074                my $rows = $thing->rows;
2075                my $count_identical = 0;
2076                foreach my $row (@$rows) {
2077                    my $id = $row->[0];
2078                    if (($id ne $fid) && ($fig->function_of($id))) {
2079                        $id_list{$id} = 1;
2080                    }
2081                }
2082            }
2083        }
2084    
2085    #    foreach my $id (@maps_to) {
2086    #        if (($id ne $fid) && ($fig->function_of($id))) {
2087    #           $id_list{$id} = 1;
2088    #        }
2089    #    }
2090        return(%id_list);
2091    }
2092    
2093    
2094    sub get_evidence_column{
2095        my ($ids, $attributes,$fig) = @_;
2096        #my $fig = new FIG;
2097        my $cgi = new CGI;
2098        my (%column, %code_attributes);
2099    
2100        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2101        foreach my $key (@codes){
2102            push (@{$code_attributes{$$key[0]}}, $key);
2103        }
2104    
2105        foreach my $id (@$ids){
2106            # add evidence code with tool tip
2107            my $ev_codes=" &nbsp; ";
2108    
2109            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2110            my @ev_codes = ();
2111            foreach my $code (@codes) {
2112                my $pretty_code = $code->[2];
2113                if ($pretty_code =~ /;/) {
2114                    my ($cd, $ss) = split(";", $code->[2]);
2115                    $ss =~ s/_/ /g;
2116                    $pretty_code = $cd;# . " in " . $ss;
2117                }
2118                push(@ev_codes, $pretty_code);
2119            }
2120    
2121            if (scalar(@ev_codes) && $ev_codes[0]) {
2122                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2123                $ev_codes = $cgi->a(
2124                                    {
2125                                        id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2126            }
2127            $column{$id}=$ev_codes;
2128        }
2129        return (%column);
2130    }
2131    
2132    sub get_pfam_column{
2133        my ($ids, $attributes,$fig) = @_;
2134        #my $fig = new FIG;
2135        my $cgi = new CGI;
2136        my (%column, %code_attributes, %attribute_locations);
2137        my $dbmaster = DBMaster->new(-database =>'Ontology',
2138                                    -host     => $WebConfig::DBHOST,
2139                                    -user     => $WebConfig::DBUSER,
2140                                    -password => $WebConfig::DBPWD);
2141    
2142        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2143        foreach my $key (@codes){
2144            my $name = $key->[1];
2145            if ($name =~ /_/){
2146                ($name) = ($key->[1]) =~ /(.*?)_/;
2147            }
2148            push (@{$code_attributes{$key->[0]}}, $name);
2149            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2150        }
2151    
2152        foreach my $id (@$ids){
2153            # add evidence code
2154            my $pfam_codes=" &nbsp; ";
2155            my @pfam_codes = "";
2156            my %description_codes;
2157    
2158            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2159                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2160                @pfam_codes = ();
2161    
2162                # get only unique values
2163                my %saw;
2164                foreach my $key (@ncodes) {$saw{$key}=1;}
2165                @ncodes = keys %saw;
2166    
2167                foreach my $code (@ncodes) {
2168                    my @parts = split("::",$code);
2169                    my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2170    
2171                    # get the locations for the domain
2172                    my @locs;
2173                    foreach my $part (@{$attribute_location{$id}{$code}}){
2174                        my ($loc) = ($part) =~ /\;(.*)/;
2175                        push (@locs,$loc);
2176                    }
2177                    my %locsaw;
2178                    foreach my $key (@locs) {$locsaw{$key}=1;}
2179                    @locs = keys %locsaw;
2180    
2181                    my $locations = join (", ", @locs);
2182    
2183                    if (defined ($description_codes{$parts[1]})){
2184                        push(@pfam_codes, "$parts[1] ($locations)");
2185                    }
2186                    else {
2187                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2188                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2189                        push(@pfam_codes, "$pfam_link ($locations)");
2190                    }
2191                }
2192            }
2193    
2194            $column{$id}=join("<br><br>", @pfam_codes);
2195        }
2196        return (%column);
2197    
2198    }
2199    
2200    sub get_aliases {
2201        my ($ids,$fig) = @_;
2202    
2203        my $all_aliases = $fig->feature_aliases_bulk($ids);
2204        foreach my $id (@$ids){
2205            foreach my $alias (@{$$all_aliases{$id}}){
2206                my $id_db = &Observation::get_database($alias);
2207                next if ($aliases->{$id}->{$id_db});
2208                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2209            }
2210        }
2211        return ($aliases);
2212    }
2213    
2214  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; $_ }
2215    
2216    sub color {
2217        my ($evalue) = @_;
2218        my $palette = WebColors::get_palette('vitamins');
2219        my $color;
2220        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2221        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2222        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2223        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2224        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2225        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2226        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2227        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2228        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2229        else{        $color = $palette->[9];    }
2230        return ($color);
2231    }
2232    
2233    
2234  ############################  ############################
# Line 1429  Line 2246 
2246  }  }
2247    
2248  sub display {  sub display {
2249      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2250    
2251        $taxes = $fig->taxonomy_list();
2252    
2253      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2254      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2255      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2256      my $fig = new FIG;      my $range = $gd_window_size;
2257      my $all_regions = [];      my $all_regions = [];
2258        my $gene_associations={};
2259    
2260      #get the organism genome      #get the organism genome
2261      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2262        $gene_associations->{$fid}->{"organism"} = $target_genome;
2263        $gene_associations->{$fid}->{"main_gene"} = $fid;
2264        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2265    
2266      # get location of the gene      # get location of the gene
2267      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 2278 
2278      my ($region_start, $region_end);      my ($region_start, $region_end);
2279      if ($beg < $end)      if ($beg < $end)
2280      {      {
2281          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2282          $region_end = $end+4000;          $region_end = $end+ ($range);
2283          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2284      }      }
2285      else      else
2286      {      {
2287          $region_start = $end-4000;          $region_start = $end-($range);
2288          $region_end = $beg+4000;          $region_end = $beg+($range);
2289          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2290          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2291            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2292      }      }
2293    
2294      # call genes in region      # call genes in region
2295      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);
2296        #foreach my $feat (@$target_gene_features){
2297        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2298        #}
2299      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2300      my (@start_array_region);      my (@start_array_region);
2301      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2302    
2303      my %all_genes;      my %all_genes;
2304      my %all_genomes;      my %all_genomes;
2305      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2306            #if ($feature =~ /peg/){
2307      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2308      {          #}
         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} = 1;  
2309                  }                  }
2310    
2311                  push (@start_array_region, $offset);      my @selected_sims;
2312    
2313                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2314                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2315                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2316                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2317            # get the similarities and store only the ones that match the lineages selected
2318            if (@selected_taxonomy > 0){
2319                foreach my $sim (@$sims_array){
2320                    next if ($sim->class ne "SIM");
2321                    next if ($sim->acc !~ /fig\|/);
2322    
2323                    #my $genome = $fig->genome_of($sim->[1]);
2324                    my $genome = $fig->genome_of($sim->acc);
2325                    #my ($genome1) = ($genome) =~ /(.*)\./;
2326                    my $lineage = $taxes->{$genome};
2327                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2328                    foreach my $taxon(@selected_taxonomy){
2329                        if ($lineage =~ /$taxon/){
2330                            #push (@selected_sims, $sim->[1]);
2331                            push (@selected_sims, $sim->acc);
2332              }              }
             $coup_count++;  
2333          }          }
2334      }      }
   
     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} = 1;  
2335                      }                      }
2336            else{
2337                my $simcount = 0;
2338                foreach my $sim (@$sims_array){
2339                    next if ($sim->class ne "SIM");
2340                    next if ($sim->acc !~ /fig\|/);
2341    
2342                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2343                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2344                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  last if ($simcount > 4);
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
                 }  
2345              }              }
2346          }          }
2347    
2348            my %saw;
2349            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2350    
2351            # get the gene context for the sorted matches
2352            foreach my $sim_fid(@selected_sims){
2353                #get the organism genome
2354                my $sim_genome = $fig->genome_of($sim_fid);
2355                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2356                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2357                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2358    
2359                # get location of the gene
2360                my $data = $fig->feature_location($sim_fid);
2361                my ($contig, $beg, $end);
2362    
2363                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2364                    $contig = $1;
2365                    $beg = $2;
2366                    $end = $3;
2367      }      }
2368    
2369      # get the PCH to each of the genes              my $offset;
2370      my $pch_sets = [];              my ($region_start, $region_end);
2371      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){next;};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
2372          {          {
2373              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2374                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2375                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2376          }          }
2377          else          else
2378          {          {
2379              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2380                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2381                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2382                    $reverse_flag{$sim_genome} = $sim_fid;
2383                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2384              }              }
2385    
2386                # call genes in region
2387                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2388                push(@$all_regions,$sim_gene_features);
2389                push (@start_array_region, $offset);
2390                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2391                $all_genomes{$sim_genome} = 1;
2392          }          }
2393    
2394      }      }
2395    
2396        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2397  #    my $bbh_sets = [];      # cluster the genes
2398  #    my %already;      my @all_pegs = keys %all_genes;
2399  #    foreach my $gene_key (keys(%all_genes)){      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2400  #       if($already{$gene_key}){next;}      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2401  #       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} = 100;  
 #           }  
 #       }  
 #    }  
2402    
2403      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2404          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2405          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2406          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2407          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2408            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2409            my $lineage = $taxes->{$region_genome};
2410            #my $lineage = $fig->taxonomy_of($region_genome);
2411            #$region_gs .= "Lineage:$lineage";
2412          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2413                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2414                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 2416 
2416    
2417          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2418    
2419            my $second_line_config = { 'title' => "$lineage",
2420                                       'short_title' => "",
2421                                       'basepair_offset' => '0',
2422                                       'no_middle_line' => '1'
2423                                       };
2424    
2425          my $line_data = [];          my $line_data = [];
2426            my $second_line_data = [];
2427    
2428            # initialize variables to check for overlap in genes
2429            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2430            my $major_line_flag = 0;
2431            my $prev_second_flag = 0;
2432    
2433          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2434                $second_line_flag = 0;
2435              my $element_hash;              my $element_hash;
2436              my $links_list = [];              my $links_list = [];
2437              my $descriptions = [];              my $descriptions = [];
2438    
2439              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2440    
2441              # get subsystem information              # get subsystem information
2442              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2443              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2444    
2445              my $link;              my $link;
2446              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2447                       "link" => $url_link};                       "link" => $url_link};
2448              push(@$links_list,$link);              push(@$links_list,$link);
2449    
2450              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2451              foreach my $subsystem (@subsystems){              my @subsystems;
2452                foreach my $array (@subs){
2453                    my $subsystem = $$array[0];
2454                    my $ss = $subsystem;
2455                    $ss =~ s/_/ /ig;
2456                    push (@subsystems, $ss);
2457                  my $link;                  my $link;
2458                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2459                           "link_title" => $subsystem};                           "link_title" => $ss};
2460                    push(@$links_list,$link);
2461                }
2462    
2463                if ($fid1 eq $fid){
2464                    my $link;
2465                    $link = {"link_title" => "Annotate this sequence",
2466                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2467                  push(@$links_list,$link);                  push(@$links_list,$link);
2468              }              }
2469    
# Line 1738  Line 2485 
2485                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2486                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2487    
2488                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2489                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2490                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2491                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2492                            $second_line_flag = 1;
2493                            $major_line_flag = 1;
2494                        }
2495                    }
2496                    $prev_start = $start;
2497                    $prev_stop = $stop;
2498                    $prev_fig = $fid1;
2499    
2500                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2501                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2502                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2503                  }                  }
2504    
2505                    my $title = $fid1;
2506                    if ($fid1 eq $fid){
2507                        $title = "My query gene: $fid1";
2508                    }
2509    
2510                  $element_hash = {                  $element_hash = {
2511                      "title" => $fid1,                      "title" => $title,
2512                      "start" => $start,                      "start" => $start,
2513                      "end" =>  $stop,                      "end" =>  $stop,
2514                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 2517 
2517                      "links_list" => $links_list,                      "links_list" => $links_list,
2518                      "description" => $descriptions                      "description" => $descriptions
2519                  };                  };
2520                  push(@$line_data,$element_hash);  
2521                    # if there is an overlap, put into second line
2522                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2523                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2524    
2525                    if ($fid1 eq $fid){
2526                        $element_hash = {
2527                            "title" => 'Query',
2528                            "start" => $start,
2529                            "end" =>  $stop,
2530                            "type"=> 'bigbox',
2531                            "color"=> $color,
2532                            "zlayer" => "1"
2533                            };
2534    
2535                        # if there is an overlap, put into second line
2536                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2537                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2538                    }
2539              }              }
2540          }          }
2541          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2542            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2543      }      }
2544      return $gd;      return ($gd, \@selected_sims);
2545  }  }
2546    
2547    sub cluster_genes {
2548        my($fig,$all_pegs,$peg) = @_;
2549        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2550    
2551        my @color_sets = ();
2552    
2553        $conn = &get_connections_by_similarity($fig,$all_pegs);
2554    
2555        for ($i=0; ($i < @$all_pegs); $i++) {
2556            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2557            if (! $seen{$i}) {
2558                $cluster = [$i];
2559                $seen{$i} = 1;
2560                for ($j=0; ($j < @$cluster); $j++) {
2561                    $x = $conn->{$cluster->[$j]};
2562                    foreach $k (@$x) {
2563                        if (! $seen{$k}) {
2564                            push(@$cluster,$k);
2565                            $seen{$k} = 1;
2566                        }
2567                    }
2568                }
2569    
2570                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2571                    push(@color_sets,$cluster);
2572                }
2573            }
2574        }
2575        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2576        $red_set = $color_sets[$i];
2577        splice(@color_sets,$i,1);
2578        @color_sets = sort { @$b <=> @$a } @color_sets;
2579        unshift(@color_sets,$red_set);
2580    
2581        my $color_sets = {};
2582        for ($i=0; ($i < @color_sets); $i++) {
2583            foreach $x (@{$color_sets[$i]}) {
2584                $color_sets->{$all_pegs->[$x]} = $i;
2585            }
2586        }
2587        return $color_sets;
2588    }
2589    
2590    sub get_connections_by_similarity {
2591        my($fig,$all_pegs) = @_;
2592        my($i,$j,$tmp,$peg,%pos_of);
2593        my($sim,%conn,$x,$y);
2594    
2595        for ($i=0; ($i < @$all_pegs); $i++) {
2596            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2597            push(@{$pos_of{$tmp}},$i);
2598            if ($tmp ne $all_pegs->[$i]) {
2599                push(@{$pos_of{$all_pegs->[$i]}},$i);
2600            }
2601        }
2602    
2603        foreach $y (keys(%pos_of)) {
2604            $x = $pos_of{$y};
2605            for ($i=0; ($i < @$x); $i++) {
2606                for ($j=$i+1; ($j < @$x); $j++) {
2607                    push(@{$conn{$x->[$i]}},$x->[$j]);
2608                    push(@{$conn{$x->[$j]}},$x->[$i]);
2609                }
2610            }
2611        }
2612    
2613        for ($i=0; ($i < @$all_pegs); $i++) {
2614            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2615                if (defined($x = $pos_of{$sim->id2})) {
2616                    foreach $y (@$x) {
2617                        push(@{$conn{$i}},$y);
2618                    }
2619                }
2620            }
2621        }
2622        return \%conn;
2623    }
2624    
2625    sub in {
2626        my($x,$xL) = @_;
2627        my($i);
2628    
2629        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2630        return ($i < @$xL);
2631    }
2632    
2633    #############################################
2634    #############################################
2635    package Observation::Commentary;
2636    
2637    use base qw(Observation);
2638    
2639    =head3 display_protein_commentary()
2640    
2641    =cut
2642    
2643    sub display_protein_commentary {
2644        my ($self,$dataset,$mypeg,$fig) = @_;
2645    
2646        my $all_rows = [];
2647        my $content;
2648        #my $fig = new FIG;
2649        my $cgi = new CGI;
2650        my $count = 0;
2651        my $peg_array = [];
2652        my (%evidence_column, %subsystems_column,  %e_identical);
2653    
2654        if (@$dataset != 1){
2655            foreach my $thing (@$dataset){
2656                if ($thing->class eq "SIM"){
2657                    push (@$peg_array, $thing->acc);
2658                }
2659            }
2660            # get the column for the evidence codes
2661            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2662    
2663            # get the column for the subsystems
2664            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2665    
2666            # get essentially identical seqs
2667            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2668        }
2669        else{
2670            push (@$peg_array, @$dataset);
2671        }
2672    
2673        my $selected_sims = [];
2674        foreach my $id (@$peg_array){
2675            last if ($count > 10);
2676            my $row_data = [];
2677            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2678            $org = $fig->org_of($id);
2679            $function = $fig->function_of($id);
2680            if ($mypeg ne $id){
2681                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2682                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2683                if (defined($e_identical{$id})) { $id_cell .= "*";}
2684            }
2685            else{
2686                $function_cell = "&nbsp;&nbsp;$function";
2687                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2688                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2689            }
2690    
2691            push(@$row_data,$id_cell);
2692            push(@$row_data,$org);
2693            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2694            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2695            push(@$row_data, $fig->translation_length($id));
2696            push(@$row_data,$function_cell);
2697            push(@$all_rows,$row_data);
2698            push (@$selected_sims, $id);
2699            $count++;
2700        }
2701    
2702        if ($count >0){
2703            $content = $all_rows;
2704        }
2705        else{
2706            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2707        }
2708        return ($content,$selected_sims);
2709    }
2710    
2711    sub display_protein_history {
2712        my ($self, $id,$fig) = @_;
2713        my $all_rows = [];
2714        my $content;
2715    
2716        my $cgi = new CGI;
2717        my $count = 0;
2718        foreach my $feat ($fig->feature_annotations($id)){
2719            my $row = [];
2720            my $col1 = $feat->[2];
2721            my $col2 = $feat->[1];
2722            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2723            my $text = $feat->[3];
2724    
2725            push (@$row, $col1);
2726            push (@$row, $col2);
2727            push (@$row, $text);
2728            push (@$all_rows, $row);
2729            $count++;
2730        }
2731        if ($count > 0){
2732            $content = $all_rows;
2733        }
2734        else {
2735            $content = "There is no history for this PEG";
2736        }
2737    
2738        return($content);
2739    }

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.53

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3