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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3