[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24, Tue Jul 10 20:11:38 2007 UTC revision 1.47, Mon Dec 3 19:53:00 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 151  Line 166 
166  sub type {  sub type {
167    my ($self) = @_;    my ($self) = @_;
168    
169    return $self->{acc};    return $self->{type};
170  }  }
171    
172  =head3 start()  =head3 start()
# Line 304  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
# Line 317  Line 332 
332      }      }
333      else{      else{
334          my %domain_classes;          my %domain_classes;
335            my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 331  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 357  Line 374 
374    
375  }  }
376    
377    =head3 display_housekeeping
378    This method returns the housekeeping data for a given peg in a table format
379    
380    =cut
381    sub display_housekeeping {
382        my ($self,$fid,$fig) = @_;
383        my $content = [];
384        my $row = [];
385    
386        my $org_name = $fig->org_of($fid);
387        my $org_id = $fig->genome_of($fid);
388        my $function = $fig->function_of($fid);
389        #my $taxonomy = $fig->taxonomy_of($org_id);
390        my $length = $fig->translation_length($fid);
391    
392        push (@$row, $org_name);
393        push (@$row, $fid);
394        push (@$row, $length);
395        push (@$row, $function);
396    
397        # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
407    
408        return ($content);
409    }
410    
411    =head3 get_sims_summary
412    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
413    
414    =cut
415    
416    sub get_sims_summary {
417        my ($observation, $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];
# Line 411  Line 531 
531    
532  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
533    
534      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
535      my $fig = new FIG;      #my $fig = new FIG;
536    
537      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
538    
539        my $dataset = {'type' => "loc",
540                       'class' => 'SIGNALP_CELLO_TMPRED',
541                       'fig_id' => $fid
542                       };
543    
544      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      foreach my $attr_ref (@$attributes_ref){
     foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
547          my @parts = split("::",$key);          my @parts = split("::",$key);
548          my $sub_class = $parts[0];          my $sub_class = $parts[0];
549          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 433  Line 558 
558                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
559              }              }
560          }          }
561    
562          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
563              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
564              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
565          }          }
566    
567            elsif($sub_class eq "Phobius"){
568                if($sub_key eq "transmembrane"){
569                    $dataset->{'phobius_tm_locations'} = $value;
570                }
571                elsif($sub_key eq "signal"){
572                    $dataset->{'phobius_signal_location'} = $value;
573                }
574            }
575    
576          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
577              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
578              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
579              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
580          }          }
# Line 455  Line 591 
591  =cut  =cut
592    
593  sub get_pdb_observations{  sub get_pdb_observations{
594      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
595    
596      my $fig = new FIG;      #my $fig = new FIG;
   
     foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
597    
598        foreach my $attr_ref (@$attributes_ref){
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600            next if ( ($key !~ /PDB/));
601          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
602          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
603          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 514  Line 650 
650    
651  sub get_sims_observations{  sub get_sims_observations{
652    
653      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
654      my $fig = new FIG;      #my $fig = new FIG;
655      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->sims($fid,500,10,"fig");
656      my ($dataset);      my ($dataset);
657    
658      foreach my $sim (@sims){      foreach my $sim (@sims){
659            next if ($fig->is_deleted_fid($sim->[1]));
660          my $hit = $sim->[1];          my $hit = $sim->[1];
661          my $percent = $sim->[2];          my $percent = $sim->[2];
662          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 533  Line 671 
671          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
672    
673          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
674                        'query' => $sim->[0],
675                      'acc' => $hit,                      'acc' => $hit,
676                      'identity' => $percent,                      'identity' => $percent,
677                      'type' => 'seq',                      'type' => 'seq',
# Line 569  Line 708 
708      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
709      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
710      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
711      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
712      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
713      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
714      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 587  Line 726 
726    
727  sub get_identical_proteins{  sub get_identical_proteins{
728    
729      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
730      my $fig = new FIG;      #my $fig = new FIG;
731      my $funcs_ref;      my $funcs_ref;
732    
733      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);
   
734      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
735          my ($tmp, $who);          my ($tmp, $who);
736          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
# Line 601  Line 739 
739          }          }
740      }      }
741    
     my ($dataset);  
742      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
743                     'type' => 'seq',                     'type' => 'seq',
744                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 621  Line 758 
758    
759  sub get_functional_coupling{  sub get_functional_coupling{
760    
761      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
762      my $fig = new FIG;      #my $fig = new FIG;
763      my @funcs = ();      my @funcs = ();
764    
765      # initialize some variables      # initialize some variables
# Line 781  Line 918 
918  =cut  =cut
919    
920  sub display{  sub display{
921      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
922    
923      my $fid = $self->fig_id;      my $fid = $self->fig_id;
924      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
925    
926      my $acc = $self->acc;      my $acc = $self->acc;
927    
     print STDERR "acc:$acc\n";  
928      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
929      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
930      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 806  Line 942 
942      my $lines = [];      my $lines = [];
943      my $line_data = [];      my $line_data = [];
944      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
945                            'hover_title' => 'PDB',
946                          'short_title' => "best PDB",                          'short_title' => "best PDB",
947                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
948    
949      my $fig = new FIG;      #my $fig = new FIG;
950      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
951      my $fid_stop = length($seq);      my $fid_stop = length($seq);
952    
# Line 910  Line 1047 
1047    
1048    
1049  sub display_table{  sub display_table{
1050      my ($self) = @_;      my ($self,$fig) = @_;
1051    
1052      my $fig = new FIG;      #my $fig = new FIG;
1053      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1054      my $rows = $self->rows;      my $rows = $self->rows;
1055      my $cgi = new CGI;      my $cgi = new CGI;
# Line 923  Line 1060 
1060          my $id = $row->[0];          my $id = $row->[0];
1061          my $who = $row->[1];          my $who = $row->[1];
1062          my $assignment = $row->[2];          my $assignment = $row->[2];
1063          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1064          my $single_domain = [];          my $single_domain = [];
1065          push(@$single_domain,$who);          push(@$single_domain,$who);
1066          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 974  Line 1111 
1111    
1112  sub display_table {  sub display_table {
1113    
1114      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1115      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1116      my $rows = $self->rows;      my $rows = $self->rows;
1117      my $cgi = new CGI;      my $cgi = new CGI;
# Line 989  Line 1126 
1126          # construct the score link          # construct the score link
1127          my $score = $row->[0];          my $score = $row->[0];
1128          my $toid = $row->[1];          my $toid = $row->[1];
1129          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";
1130          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1131    
1132          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1133          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1031  Line 1168 
1168  sub display {  sub display {
1169      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1170      my $lines = [];      my $lines = [];
1171      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1172                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1173                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1174      my $color = "4";      my $color = "4";
1175    
1176      my $line_data = [];      my $line_data = [];
# Line 1062  Line 1199 
1199              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1200          }          }
1201      }      }
1202        elsif($db =~ /PFAM/){
1203            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1204            if(!scalar(@$pfam_objs)){
1205                $name_title = "name";
1206                $name_value = "not available";
1207                $description_title = "description";
1208                $description_value = "not available";
1209            }
1210            else{
1211                my $pfam_obj = $pfam_objs->[0];
1212                $name_title = "name";
1213                $name_value = $pfam_obj->term;
1214                #$description_title = "description";
1215                #$description_value = $pfam_obj->description;
1216            }
1217        }
1218    
1219        my $short_title = $thing->acc;
1220        $short_title =~ s/::/ - /ig;
1221        my $line_config = { 'title' => $name_value,
1222                            'hover_title', => 'Domain',
1223                            'short_title' => $short_title,
1224                            'basepair_offset' => '1' };
1225    
1226      my $name;      my $name;
1227      $name = {"title" => $name_title,      $name = {"title" => $db,
1228               "value" => $name_value};               "value" => $id};
1229      push(@$descriptions,$name);      push(@$descriptions,$name);
1230    
1231      my $description;  #    my $description;
1232      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1233                               "value" => $description_value};  #                   "value" => $description_value};
1234      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1235    
1236      my $score;      my $score;
1237      $score = {"title" => "score",      $score = {"title" => "score",
1238                "value" => $thing->evalue};                "value" => $thing->evalue};
1239      push(@$descriptions,$score);      push(@$descriptions,$score);
1240    
1241        my $location;
1242        $location = {"title" => "location",
1243                     "value" => $thing->start . " - " . $thing->stop};
1244        push(@$descriptions,$location);
1245    
1246      my $link_id;      my $link_id;
1247      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1248          $link_id = $1;          $link_id = $1;
1249      }      }
1250    
# Line 1094  Line 1259 
1259      push(@$links_list,$link);      push(@$links_list,$link);
1260    
1261      my $element_hash = {      my $element_hash = {
1262          "title" => $thing->type,          "title" => $name_value,
1263          "start" => $thing->start,          "start" => $thing->start,
1264          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1265          "color"=> $color,          "color"=> $color,
# Line 1109  Line 1274 
1274    
1275  }  }
1276    
1277    sub display_table {
1278        my ($self,$dataset) = @_;
1279        my $cgi = new CGI;
1280        my $data = [];
1281        my $count = 0;
1282        my $content;
1283    
1284        foreach my $thing (@$dataset) {
1285            next if ($thing->type !~ /dom/);
1286            my $single_domain = [];
1287            $count++;
1288    
1289            my $db_and_id = $thing->acc;
1290            my ($db,$id) = split("::",$db_and_id);
1291    
1292            my $dbmaster = DBMaster->new(-database =>'Ontology');
1293    
1294            my ($name_title,$name_value,$description_title,$description_value);
1295            if($db eq "CDD"){
1296                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1297                if(!scalar(@$cdd_objs)){
1298                    $name_title = "name";
1299                    $name_value = "not available";
1300                    $description_title = "description";
1301                    $description_value = "not available";
1302                }
1303                else{
1304                    my $cdd_obj = $cdd_objs->[0];
1305                    $name_title = "name";
1306                    $name_value = $cdd_obj->term;
1307                    $description_title = "description";
1308                    $description_value = $cdd_obj->description;
1309                }
1310            }
1311    
1312            my $location =  $thing->start . " - " . $thing->stop;
1313    
1314            push(@$single_domain,$db);
1315            push(@$single_domain,$thing->acc);
1316            push(@$single_domain,$name_value);
1317            push(@$single_domain,$location);
1318            push(@$single_domain,$thing->evalue);
1319            push(@$single_domain,$description_value);
1320            push(@$data,$single_domain);
1321        }
1322    
1323        if ($count >0){
1324            $content = $data;
1325        }
1326        else
1327        {
1328            $content = "<p>This PEG does not have any similarities to domains</p>";
1329        }
1330    }
1331    
1332    
1333  #########################################  #########################################
1334  #########################################  #########################################
1335  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1347 
1347      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1348      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1349      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1350        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1351        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1352    
1353      bless($self,$class);      bless($self,$class);
1354      return $self;      return $self;
1355  }  }
1356    
1357    sub display_cello {
1358        my ($thing) = @_;
1359        my $html;
1360        my $cello_location = $thing->cello_location;
1361        my $cello_score = $thing->cello_score;
1362        if($cello_location){
1363            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1364            #$html .= "<p>CELLO score: $cello_score </p>";
1365        }
1366        return ($html);
1367    }
1368    
1369  sub display {  sub display {
1370      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1371    
1372      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1373      my $fig= new FIG;      #my $fig= new FIG;
1374      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1375    
1376      my $cleavage_prob;      my $cleavage_prob;
# Line 1147  Line 1382 
1382      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1383      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1384    
1385        my $phobius_signal_location = $thing->phobius_signal_location;
1386        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1387    
1388      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1389    
1390      #color is      #color is
1391      my $color = "5";      my $color = "6";
1392    
1393      my $line_data = [];  =pod=
1394    
1395      if($cello_location){      if($cello_location){
1396          my $cello_descriptions = [];          my $cello_descriptions = [];
1397            my $line_data =[];
1398    
1399            my $line_config = { 'title' => 'Localization Evidence',
1400                                'short_title' => 'CELLO',
1401                                'basepair_offset' => '1' };
1402    
1403          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1404                                            "value" => $cello_location};                                            "value" => $cello_location};
1405    
# Line 1171  Line 1412 
1412    
1413          my $element_hash = {          my $element_hash = {
1414              "title" => "CELLO",              "title" => "CELLO",
1415                "color"=> $color,
1416              "start" => "1",              "start" => "1",
1417              "end" =>  $length + 1,              "end" =>  $length + 1,
1418              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1419              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1420    
1421          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1422            $gd->add_line($line_data, $line_config);
1423      }      }
1424    
1425      my $color = "6";      $color = "2";
1426      if($tmpred_score){      if($tmpred_score){
1427            my $line_data =[];
1428            my $line_config = { 'title' => 'Localization Evidence',
1429                                'short_title' => 'Transmembrane',
1430                                'basepair_offset' => '1' };
1431    
1432          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1433              my $descriptions = [];              my $descriptions = [];
1434              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1443 
1443              "end" =>  $end + 1,              "end" =>  $end + 1,
1444              "color"=> $color,              "color"=> $color,
1445              "zlayer" => '5',              "zlayer" => '5',
1446              "type" => 'smallbox',              "type" => 'box',
1447                "description" => $descriptions};
1448    
1449                push(@$line_data,$element_hash);
1450    
1451            }
1452            $gd->add_line($line_data, $line_config);
1453        }
1454    =cut
1455    
1456        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1457            my $line_data =[];
1458            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1459                                'short_title' => 'TM and SP',
1460                                'basepair_offset' => '1' };
1461    
1462            foreach my $tm_loc (@phobius_tm_locations){
1463                my $descriptions = [];
1464                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1465                                 "value" => $tm_loc};
1466                push(@$descriptions,$description_phobius_tm_locations);
1467    
1468                my ($begin,$end) =split("-",$tm_loc);
1469    
1470                my $element_hash = {
1471                "title" => "Phobius",
1472                "start" => $begin + 1,
1473                "end" =>  $end + 1,
1474                "color"=> '6',
1475                "zlayer" => '4',
1476                "type" => 'bigbox',
1477              "description" => $descriptions};              "description" => $descriptions};
1478    
1479              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1480    
1481            }
1482    
1483            if($phobius_signal_location){
1484                my $descriptions = [];
1485                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1486                                 "value" => $phobius_signal_location};
1487                push(@$descriptions,$description_phobius_signal_location);
1488    
1489    
1490                my ($begin,$end) =split("-",$phobius_signal_location);
1491                my $element_hash = {
1492                "title" => "phobius signal locations",
1493                "start" => $begin + 1,
1494                "end" =>  $end + 1,
1495                "color"=> '1',
1496                "zlayer" => '5',
1497                "type" => 'box',
1498                "description" => $descriptions};
1499                push(@$line_data,$element_hash);
1500          }          }
1501    
1502            $gd->add_line($line_data, $line_config);
1503      }      }
1504    
1505      my $color = "1";  =head3
1506        $color = "1";
1507      if($signal_peptide_score){      if($signal_peptide_score){
1508            my $line_data = [];
1509          my $descriptions = [];          my $descriptions = [];
1510    
1511            my $line_config = { 'title' => 'Localization Evidence',
1512                                'short_title' => 'SignalP',
1513                                'basepair_offset' => '1' };
1514    
1515          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1516                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1517    
# Line 1220  Line 1525 
1525          my $element_hash = {          my $element_hash = {
1526              "title" => "SignalP",              "title" => "SignalP",
1527              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1528              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1529              "type" => 'bigbox',              "type" => 'bigbox',
1530              "color"=> $color,              "color"=> $color,
1531              "zlayer" => '10',              "zlayer" => '10',
1532              "description" => $descriptions};              "description" => $descriptions};
1533    
1534          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1535      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1536        }
1537    =cut
1538    
1539      return ($gd);      return ($gd);
1540    
# Line 1277  Line 1582 
1582    return $self->{cello_score};    return $self->{cello_score};
1583  }  }
1584    
1585    sub phobius_signal_location {
1586      my ($self) = @_;
1587      return $self->{phobius_signal_location};
1588    }
1589    
1590    sub phobius_tm_locations {
1591      my ($self) = @_;
1592      return $self->{phobius_tm_locations};
1593    }
1594    
1595    
1596    
1597  #########################################  #########################################
1598  #########################################  #########################################
# Line 1290  Line 1606 
1606      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1607      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1608      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1609        $self->{query} = $dataset->{'query'};
1610      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1611      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1612      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1305  Line 1622 
1622      return $self;      return $self;
1623  }  }
1624    
1625  =head3 display_table()  =head3 display()
   
 If available use the function specified here to display the "raw" observation.  
 This code will display a table for the similarities protein  
