[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.48, Tue Dec 4 20:41:34 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                                'hover_title' => 'Localization',
1402                                'basepair_offset' => '1' };
1403    
1404          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1405                                            "value" => $cello_location};                                            "value" => $cello_location};
1406    
# Line 1171  Line 1413 
1413    
1414          my $element_hash = {          my $element_hash = {
1415              "title" => "CELLO",              "title" => "CELLO",
1416                "color"=> $color,
1417              "start" => "1",              "start" => "1",
1418              "end" =>  $length + 1,              "end" =>  $length + 1,
1419              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1420              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1421    
1422          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1423            $gd->add_line($line_data, $line_config);
1424      }      }
1425    
1426      my $color = "6";      $color = "2";
1427      if($tmpred_score){      if($tmpred_score){
1428            my $line_data =[];
1429            my $line_config = { 'title' => 'Localization Evidence',
1430                                'short_title' => 'Transmembrane',
1431                                'basepair_offset' => '1' };
1432    
1433          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1434              my $descriptions = [];              my $descriptions = [];
1435              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1444 
1444              "end" =>  $end + 1,              "end" =>  $end + 1,
1445              "color"=> $color,              "color"=> $color,
1446              "zlayer" => '5',              "zlayer" => '5',
1447              "type" => 'smallbox',              "type" => 'box',
1448                "description" => $descriptions};
1449    
1450                push(@$line_data,$element_hash);
1451    
1452            }
1453            $gd->add_line($line_data, $line_config);
1454        }
1455    =cut
1456    
1457        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1458            my $line_data =[];
1459            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1460                                'short_title' => 'TM and SP',
1461                                'hover_title' => 'Localization',
1462                                'basepair_offset' => '1' };
1463    
1464            foreach my $tm_loc (@phobius_tm_locations){
1465                my $descriptions = [];
1466                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1467                                 "value" => $tm_loc};
1468                push(@$descriptions,$description_phobius_tm_locations);
1469    
1470                my ($begin,$end) =split("-",$tm_loc);
1471    
1472                my $element_hash = {
1473                "title" => "Phobius",
1474                "start" => $begin + 1,
1475                "end" =>  $end + 1,
1476                "color"=> '6',
1477                "zlayer" => '4',
1478                "type" => 'bigbox',
1479              "description" => $descriptions};              "description" => $descriptions};
1480    
1481              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1482    
1483            }
1484    
1485            if($phobius_signal_location){
1486                my $descriptions = [];
1487                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1488                                 "value" => $phobius_signal_location};
1489                push(@$descriptions,$description_phobius_signal_location);
1490    
1491    
1492                my ($begin,$end) =split("-",$phobius_signal_location);
1493                my $element_hash = {
1494                "title" => "phobius signal locations",
1495                "start" => $begin + 1,
1496                "end" =>  $end + 1,
1497                "color"=> '1',
1498                "zlayer" => '5',
1499                "type" => 'box',
1500                "description" => $descriptions};
1501                push(@$line_data,$element_hash);
1502          }          }
1503    
1504            $gd->add_line($line_data, $line_config);
1505      }      }
1506    
1507      my $color = "1";  =head3
1508        $color = "1";
1509      if($signal_peptide_score){      if($signal_peptide_score){
1510            my $line_data = [];
1511          my $descriptions = [];          my $descriptions = [];
1512    
1513            my $line_config = { 'title' => 'Localization Evidence',
1514                                'short_title' => 'SignalP',
1515                                'hover_title' => 'Localization',
1516                                'basepair_offset' => '1' };
1517    
1518          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1519                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1520    
# Line 1220  Line 1528 
1528          my $element_hash = {          my $element_hash = {
1529              "title" => "SignalP",              "title" => "SignalP",
1530              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1531              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1532              "type" => 'bigbox',              "type" => 'bigbox',
1533              "color"=> $color,              "color"=> $color,
1534              "zlayer" => '10',              "zlayer" => '10',
1535              "description" => $descriptions};              "description" => $descriptions};
1536    
1537          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1538      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1539        }
1540    =cut
1541    
1542      return ($gd);      return ($gd);
1543    
# Line 1277  Line 1585 
1585    return $self->{cello_score};    return $self->{cello_score};
1586  }  }
1587    
1588    sub phobius_signal_location {
1589      my ($self) = @_;
1590      return $self->{phobius_signal_location};
1591    }
1592    
1593    sub phobius_tm_locations {
1594      my ($self) = @_;
1595      return $self->{phobius_tm_locations};
1596    }
1597    
1598    
1599    
1600  #########################################  #########################################
1601  #########################################  #########################################
# Line 1290  Line 1609 
1609      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1610      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1611      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1612        $self->{query} = $dataset->{'query'};
1613      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1614      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1615      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1305  Line 1625 
1625      return $self;      return $self;
1626  }  }
1627    
1628  =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  
1629    
1630  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.
1631    This code will display a graphical view of the similarities using the genome drawer object
1632    
1633  =cut  =cut
1634    
1635  sub display_table {  sub display {
1636      my ($self,$dataset) = @_;      my ($self,$gd,$array,$fig) = @_;
1637        #my $fig = new FIG;
1638    
1639      my $data = [];      my @ids;
1640      my $count = 0;      foreach my $thing(@$array){
     my $content;  
     my $fig = new FIG;  
     my $cgi = new CGI;  
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
1641          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1642          $count++;          push (@ids, $thing->acc);
1643        }
1644    
1645          my $id = $thing->acc;      my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1646    
1647          # add the subsystem information      foreach my $thing (@$array){
1648          my @in_sub  = $fig->peg_to_subsystems($id);          if ($thing->class eq "SIM"){
         my $in_sub;  
1649    
1650          if (@in_sub > 0) {              my $peg = $thing->acc;
1651              $in_sub = @in_sub;              my $query = $thing->query;
1652    
1653              # RAE: add a javascript popup with all the subsystems              my $organism = $thing->organism;
1654              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $genome = $fig->genome_of($peg);
1655              $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) =~ /(.*)\./;
1656          } else {              my $function = $thing->function;
1657              $in_sub = "&nbsp;";              my $abbrev_name = $fig->abbrev($organism);
1658          }              my $align_start = $thing->qstart;
1659                my $align_stop = $thing->qstop;
1660                my $hit_start = $thing->hstart;
1661                my $hit_stop = $thing->hstop;
1662    
1663          # 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);  
             }  
         }  
