[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.54, Mon Feb 18 20:40:19 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 FigFams;
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      foreach my $thing (@$array){
1690          my @in_sub  = $fig->peg_to_subsystems($id);          if ($thing->class eq "SIM"){
         my $in_sub;  
1691    
1692          if (@in_sub > 0) {              my $peg = $thing->acc;
1693              $in_sub = @in_sub;              my $query = $thing->query;
1694    
1695              # RAE: add a javascript popup with all the subsystems              my $organism = $thing->organism;
1696              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $genome = $fig->genome_of($peg);
1697              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              my ($org_tax) = ($genome) =~ /(.*)\./;
1698          } else {              my $function = $thing->function;
1699              $in_sub = "&nbsp;";              my $abbrev_name = $fig->abbrev($organism);
1700          }              my $align_start = $thing->qstart;
1701                my $align_stop = $thing->qstop;
1702                my $hit_start = $thing->hstart;
1703                my $hit_stop = $thing->hstop;
1704    
1705          # add evidence code with tool tip              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1706          my $ev_codes=" &nbsp; ";  
1707          my @ev_codes = "";              my $line_config = { 'title' => "$organism [$org_tax]",
1708          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {                                  'short_title' => "$abbrev_name",
1709              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);                                  'title_link' => '$tax_link',
1710              @ev_codes = ();                                  'basepair_offset' => '0'
1711              foreach my $code (@codes) {                                  };
1712                  my $pretty_code = $code->[2];  
1713                  if ($pretty_code =~ /;/) {              my $line_data = [];
1714                      my ($cd, $ss) = split(";", $code->[2]);  
1715                      $ss =~ s/_/ /g;              my $element_hash;
1716                      $pretty_code = $cd;# . " in " . $ss;              my $links_list = [];
1717                  }              my $descriptions = [];
1718                  push(@ev_codes, $pretty_code);  
1719              }              # get subsystem information
1720                my $url_link = "?page=Annotation&feature=".$peg;
1721                my $link;
1722                $link = {"link_title" => $peg,
1723                         "link" => $url_link};
1724                push(@$links_list,$link);
1725    
1726                #my @subsystems = $fig->peg_to_subsystems($peg);
1727                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1728                my @subsystems;
1729    
1730                foreach my $array (@subs){
1731                    my $subsystem = $$array[0];
1732                    push(@subsystems,$subsystem);
1733                    my $link;
1734                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1735                             "link_title" => $subsystem};
1736                    push(@$links_list,$link);
1737          }          }
1738    
1739          if (scalar(@ev_codes) && $ev_codes[0]) {              $link = {"link_title" => "view blast alignment",
1740              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);                       "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1741              $ev_codes = $cgi->a(              push (@$links_list,$link);
1742    
1743                my $description_function;
1744                $description_function = {"title" => "function",
1745                                         "value" => $function};
1746                push(@$descriptions,$description_function);
1747    
1748                my ($description_ss, $ss_string);
1749                $ss_string = join (",", @subsystems);
1750                $description_ss = {"title" => "subsystems",
1751                                   "value" => $ss_string};
1752                push(@$descriptions,$description_ss);
1753    
1754                my $description_loc;
1755                $description_loc = {"title" => "location start",
1756                                    "value" => $hit_start};
1757                push(@$descriptions, $description_loc);
1758    
1759                $description_loc = {"title" => "location stop",
1760                                    "value" => $hit_stop};
1761                push(@$descriptions, $description_loc);
1762    
1763                my $evalue = $thing->evalue;
1764                while ($evalue =~ /-0/)
1765                                  {                                  {
1766                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                  my ($chunk1, $chunk2) = split(/-/, $evalue);
1767                    $chunk2 = substr($chunk2,1);
1768                    $evalue = $chunk1 . "-" . $chunk2;
1769                }
1770    
1771                my $color = &color($evalue);
1772    
1773                my $description_eval = {"title" => "E-Value",
1774                                        "value" => $evalue};
1775                push(@$descriptions, $description_eval);
1776    
1777                my $identity = $self->identity;
1778                my $description_identity = {"title" => "Identity",
1779                                            "value" => $identity};
1780                push(@$descriptions, $description_identity);
1781    
1782                $element_hash = {
1783                    "title" => $peg,
1784                    "start" => $align_start,
1785                    "end" =>  $align_stop,
1786                    "type"=> 'box',
1787                    "color"=> $color,
1788                    "zlayer" => "2",
1789                    "links_list" => $links_list,
1790                    "description" => $descriptions
1791                    };
1792                push(@$line_data,$element_hash);
1793                $gd->add_line($line_data, $line_config);
1794            }
1795        }
1796        return ($gd);
1797    }
1798    
1799    =head3 display_domain_composition()
1800    
1801    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
1802    
1803    =cut
1804    
1805    sub display_domain_composition {
1806        my ($self,$gd,$fig) = @_;
1807    
1808        #$fig = new FIG;
1809        my $peg = $self->acc;
1810    
1811        my $line_data = [];
1812        my $links_list = [];
1813        my $descriptions = [];
1814    
1815        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1816        #my @domain_query_results = ();
1817        foreach $dqr (@domain_query_results){
1818            my $key = @$dqr[1];
1819            my @parts = split("::",$key);
1820            my $db = $parts[0];
1821            my $id = $parts[1];
1822            my $val = @$dqr[2];
1823            my $from;
1824            my $to;
1825            my $evalue;
1826    
1827            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1828                my $raw_evalue = $1;
1829                $from = $2;
1830                $to = $3;
1831                if($raw_evalue =~/(\d+)\.(\d+)/){
1832                    my $part2 = 1000 - $1;
1833                    my $part1 = $2/100;
1834                    $evalue = $part1."e-".$part2;
1835                }
1836                else{
1837                    $evalue = "0.0";
1838                }
1839          }          }
1840    
1841          # add the aliases          my $dbmaster = DBMaster->new(-database =>'Ontology',
1842          my $aliases = undef;                                  -host     => $WebConfig::DBHOST,
1843          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );                                  -user     => $WebConfig::DBUSER,
1844          $aliases = &HTML::set_prot_links( $cgi, $aliases );                                  -password => $WebConfig::DBPWD);
1845          $aliases ||= "&nbsp;";          my ($name_value,$description_value);
1846    
1847            if($db eq "CDD"){
1848                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1849                if(!scalar(@$cdd_objs)){
1850                    $name_title = "name";
1851                    $name_value = "not available";
1852                    $description_title = "description";
1853                    $description_value = "not available";
1854                }
1855                else{
1856                    my $cdd_obj = $cdd_objs->[0];
1857                    $name_value = $cdd_obj->term;
1858                    $description_value = $cdd_obj->description;
1859                }
1860            }
1861    
1862            my $domain_name;
1863            $domain_name = {"title" => "name",
1864                            "value" => $name_value};
1865            push(@$descriptions,$domain_name);
1866    
1867            my $description;
1868            $description = {"title" => "description",
1869                            "value" => $description_value};
1870            push(@$descriptions,$description);
1871    
1872            my $score;
1873            $score = {"title" => "score",
1874                      "value" => $evalue};
1875            push(@$descriptions,$score);
1876    
1877            my $link_id = $id;
1878            my $link;
1879            my $link_url;
1880            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"}
1881            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1882            else{$link_url = "NO_URL"}
1883    
1884            $link = {"link_title" => $name_value,
1885                     "link" => $link_url};
1886            push(@$links_list,$link);
1887    
1888            my $domain_element_hash = {
1889                "title" => $peg,
1890                "start" => $from,
1891                "end" =>  $to,
1892                "type"=> 'box',
1893                "zlayer" => '4',
1894                "links_list" => $links_list,
1895                "description" => $descriptions
1896                };
1897    
1898            push(@$line_data,$domain_element_hash);
1899    
1900            #just one CDD domain for now, later will add option for multiple domains from selected DB
1901            last;
1902        }
1903    
1904        my $line_config = { 'title' => $peg,
1905                            'hover_title' => 'Domain',
1906                            'short_title' => $peg,
1907                            'basepair_offset' => '1' };
1908    
1909        $gd->add_line($line_data, $line_config);
1910    
1911        return ($gd);
1912    
1913    }
1914    
1915    =head3 display_table()
1916    
1917    If available use the function specified here to display the "raw" observation.
1918    This code will display a table for the similarities protein
1919    
1920    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.
1921    
1922    =cut
1923    
1924    sub display_table {
1925        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1926    
1927        my $data = [];
1928        my $count = 0;
1929        my $content;
1930        #my $fig = new FIG;
1931        my $cgi = new CGI;
1932        my @ids;
1933        $lineages = $fig->taxonomy_list();
1934    
1935        foreach my $thing (@$dataset) {
1936            next if ($thing->class ne "SIM");
1937            push (@ids, $thing->acc);
1938        }
1939    
1940        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1941        my @attributes = $fig->get_attributes(\@ids);
1942    
1943        # get the column for the subsystems
1944        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1945    
1946        # get the column for the evidence codes
1947        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1948    
1949        # get the column for pfam_domain
1950        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1951    
1952        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1953        my $alias_col = &get_aliases(\@ids,$fig);
1954        #my $alias_col = {};
1955    
1956        my $figfam_data = "$FIG_Config::FigfamsData";
1957        my $figfams = new FigFams($fig,$figfam_data);
1958        my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1959    
1960        foreach my $thing (@$dataset) {
1961            next if ($thing->class ne "SIM");
1962            my $single_domain = [];
1963            $count++;
1964    
1965            my $id      = $thing->acc;
1966            my $taxid   = $fig->genome_of($id);
1967          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1968          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1969          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1385  Line 1976 
1976          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1977          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1978    
1979            # checkbox column
1980            my $field_name = "tables_" . $id;
1981            my $pair_name = "visual_" . $id;
1982            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1983            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1984    
1985            # get the linked fig id
1986            my $fig_col;
1987            if (defined ($e_identical{$id})){
1988                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1989            }
1990            else{
1991                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1992            }
1993    
1994          push(@$single_domain,$thing->database);          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1995          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1996          push(@$single_domain,$thing->evalue);  
1997          push(@$single_domain,"$iden\%");          foreach my $col (sort keys %$scroll_list){
1998          push(@$single_domain,$reg1);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1999          push(@$single_domain,$reg2);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2000          push(@$single_domain,$in_sub);              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2001          push(@$single_domain,$ev_codes);              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
2002          push(@$single_domain,$thing->organism);              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
2003          push(@$single_domain,$thing->function);              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
2004          push(@$single_domain,$aliases);              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
2005                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
2006                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
2007                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
2008                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2009                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2010                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2011                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2012                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2013                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2014            }
2015          push(@$data,$single_domain);          push(@$data,$single_domain);
2016      }      }
   