1626    
1627  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.
1628    This code will display a graphical view of the similarities using the genome drawer object
1629    
1630  =cut  =cut
1631    
1632  sub display_table {  sub display {
1633      my ($self,$dataset) = @_;      my ($self,$gd,$array,$fig) = @_;
1634        #my $fig = new FIG;
1635    
1636      my $data = [];      my @ids;
1637      my $count = 0;      foreach my $thing(@$array){
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
1638          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1639          $count++;          push (@ids, $thing->acc);
1640        }
1641    
1642          my $id = $thing->acc;      my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1643    
1644          # add the subsystem information      foreach my $thing (@$array){
1645          my @in_sub  = $fig->peg_to_subsystems($id);          if ($thing->class eq "SIM"){
         my $in_sub;  
1646    
1647          if (@in_sub > 0) {              my $peg = $thing->acc;
1648              $in_sub = @in_sub;              my $query = $thing->query;
1649    
1650              # RAE: add a javascript popup with all the subsystems              my $organism = $thing->organism;
1651              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $genome = $fig->genome_of($peg);
1652              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              my ($org_tax) = ($genome) =~ /(.*)\./;
1653          } else {              my $function = $thing->function;
1654              $in_sub = "&nbsp;";              my $abbrev_name = $fig->abbrev($organism);
1655          }              my $align_start = $thing->qstart;
1656                my $align_stop = $thing->qstop;
1657                my $hit_start = $thing->hstart;
1658                my $hit_stop = $thing->hstop;
1659    
1660          # add evidence code with tool tip              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
         my $ev_codes=" &nbsp; ";  
         my @ev_codes = "";  
         if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {  
             my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
             @ev_codes = ();  
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
                 }  
                 push(@ev_codes, $pretty_code);  
             }  
         }  
1661    
1662          if (scalar(@ev_codes) && $ev_codes[0]) {              my $line_config = { 'title' => "$organism [$org_tax]",
1663              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);                                  'short_title' => "$abbrev_name",
1664              $ev_codes = $cgi->a(                                  'title_link' => '$tax_link',
1665                                  {                                  'basepair_offset' => '0'
1666                                      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));                                  };
         }  