1664    
1665          if (scalar(@ev_codes) && $ev_codes[0]) {              my $line_config = { 'title' => "$organism [$org_tax]",
1666              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);                                  'short_title' => "$abbrev_name",
1667              $ev_codes = $cgi->a(                                  'title_link' => '$tax_link',
1668                                  {                                  'basepair_offset' => '0'
1669                                      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));                                  };
         }  
1670    
1671          # 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;";  
1672    
1673          my $iden    = $thing->identity;              my $element_hash;
1674          my $ln1     = $thing->qlength;              my $links_list = [];
1675          my $ln2     = $thing->hlength;              my $descriptions = [];
1676          my $b1      = $thing->qstart;  
1677          my $e1      = $thing->qstop;              # get subsystem information
1678          my $b2      = $thing->hstart;              my $url_link = "?page=Annotation&feature=".$peg;
1679          my $e2      = $thing->hstop;              my $link;
1680          my $d1      = abs($e1 - $b1) + 1;              $link = {"link_title" => $peg,
1681          my $d2      = abs($e2 - $b2) + 1;                       "link" => $url_link};
1682          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              push(@$links_list,$link);
1683    
1684                #my @subsystems = $fig->peg_to_subsystems($peg);
1685                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1686                my @subsystems;
1687    
1688                foreach my $array (@subs){
1689                    my $subsystem = $$array[0];
1690                    push(@subsystems,$subsystem);
1691                    my $link;
1692                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1693                             "link_title" => $subsystem};
1694                    push(@$links_list,$link);
1695                }
1696    
1697                $link = {"link_title" => "view blast alignment",
1698                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1699                push (@$links_list,$link);
1700    
1701                my $description_function;
1702                $description_function = {"title" => "function",
1703                                         "value" => $function};
1704                push(@$descriptions,$description_function);
1705    
1706                my ($description_ss, $ss_string);
1707                $ss_string = join (",", @subsystems);
1708                $description_ss = {"title" => "subsystems",
1709                                   "value" => $ss_string};
1710                push(@$descriptions,$description_ss);
1711    
1712                my $description_loc;
1713                $description_loc = {"title" => "location start",
1714                                    "value" => $hit_start};
1715                push(@$descriptions, $description_loc);
1716    
1717                $description_loc = {"title" => "location stop",
1718                                    "value" => $hit_stop};
1719                push(@$descriptions, $description_loc);
1720    
1721                my $evalue = $thing->evalue;
1722                while ($evalue =~ /-0/)
1723                {
1724                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1725                    $chunk2 = substr($chunk2,1);
1726                    $evalue = $chunk1 . "-" . $chunk2;
1727                }
1728    
1729                my $color = &color($evalue);
1730    
1731                my $description_eval = {"title" => "E-Value",
1732                                        "value" => $evalue};
1733                push(@$descriptions, $description_eval);
1734    
1735                my $identity = $self->identity;
1736                my $description_identity = {"title" => "Identity",
1737                                            "value" => $identity};
1738                push(@$descriptions, $description_identity);
1739    
1740                $element_hash = {
1741                    "title" => $peg,
1742                    "start" => $align_start,
1743                    "end" =>  $align_stop,
1744                    "type"=> 'box',
1745                    "color"=> $color,
1746                    "zlayer" => "2",
1747                    "links_list" => $links_list,
1748                    "description" => $descriptions
1749                    };
1750                push(@$line_data,$element_hash);
1751                $gd->add_line($line_data, $line_config);
1752            }
1753        }
1754        return ($gd);
1755    }
1756    
1757    =head3 display_domain_composition()
1758    
1759    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
1760    
1761    =cut
1762    
1763    sub display_domain_composition {
1764        my ($self,$gd,$fig) = @_;
1765    
1766        #$fig = new FIG;
1767        my $peg = $self->acc;
1768    
1769        my $line_data = [];
1770        my $links_list = [];
1771        my $descriptions = [];
1772    
1773        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1774        #my @domain_query_results = ();
1775        foreach $dqr (@domain_query_results){
1776            my $key = @$dqr[1];
1777            my @parts = split("::",$key);
1778            my $db = $parts[0];
1779            my $id = $parts[1];
1780            my $val = @$dqr[2];
1781            my $from;
1782            my $to;
1783            my $evalue;
1784    
1785            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1786                my $raw_evalue = $1;
1787                $from = $2;
1788                $to = $3;
1789                if($raw_evalue =~/(\d+)\.(\d+)/){
1790                    my $part2 = 1000 - $1;
1791                    my $part1 = $2/100;
1792                    $evalue = $part1."e-".$part2;
1793                }
1794                else{
1795                    $evalue = "0.0";
1796                }
1797            }
1798    
1799            my $dbmaster = DBMaster->new(-database =>'Ontology');
1800            my ($name_value,$description_value);
1801    
1802            if($db eq "CDD"){
1803                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1804                if(!scalar(@$cdd_objs)){
1805                    $name_title = "name";
1806                    $name_value = "not available";
1807                    $description_title = "description";
1808                    $description_value = "not available";
1809                }
1810                else{
1811                    my $cdd_obj = $cdd_objs->[0];
1812                    $name_value = $cdd_obj->term;
1813                    $description_value = $cdd_obj->description;
1814                }
1815            }
1816    
1817            my $domain_name;
1818            $domain_name = {"title" => "name",
1819                            "value" => $name_value};
1820            push(@$descriptions,$domain_name);
1821    
1822            my $description;
1823            $description = {"title" => "description",
1824                            "value" => $description_value};
1825            push(@$descriptions,$description);
1826    
1827            my $score;
1828            $score = {"title" => "score",
1829                      "value" => $evalue};
1830            push(@$descriptions,$score);
1831    
1832            my $link_id = $id;
1833            my $link;
1834            my $link_url;
1835            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"}
1836            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1837            else{$link_url = "NO_URL"}
1838    
1839            $link = {"link_title" => $name_value,
1840                     "link" => $link_url};
1841            push(@$links_list,$link);
1842    
1843            my $domain_element_hash = {
1844                "title" => $peg,
1845                "start" => $from,
1846                "end" =>  $to,
1847                "type"=> 'box',
1848                "zlayer" => '4',
1849                "links_list" => $links_list,
1850                "description" => $descriptions
1851                };
1852    
1853            push(@$line_data,$domain_element_hash);
1854    
1855            #just one CDD domain for now, later will add option for multiple domains from selected DB
1856            last;
1857        }
1858    
1859        my $line_config = { 'title' => $peg,
1860                            'hover_title' => 'Domain',
1861                            'short_title' => $peg,
1862                            'basepair_offset' => '1' };
1863    
1864        $gd->add_line($line_data, $line_config);
1865    
1866        return ($gd);
1867    
1868    }
1869    
1870    =head3 display_table()
1871    
1872    If available use the function specified here to display the "raw" observation.
1873    This code will display a table for the similarities protein
1874    
1875    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.
1876    
1877    =cut
1878    
1879    sub display_table {
1880        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1881    
1882        my $data = [];
1883        my $count = 0;
1884        my $content;
1885        #my $fig = new FIG;
1886        my $cgi = new CGI;
1887        my @ids;
1888        foreach my $thing (@$dataset) {
1889            next if ($thing->class ne "SIM");
1890            push (@ids, $thing->acc);
1891        }
1892    
1893        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1894        my @attributes = $fig->get_attributes(\@ids);
1895    
1896        # get the column for the subsystems
1897        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1898    
1899        # get the column for the evidence codes
1900        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1901    
1902        # get the column for pfam_domain
1903        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1904    
1905        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1906        my $alias_col = &get_aliases(\@ids,$fig);
1907        #my $alias_col = {};
1908    
1909        foreach my $thing (@$dataset) {
1910            next if ($thing->class ne "SIM");
1911            my $single_domain = [];
1912            $count++;
1913    
1914            my $id      = $thing->acc;
1915            my $taxid   = $fig->genome_of($id);
1916            my $iden    = $thing->identity;
1917            my $ln1     = $thing->qlength;
1918            my $ln2     = $thing->hlength;
1919            my $b1      = $thing->qstart;
1920            my $e1      = $thing->qstop;
1921            my $b2      = $thing->hstart;
1922            my $e2      = $thing->hstop;
1923            my $d1      = abs($e1 - $b1) + 1;
1924            my $d2      = abs($e2 - $b2) + 1;
1925            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1926          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1927    
1928            # checkbox column
1929            my $field_name = "tables_" . $id;
1930            my $pair_name = "visual_" . $id;
1931            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1932            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1933    
1934            # get the linked fig id
1935            my $fig_col;
1936            if (defined ($e_identical{$id})){
1937                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1938            }
1939            else{
1940                $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1941            }
1942    
1943          push(@$single_domain,$thing->database);          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1944          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1945          push(@$single_domain,$thing->evalue);  
1946          push(@$single_domain,"$iden\%");          foreach my $col (sort keys %$scroll_list){
1947          push(@$single_domain,$reg1);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1948          push(@$single_domain,$reg2);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1949          push(@$single_domain,$in_sub);              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1950          push(@$single_domain,$ev_codes);              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1951          push(@$single_domain,$thing->organism);              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1952          push(@$single_domain,$thing->function);              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1953          push(@$single_domain,$aliases);              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1954                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1955                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1956                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1957                #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1958                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1959                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1960                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1961                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1962            }
1963          push(@$data,$single_domain);          push(@$data,$single_domain);
1964      }      }
   
1965      if ($count >0){      if ($count >0){
1966          $content = $data;          $content = $data;
1967      }      }
1968      else      else{
     {  
1969          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
1970      }      }
1971      return ($content);      return ($content);
1972  }  }
1973    
1974    sub get_box_column{
1975        my ($ids) = @_;
1976        my %column;
1977        foreach my $id (@$ids){
1978            my $field_name = "tables_" . $id;
1979            my $pair_name = "visual_" . $id;
1980            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1981        }
1982        return (%column);
1983    }
1984    
1985    sub get_subsystems_column{
1986        my ($ids,$fig) = @_;
1987    
1988        #my $fig = new FIG;
1989        my $cgi = new CGI;
1990        my %in_subs  = $fig->subsystems_for_pegs($ids);
1991        my %column;
1992        foreach my $id (@$ids){
1993            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1994            my @subsystems;
1995    
1996            if (@in_sub > 0) {
1997                foreach my $array(@in_sub){
1998                    my $ss = $$array[0];
1999                    $ss =~ s/_/ /ig;
2000                    push (@subsystems, "-" . $ss);
2001                }
2002                my $in_sub_line = join ("<br>", @subsystems);
2003                $column{$id} = $in_sub_line;
2004            } else {
2005                $column{$id} = "&nbsp;";
2006            }
2007        }
2008        return (%column);
2009    }
2010    
2011    sub get_essentially_identical{
2012        my ($fid,$dataset,$fig) = @_;
2013        #my $fig = new FIG;
2014    
2015        my %id_list;
2016        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2017    
2018        foreach my $thing (@$dataset){
2019            if($thing->class eq "IDENTICAL"){
2020                my $rows = $thing->rows;
2021                my $count_identical = 0;
2022                foreach my $row (@$rows) {
2023                    my $id = $row->[0];
2024                    if (($id ne $fid) && ($fig->function_of($id))) {
2025                        $id_list{$id} = 1;
2026                    }
2027                }
2028            }
2029        }
2030    
2031    #    foreach my $id (@maps_to) {
2032    #        if (($id ne $fid) && ($fig->function_of($id))) {
2033    #           $id_list{$id} = 1;
2034    #        }
2035    #    }
2036        return(%id_list);
2037    }
2038    
2039    
2040    sub get_evidence_column{
2041        my ($ids, $attributes,$fig) = @_;
2042        #my $fig = new FIG;
2043        my $cgi = new CGI;
2044        my (%column, %code_attributes);
2045    
2046        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2047        foreach my $key (@codes){
2048            push (@{$code_attributes{$$key[0]}}, $key);
2049        }
2050    
2051        foreach my $id (@$ids){
2052            # add evidence code with tool tip
2053            my $ev_codes=" &nbsp; ";
2054    
2055            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2056            my @ev_codes = ();
2057            foreach my $code (@codes) {
2058                my $pretty_code = $code->[2];
2059                if ($pretty_code =~ /;/) {
2060                    my ($cd, $ss) = split(";", $code->[2]);
2061                    $ss =~ s/_/ /g;
2062                    $pretty_code = $cd;# . " in " . $ss;
2063                }
2064                push(@ev_codes, $pretty_code);
2065            }
2066    
2067            if (scalar(@ev_codes) && $ev_codes[0]) {
2068                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2069                $ev_codes = $cgi->a(
2070                                    {
2071                                        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));
2072            }
2073            $column{$id}=$ev_codes;
2074        }
2075        return (%column);
2076    }
2077    
2078    sub get_pfam_column{
2079        my ($ids, $attributes,$fig) = @_;
2080        #my $fig = new FIG;
2081        my $cgi = new CGI;
2082        my (%column, %code_attributes, %attribute_locations);
2083        my $dbmaster = DBMaster->new(-database =>'Ontology');
2084    
2085        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2086        foreach my $key (@codes){
2087            my $name = $key->[1];
2088            if ($name =~ /_/){
2089                ($name) = ($key->[1]) =~ /(.*?)_/;
2090            }
2091            push (@{$code_attributes{$key->[0]}}, $name);
2092            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2093        }
2094    
2095        foreach my $id (@$ids){
2096            # add evidence code
2097            my $pfam_codes=" &nbsp; ";
2098            my @pfam_codes = "";
2099            my %description_codes;
2100    
2101            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2102                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2103                @pfam_codes = ();
2104    
2105                # get only unique values
2106                my %saw;
2107                foreach my $key (@ncodes) {$saw{$key}=1;}
2108                @ncodes = keys %saw;
2109    
2110                foreach my $code (@ncodes) {
2111                    my @parts = split("::",$code);
2112                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2113    
2114                    # get the locations for the domain
2115                    my @locs;
2116                    foreach my $part (@{$attribute_location{$id}{$code}}){
2117                        my ($loc) = ($part) =~ /\;(.*)/;
2118                        push (@locs,$loc);
2119                    }
2120                    my %locsaw;
2121                    foreach my $key (@locs) {$locsaw{$key}=1;}
2122                    @locs = keys %locsaw;
2123    
2124                    my $locations = join (", ", @locs);
2125    
2126                    if (defined ($description_codes{$parts[1]})){
2127                        push(@pfam_codes, "$parts[1] ($locations)");
2128                    }
2129                    else {
2130                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2131                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2132                        push(@pfam_codes, "$pfam_link ($locations)");
2133                    }
2134                }
2135            }
2136    
2137            $column{$id}=join("<br><br>", @pfam_codes);
2138        }
2139        return (%column);
2140    
2141    }
2142    
2143    sub get_aliases {
2144        my ($ids,$fig) = @_;
2145    
2146        my $all_aliases = $fig->feature_aliases_bulk($ids);
2147        foreach my $id (@$ids){
2148            foreach my $alias (@{$$all_aliases{$id}}){
2149                my $id_db = &Observation::get_database($alias);
2150                next if ($aliases->{$id}->{$id_db});
2151                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2152            }
2153        }
2154        return ($aliases);
2155    }
2156    
2157  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; $_ }
2158    
2159    sub color {
2160        my ($evalue) = @_;
2161        my $palette = WebColors::get_palette('vitamins');
2162        my $color;
2163        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2164        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2165        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2166        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2167        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2168        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2169        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2170        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2171        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2172        else{        $color = $palette->[9];    }
2173        return ($color);
2174    }
2175    
2176    
2177  ############################  ############################
# Line 1429  Line 2189 
2189  }  }
2190    
2191  sub display {  sub display {
2192      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2193    
2194      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2195      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2196      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2197      my $fig = new FIG;      my $range = $gd_window_size;
2198      my $all_regions = [];      my $all_regions = [];
2199        my $gene_associations={};
2200    
2201      #get the organism genome      #get the organism genome
2202      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2203        $gene_associations->{$fid}->{"organism"} = $target_genome;
2204        $gene_associations->{$fid}->{"main_gene"} = $fid;
2205        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2206    
2207      # get location of the gene      # get location of the gene
2208      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1455  Line 2219 
2219      my ($region_start, $region_end);      my ($region_start, $region_end);
2220      if ($beg < $end)      if ($beg < $end)
2221      {      {
2222          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2223          $region_end = $end+4000;          $region_end = $end+ ($range);
2224          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2225      }      }
2226      else      else
2227      {      {
2228          $region_start = $end-4000;          $region_start = $end-($range);
2229          $region_end = $beg+4000;          $region_end = $beg+($range);
2230          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2231          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2232            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2233      }      }
2234    
2235      # call genes in region      # call genes in region
2236      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);
2237        #foreach my $feat (@$target_gene_features){
2238        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2239        #}
2240      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2241      my (@start_array_region);      my (@start_array_region);
2242      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2243    
2244      my %all_genes;      my %all_genes;
2245      my %all_genomes;      my %all_genomes;
2246      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2247            #if ($feature =~ /peg/){
2248      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2249      {          #}
         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;  
2250                  }                  }
2251    
2252                  push (@start_array_region, $offset);      my @selected_sims;
2253    
2254                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2255                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2256                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2257                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2258              }          # get the similarities and store only the ones that match the lineages selected
2259              $coup_count++;          if (@selected_taxonomy > 0){
2260                foreach my $sim (@$sims_array){
2261                    next if ($sim->class ne "SIM");
2262                    next if ($sim->acc !~ /fig\|/);
2263    
2264                    #my $genome = $fig->genome_of($sim->[1]);
2265                    my $genome = $fig->genome_of($sim->acc);
2266                    #my ($genome1) = ($genome) =~ /(.*)\./;
2267                    #my $lineage = $taxes->{$genome1};
2268                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2269                    foreach my $taxon(@selected_taxonomy){
2270                        if ($lineage =~ /$taxon/){
2271                            #push (@selected_sims, $sim->[1]);
2272                            push (@selected_sims, $sim->acc);
2273          }          }
2274      }      }
   
     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);  