2017      if ($count >0){      if ($count >0){
2018          $content = $data;          $content = $data;
2019      }      }
2020      else      else{
     {  
2021          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2022      }      }
2023      return ($content);      return ($content);
2024  }  }
2025    
2026    sub get_box_column{
2027        my ($ids) = @_;
2028        my %column;
2029        foreach my $id (@$ids){
2030            my $field_name = "tables_" . $id;
2031            my $pair_name = "visual_" . $id;
2032            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2033        }
2034        return (%column);
2035    }
2036    
2037    sub get_subsystems_column{
2038        my ($ids,$fig) = @_;
2039    
2040        #my $fig = new FIG;
2041        my $cgi = new CGI;
2042        my %in_subs  = $fig->subsystems_for_pegs($ids);
2043        my %column;
2044        foreach my $id (@$ids){
2045            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2046            my @subsystems;
2047    
2048            if (@in_sub > 0) {
2049                foreach my $array(@in_sub){
2050                    my $ss = $$array[0];
2051                    $ss =~ s/_/ /ig;
2052                    push (@subsystems, "-" . $ss);
2053                }
2054                my $in_sub_line = join ("<br>", @subsystems);
2055                $column{$id} = $in_sub_line;
2056            } else {
2057                $column{$id} = "&nbsp;";
2058            }
2059        }
2060        return (%column);
2061    }
2062    
2063    sub get_essentially_identical{
2064        my ($fid,$dataset,$fig) = @_;
2065        #my $fig = new FIG;
2066    
2067        my %id_list;
2068        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2069    
2070        foreach my $thing (@$dataset){
2071            if($thing->class eq "IDENTICAL"){
2072                my $rows = $thing->rows;
2073                my $count_identical = 0;
2074                foreach my $row (@$rows) {
2075                    my $id = $row->[0];
2076                    if (($id ne $fid) && ($fig->function_of($id))) {
2077                        $id_list{$id} = 1;
2078                    }
2079                }
2080            }
2081        }
2082    
2083    #    foreach my $id (@maps_to) {
2084    #        if (($id ne $fid) && ($fig->function_of($id))) {
2085    #           $id_list{$id} = 1;
2086    #        }
2087    #    }
2088        return(%id_list);
2089    }
2090    
2091    
2092    sub get_evidence_column{
2093        my ($ids, $attributes,$fig) = @_;
2094        #my $fig = new FIG;
2095        my $cgi = new CGI;
2096        my (%column, %code_attributes);
2097    
2098        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2099        foreach my $key (@codes){
2100            push (@{$code_attributes{$$key[0]}}, $key);
2101        }
2102    
2103        foreach my $id (@$ids){
2104            # add evidence code with tool tip
2105            my $ev_codes=" &nbsp; ";
2106    
2107            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2108            my @ev_codes = ();
2109            foreach my $code (@codes) {
2110                my $pretty_code = $code->[2];
2111                if ($pretty_code =~ /;/) {
2112                    my ($cd, $ss) = split(";", $code->[2]);
2113                    $ss =~ s/_/ /g;
2114                    $pretty_code = $cd;# . " in " . $ss;
2115                }
2116                push(@ev_codes, $pretty_code);
2117            }
2118    
2119            if (scalar(@ev_codes) && $ev_codes[0]) {
2120                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2121                $ev_codes = $cgi->a(
2122                                    {
2123                                        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));
2124            }
2125            $column{$id}=$ev_codes;
2126        }
2127        return (%column);
2128    }
2129    
2130    sub get_pfam_column{
2131        my ($ids, $attributes,$fig) = @_;
2132        #my $fig = new FIG;
2133        my $cgi = new CGI;
2134        my (%column, %code_attributes, %attribute_locations);
2135        my $dbmaster = DBMaster->new(-database =>'Ontology',
2136                                    -host     => $WebConfig::DBHOST,
2137                                    -user     => $WebConfig::DBUSER,
2138                                    -password => $WebConfig::DBPWD);
2139    
2140        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2141        foreach my $key (@codes){
2142            my $name = $key->[1];
2143            if ($name =~ /_/){
2144                ($name) = ($key->[1]) =~ /(.*?)_/;
2145            }
2146            push (@{$code_attributes{$key->[0]}}, $name);
2147            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2148        }
2149    
2150        foreach my $id (@$ids){
2151            # add evidence code
2152            my $pfam_codes=" &nbsp; ";
2153            my @pfam_codes = "";
2154            my %description_codes;
2155    
2156            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2157                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2158                @pfam_codes = ();
2159    
2160                # get only unique values
2161                my %saw;
2162                foreach my $key (@ncodes) {$saw{$key}=1;}
2163                @ncodes = keys %saw;
2164    
2165                foreach my $code (@ncodes) {
2166                    my @parts = split("::",$code);
2167                    my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2168    
2169                    # get the locations for the domain
2170                    my @locs;
2171                    foreach my $part (@{$attribute_location{$id}{$code}}){
2172                        my ($loc) = ($part) =~ /\;(.*)/;
2173                        push (@locs,$loc);
2174                    }
2175                    my %locsaw;
2176                    foreach my $key (@locs) {$locsaw{$key}=1;}
2177                    @locs = keys %locsaw;
2178    
2179                    my $locations = join (", ", @locs);
2180    
2181                    if (defined ($description_codes{$parts[1]})){
2182                        push(@pfam_codes, "$parts[1] ($locations)");
2183                    }
2184                    else {
2185                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2186                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2187                        push(@pfam_codes, "$pfam_link ($locations)");
2188                    }
2189                }
2190            }
2191    
2192            $column{$id}=join("<br><br>", @pfam_codes);
2193        }
2194        return (%column);
2195    
2196    }
2197    
2198    sub get_aliases {
2199        my ($ids,$fig) = @_;
2200    
2201        my $all_aliases = $fig->feature_aliases_bulk($ids);
2202        foreach my $id (@$ids){
2203            foreach my $alias (@{$$all_aliases{$id}}){
2204                my $id_db = &Observation::get_database($alias);
2205                next if ($aliases->{$id}->{$id_db});
2206                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2207            }
2208        }
2209        return ($aliases);
2210    }
2211    
2212  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; $_ }
2213    
2214    sub color {
2215        my ($evalue) = @_;
2216        my $palette = WebColors::get_palette('vitamins');
2217        my $color;
2218        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2219        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2220        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2221        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2222        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2223        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2224        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2225        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2226        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2227        else{        $color = $palette->[9];    }
2228        return ($color);
2229    }
2230    
2231    
2232  ############################  ############################
# Line 1429  Line 2244 
2244  }  }
2245    
2246  sub display {  sub display {
2247      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2248    
2249        $taxes = $fig->taxonomy_list();
2250    
2251      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2252      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2253      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2254      my $fig = new FIG;      my $range = $gd_window_size;
2255      my $all_regions = [];      my $all_regions = [];
2256        my $gene_associations={};
2257    
2258      #get the organism genome      #get the organism genome
2259      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2260        $gene_associations->{$fid}->{"organism"} = $target_genome;
2261        $gene_associations->{$fid}->{"main_gene"} = $fid;
2262        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2263    
2264      # get location of the gene      # get location of the gene
2265      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 2276 
2276      my ($region_start, $region_end);      my ($region_start, $region_end);
2277      if ($beg < $end)      if ($beg < $end)
2278      {      {
2279          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2280          $region_end = $end+4000;          $region_end = $end+ ($range);
2281          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2282      }      }
2283      else      else
2284      {      {
2285          $region_start = $end-4000;          $region_start = $end-($range);
2286          $region_end = $beg+4000;          $region_end = $beg+($range);
2287          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2288          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2289            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2290      }      }
2291    
2292      # call genes in region      # call genes in region
2293      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);
2294        #foreach my $feat (@$target_gene_features){
2295        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2296        #}
2297      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2298      my (@start_array_region);      my (@start_array_region);
2299      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2300    
2301      my %all_genes;      my %all_genes;
2302      my %all_genomes;      my %all_genomes;
2303      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2304            #if ($feature =~ /peg/){
2305      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2306      {          #}
         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;  
2307                  }                  }
2308    
2309                  push (@start_array_region, $offset);      my @selected_sims;
2310    
2311                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2312                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2313                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2314                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2315            # get the similarities and store only the ones that match the lineages selected
2316            if (@selected_taxonomy > 0){
2317                foreach my $sim (@$sims_array){
2318                    next if ($sim->class ne "SIM");
2319                    next if ($sim->acc !~ /fig\|/);
2320    
2321                    #my $genome = $fig->genome_of($sim->[1]);
2322                    my $genome = $fig->genome_of($sim->acc);
2323                    #my ($genome1) = ($genome) =~ /(.*)\./;
2324                    my $lineage = $taxes->{$genome};
2325                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2326                    foreach my $taxon(@selected_taxonomy){
2327                        if ($lineage =~ /$taxon/){
2328                            #push (@selected_sims, $sim->[1]);
2329                            push (@selected_sims, $sim->acc);
2330              }              }
             $coup_count++;  
2331          }          }
2332      }      }
   
     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;  