1667    
1668          # add the aliases              my $line_data = [];
         my $aliases = undef;  
         $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );  
         $aliases = &HTML::set_prot_links( $cgi, $aliases );  
         $aliases ||= "&nbsp;";  
1669    
1670          my $iden    = $thing->identity;              my $element_hash;
1671          my $ln1     = $thing->qlength;              my $links_list = [];
1672          my $ln2     = $thing->hlength;              my $descriptions = [];
1673          my $b1      = $thing->qstart;  
1674          my $e1      = $thing->qstop;              # get subsystem information
1675          my $b2      = $thing->hstart;              my $url_link = "?page=Annotation&feature=".$peg;
1676          my $e2      = $thing->hstop;              my $link;
1677          my $d1      = abs($e1 - $b1) + 1;              $link = {"link_title" => $peg,
1678          my $d2      = abs($e2 - $b2) + 1;                       "link" => $url_link};
1679          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              push(@$links_list,$link);
1680    
1681                #my @subsystems = $fig->peg_to_subsystems($peg);
1682                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1683                my @subsystems;
1684    
1685                foreach my $array (@subs){
1686                    my $subsystem = $$array[0];
1687                    push(@subsystems,$subsystem);
1688                    my $link;
1689                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1690                             "link_title" => $subsystem};
1691                    push(@$links_list,$link);
1692                }
1693    
1694                $link = {"link_title" => "view blast alignment",
1695                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1696                push (@$links_list,$link);
1697    
1698                my $description_function;
1699                $description_function = {"title" => "function",
1700                                         "value" => $function};
1701                push(@$descriptions,$description_function);
1702    
1703                my ($description_ss, $ss_string);
1704                $ss_string = join (",", @subsystems);
1705                $description_ss = {"title" => "subsystems",
1706                                   "value" => $ss_string};
1707                push(@$descriptions,$description_ss);
1708    
1709                my $description_loc;
1710                $description_loc = {"title" => "location start",
1711                                    "value" => $hit_start};
1712                push(@$descriptions, $description_loc);
1713    
1714                $description_loc = {"title" => "location stop",
1715                                    "value" => $hit_stop};
1716                push(@$descriptions, $description_loc);
1717    
1718                my $evalue = $thing->evalue;
1719                while ($evalue =~ /-0/)
1720                {
1721                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1722                    $chunk2 = substr($chunk2,1);
1723                    $evalue = $chunk1 . "-" . $chunk2;
1724                }
1725    
1726                my $color = &color($evalue);
1727    
1728                my $description_eval = {"title" => "E-Value",
1729                                        "value" => $evalue};
1730                push(@$descriptions, $description_eval);
1731    
1732                my $identity = $self->identity;
1733                my $description_identity = {"title" => "Identity",
1734                                            "value" => $identity};
1735                push(@$descriptions, $description_identity);
1736    
1737                $element_hash = {
1738                    "title" => $peg,
1739                    "start" => $align_start,
1740                    "end" =>  $align_stop,
1741                    "type"=> 'box',
1742                    "color"=> $color,
1743                    "zlayer" => "2",
1744                    "links_list" => $links_list,
1745                    "description" => $descriptions
1746                    };
1747                push(@$line_data,$element_hash);
1748                $gd->add_line($line_data, $line_config);
1749            }
1750        }
1751        return ($gd);
1752    }
1753    
1754    =head3 display_domain_composition()
1755    
1756    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
1757    
1758    =cut
1759    
1760    sub display_domain_composition {
1761        my ($self,$gd,$fig) = @_;
1762    
1763        #$fig = new FIG;
1764        my $peg = $self->acc;
1765    
1766        my $line_data = [];
1767        my $links_list = [];
1768        my $descriptions = [];
1769    
1770        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1771        #my @domain_query_results = ();
1772        foreach $dqr (@domain_query_results){
1773            my $key = @$dqr[1];
1774            my @parts = split("::",$key);
1775            my $db = $parts[0];
1776            my $id = $parts[1];
1777            my $val = @$dqr[2];
1778            my $from;
1779            my $to;
1780            my $evalue;
1781    
1782            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1783                my $raw_evalue = $1;
1784                $from = $2;
1785                $to = $3;
1786                if($raw_evalue =~/(\d+)\.(\d+)/){
1787                    my $part2 = 1000 - $1;
1788                    my $part1 = $2/100;
1789                    $evalue = $part1."e-".$part2;
1790                }
1791                else{
1792                    $evalue = "0.0";
1793                }
1794            }
1795    
1796            my $dbmaster = DBMaster->new(-database =>'Ontology');
1797            my ($name_value,$description_value);
1798    
1799            if($db eq "CDD"){
1800                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1801                if(!scalar(@$cdd_objs)){
1802                    $name_title = "name";
1803                    $name_value = "not available";
1804                    $description_title = "description";
1805                    $description_value = "not available";
1806                }
1807                else{
1808                    my $cdd_obj = $cdd_objs->[0];
1809                    $name_value = $cdd_obj->term;
1810                    $description_value = $cdd_obj->description;
1811                }
1812            }
1813    
1814            my $domain_name;
1815            $domain_name = {"title" => "name",
1816                            "value" => $name_value};
1817            push(@$descriptions,$domain_name);
1818    
1819            my $description;
1820            $description = {"title" => "description",
1821                            "value" => $description_value};
1822            push(@$descriptions,$description);
1823    
1824            my $score;
1825            $score = {"title" => "score",
1826                      "value" => $evalue};
1827            push(@$descriptions,$score);
1828    
1829            my $link_id = $id;
1830            my $link;
1831            my $link_url;
1832            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"}
1833            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1834            else{$link_url = "NO_URL"}
1835    
1836            $link = {"link_title" => $name_value,
1837                     "link" => $link_url};
1838            push(@$links_list,$link);
1839    
1840            my $domain_element_hash = {
1841                "title" => $peg,
1842                "start" => $from,
1843                "end" =>  $to,
1844                "type"=> 'box',
1845                "zlayer" => '4',
1846                "links_list" => $links_list,
1847                "description" => $descriptions
1848                };
1849    
1850            push(@$line_data,$domain_element_hash);
1851    
1852            #just one CDD domain for now, later will add option for multiple domains from selected DB
1853            last;
1854        }
1855    
1856        my $line_config = { 'title' => $peg,
1857                            'hover_title' => 'Domain',
1858                            'short_title' => $peg,
1859                            'basepair_offset' => '1' };
1860    
1861        $gd->add_line($line_data, $line_config);
1862    
1863        return ($gd);
1864    
1865    }
1866    
1867    =head3 display_table()
1868    
1869    If available use the function specified here to display the "raw" observation.
1870    This code will display a table for the similarities protein
1871    
1872    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.
1873    
1874    =cut
1875    
1876    sub display_table {
1877        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1878    
1879        my $data = [];
1880        my $count = 0;
1881        my $content;
1882        #my $fig = new FIG;
1883        my $cgi = new CGI;
1884        my @ids;
1885        foreach my $thing (@$dataset) {
1886            next if ($thing->class ne "SIM");
1887            push (@ids, $thing->acc);
1888        }
1889    
1890        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1891        my @attributes = $fig->get_attributes(\@ids);
1892    
1893        # get the column for the subsystems
1894        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1895    
1896        # get the column for the evidence codes
1897        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1898    
1899        # get the column for pfam_domain
1900        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1901    
1902        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1903        my $alias_col = &get_aliases(\@ids,$fig);
1904        #my $alias_col = {};
1905    
1906        foreach my $thing (@$dataset) {
1907            next if ($thing->class ne "SIM");
1908            my $single_domain = [];
1909            $count++;
1910    
1911            my $id      = $thing->acc;
1912            my $taxid   = $fig->genome_of($id);
1913            my $iden    = $thing->identity;
1914            my $ln1     = $thing->qlength;
1915            my $ln2     = $thing->hlength;
1916            my $b1      = $thing->qstart;
1917            my $e1      = $thing->qstop;
1918            my $b2      = $thing->hstart;
1919            my $e2      = $thing->hstop;
1920            my $d1      = abs($e1 - $b1) + 1;
1921            my $d2      = abs($e2 - $b2) + 1;
1922            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1923          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1924    
1925            # checkbox column
1926            my $field_name = "tables_" . $id;
1927            my $pair_name = "visual_" . $id;
1928            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1929            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1930    
1931            # get the linked fig id
1932            my $fig_col;
1933            if (defined ($e_identical{$id})){
1934                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1935            }
1936            else{
1937                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1938            }
1939    
1940          push(@$single_domain,$thing->database);          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1941          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1942          push(@$single_domain,$thing->evalue);  
1943          push(@$single_domain,"$iden\%");          foreach my $col (sort keys %$scroll_list){
1944          push(@$single_domain,$reg1);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1945          push(@$single_domain,$reg2);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1946          push(@$single_domain,$in_sub);              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1947          push(@$single_domain,$ev_codes);              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1948          push(@$single_domain,$thing->organism);              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1949          push(@$single_domain,$thing->function);              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1950          push(@$single_domain,$aliases);              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1951                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1952                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1953                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1954                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1955                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1956                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1957                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1958                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1959            }
1960          push(@$data,$single_domain);          push(@$data,$single_domain);
1961      }      }
   