2275                      }                      }
                     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;  
2276                      }                      }
2277            else{
2278                my $simcount = 0;
2279                foreach my $sim (@$sims_array){
2280                    next if ($sim->class ne "SIM");
2281                    next if ($sim->acc !~ /fig\|/);
2282    
2283                      push (@start_array_region, $offset);                  push (@selected_sims, $sim->acc);
2284                      $all_genomes{$pair_genome} = 1;                  $simcount++;
2285                      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;}  
                 }  
2286              }              }
2287          }          }
2288    
2289            my %saw;
2290            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2291    
2292            # get the gene context for the sorted matches
2293            foreach my $sim_fid(@selected_sims){
2294                #get the organism genome
2295                my $sim_genome = $fig->genome_of($sim_fid);
2296                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2297                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2298                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2299    
2300                # get location of the gene
2301                my $data = $fig->feature_location($sim_fid);
2302                my ($contig, $beg, $end);
2303    
2304                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2305                    $contig = $1;
2306                    $beg = $2;
2307                    $end = $3;
2308      }      }
2309    
2310      # get the PCH to each of the genes              my $offset;
2311      my $pch_sets = [];              my ($region_start, $region_end);
2312      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)  
2313          {          {
2314              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2315                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2316                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2317          }          }
2318          else          else
2319          {          {
2320              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2321                  $peg_rank{$peg} = 100;                  $region_end = $beg+($range/2);
2322              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2323                    $reverse_flag{$sim_genome} = $sim_fid;
2324                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2325          }          }
2326    
2327                # call genes in region
2328                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2329                push(@$all_regions,$sim_gene_features);
2330                push (@start_array_region, $offset);
2331                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2332                $all_genomes{$sim_genome} = 1;
2333      }      }
2334    
2335        }
2336    
2337  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2338  #    my %already;      # cluster the genes
2339  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
2340  #       if($already{$gene_key}){next;}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2341  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2342  #      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;  
 #           }  
 #       }  
 #    }  
