[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.26, Wed Jul 25 16:52:04 2007 UTC revision 1.50, Thu Dec 6 18:47:35 2007 UTC
# Line 2  Line 2 
2    
3  use lib '/vol/ontologies';  use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10    use WebColors;
11    
12  use FIG_Config;  use FIG_Config;
13  use strict;  #use strict;
14  #use warnings;  #use warnings;
15  use HTML;  use HTML;
16    
# 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 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, $fid, $taxes, $dataset, $fig) = @_;
418        my %families;
419        #my @sims= $fig->nsims($fid,20000,10,"fig");
420    
421        foreach my $thing (@$dataset) {
422            next if ($thing->class ne "SIM");
423    
424            my $id      = $thing->acc;
425            my $evalue  = $thing->evalue;
426    
427            next if ($id !~ /fig\|/);
428            next if ($fig->is_deleted_fid($id));
429            my $genome = $fig->genome_of($id);
430            #my ($genome1) = ($genome) =~ /(.*)\./;
431            #my $taxonomy = $taxes->{$genome1};
432            my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated
433            my $parent_tax = "Root";
434            my @currLineage = ($parent_tax);
435            foreach my $tax (split(/\; /, $taxonomy)){
436                push (@{$families{children}{$parent_tax}}, $tax);
437                push (@currLineage, $tax);
438                $families{parent}{$tax} = $parent_tax;
439                $families{lineage}{$tax} = join(";", @currLineage);
440                if (defined ($families{evalue}{$tax})){
441                    if ($sim->[10] < $families{evalue}{$tax}){
442                        $families{evalue}{$tax} = $evalue;
443                        $families{color}{$tax} = &get_taxcolor($evalue);
444                    }
445                }
446                else{
447                    $families{evalue}{$tax} = $evalue;
448                    $families{color}{$tax} = &get_taxcolor($evalue);
449                }
450    
451                $parent_tax = $tax;
452            }
453        }
454    
455        foreach my $key (keys %{$families{children}}){
456            $families{count}{$key} = @{$families{children}{$key}};
457    
458            my %saw;
459            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
460            $families{children}{$key} = \@out;
461        }
462        return (\%families);
463    }
464    
465  =head1 Internal Methods  =head1 Internal Methods
466    
467  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 470 
470    
471  =cut  =cut
472    
473    sub get_taxcolor{
474        my ($evalue) = @_;
475        my $color;
476        if ($evalue <= 1e-170){        $color = "#FF2000";    }
477        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
478        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
479        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
480        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
481        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
482        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
483        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
484        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
485        else{        $color = "#6666FF";    }
486        return ($color);
487    }
488    
489    
490  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
491    
492      # 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)
493      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
494    
495      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
496          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
497          my @parts = split("::",$key);          my @parts = split("::",$key);
498          my $class = $parts[0];          my $class = $parts[0];
499            my $name = $parts[1];
500            next if (($class eq "PFAM") && ($name !~ /interpro/));
501    
502          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
503              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 384  Line 506 
506                  my $from = $2;                  my $from = $2;
507                  my $to = $3;                  my $to = $3;
508                  my $evalue;                  my $evalue;
509                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
510                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
511                      my $part1 = $2/100;                      my $part1 = $2/100;
512                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
513                  }                  }
514                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
515                        $evalue=$raw_evalue;
516                    }
517                  else{                  else{
518                      $evalue = "0.0";                      $evalue = "0.0";
519                  }                  }
# Line 411  Line 536 
536    
537  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
538    
539      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
540      my $fig = new FIG;      #my $fig = new FIG;
541    
542      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
543    
544      my $dataset = {'type' => "loc",      my $dataset = {'type' => "loc",
545                     'class' => 'SIGNALP_CELLO_TMPRED',                     'class' => 'SIGNALP_CELLO_TMPRED',
546                     'fig_id' => $fid                     'fig_id' => $fid
547                     };                     };
548    
549      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {      foreach my $attr_ref (@$attributes_ref){
550          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
551            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
552          my @parts = split("::",$key);          my @parts = split("::",$key);
553          my $sub_class = $parts[0];          my $sub_class = $parts[0];
554          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 437  Line 563 
563                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
564              }              }
565          }          }
566    
567          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
568              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
569              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
570          }          }
571    
572            elsif($sub_class eq "Phobius"){
573                if($sub_key eq "transmembrane"){
574                    $dataset->{'phobius_tm_locations'} = $value;
575                }
576                elsif($sub_key eq "signal"){
577                    $dataset->{'phobius_signal_location'} = $value;
578                }
579            }
580    
581          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
582              my @value_parts = split(/\;/,$value);              my @value_parts = split(/\;/,$value);
583              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
# Line 459  Line 596 
596  =cut  =cut
597    
598  sub get_pdb_observations{  sub get_pdb_observations{
599      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
600    
601      my $fig = new FIG;      #my $fig = new FIG;
   
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
602    
603        foreach my $attr_ref (@$attributes_ref){
604          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
605            next if ( ($key !~ /PDB/));
606          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
607          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
608          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 518  Line 655 
655    
656  sub get_sims_observations{  sub get_sims_observations{
657    
658      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
659      my $fig = new FIG;      #my $fig = new FIG;
660      my @sims= $fig->nsims($fid,500,1e-20,"all");      my @sims= $fig->sims($fid,500,10,"fig");
661      my ($dataset);      my ($dataset);
662    
     my %id_list;  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
663      foreach my $sim (@sims){      foreach my $sim (@sims){
664          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($sim->[1]));
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
   
     foreach my $sim (@new_sims){  
665          my $hit = $sim->[1];          my $hit = $sim->[1];
666          my $percent = $sim->[2];          my $percent = $sim->[2];
667          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 560  Line 676 
676          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
677    
678          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
679                        'query' => $sim->[0],
680                      'acc' => $hit,                      'acc' => $hit,
681                      'identity' => $percent,                      'identity' => $percent,
682                      'type' => 'seq',                      'type' => 'seq',
# Line 596  Line 713 
713      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
714      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
715      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
716      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
717      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
718      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
719      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 614  Line 731 
731    
732  sub get_identical_proteins{  sub get_identical_proteins{
733    
734      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
735      my $fig = new FIG;      #my $fig = new FIG;
736      my $funcs_ref;      my $funcs_ref;
737    
     my %id_list;  
738      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
     my @aliases = $fig->feature_aliases($fid);  
     foreach my $alias (@aliases){  
         $id_list{$alias} = 1;  
     }  
   
739      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
740          my ($tmp, $who);          my ($tmp, $who);
741          if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
742              $who = &get_database($id);              $who = &get_database($id);
743              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
744          }          }
745      }      }
746    
     my ($dataset);  
747      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
748                     'type' => 'seq',                     'type' => 'seq',
749                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 653  Line 763 
763    
764  sub get_functional_coupling{  sub get_functional_coupling{
765    
766      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
767      my $fig = new FIG;      #my $fig = new FIG;
768      my @funcs = ();      my @funcs = ();
769    
770      # initialize some variables      # initialize some variables
# Line 671  Line 781 
781                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
782                    } @fc_data;                    } @fc_data;
783    
     my ($dataset);  
784      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
785                     'type' => 'fc',                     'type' => 'fc',
786                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 782  Line 891 
891      return $self->{database};      return $self->{database};
892  }  }
893    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
894  ############################################################  ############################################################
895  ############################################################  ############################################################
896  package Observation::PDB;  package Observation::PDB;
# Line 813  Line 916 
916  =cut  =cut
917    
918  sub display{  sub display{
919      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
920    
921      my $fid = $self->fig_id;      my $fid = $self->fig_id;
922      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 837  Line 940 
940      my $lines = [];      my $lines = [];
941      my $line_data = [];      my $line_data = [];
942      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
943                            'hover_title' => 'PDB',
944                          'short_title' => "best PDB",                          'short_title' => "best PDB",
945                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
946    
947      my $fig = new FIG;      #my $fig = new FIG;
948      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
949      my $fid_stop = length($seq);      my $fid_stop = length($seq);
950    
# Line 941  Line 1045 
1045    
1046    
1047  sub display_table{  sub display_table{
1048      my ($self) = @_;      my ($self,$fig) = @_;
1049    
1050      my $fig = new FIG;      #my $fig = new FIG;
1051      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1052      my $rows = $self->rows;      my $rows = $self->rows;
1053      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1005  Line 1109 
1109    
1110  sub display_table {  sub display_table {
1111    
1112      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1113      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1114      my $rows = $self->rows;      my $rows = $self->rows;
1115      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1020  Line 1124 
1124          # construct the score link          # construct the score link
1125          my $score = $row->[0];          my $score = $row->[0];
1126          my $toid = $row->[1];          my $toid = $row->[1];
1127          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";
1128          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1129    
1130          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1131          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1062  Line 1166 
1166  sub display {  sub display {
1167      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1168      my $lines = [];      my $lines = [];
1169      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1170                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1171                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1172      my $color = "4";      my $color = "4";
1173    
1174      my $line_data = [];      my $line_data = [];
# Line 1093  Line 1197 
1197              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1198          }          }
1199      }      }
1200        elsif($db =~ /PFAM/){
1201            my ($new_id) = ($id) =~ /(.*?)_/;
1202            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1203            if(!scalar(@$pfam_objs)){
1204                $name_title = "name";
1205                $name_value = "not available";
1206                $description_title = "description";
1207                $description_value = "not available";
1208            }
1209            else{
1210                my $pfam_obj = $pfam_objs->[0];
1211                $name_title = "name";
1212                $name_value = $pfam_obj->term;
1213                #$description_title = "description";
1214                #$description_value = $pfam_obj->description;
1215            }
1216        }
1217    
1218        my $short_title = $thing->acc;
1219        $short_title =~ s/::/ - /ig;
1220        my $new_short_title=$short_title;
1221        if ($short_title =~ /interpro/){
1222            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1223        }
1224        my $line_config = { 'title' => $name_value,
1225                            'hover_title', => 'Domain',
1226                            'short_title' => $new_short_title,
1227                            'basepair_offset' => '1' };
1228    
1229      my $name;      my $name;
1230      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1231               "value" => $name_value};      $name = {"title" => $db,
1232                 "value" => $new_id};
1233      push(@$descriptions,$name);      push(@$descriptions,$name);
1234    
1235      my $description;  #    my $description;
1236      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1237                               "value" => $description_value};  #                   "value" => $description_value};
1238      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1239    
1240      my $score;      my $score;
1241      $score = {"title" => "score",      $score = {"title" => "score",
1242                "value" => $thing->evalue};                "value" => $thing->evalue};
1243      push(@$descriptions,$score);      push(@$descriptions,$score);
1244    
1245        my $location;
1246        $location = {"title" => "location",
1247                     "value" => $thing->start . " - " . $thing->stop};
1248        push(@$descriptions,$location);
1249    
1250      my $link_id;      my $link_id;
1251      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1252          $link_id = $1;          $link_id = $1;
1253      }      }
1254    
# Line 1125  Line 1263 
1263      push(@$links_list,$link);      push(@$links_list,$link);
1264    
1265      my $element_hash = {      my $element_hash = {
1266          "title" => $thing->type,          "title" => $name_value,
1267          "start" => $thing->start,          "start" => $thing->start,
1268          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1269          "color"=> $color,          "color"=> $color,
# Line 1140  Line 1278 
1278    
1279  }  }
1280    
1281    sub display_table {
1282        my ($self,$dataset) = @_;
1283        my $cgi = new CGI;
1284        my $data = [];
1285        my $count = 0;
1286        my $content;
1287    
1288        foreach my $thing (@$dataset) {
1289            next if ($thing->type !~ /dom/);
1290            my $single_domain = [];
1291            $count++;
1292    
1293            my $db_and_id = $thing->acc;
1294            my ($db,$id) = split("::",$db_and_id);
1295    
1296            my $dbmaster = DBMaster->new(-database =>'Ontology');
1297    
1298            my ($name_title,$name_value,$description_title,$description_value);
1299            if($db eq "CDD"){
1300                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1301                if(!scalar(@$cdd_objs)){
1302                    $name_title = "name";
1303                    $name_value = "not available";
1304                    $description_title = "description";
1305                    $description_value = "not available";
1306                }
1307                else{
1308                    my $cdd_obj = $cdd_objs->[0];
1309                    $name_title = "name";
1310                    $name_value = $cdd_obj->term;
1311                    $description_title = "description";
1312                    $description_value = $cdd_obj->description;
1313                }
1314            }
1315    
1316            my $location =  $thing->start . " - " . $thing->stop;
1317    
1318            push(@$single_domain,$db);
1319            push(@$single_domain,$thing->acc);
1320            push(@$single_domain,$name_value);
1321            push(@$single_domain,$location);
1322            push(@$single_domain,$thing->evalue);
1323            push(@$single_domain,$description_value);
1324            push(@$data,$single_domain);
1325        }
1326    
1327        if ($count >0){
1328            $content = $data;
1329        }
1330        else
1331        {
1332            $content = "<p>This PEG does not have any similarities to domains</p>";
1333        }
1334    }
1335    
1336    
1337  #########################################  #########################################
1338  #########################################  #########################################
1339  package Observation::Location;  package Observation::Location;
# Line 1157  Line 1351 
1351      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1352      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1353      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1354        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1355        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1356    
1357      bless($self,$class);      bless($self,$class);
1358      return $self;      return $self;
1359  }  }
1360    
1361    sub display_cello {
1362        my ($thing) = @_;
1363        my $html;
1364        my $cello_location = $thing->cello_location;
1365        my $cello_score = $thing->cello_score;
1366        if($cello_location){
1367            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1368            #$html .= "<p>CELLO score: $cello_score </p>";
1369        }
1370        return ($html);
1371    }
1372    
1373  sub display {  sub display {
1374      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1375    
1376      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1377      my $fig= new FIG;      #my $fig= new FIG;
1378      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1379    
1380      my $cleavage_prob;      my $cleavage_prob;
# Line 1178  Line 1386 
1386      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1387      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1388    
1389        my $phobius_signal_location = $thing->phobius_signal_location;
1390        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1391    
1392      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1393    
1394      #color is      #color is
1395      my $color = "5";      my $color = "6";
1396    
1397      my $line_data = [];  =pod=
1398    
1399      if($cello_location){      if($cello_location){
1400          my $cello_descriptions = [];          my $cello_descriptions = [];
1401            my $line_data =[];
1402    
1403            my $line_config = { 'title' => 'Localization Evidence',
1404                                'short_title' => 'CELLO',
1405                                'hover_title' => 'Localization',
1406                                'basepair_offset' => '1' };
1407    
1408          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1409                                            "value" => $cello_location};                                            "value" => $cello_location};
1410    
# Line 1202  Line 1417 
1417    
1418          my $element_hash = {          my $element_hash = {
1419              "title" => "CELLO",              "title" => "CELLO",
1420                "color"=> $color,
1421              "start" => "1",              "start" => "1",
1422              "end" =>  $length + 1,              "end" =>  $length + 1,
1423              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1424              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1425    
1426          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1427            $gd->add_line($line_data, $line_config);
1428      }      }
1429    
1430      my $color = "6";      $color = "2";
1431      if($tmpred_score){      if($tmpred_score){
1432            my $line_data =[];
1433            my $line_config = { 'title' => 'Localization Evidence',
1434                                'short_title' => 'Transmembrane',
1435                                'basepair_offset' => '1' };
1436    
1437          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1438              my $descriptions = [];              my $descriptions = [];
1439              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1228  Line 1448 
1448              "end" =>  $end + 1,              "end" =>  $end + 1,
1449              "color"=> $color,              "color"=> $color,
1450              "zlayer" => '5',              "zlayer" => '5',
1451              "type" => 'smallbox',              "type" => 'box',
1452                "description" => $descriptions};
1453    
1454                push(@$line_data,$element_hash);
1455    
1456            }
1457            $gd->add_line($line_data, $line_config);
1458        }
1459    =cut
1460    
1461        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1462            my $line_data =[];
1463            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1464                                'short_title' => 'TM and SP',
1465                                'hover_title' => 'Localization',
1466                                'basepair_offset' => '1' };
1467    
1468            foreach my $tm_loc (@phobius_tm_locations){
1469                my $descriptions = [];
1470                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1471                                 "value" => $tm_loc};
1472                push(@$descriptions,$description_phobius_tm_locations);
1473    
1474                my ($begin,$end) =split("-",$tm_loc);
1475    
1476                my $element_hash = {
1477                "title" => "Phobius",
1478                "start" => $begin + 1,
1479                "end" =>  $end + 1,
1480                "color"=> '6',
1481                "zlayer" => '4',
1482                "type" => 'bigbox',
1483              "description" => $descriptions};              "description" => $descriptions};
1484    
1485              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1486    
1487            }
1488    
1489            if($phobius_signal_location){
1490                my $descriptions = [];
1491                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1492                                 "value" => $phobius_signal_location};
1493                push(@$descriptions,$description_phobius_signal_location);
1494    
1495    
1496                my ($begin,$end) =split("-",$phobius_signal_location);
1497                my $element_hash = {
1498                "title" => "phobius signal locations",
1499                "start" => $begin + 1,
1500                "end" =>  $end + 1,
1501                "color"=> '1',
1502                "zlayer" => '5',
1503                "type" => 'box',
1504                "description" => $descriptions};
1505                push(@$line_data,$element_hash);
1506          }          }
1507    
1508            $gd->add_line($line_data, $line_config);
1509      }      }
1510    
1511      my $color = "1";  =head3
1512        $color = "1";
1513      if($signal_peptide_score){      if($signal_peptide_score){
1514            my $line_data = [];
1515          my $descriptions = [];          my $descriptions = [];
1516    
1517            my $line_config = { 'title' => 'Localization Evidence',
1518                                'short_title' => 'SignalP',
1519                                'hover_title' => 'Localization',
1520                                'basepair_offset' => '1' };
1521    
1522          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1523                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1524    
# Line 1251  Line 1532 
1532          my $element_hash = {          my $element_hash = {
1533              "title" => "SignalP",              "title" => "SignalP",
1534              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1535              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1536              "type" => 'bigbox',              "type" => 'bigbox',
1537              "color"=> $color,              "color"=> $color,
1538              "zlayer" => '10',              "zlayer" => '10',
1539              "description" => $descriptions};              "description" => $descriptions};
1540    
1541          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1542      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1543        }
1544    =cut
1545    
1546      return ($gd);      return ($gd);
1547    
# Line 1308  Line 1589 
1589    return $self->{cello_score};    return $self->{cello_score};
1590  }  }
1591    
1592    sub phobius_signal_location {
1593      my ($self) = @_;
1594      return $self->{phobius_signal_location};
1595    }
1596    
1597    sub phobius_tm_locations {
1598      my ($self) = @_;
1599      return $self->{phobius_tm_locations};
1600    }
1601    
1602    
1603    
1604  #########################################  #########################################
1605  #########################################  #########################################
# Line 1321  Line 1613 
1613      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1614      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1615      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1616        $self->{query} = $dataset->{'query'};
1617      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1618      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1619      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1344  Line 1637 
1637  =cut  =cut
1638    
1639  sub display {  sub display {
1640      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1641        #my $fig = new FIG;
1642    
1643      my $fig = new FIG;      my @ids;
1644      my $peg = $self->acc;      foreach my $thing(@$array){
1645            next if ($thing->class ne "SIM");
1646            push (@ids, $thing->acc);
1647        }
1648    
1649        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1650    
1651        foreach my $thing (@$array){
1652            if ($thing->class eq "SIM"){
1653    
1654                my $peg = $thing->acc;
1655                my $query = $thing->query;
1656    
1657      my $organism = $self->organism;              my $organism = $thing->organism;
1658      my $function = $self->function;              my $genome = $fig->genome_of($peg);
1659                my ($org_tax) = ($genome) =~ /(.*)\./;
1660                my $function = $thing->function;
1661      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1662      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1663      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1664      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1665      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1666    
1667      my $line_config = { 'title' => "$organism",              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1668    
1669                my $line_config = { 'title' => "$organism [$org_tax]",
1670                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1671                                    'title_link' => '$tax_link',
1672                          'basepair_offset' => '0'                          'basepair_offset' => '0'
1673                          };                          };
1674    
# Line 1369  Line 1679 
1679      my $descriptions = [];      my $descriptions = [];
1680    
1681      # get subsystem information      # get subsystem information
1682      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1683      my $link;      my $link;
1684      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1685               "link" => $url_link};               "link" => $url_link};
1686      push(@$links_list,$link);      push(@$links_list,$link);
1687    
1688      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1689      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1690                my @subsystems;
1691    
1692                foreach my $array (@subs){
1693                    my $subsystem = $$array[0];
1694                    push(@subsystems,$subsystem);
1695          my $link;          my $link;
1696          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1697                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1698          push(@$links_list,$link);          push(@$links_list,$link);
1699      }      }
1700    
1701                $link = {"link_title" => "view blast alignment",
1702                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1703                push (@$links_list,$link);
1704    
1705      my $description_function;      my $description_function;
1706      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1707                               "value" => $function};                               "value" => $function};
# Line 1404  Line 1722 
1722                          "value" => $hit_stop};                          "value" => $hit_stop};
1723      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1724    
1725      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1726      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1727      {      {
1728          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1435  Line 1753 
1753          };          };
1754      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1755      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1756            }
1757        }
1758      return ($gd);      return ($gd);
   