1962      if ($count >0){      if ($count >0){
1963          $content = $data;          $content = $data;
1964      }      }
1965      else      else{
     {  
1966          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
1967      }      }
1968      return ($content);      return ($content);
1969  }  }
1970    
1971    sub get_box_column{
1972        my ($ids) = @_;
1973        my %column;
1974        foreach my $id (@$ids){
1975            my $field_name = "tables_" . $id;
1976            my $pair_name = "visual_" . $id;
1977            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1978        }
1979        return (%column);
1980    }
1981    
1982    sub get_subsystems_column{
1983        my ($ids,$fig) = @_;
1984    
1985        #my $fig = new FIG;
1986        my $cgi = new CGI;
1987        my %in_subs  = $fig->subsystems_for_pegs($ids);
1988        my %column;
1989        foreach my $id (@$ids){
1990            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1991            my @subsystems;
1992    
1993            if (@in_sub > 0) {
1994                foreach my $array(@in_sub){
1995                    my $ss = $$array[0];
1996                    $ss =~ s/_/ /ig;
1997                    push (@subsystems, "-" . $ss);
1998                }
1999                my $in_sub_line = join ("<br>", @subsystems);
2000                $column{$id} = $in_sub_line;
2001            } else {
2002                $column{$id} = "&nbsp;";
2003            }
2004        }
2005        return (%column);
2006    }
2007    
2008    sub get_essentially_identical{
2009        my ($fid,$dataset,$fig) = @_;
2010        #my $fig = new FIG;
2011    
2012        my %id_list;
2013        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2014    
2015        foreach my $thing (@$dataset){
2016            if($thing->class eq "IDENTICAL"){
2017                my $rows = $thing->rows;
2018                my $count_identical = 0;
2019                foreach my $row (@$rows) {
2020                    my $id = $row->[0];
2021                    if (($id ne $fid) && ($fig->function_of($id))) {
2022                        $id_list{$id} = 1;
2023                    }
2024                }
2025            }
2026        }
2027    
2028    #    foreach my $id (@maps_to) {
2029    #        if (($id ne $fid) && ($fig->function_of($id))) {
2030    #           $id_list{$id} = 1;
2031    #        }
2032    #    }
2033        return(%id_list);
2034    }
2035    
2036    
2037    sub get_evidence_column{
2038        my ($ids, $attributes,$fig) = @_;
2039        #my $fig = new FIG;
2040        my $cgi = new CGI;
2041        my (%column, %code_attributes);
2042    
2043        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2044        foreach my $key (@codes){
2045            push (@{$code_attributes{$$key[0]}}, $key);
2046        }
2047    
2048        foreach my $id (@$ids){
2049            # add evidence code with tool tip
2050            my $ev_codes=" &nbsp; ";
2051    
2052            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2053            my @ev_codes = ();
2054            foreach my $code (@codes) {
2055                my $pretty_code = $code->[2];
2056                if ($pretty_code =~ /;/) {
2057                    my ($cd, $ss) = split(";", $code->[2]);
2058                    $ss =~ s/_/ /g;
2059                    $pretty_code = $cd;# . " in " . $ss;
2060                }
2061                push(@ev_codes, $pretty_code);
2062            }
2063    
2064            if (scalar(@ev_codes) && $ev_codes[0]) {
2065                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2066                $ev_codes = $cgi->a(
2067                                    {
2068                                        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));
2069            }
2070            $column{$id}=$ev_codes;
2071        }
2072        return (%column);
2073    }
2074    
2075    sub get_pfam_column{
2076        my ($ids, $attributes,$fig) = @_;
2077        #my $fig = new FIG;
2078        my $cgi = new CGI;
2079        my (%column, %code_attributes, %attribute_locations);
2080        my $dbmaster = DBMaster->new(-database =>'Ontology');
2081    
2082        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2083        foreach my $key (@codes){
2084            my $name = $key->[1];
2085            if ($name =~ /_/){
2086                ($name) = ($key->[1]) =~ /(.*?)_/;
2087            }
2088            push (@{$code_attributes{$key->[0]}}, $name);
2089            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2090        }
2091    
2092        foreach my $id (@$ids){
2093            # add evidence code
2094            my $pfam_codes=" &nbsp; ";
2095            my @pfam_codes = "";
2096            my %description_codes;
2097    
2098            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2099                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2100                @pfam_codes = ();
2101    
2102                # get only unique values
2103                my %saw;
2104                foreach my $key (@ncodes) {$saw{$key}=1;}
2105                @ncodes = keys %saw;
2106    
2107                foreach my $code (@ncodes) {
2108                    my @parts = split("::",$code);
2109                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2110    
2111                    # get the locations for the domain
2112                    my @locs;
2113                    foreach my $part (@{$attribute_location{$id}{$code}}){
2114                        my ($loc) = ($part) =~ /\;(.*)/;
2115                        push (@locs,$loc);
2116                    }
2117                    my %locsaw;
2118                    foreach my $key (@locs) {$locsaw{$key}=1;}
2119                    @locs = keys %locsaw;
2120    
2121                    my $locations = join (", ", @locs);
2122    
2123                    if (defined ($description_codes{$parts[1]})){
2124                        push(@pfam_codes, "$parts[1] ($locations)");
2125                    }
2126                    else {
2127                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2128                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2129                        push(@pfam_codes, "$pfam_link ($locations)");
2130                    }
2131                }
2132            }
2133    
2134            $column{$id}=join("<br><br>", @pfam_codes);
2135        }
2136        return (%column);
2137    
2138    }
2139    
2140    sub get_aliases {
2141        my ($ids,$fig) = @_;
2142    
2143        my $all_aliases = $fig->feature_aliases_bulk($ids);
2144        foreach my $id (@$ids){
2145            foreach my $alias (@{$$all_aliases{$id}}){
2146                my $id_db = &Observation::get_database($alias);
2147                next if ($aliases->{$id}->{$id_db});
2148                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2149            }
2150        }
2151        return ($aliases);
2152    }
2153    
2154  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2155    
2156    sub color {
2157        my ($evalue) = @_;
2158        my $palette = WebColors::get_palette('vitamins');
2159        my $color;
2160        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2161        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2162        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2163        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2164        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2165        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2166        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2167        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2168        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2169        else{        $color = $palette->[9];    }
2170        return ($color);
2171    }
2172    
2173    
2174  ############################  ############################
# Line 1429  Line 2186 
2186  }  }
2187    
2188  sub display {  sub display {
2189      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2190    
2191      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2192      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2193      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2194      my $fig = new FIG;      my $range = $gd_window_size;
2195      my $all_regions = [];      my $all_regions = [];
2196        my $gene_associations={};
2197    
2198      #get the organism genome      #get the organism genome
2199      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2200        $gene_associations->{$fid}->{"organism"} = $target_genome;
2201        $gene_associations->{$fid}->{"main_gene"} = $fid;
2202        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2203    
2204      # get location of the gene      # get location of the gene
2205      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 2216 
2216      my ($region_start, $region_end);      my ($region_start, $region_end);
2217      if ($beg < $end)      if ($beg < $end)
2218      {      {
2219          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2220          $region_end = $end+4000;          $region_end = $end+ ($range);
2221          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2222      }      }
2223      else      else
2224      {      {
2225          $region_start = $end-4000;          $region_start = $end-($range);
2226          $region_end = $beg+4000;          $region_end = $beg+($range);
2227          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2228          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2229            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2230      }      }
2231    
2232      # call genes in region      # call genes in region
2233      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);
2234        #foreach my $feat (@$target_gene_features){
2235        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2236        #}
2237      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2238      my (@start_array_region);      my (@start_array_region);
2239      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2240    
2241      my %all_genes;      my %all_genes;
2242      my %all_genomes;      my %all_genomes;
2243      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2244            #if ($feature =~ /peg/){
2245      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2246      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = 1;  
2247                  }                  }
2248    
2249                  push (@start_array_region, $offset);      my @selected_sims;
2250    
2251                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2252                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2253                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2254                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2255              }          # get the similarities and store only the ones that match the lineages selected
2256              $coup_count++;          if (@selected_taxonomy > 0){
2257                foreach my $sim (@$sims_array){
2258                    next if ($sim->class ne "SIM");
2259                    next if ($sim->acc !~ /fig\|/);
2260    
2261                    #my $genome = $fig->genome_of($sim->[1]);
2262                    my $genome = $fig->genome_of($sim->acc);
2263                    #my ($genome1) = ($genome) =~ /(.*)\./;
2264                    #my $lineage = $taxes->{$genome1};
2265                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2266                    foreach my $taxon(@selected_taxonomy){
2267                        if ($lineage =~ /$taxon/){
2268                            #push (@selected_sims, $sim->[1]);
2269                            push (@selected_sims, $sim->acc);
2270          }          }
2271      }      }
   
     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);  