2343    
2344      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2345          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2346          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2347          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2348          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2349            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2350            #my $lineage = $taxes->{$genome1};
2351            my $lineage = $fig->taxonomy_of($region_genome);
2352            #$region_gs .= "Lineage:$lineage";
2353          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2354                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2355                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 1695  Line 2357 
2357    
2358          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2359    
2360            my $second_line_config = { 'title' => "$lineage",
2361                                       'short_title' => "",
2362                                       'basepair_offset' => '0',
2363                                       'no_middle_line' => '1'
2364                                       };
2365    
2366          my $line_data = [];          my $line_data = [];
2367            my $second_line_data = [];
2368    
2369            # initialize variables to check for overlap in genes
2370            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2371            my $major_line_flag = 0;
2372            my $prev_second_flag = 0;
2373    
2374          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2375                $second_line_flag = 0;
2376              my $element_hash;              my $element_hash;
2377              my $links_list = [];              my $links_list = [];
2378              my $descriptions = [];              my $descriptions = [];
2379    
2380              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2381    
2382              # get subsystem information              # get subsystem information
2383              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2384              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2385    
2386              my $link;              my $link;
2387              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2388                       "link" => $url_link};                       "link" => $url_link};
2389              push(@$links_list,$link);              push(@$links_list,$link);
2390    
2391              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2392              foreach my $subsystem (@subsystems){              my @subsystems;
2393                foreach my $array (@subs){
2394                    my $subsystem = $$array[0];
2395                    my $ss = $subsystem;
2396                    $ss =~ s/_/ /ig;
2397                    push (@subsystems, $ss);
2398                  my $link;                  my $link;
2399                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2400                           "link_title" => $subsystem};                           "link_title" => $ss};
2401                    push(@$links_list,$link);
2402                }
2403    
2404                if ($fid1 eq $fid){
2405                    my $link;
2406                    $link = {"link_title" => "Annotate this sequence",
2407                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2408                  push(@$links_list,$link);                  push(@$links_list,$link);
2409              }              }
2410    
# Line 1738  Line 2426 
2426                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2427                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2428    
2429                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2430                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2431                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2432                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2433                            $second_line_flag = 1;
2434                            $major_line_flag = 1;
2435                        }
2436                    }
2437                    $prev_start = $start;
2438                    $prev_stop = $stop;
2439                    $prev_fig = $fid1;
2440    
2441                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2442                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2443                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2444                  }                  }
2445    
2446                    my $title = $fid1;
2447                    if ($fid1 eq $fid){
2448                        $title = "My query gene: $fid1";
2449                    }
2450    
2451                  $element_hash = {                  $element_hash = {
2452                      "title" => $fid1,                      "title" => $title,
2453                      "start" => $start,                      "start" => $start,
2454                      "end" =>  $stop,                      "end" =>  $stop,
2455                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 1753  Line 2458 
2458                      "links_list" => $links_list,                      "links_list" => $links_list,
2459                      "description" => $descriptions                      "description" => $descriptions
2460                  };                  };
2461                  push(@$line_data,$element_hash);  
2462                    # if there is an overlap, put into second line
2463                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2464                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2465    
2466                    if ($fid1 eq $fid){
2467                        $element_hash = {
2468                            "title" => 'Query',
2469                            "start" => $start,
2470                            "end" =>  $stop,
2471                            "type"=> 'bigbox',
2472                            "color"=> $color,
2473                            "zlayer" => "1"
2474                            };
2475    
2476                        # if there is an overlap, put into second line
2477                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2478                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2479                    }
2480              }              }
2481          }          }
2482          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2483            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2484      }      }
2485      return $gd;      return ($gd, \@selected_sims);
2486  }  }
2487    
2488    sub cluster_genes {
2489        my($fig,$all_pegs,$peg) = @_;
2490        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2491    
2492        my @color_sets = ();
2493    
2494        $conn = &get_connections_by_similarity($fig,$all_pegs);
2495    
2496        for ($i=0; ($i < @$all_pegs); $i++) {
2497            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2498            if (! $seen{$i}) {
2499                $cluster = [$i];
2500                $seen{$i} = 1;
2501                for ($j=0; ($j < @$cluster); $j++) {
2502                    $x = $conn->{$cluster->[$j]};
2503                    foreach $k (@$x) {
2504                        if (! $seen{$k}) {
2505                            push(@$cluster,$k);
2506                            $seen{$k} = 1;
2507                        }
2508                    }
2509                }
2510    
2511                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2512                    push(@color_sets,$cluster);
2513                }
2514            }
2515        }
2516        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2517        $red_set = $color_sets[$i];
2518        splice(@color_sets,$i,1);
2519        @color_sets = sort { @$b <=> @$a } @color_sets;
2520        unshift(@color_sets,$red_set);
2521    
2522        my $color_sets = {};
2523        for ($i=0; ($i < @color_sets); $i++) {
2524            foreach $x (@{$color_sets[$i]}) {
2525                $color_sets->{$all_pegs->[$x]} = $i;
2526            }
2527        }
2528        return $color_sets;
2529    }
2530    
2531    sub get_connections_by_similarity {
2532        my($fig,$all_pegs) = @_;
2533        my($i,$j,$tmp,$peg,%pos_of);
2534        my($sim,%conn,$x,$y);
2535    
2536        for ($i=0; ($i < @$all_pegs); $i++) {
2537            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2538            push(@{$pos_of{$tmp}},$i);
2539            if ($tmp ne $all_pegs->[$i]) {
2540                push(@{$pos_of{$all_pegs->[$i]}},$i);
2541            }
2542        }
2543    
2544        foreach $y (keys(%pos_of)) {
2545            $x = $pos_of{$y};
2546            for ($i=0; ($i < @$x); $i++) {
2547                for ($j=$i+1; ($j < @$x); $j++) {
2548                    push(@{$conn{$x->[$i]}},$x->[$j]);
2549                    push(@{$conn{$x->[$j]}},$x->[$i]);
2550                }
2551            }
2552        }
2553    
2554        for ($i=0; ($i < @$all_pegs); $i++) {
2555            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2556                if (defined($x = $pos_of{$sim->id2})) {
2557                    foreach $y (@$x) {
2558                        push(@{$conn{$i}},$y);
2559                    }
2560                }
2561            }
2562        }
2563        return \%conn;
2564    }
2565    
2566    sub in {
2567        my($x,$xL) = @_;
2568        my($i);
2569    
2570        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2571        return ($i < @$xL);
2572    }
2573    
2574    #############################################
2575    #############################################
2576    package Observation::Commentary;
2577    
2578    use base qw(Observation);
2579    
2580    =head3 display_protein_commentary()
2581    
2582    =cut
2583    
2584    sub display_protein_commentary {
2585        my ($self,$dataset,$mypeg,$fig) = @_;
2586    
2587        my $all_rows = [];
2588        my $content;
2589        #my $fig = new FIG;
2590        my $cgi = new CGI;
2591        my $count = 0;
2592        my $peg_array = [];
2593        my (%evidence_column, %subsystems_column,  %e_identical);
2594    
2595        if (@$dataset != 1){
2596            foreach my $thing (@$dataset){
2597                if ($thing->class eq "SIM"){
2598                    push (@$peg_array, $thing->acc);
2599                }
2600            }
2601            # get the column for the evidence codes
2602            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2603    
2604            # get the column for the subsystems
2605            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2606    
2607            # get essentially identical seqs
2608            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2609        }
2610        else{
2611            push (@$peg_array, @$dataset);
2612        }
2613    
2614        my $selected_sims = [];
2615        foreach my $id (@$peg_array){
2616            last if ($count > 10);
2617            my $row_data = [];
2618            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2619            $org = $fig->org_of($id);
2620            $function = $fig->function_of($id);
2621            if ($mypeg ne $id){
2622                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2623                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2624                if (defined($e_identical{$id})) { $id_cell .= "*";}
2625            }
2626            else{
2627                $function_cell = "&nbsp;&nbsp;$function";
2628                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2629                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2630            }
2631    
2632            push(@$row_data,$id_cell);
2633            push(@$row_data,$org);
2634            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2635            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2636            push(@$row_data, $fig->translation_length($id));
2637            push(@$row_data,$function_cell);
2638            push(@$all_rows,$row_data);
2639            push (@$selected_sims, $id);
2640            $count++;
2641        }
2642    
2643        if ($count >0){
2644            $content = $all_rows;
2645        }
2646        else{
2647            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2648        }
2649        return ($content,$selected_sims);
2650    }
2651    
2652    sub display_protein_history {
2653        my ($self, $id,$fig) = @_;
2654        my $all_rows = [];
2655        my $content;
2656    
2657        my $cgi = new CGI;
2658        my $count = 0;
2659        foreach my $feat ($fig->feature_annotations($id)){
2660            my $row = [];
2661            my $col1 = $feat->[2];
2662            my $col2 = $feat->[1];
2663            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2664            my $text = $feat->[3];
2665    
2666            push (@$row, $col1);
2667            push (@$row, $col2);
2668            push (@$row, $text);
2669            push (@$all_rows, $row);
2670            $count++;
2671        }
2672        if ($count > 0){
2673            $content = $all_rows;
2674        }
2675        else {
2676            $content = "There is no history for this PEG";
2677        }
2678    
2679        return($content);
2680    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3