1759  }  }
1760    
1761  =head3 display_table()  =head3 display_domain_composition()
   
 If available use the function specified here to display the "raw" observation.  
 This code will display a table for the similarities protein  
1762    
1763  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 of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1764    
1765  =cut  =cut
1766    
1767  sub display_table {  sub display_domain_composition {
1768      my ($self,$dataset) = @_;      my ($self,$gd,$fig) = @_;
1769    
1770      my $data = [];      #$fig = new FIG;
1771      my $count = 0;      my $peg = $self->acc;
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
         next if ($thing->class ne "SIM");  
         $count++;  
1772    
1773          my $id = $thing->acc;      my $line_data = [];
1774        my $links_list = [];
1775        my $descriptions = [];
1776    
1777          # add the subsystem information      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1778          my @in_sub  = $fig->peg_to_subsystems($id);      #my @domain_query_results = ();
1779          my $in_sub;      foreach $dqr (@domain_query_results){
1780            my $key = @$dqr[1];
1781          if (@in_sub > 0) {          my @parts = split("::",$key);
1782              $in_sub = @in_sub;          my $db = $parts[0];
1783            my $id = $parts[1];
1784            my $val = @$dqr[2];
1785            my $from;
1786            my $to;
1787            my $evalue;
1788    
1789              # RAE: add a javascript popup with all the subsystems          if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1790              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $raw_evalue = $1;
1791              $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);              $from = $2;
1792          } else {              $to = $3;
1793              $in_sub = "&nbsp;";              if($raw_evalue =~/(\d+)\.(\d+)/){
1794                    my $part2 = 1000 - $1;
1795                    my $part1 = $2/100;
1796                    $evalue = $part1."e-".$part2;
1797                }
1798                else{
1799                    $evalue = "0.0";
1800                }
1801          }          }
1802    
1803          # add evidence code with tool tip          my $dbmaster = DBMaster->new(-database =>'Ontology');
1804          my $ev_codes=" &nbsp; ";          my ($name_value,$description_value);
1805          my @ev_codes = "";  
1806          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if($db eq "CDD"){
1807              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1808              @ev_codes = ();              if(!scalar(@$cdd_objs)){
1809              foreach my $code (@codes) {                  $name_title = "name";
1810                  my $pretty_code = $code->[2];                  $name_value = "not available";
1811                  if ($pretty_code =~ /;/) {                  $description_title = "description";
1812                      my ($cd, $ss) = split(";", $code->[2]);                  $description_value = "not available";
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
1813                  }                  }
1814                  push(@ev_codes, $pretty_code);              else{
1815                    my $cdd_obj = $cdd_objs->[0];
1816                    $name_value = $cdd_obj->term;
1817                    $description_value = $cdd_obj->description;
1818              }              }
1819          }          }
1820    
1821          if (scalar(@ev_codes) && $ev_codes[0]) {          my $domain_name;
1822              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);          $domain_name = {"title" => "name",
1823              $ev_codes = $cgi->a(                          "value" => $name_value};
1824                                  {          push(@$descriptions,$domain_name);
1825                                      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));  
1826            my $description;
1827            $description = {"title" => "description",
1828                            "value" => $description_value};
1829            push(@$descriptions,$description);
1830    
1831            my $score;
1832            $score = {"title" => "score",
1833                      "value" => $evalue};
1834            push(@$descriptions,$score);
1835    
1836            my $link_id = $id;
1837            my $link;
1838            my $link_url;
1839            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"}
1840            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1841            else{$link_url = "NO_URL"}
1842    
1843            $link = {"link_title" => $name_value,
1844                     "link" => $link_url};
1845            push(@$links_list,$link);
1846    
1847            my $domain_element_hash = {
1848                "title" => $peg,
1849                "start" => $from,
1850                "end" =>  $to,
1851                "type"=> 'box',
1852                "zlayer" => '4',
1853                "links_list" => $links_list,
1854                "description" => $descriptions
1855                };
1856    
1857            push(@$line_data,$domain_element_hash);
1858    
1859            #just one CDD domain for now, later will add option for multiple domains from selected DB
1860            last;
1861        }
1862    
1863        my $line_config = { 'title' => $peg,
1864                            'hover_title' => 'Domain',
1865                            'short_title' => $peg,
1866                            'basepair_offset' => '1' };
1867    
1868        $gd->add_line($line_data, $line_config);
1869    
1870        return ($gd);
1871    
1872    }
1873    
1874    =head3 display_table()
1875    
1876    If available use the function specified here to display the "raw" observation.
1877    This code will display a table for the similarities protein
1878    
1879    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.
1880    
1881    =cut
1882    
1883    sub display_table {
1884        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1885    
1886        my $data = [];
1887        my $count = 0;
1888        my $content;
1889        #my $fig = new FIG;
1890        my $cgi = new CGI;
1891        my @ids;
1892        foreach my $thing (@$dataset) {
1893            next if ($thing->class ne "SIM");
1894            push (@ids, $thing->acc);
1895          }          }
1896    
1897        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1898        my @attributes = $fig->get_attributes(\@ids);
1899    
1900        # get the column for the subsystems
1901        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1902    
1903        # get the column for the evidence codes
1904        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1905    
1906        # get the column for pfam_domain
1907        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1908    
1909        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1910        my $alias_col = &get_aliases(\@ids,$fig);
1911        #my $alias_col = {};
1912    
1913        foreach my $thing (@$dataset) {
1914            next if ($thing->class ne "SIM");
1915            my $single_domain = [];
1916            $count++;
1917    
1918            my $id      = $thing->acc;
1919            my $taxid   = $fig->genome_of($id);
1920          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1921          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1922          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1514  Line 1929 
1929          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1930          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1931    
1932          my $name = $thing->acc;          # checkbox column
1933          my $field_name = "tables_" . $name;          my $field_name = "tables_" . $id;
1934          my $pair_name = "visual_" . $name;          my $pair_name = "visual_" . $id;
1935            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1936          my $checkbox_col = qq(<input type=checkbox name=seq value="$name" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my ($tax) = ($id) =~ /fig\|(.*?)\./;
1937          my $acc_col .= &HTML::set_prot_links($cgi,$thing->acc);  
1938            # get the linked fig id
1939          push(@$single_domain,$checkbox_col);          my $fig_col;
1940          push(@$single_domain,$thing->database);          if (defined ($e_identical{$id})){
1941          push(@$single_domain,$acc_col);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1942          push(@$single_domain,$thing->evalue);          }
1943          push(@$single_domain,"$iden\%");          else{
1944          push(@$single_domain,$reg1);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
         push(@$single_domain,$reg2);  
         push(@$single_domain,$in_sub);  
         push(@$single_domain,$ev_codes);  
         push(@$single_domain,$thing->organism);  
         push(@$single_domain,$thing->function);  
         push(@$data,$single_domain);  
   
1945      }      }
1946    
1947            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1948                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1949    
1950            foreach my $col (sort keys %$scroll_list){
1951                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1952                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1953                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1954                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1955                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1956                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1957                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1958                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1959                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1960                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1961                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1962                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1963                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1964                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1965                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1966            }
1967            push(@$data,$single_domain);
1968        }
1969      if ($count >0 ){      if ($count >0 ){
1970          $content = $data;          $content = $data;
1971      }      }
# Line 1545  Line 1975 
1975      return ($content);      return ($content);
1976  }  }
1977    
1978  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub get_box_column{
1979        my ($ids) = @_;
1980        my %column;
1981        foreach my $id (@$ids){
1982            my $field_name = "tables_" . $id;
1983            my $pair_name = "visual_" . $id;
1984            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1985        }
1986        return (%column);
1987    }
1988    
1989  sub color {  sub get_subsystems_column{
1990      my ($evalue) = @_;      my ($ids,$fig) = @_;
1991    
1992      my $color;      #my $fig = new FIG;
1993      if ($evalue <= 1e-100){      my $cgi = new CGI;
1994          $color = 1;      my %in_subs  = $fig->subsystems_for_pegs($ids);
1995        my %column;
1996        foreach my $id (@$ids){
1997            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1998            my @subsystems;
1999    
2000            if (@in_sub > 0) {
2001                foreach my $array(@in_sub){
2002                    my $ss = $$array[0];
2003                    $ss =~ s/_/ /ig;
2004                    push (@subsystems, "-" . $ss);
2005                }
2006                my $in_sub_line = join ("<br>", @subsystems);
2007                $column{$id} = $in_sub_line;
2008            } else {
2009                $column{$id} = "&nbsp;";
2010            }
2011        }
2012        return (%column);
2013    }
2014    
2015    sub get_essentially_identical{
2016        my ($fid,$dataset,$fig) = @_;
2017        #my $fig = new FIG;
2018    
2019        my %id_list;
2020        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2021    
2022        foreach my $thing (@$dataset){
2023            if($thing->class eq "IDENTICAL"){
2024                my $rows = $thing->rows;
2025                my $count_identical = 0;
2026                foreach my $row (@$rows) {
2027                    my $id = $row->[0];
2028                    if (($id ne $fid) && ($fig->function_of($id))) {
2029                        $id_list{$id} = 1;
2030                    }
2031                }
2032            }
2033        }
2034    
2035    #    foreach my $id (@maps_to) {
2036    #        if (($id ne $fid) && ($fig->function_of($id))) {
2037    #           $id_list{$id} = 1;
2038    #        }
2039    #    }
2040        return(%id_list);
2041    }
2042    
2043    
2044    sub get_evidence_column{
2045        my ($ids, $attributes,$fig) = @_;
2046        #my $fig = new FIG;
2047        my $cgi = new CGI;
2048        my (%column, %code_attributes);
2049    
2050        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2051        foreach my $key (@codes){
2052            push (@{$code_attributes{$$key[0]}}, $key);
2053        }
2054    
2055        foreach my $id (@$ids){
2056            # add evidence code with tool tip
2057            my $ev_codes=" &nbsp; ";
2058    
2059            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2060            my @ev_codes = ();
2061            foreach my $code (@codes) {
2062                my $pretty_code = $code->[2];
2063                if ($pretty_code =~ /;/) {
2064                    my ($cd, $ss) = split(";", $code->[2]);
2065                    $ss =~ s/_/ /g;
2066                    $pretty_code = $cd;# . " in " . $ss;
2067      }      }
2068      elsif (($evalue <= 1e-70) && ($evalue > 1e-100)){              push(@ev_codes, $pretty_code);
2069          $color = 2;          }
2070    
2071            if (scalar(@ev_codes) && $ev_codes[0]) {
2072                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2073                $ev_codes = $cgi->a(
2074                                    {
2075                                        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));
2076      }      }
2077      elsif (($evalue <= 1e-20) && ($evalue > 1e-70)){          $column{$id}=$ev_codes;
         $color = 3;  
2078      }      }
2079      elsif (($evalue <= 1e-10) && ($evalue > 1e-20)){      return (%column);
         $color = 4;  
2080      }      }
2081      elsif (($evalue <= 1e-4) && ($evalue > 1e-1)){  
2082          $color = 5;  sub get_pfam_column{
2083        my ($ids, $attributes,$fig) = @_;
2084        #my $fig = new FIG;
2085        my $cgi = new CGI;
2086        my (%column, %code_attributes, %attribute_locations);
2087        my $dbmaster = DBMaster->new(-database =>'Ontology');
2088    
2089        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2090        foreach my $key (@codes){
2091            my $name = $key->[1];
2092            if ($name =~ /_/){
2093                ($name) = ($key->[1]) =~ /(.*?)_/;
2094            }
2095            push (@{$code_attributes{$key->[0]}}, $name);
2096            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2097        }
2098    
2099        foreach my $id (@$ids){
2100            # add evidence code
2101            my $pfam_codes=" &nbsp; ";
2102            my @pfam_codes = "";
2103            my %description_codes;
2104    
2105            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2106                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2107                @pfam_codes = ();
2108    
2109                # get only unique values
2110                my %saw;
2111                foreach my $key (@ncodes) {$saw{$key}=1;}
2112                @ncodes = keys %saw;
2113    
2114                foreach my $code (@ncodes) {
2115                    my @parts = split("::",$code);
2116                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2117    
2118                    # get the locations for the domain
2119                    my @locs;
2120                    foreach my $part (@{$attribute_location{$id}{$code}}){
2121                        my ($loc) = ($part) =~ /\;(.*)/;
2122                        push (@locs,$loc);
2123                    }
2124                    my %locsaw;
2125                    foreach my $key (@locs) {$locsaw{$key}=1;}
2126                    @locs = keys %locsaw;
2127    
2128                    my $locations = join (", ", @locs);
2129    
2130                    if (defined ($description_codes{$parts[1]})){
2131                        push(@pfam_codes, "$parts[1] ($locations)");
2132      }      }
2133      else{      else{
2134          $color = 6;                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2135                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2136                        push(@pfam_codes, "$pfam_link ($locations)");
2137                    }
2138                }
2139            }
2140    
2141            $column{$id}=join("<br><br>", @pfam_codes);
2142        }
2143        return (%column);
2144    
2145    }
2146    
2147    sub get_aliases {
2148        my ($ids,$fig) = @_;
2149    
2150        my $all_aliases = $fig->feature_aliases_bulk($ids);
2151        foreach my $id (@$ids){
2152            foreach my $alias (@{$$all_aliases{$id}}){
2153                my $id_db = &Observation::get_database($alias);
2154                next if ($aliases->{$id}->{$id_db});
2155                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2156            }
2157        }
2158        return ($aliases);
2159      }      }
2160    
2161    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2162    
2163    sub color {
2164        my ($evalue) = @_;
2165        my $palette = WebColors::get_palette('vitamins');
2166        my $color;
2167        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2168        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2169        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2170        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2171        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2172        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2173        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2174        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2175        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2176        else{        $color = $palette->[9];    }
2177      return ($color);      return ($color);
2178  }  }
2179    
# Line 1588  Line 2193 
2193  }  }
2194    
2195  sub display {  sub display {
2196      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2197    
2198      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2199      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2200      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2201      my $fig = new FIG;      my $range = $gd_window_size;
2202      my $all_regions = [];      my $all_regions = [];
2203        my $gene_associations={};
2204    
2205      #get the organism genome      #get the organism genome
2206      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2207        $gene_associations->{$fid}->{"organism"} = $target_genome;
2208        $gene_associations->{$fid}->{"main_gene"} = $fid;
2209        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2210    
2211      # get location of the gene      # get location of the gene
2212      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1614  Line 2223 
2223      my ($region_start, $region_end);      my ($region_start, $region_end);
2224      if ($beg < $end)      if ($beg < $end)
2225      {      {
2226          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2227          $region_end = $end+4000;          $region_end = $end+ ($range);
2228          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2229      }      }
2230      else      else
2231      {      {
2232          $region_start = $end-4000;          $region_start = $end-($range);
2233          $region_end = $beg+4000;          $region_end = $beg+($range);
2234          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2235          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2236            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2237      }      }
2238    
2239      # call genes in region      # call genes in region
2240      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);
2241        #foreach my $feat (@$target_gene_features){
2242        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2243        #}
2244      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2245      my (@start_array_region);      my (@start_array_region);
2246      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2247    
2248      my %all_genes;      my %all_genes;
2249      my %all_genomes;      my %all_genomes;
2250      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}      foreach my $feature (@$target_gene_features){
2251            #if ($feature =~ /peg/){
2252      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2253      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
2254                  }                  }
2255    
2256                  push (@start_array_region, $offset);      my @selected_sims;
2257    
2258                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2259                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2260                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2261                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
2262            # get the similarities and store only the ones that match the lineages selected
2263            if (@selected_taxonomy > 0){
2264                foreach my $sim (@$sims_array){
2265                    next if ($sim->class ne "SIM");
2266                    next if ($sim->acc !~ /fig\|/);
2267    
2268                    #my $genome = $fig->genome_of($sim->[1]);
2269                    my $genome = $fig->genome_of($sim->acc);
2270                    #my ($genome1) = ($genome) =~ /(.*)\./;
2271                    #my $lineage = $taxes->{$genome1};
2272                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2273                    foreach my $taxon(@selected_taxonomy){
2274                        if ($lineage =~ /$taxon/){
2275                            #push (@selected_sims, $sim->[1]);
2276                            push (@selected_sims, $sim->acc);
2277              }              }
             $coup_count++;  
2278          }          }
2279      }      }
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                     }  
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = $peg1;  
2280                      }                      }
2281            else{
2282                my $simcount = 0;
2283                foreach my $sim (@$sims_array){
2284                    next if ($sim->class ne "SIM");
2285                    next if ($sim->acc !~ /fig\|/);
2286    
2287                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2288                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2289                      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} = $peg1;}  
                 }  