2272                      }                      }
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = 1;  
2273                      }                      }
2274            else{
2275                my $simcount = 0;
2276                foreach my $sim (@$sims_array){
2277                    next if ($sim->class ne "SIM");
2278                    next if ($sim->acc !~ /fig\|/);
2279    
2280                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2281                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2282                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  last if ($simcount > 4);
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
                 }  
2283              }              }
2284          }          }
2285    
2286            my %saw;
2287            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2288    
2289            # get the gene context for the sorted matches
2290            foreach my $sim_fid(@selected_sims){
2291                #get the organism genome
2292                my $sim_genome = $fig->genome_of($sim_fid);
2293                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2294                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2295                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2296    
2297                # get location of the gene
2298                my $data = $fig->feature_location($sim_fid);
2299                my ($contig, $beg, $end);
2300    
2301                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2302                    $contig = $1;
2303                    $beg = $2;
2304                    $end = $3;
2305      }      }
2306    
2307      # get the PCH to each of the genes              my $offset;
2308      my $pch_sets = [];              my ($region_start, $region_end);
2309      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)  
2310          {          {
2311              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2312                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2313                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2314          }          }
2315          else          else
2316          {          {
2317              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2318                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2319              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2320                    $reverse_flag{$sim_genome} = $sim_fid;
2321                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2322          }          }
2323    
2324                # call genes in region
2325                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2326                push(@$all_regions,$sim_gene_features);
2327                push (@start_array_region, $offset);
2328                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2329                $all_genomes{$sim_genome} = 1;
2330      }      }
2331    
2332        }
2333    
2334  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2335  #    my %already;      # cluster the genes
2336  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
2337  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2338  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2339  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = 100;  
 #           }  
 #       }  
 #    }  
