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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3