2290              }              }
2291          }          }
2292    
2293            my %saw;
2294            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2295    
2296            # get the gene context for the sorted matches
2297            foreach my $sim_fid(@selected_sims){
2298                #get the organism genome
2299                my $sim_genome = $fig->genome_of($sim_fid);
2300                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2301                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2302                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2303    
2304                # get location of the gene
2305                my $data = $fig->feature_location($sim_fid);
2306                my ($contig, $beg, $end);
2307    
2308                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2309                    $contig = $1;
2310                    $beg = $2;
2311                    $end = $3;
2312      }      }
2313    
2314      # get the PCH to each of the genes              my $offset;
2315      my $pch_sets = [];              my ($region_start, $region_end);
2316      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)  
2317          {          {
2318              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2319                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2320                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2321          }          }
2322          else          else
2323          {          {
2324              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2325                  $peg_rank{$peg} = "20";                  $region_end = $beg+($range/2);
2326              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2327                    $reverse_flag{$sim_genome} = $sim_fid;
2328                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2329          }          }
2330    
2331                # call genes in region
2332                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2333                push(@$all_regions,$sim_gene_features);
2334                push (@start_array_region, $offset);
2335                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2336                $all_genomes{$sim_genome} = 1;
2337      }      }
2338    
2339        }
2340    
2341  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2342  #    my %already;      # cluster the genes
2343  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
2344  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2345  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2346  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = "20";  
 #           }  
 #       }  
 #    }  
