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

Diff of /FigKernelPackages/Observation.pm

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

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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3