2333                      }                      }
2334            else{
2335                my $simcount = 0;
2336                foreach my $sim (@$sims_array){
2337                    next if ($sim->class ne "SIM");
2338                    next if ($sim->acc !~ /fig\|/);
2339    
2340                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2341                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2342                      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;}  
                 }  
2343              }              }
2344          }          }
2345    
2346            my %saw;
2347            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2348    
2349            # get the gene context for the sorted matches
2350            foreach my $sim_fid(@selected_sims){
2351                #get the organism genome
2352                my $sim_genome = $fig->genome_of($sim_fid);
2353                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2354                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2355                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2356    
2357                # get location of the gene
2358                my $data = $fig->feature_location($sim_fid);
2359                my ($contig, $beg, $end);
2360    
2361                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2362                    $contig = $1;
2363                    $beg = $2;
2364                    $end = $3;
2365      }      }
2366    
2367      # get the PCH to each of the genes              my $offset;
2368      my $pch_sets = [];              my ($region_start, $region_end);
2369      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)  
2370          {          {
2371              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2372                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2373                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2374          }          }
2375          else          else
2376          {          {
2377              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2378                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2379                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2380                    $reverse_flag{$sim_genome} = $sim_fid;
2381                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2382              }              }
2383    
2384                # call genes in region
2385                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2386                push(@$all_regions,$sim_gene_features);
2387                push (@start_array_region, $offset);
2388                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2389                $all_genomes{$sim_genome} = 1;
2390          }          }
2391    
2392      }      }
2393    
2394        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2395  #    my $bbh_sets = [];      # cluster the genes
2396  #    my %already;      my @all_pegs = keys %all_genes;
2397  #    foreach my $gene_key (keys(%all_genes)){      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2398  #       if($already{$gene_key}){next;}      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2399  #       my $gene_set = [$gene_key];      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #  
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = 100;  
 #           }  
 #       }  
 #    }  