2347    
2348      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2349          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2350          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2351          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2352          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2353            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2354            #my $lineage = $taxes->{$genome1};
2355            my $lineage = $fig->taxonomy_of($region_genome);
2356            #$region_gs .= "Lineage:$lineage";
2357          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2358                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2359                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1854  Line 2361 
2361    
2362          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2363    
2364          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2365                                     'short_title' => "",                                     'short_title' => "",
2366                                     'basepair_offset' => '0'                                     'basepair_offset' => '0',
2367                                       'no_middle_line' => '1'
2368                                     };                                     };
2369    
2370          my $line_data = [];          my $line_data = [];
# Line 1873  Line 2381 
2381              my $links_list = [];              my $links_list = [];
2382              my $descriptions = [];              my $descriptions = [];
2383    
2384              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2385    
2386              # get subsystem information              # get subsystem information
2387              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2388              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2389    
2390              my $link;              my $link;
2391              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2392                       "link" => $url_link};                       "link" => $url_link};
2393              push(@$links_list,$link);              push(@$links_list,$link);
2394    
2395              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2396              foreach my $subsystem (@subsystems){              my @subsystems;
2397                foreach my $array (@subs){
2398                    my $subsystem = $$array[0];
2399                    my $ss = $subsystem;
2400                    $ss =~ s/_/ /ig;
2401                    push (@subsystems, $ss);
2402                  my $link;                  my $link;
2403                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2404                           "link_title" => $subsystem};                           "link_title" => $ss};
2405                    push(@$links_list,$link);
2406                }
2407    
2408                if ($fid1 eq $fid){
2409                    my $link;
2410                    $link = {"link_title" => "Annotate this sequence",
2411                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2412                  push(@$links_list,$link);                  push(@$links_list,$link);
2413              }              }
2414    
# Line 1927  Line 2447 
2447                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2448                  }                  }
2449    
2450                    my $title = $fid1;
2451                    if ($fid1 eq $fid){
2452                        $title = "My query gene: $fid1";
2453                    }
2454    
2455                  $element_hash = {                  $element_hash = {
2456                      "title" => $fid1,                      "title" => $title,
2457                      "start" => $start,                      "start" => $start,
2458                      "end" =>  $stop,                      "end" =>  $stop,
2459                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1942  Line 2467 
2467                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2468                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2469    
2470                    if ($fid1 eq $fid){
2471                        $element_hash = {
2472                            "title" => 'Query',
2473                            "start" => $start,
2474                            "end" =>  $stop,
2475                            "type"=> 'bigbox',
2476                            "color"=> $color,
2477                            "zlayer" => "1"
2478                            };
2479    
2480                        # if there is an overlap, put into second line
2481                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2482                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2483                    }
2484              }              }
2485          }          }
2486          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2487          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2488        }
2489        return ($gd, \@selected_sims);
2490    }
2491    
2492    sub cluster_genes {
2493        my($fig,$all_pegs,$peg) = @_;
2494        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2495    
2496        my @color_sets = ();
2497    
2498        $conn = &get_connections_by_similarity($fig,$all_pegs);
2499    
2500        for ($i=0; ($i < @$all_pegs); $i++) {
2501            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2502            if (! $seen{$i}) {
2503                $cluster = [$i];
2504                $seen{$i} = 1;
2505                for ($j=0; ($j < @$cluster); $j++) {
2506                    $x = $conn->{$cluster->[$j]};
2507                    foreach $k (@$x) {
2508                        if (! $seen{$k}) {
2509                            push(@$cluster,$k);
2510                            $seen{$k} = 1;
2511                        }
2512                    }
2513                }
2514    
2515                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2516                    push(@color_sets,$cluster);
2517                }
2518            }
2519        }
2520        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2521        $red_set = $color_sets[$i];
2522        splice(@color_sets,$i,1);
2523        @color_sets = sort { @$b <=> @$a } @color_sets;
2524        unshift(@color_sets,$red_set);
2525    
2526        my $color_sets = {};
2527        for ($i=0; ($i < @color_sets); $i++) {
2528            foreach $x (@{$color_sets[$i]}) {
2529                $color_sets->{$all_pegs->[$x]} = $i;
2530            }
2531        }
2532        return $color_sets;
2533    }
2534    
2535    sub get_connections_by_similarity {
2536        my($fig,$all_pegs) = @_;
2537        my($i,$j,$tmp,$peg,%pos_of);
2538        my($sim,%conn,$x,$y);
2539    
2540        for ($i=0; ($i < @$all_pegs); $i++) {
2541            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2542            push(@{$pos_of{$tmp}},$i);
2543            if ($tmp ne $all_pegs->[$i]) {
2544                push(@{$pos_of{$all_pegs->[$i]}},$i);
2545            }
2546        }
2547    
2548        foreach $y (keys(%pos_of)) {
2549            $x = $pos_of{$y};
2550            for ($i=0; ($i < @$x); $i++) {
2551                for ($j=$i+1; ($j < @$x); $j++) {
2552                    push(@{$conn{$x->[$i]}},$x->[$j]);
2553                    push(@{$conn{$x->[$j]}},$x->[$i]);
2554                }
2555      }      }
     return $gd;  
2556  }  }
2557    
2558        for ($i=0; ($i < @$all_pegs); $i++) {
2559            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2560                if (defined($x = $pos_of{$sim->id2})) {
2561                    foreach $y (@$x) {
2562                        push(@{$conn{$i}},$y);
2563                    }
2564                }
2565            }
2566        }
2567        return \%conn;
2568    }
2569    
2570    sub in {
2571        my($x,$xL) = @_;
2572        my($i);
2573    
2574        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2575        return ($i < @$xL);
2576    }
2577    
2578    #############################################
2579    #############################################
2580    package Observation::Commentary;
2581    
2582    use base qw(Observation);
2583    
2584    =head3 display_protein_commentary()
2585    
2586    =cut
2587    
2588    sub display_protein_commentary {
2589        my ($self,$dataset,$mypeg,$fig) = @_;
2590    
2591        my $all_rows = [];
2592        my $content;
2593        #my $fig = new FIG;
2594        my $cgi = new CGI;
2595        my $count = 0;
2596        my $peg_array = [];
2597        my (%evidence_column, %subsystems_column,  %e_identical);
2598    
2599        if (@$dataset != 1){
2600            foreach my $thing (@$dataset){
2601                if ($thing->class eq "SIM"){
2602                    push (@$peg_array, $thing->acc);
2603                }
2604            }
2605            # get the column for the evidence codes
2606            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2607    
2608            # get the column for the subsystems
2609            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2610    
2611            # get essentially identical seqs
2612            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2613        }
2614        else{
2615            push (@$peg_array, @$dataset);
2616        }
2617    
2618        my $selected_sims = [];
2619        foreach my $id (@$peg_array){
2620            last if ($count > 10);
2621            my $row_data = [];
2622            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2623            $org = $fig->org_of($id);
2624            $function = $fig->function_of($id);
2625            if ($mypeg ne $id){
2626                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2627                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2628                if (defined($e_identical{$id})) { $id_cell .= "*";}
2629            }
2630            else{
2631                $function_cell = "&nbsp;&nbsp;$function";
2632                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2633                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2634            }
2635    
2636            push(@$row_data,$id_cell);
2637            push(@$row_data,$org);
2638            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2639            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2640            push(@$row_data, $fig->translation_length($id));
2641            push(@$row_data,$function_cell);
2642            push(@$all_rows,$row_data);
2643            push (@$selected_sims, $id);
2644            $count++;
2645        }
2646    
2647        if ($count >0){
2648            $content = $all_rows;
2649        }
2650        else{
2651            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2652        }
2653        return ($content,$selected_sims);
2654    }
2655    
2656    sub display_protein_history {
2657        my ($self, $id,$fig) = @_;
2658        my $all_rows = [];
2659        my $content;
2660    
2661        my $cgi = new CGI;
2662        my $count = 0;
2663        foreach my $feat ($fig->feature_annotations($id)){
2664            my $row = [];
2665            my $col1 = $feat->[2];
2666            my $col2 = $feat->[1];
2667            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2668            my $text = $feat->[3];
2669    
2670            push (@$row, $col1);
2671            push (@$row, $col2);
2672            push (@$row, $text);
2673            push (@$all_rows, $row);
2674            $count++;
2675        }
2676        if ($count > 0){
2677            $content = $all_rows;
2678        }
2679        else {
2680            $content = "There is no history for this PEG";
2681        }
2682    
2683        return($content);
2684    }

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.50

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3