2340    
2341      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2342          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2343          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2344          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2345          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2346            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2347            #my $lineage = $taxes->{$genome1};
2348            my $lineage = $fig->taxonomy_of($region_genome);
2349            #$region_gs .= "Lineage:$lineage";
2350          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2351                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2352                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 2354 
2354    
2355          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2356    
2357            my $second_line_config = { 'title' => "$lineage",
2358                                       'short_title' => "",
2359                                       'basepair_offset' => '0',
2360                                       'no_middle_line' => '1'
2361                                       };
2362    
2363          my $line_data = [];          my $line_data = [];
2364            my $second_line_data = [];
2365    
2366            # initialize variables to check for overlap in genes
2367            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2368            my $major_line_flag = 0;
2369            my $prev_second_flag = 0;
2370    
2371          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2372                $second_line_flag = 0;
2373              my $element_hash;              my $element_hash;
2374              my $links_list = [];              my $links_list = [];
2375              my $descriptions = [];              my $descriptions = [];
2376    
2377              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2378    
2379              # get subsystem information              # get subsystem information
2380              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2381              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2382    
2383              my $link;              my $link;
2384              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2385                       "link" => $url_link};                       "link" => $url_link};
2386              push(@$links_list,$link);              push(@$links_list,$link);
2387    
2388              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2389              foreach my $subsystem (@subsystems){              my @subsystems;
2390                foreach my $array (@subs){
2391                    my $subsystem = $$array[0];
2392                    my $ss = $subsystem;
2393                    $ss =~ s/_/ /ig;
2394                    push (@subsystems, $ss);
2395                  my $link;                  my $link;
2396                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2397                           "link_title" => $subsystem};                           "link_title" => $ss};
2398                    push(@$links_list,$link);
2399                }
2400    
2401                if ($fid1 eq $fid){
2402                    my $link;
2403                    $link = {"link_title" => "Annotate this sequence",
2404                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2405                  push(@$links_list,$link);                  push(@$links_list,$link);
2406              }              }
2407    
# Line 1738  Line 2423 
2423                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2424                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2425    
2426                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2427                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2428                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2429                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2430                            $second_line_flag = 1;
2431                            $major_line_flag = 1;
2432                        }
2433                    }
2434                    $prev_start = $start;
2435                    $prev_stop = $stop;
2436                    $prev_fig = $fid1;
2437    
2438                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2439                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2440                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2441                  }                  }
2442    
2443                    my $title = $fid1;
2444                    if ($fid1 eq $fid){
2445                        $title = "My query gene: $fid1";
2446                    }
2447    
2448                  $element_hash = {                  $element_hash = {
2449                      "title" => $fid1,                      "title" => $title,
2450                      "start" => $start,                      "start" => $start,
2451                      "end" =>  $stop,                      "end" =>  $stop,
2452                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 2455 
2455                      "links_list" => $links_list,                      "links_list" => $links_list,
2456                      "description" => $descriptions                      "description" => $descriptions
2457                  };                  };
2458                  push(@$line_data,$element_hash);  
2459                    # if there is an overlap, put into second line
2460                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2461                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2462    
2463                    if ($fid1 eq $fid){
2464                        $element_hash = {
2465                            "title" => 'Query',
2466                            "start" => $start,
2467                            "end" =>  $stop,
2468                            "type"=> 'bigbox',
2469                            "color"=> $color,
2470                            "zlayer" => "1"
2471                            };
2472    
2473                        # if there is an overlap, put into second line
2474                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2475                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2476                    }
2477              }              }
2478          }          }
2479          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2480            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2481      }      }
2482      return $gd;      return ($gd, \@selected_sims);
2483  }  }
2484    
2485    sub cluster_genes {
2486        my($fig,$all_pegs,$peg) = @_;
2487        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2488    
2489        my @color_sets = ();
2490    
2491        $conn = &get_connections_by_similarity($fig,$all_pegs);
2492    
2493        for ($i=0; ($i < @$all_pegs); $i++) {
2494            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2495            if (! $seen{$i}) {
2496                $cluster = [$i];
2497                $seen{$i} = 1;
2498                for ($j=0; ($j < @$cluster); $j++) {
2499                    $x = $conn->{$cluster->[$j]};
2500                    foreach $k (@$x) {
2501                        if (! $seen{$k}) {
2502                            push(@$cluster,$k);
2503                            $seen{$k} = 1;
2504                        }
2505                    }
2506                }
2507    
2508                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2509                    push(@color_sets,$cluster);
2510                }
2511            }
2512        }
2513        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2514        $red_set = $color_sets[$i];
2515        splice(@color_sets,$i,1);
2516        @color_sets = sort { @$b <=> @$a } @color_sets;
2517        unshift(@color_sets,$red_set);
2518    
2519        my $color_sets = {};
2520        for ($i=0; ($i < @color_sets); $i++) {
2521            foreach $x (@{$color_sets[$i]}) {
2522                $color_sets->{$all_pegs->[$x]} = $i;
2523            }
2524        }
2525        return $color_sets;
2526    }
2527    
2528    sub get_connections_by_similarity {
2529        my($fig,$all_pegs) = @_;
2530        my($i,$j,$tmp,$peg,%pos_of);
2531        my($sim,%conn,$x,$y);
2532    
2533        for ($i=0; ($i < @$all_pegs); $i++) {
2534            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2535            push(@{$pos_of{$tmp}},$i);
2536            if ($tmp ne $all_pegs->[$i]) {
2537                push(@{$pos_of{$all_pegs->[$i]}},$i);
2538            }
2539        }
2540    
2541        foreach $y (keys(%pos_of)) {
2542            $x = $pos_of{$y};
2543            for ($i=0; ($i < @$x); $i++) {
2544                for ($j=$i+1; ($j < @$x); $j++) {
2545                    push(@{$conn{$x->[$i]}},$x->[$j]);
2546                    push(@{$conn{$x->[$j]}},$x->[$i]);
2547                }
2548            }
2549        }
2550    
2551        for ($i=0; ($i < @$all_pegs); $i++) {
2552            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2553                if (defined($x = $pos_of{$sim->id2})) {
2554                    foreach $y (@$x) {
2555                        push(@{$conn{$i}},$y);
2556                    }
2557                }
2558            }
2559        }
2560        return \%conn;
2561    }
2562    
2563    sub in {
2564        my($x,$xL) = @_;
2565        my($i);
2566    
2567        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2568        return ($i < @$xL);
2569    }
2570    
2571    #############################################
2572    #############################################
2573    package Observation::Commentary;
2574    
2575    use base qw(Observation);
2576    
2577    =head3 display_protein_commentary()
2578    
2579    =cut
2580    
2581    sub display_protein_commentary {
2582        my ($self,$dataset,$mypeg,$fig) = @_;
2583    
2584        my $all_rows = [];
2585        my $content;
2586        #my $fig = new FIG;
2587        my $cgi = new CGI;
2588        my $count = 0;
2589        my $peg_array = [];
2590        my (%evidence_column, %subsystems_column,  %e_identical);
2591    
2592        if (@$dataset != 1){
2593            foreach my $thing (@$dataset){
2594                if ($thing->class eq "SIM"){
2595                    push (@$peg_array, $thing->acc);
2596                }
2597            }
2598            # get the column for the evidence codes
2599            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2600    
2601            # get the column for the subsystems
2602            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2603    
2604            # get essentially identical seqs
2605            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2606        }
2607        else{
2608            push (@$peg_array, @$dataset);
2609        }
2610    
2611        my $selected_sims = [];
2612        foreach my $id (@$peg_array){
2613            last if ($count > 10);
2614            my $row_data = [];
2615            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2616            $org = $fig->org_of($id);
2617            $function = $fig->function_of($id);
2618            if ($mypeg ne $id){
2619                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2620                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2621                if (defined($e_identical{$id})) { $id_cell .= "*";}
2622            }
2623            else{
2624                $function_cell = "&nbsp;&nbsp;$function";
2625                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2626                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2627            }
2628    
2629            push(@$row_data,$id_cell);
2630            push(@$row_data,$org);
2631            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2632            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2633            push(@$row_data, $fig->translation_length($id));
2634            push(@$row_data,$function_cell);
2635            push(@$all_rows,$row_data);
2636            push (@$selected_sims, $id);
2637            $count++;
2638        }
2639    
2640        if ($count >0){
2641            $content = $all_rows;
2642        }
2643        else{
2644            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2645        }
2646        return ($content,$selected_sims);
2647    }
2648    
2649    sub display_protein_history {
2650        my ($self, $id,$fig) = @_;
2651        my $all_rows = [];
2652        my $content;
2653    
2654        my $cgi = new CGI;
2655        my $count = 0;
2656        foreach my $feat ($fig->feature_annotations($id)){
2657            my $row = [];
2658            my $col1 = $feat->[2];
2659            my $col2 = $feat->[1];
2660            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2661            my $text = $feat->[3];
2662    
2663            push (@$row, $col1);
2664            push (@$row, $col2);
2665            push (@$row, $text);
2666            push (@$all_rows, $row);
2667            $count++;
2668        }
2669        if ($count > 0){
2670            $content = $all_rows;
2671        }
2672        else {
2673            $content = "There is no history for this PEG";
2674        }
2675    
2676        return($content);
2677    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3