2400    
2401      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2402          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2403          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2404          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2405          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2406            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2407            my $lineage = $taxes->{$region_genome};
2408            #my $lineage = $fig->taxonomy_of($region_genome);
2409            #$region_gs .= "Lineage:$lineage";
2410          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2411                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2412                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 2414 
2414    
2415          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2416    
2417            my $second_line_config = { 'title' => "$lineage",
2418                                       'short_title' => "",
2419                                       'basepair_offset' => '0',
2420                                       'no_middle_line' => '1'
2421                                       };
2422    
2423          my $line_data = [];          my $line_data = [];
2424            my $second_line_data = [];
2425    
2426            # initialize variables to check for overlap in genes
2427            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2428            my $major_line_flag = 0;
2429            my $prev_second_flag = 0;
2430    
2431          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2432                $second_line_flag = 0;
2433              my $element_hash;              my $element_hash;
2434              my $links_list = [];              my $links_list = [];
2435              my $descriptions = [];              my $descriptions = [];
2436    
2437              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2438    
2439              # get subsystem information              # get subsystem information
2440              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2441              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2442    
2443              my $link;              my $link;
2444              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2445                       "link" => $url_link};                       "link" => $url_link};
2446              push(@$links_list,$link);              push(@$links_list,$link);
2447    
2448              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2449              foreach my $subsystem (@subsystems){              my @subsystems;
2450                foreach my $array (@subs){
2451                    my $subsystem = $$array[0];
2452                    my $ss = $subsystem;
2453                    $ss =~ s/_/ /ig;
2454                    push (@subsystems, $ss);
2455                  my $link;                  my $link;
2456                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2457                           "link_title" => $subsystem};                           "link_title" => $ss};
2458                    push(@$links_list,$link);
2459                }
2460    
2461                if ($fid1 eq $fid){
2462                    my $link;
2463                    $link = {"link_title" => "Annotate this sequence",
2464                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2465                  push(@$links_list,$link);                  push(@$links_list,$link);
2466              }              }
2467    
# Line 1738  Line 2483 
2483                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2484                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2485    
2486                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2487                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2488                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2489                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2490                            $second_line_flag = 1;
2491                            $major_line_flag = 1;
2492                        }
2493                    }
2494                    $prev_start = $start;
2495                    $prev_stop = $stop;
2496                    $prev_fig = $fid1;
2497    
2498                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2499                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2500                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2501                  }                  }
2502    
2503                    my $title = $fid1;
2504                    if ($fid1 eq $fid){
2505                        $title = "My query gene: $fid1";
2506                    }
2507    
2508                  $element_hash = {                  $element_hash = {
2509                      "title" => $fid1,                      "title" => $title,
2510                      "start" => $start,                      "start" => $start,
2511                      "end" =>  $stop,                      "end" =>  $stop,
2512                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 2515 
2515                      "links_list" => $links_list,                      "links_list" => $links_list,
2516                      "description" => $descriptions                      "description" => $descriptions
2517                  };                  };
2518                  push(@$line_data,$element_hash);  
2519                    # if there is an overlap, put into second line
2520                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2521                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2522    
2523                    if ($fid1 eq $fid){
2524                        $element_hash = {
2525                            "title" => 'Query',
2526                            "start" => $start,
2527                            "end" =>  $stop,
2528                            "type"=> 'bigbox',
2529                            "color"=> $color,
2530                            "zlayer" => "1"
2531                            };
2532    
2533                        # if there is an overlap, put into second line
2534                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2535                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2536                    }
2537              }              }
2538          }          }
2539          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2540            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2541      }      }
2542      return $gd;      return ($gd, \@selected_sims);
2543  }  }
2544    
2545    sub cluster_genes {
2546        my($fig,$all_pegs,$peg) = @_;
2547        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2548    
2549        my @color_sets = ();
2550    
2551        $conn = &get_connections_by_similarity($fig,$all_pegs);
2552    
2553        for ($i=0; ($i < @$all_pegs); $i++) {
2554            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2555            if (! $seen{$i}) {
2556                $cluster = [$i];
2557                $seen{$i} = 1;
2558                for ($j=0; ($j < @$cluster); $j++) {
2559                    $x = $conn->{$cluster->[$j]};
2560                    foreach $k (@$x) {
2561                        if (! $seen{$k}) {
2562                            push(@$cluster,$k);
2563                            $seen{$k} = 1;
2564                        }
2565                    }
2566                }
2567    
2568                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2569                    push(@color_sets,$cluster);
2570                }
2571            }
2572        }
2573        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2574        $red_set = $color_sets[$i];
2575        splice(@color_sets,$i,1);
2576        @color_sets = sort { @$b <=> @$a } @color_sets;
2577        unshift(@color_sets,$red_set);
2578    
2579        my $color_sets = {};
2580        for ($i=0; ($i < @color_sets); $i++) {
2581            foreach $x (@{$color_sets[$i]}) {
2582                $color_sets->{$all_pegs->[$x]} = $i;
2583            }
2584        }
2585        return $color_sets;
2586    }
2587    
2588    sub get_connections_by_similarity {
2589        my($fig,$all_pegs) = @_;
2590        my($i,$j,$tmp,$peg,%pos_of);
2591        my($sim,%conn,$x,$y);
2592    
2593        for ($i=0; ($i < @$all_pegs); $i++) {
2594            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2595            push(@{$pos_of{$tmp}},$i);
2596            if ($tmp ne $all_pegs->[$i]) {
2597                push(@{$pos_of{$all_pegs->[$i]}},$i);
2598            }
2599        }
2600    
2601        foreach $y (keys(%pos_of)) {
2602            $x = $pos_of{$y};
2603            for ($i=0; ($i < @$x); $i++) {
2604                for ($j=$i+1; ($j < @$x); $j++) {
2605                    push(@{$conn{$x->[$i]}},$x->[$j]);
2606                    push(@{$conn{$x->[$j]}},$x->[$i]);
2607                }
2608            }
2609        }
2610    
2611        for ($i=0; ($i < @$all_pegs); $i++) {
2612            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2613                if (defined($x = $pos_of{$sim->id2})) {
2614                    foreach $y (@$x) {
2615                        push(@{$conn{$i}},$y);
2616                    }
2617                }
2618            }
2619        }
2620        return \%conn;
2621    }
2622    
2623    sub in {
2624        my($x,$xL) = @_;
2625        my($i);
2626    
2627        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2628        return ($i < @$xL);
2629    }
2630    
2631    #############################################
2632    #############################################
2633    package Observation::Commentary;
2634    
2635    use base qw(Observation);
2636    
2637    =head3 display_protein_commentary()
2638    
2639    =cut
2640    
2641    sub display_protein_commentary {
2642        my ($self,$dataset,$mypeg,$fig) = @_;
2643    
2644        my $all_rows = [];
2645        my $content;
2646        #my $fig = new FIG;
2647        my $cgi = new CGI;
2648        my $count = 0;
2649        my $peg_array = [];
2650        my (%evidence_column, %subsystems_column,  %e_identical);
2651    
2652        if (@$dataset != 1){
2653            foreach my $thing (@$dataset){
2654                if ($thing->class eq "SIM"){
2655                    push (@$peg_array, $thing->acc);
2656                }
2657            }
2658            # get the column for the evidence codes
2659            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2660    
2661            # get the column for the subsystems
2662            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2663    
2664            # get essentially identical seqs
2665            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2666        }
2667        else{
2668            push (@$peg_array, @$dataset);
2669        }
2670    
2671        my $selected_sims = [];
2672        foreach my $id (@$peg_array){
2673            last if ($count > 10);
2674            my $row_data = [];
2675            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2676            $org = $fig->org_of($id);
2677            $function = $fig->function_of($id);
2678            if ($mypeg ne $id){
2679                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2680                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2681                if (defined($e_identical{$id})) { $id_cell .= "*";}
2682            }
2683            else{
2684                $function_cell = "&nbsp;&nbsp;$function";
2685                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2686                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2687            }
2688    
2689            push(@$row_data,$id_cell);
2690            push(@$row_data,$org);
2691            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2692            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2693            push(@$row_data, $fig->translation_length($id));
2694            push(@$row_data,$function_cell);
2695            push(@$all_rows,$row_data);
2696            push (@$selected_sims, $id);
2697            $count++;
2698        }
2699    
2700        if ($count >0){
2701            $content = $all_rows;
2702        }
2703        else{
2704            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2705        }
2706        return ($content,$selected_sims);
2707    }
2708    
2709    sub display_protein_history {
2710        my ($self, $id,$fig) = @_;
2711        my $all_rows = [];
2712        my $content;
2713    
2714        my $cgi = new CGI;
2715        my $count = 0;
2716        foreach my $feat ($fig->feature_annotations($id)){
2717            my $row = [];
2718            my $col1 = $feat->[2];
2719            my $col2 = $feat->[1];
2720            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2721            my $text = $feat->[3];
2722    
2723            push (@$row, $col1);
2724            push (@$row, $col2);
2725            push (@$row, $text);
2726            push (@$all_rows, $row);
2727            $count++;
2728        }
2729        if ($count > 0){
2730            $content = $all_rows;
2731        }
2732        else {
2733            $content = "There is no history for this PEG";
2734        }
2735    
2736        return($content);
2737    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3