[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.38, Mon Sep 10 15:10:04 2007 UTC revision 1.49, Thu Dec 6 13:59:34 2007 UTC
# Line 7  Line 7 
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;
# Line 86  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 305  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=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          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,\@attributes);          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,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          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 334  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 365  Line 379 
379    
380  =cut  =cut
381  sub display_housekeeping {  sub display_housekeeping {
382      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
383      my $fig = new FIG;      my $content = [];
384      my $content;      my $row = [];
385    
386      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
387      my $org_id   = $fig->orgid_of_orgname($org_name);      my $org_id = $fig->genome_of($fid);
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
388      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
389      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
390      my $taxonomy = $fig->taxonomy_of($org_id);      my $length = $fig->translation_length($fid);
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
   
     $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);  
     $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);  
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
391    
392      if ( @subsystems ) {      push (@$row, $org_name);
393          $content .= qq(<tr><td>Subsystems</td><td>);      push (@$row, $fid);
394          foreach my $subsystem ( @subsystems ) {      push (@$row, $length);
395              $content .= join(" -- ", @$subsystem) . "<br>\n";      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      my %groups;      push(@$content, $row);
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
         }  
   
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
   
   
         $content .= qq(<tr><td>Aliases</td><td><table border="0">);  
         foreach my $key (sort keys %db_aliases){  
             $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);  
         }  
         $content .= qq(</td></tr></table>\n);  
     }  
   
     $content .= qq(</table><p>\n);  
407    
408      return ($content);      return ($content);
409  }  }
# Line 435  Line 414 
414  =cut  =cut
415    
416  sub get_sims_summary {  sub get_sims_summary {
417      my ($observation, $fid) = @_;      my ($observation, $fid, $taxes, $dataset, $fig) = @_;
     my $fig = new FIG;  
418      my %families;      my %families;
419      my @sims= $fig->nsims($fid,20000,10,"fig");      #my @sims= $fig->nsims($fid,20000,10,"fig");
420    
421      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
422          next if ($sim->[1] !~ /fig\|/);          next if ($thing->class ne "SIM");
423          my $genome = $fig->genome_of($sim->[1]);  
424          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));          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";          my $parent_tax = "Root";
434          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
435          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 451  Line 437 
437              push (@currLineage, $tax);              push (@currLineage, $tax);
438              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
439              $families{lineage}{$tax} = join(";", @currLineage);              $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;              $parent_tax = $tax;
452          }          }
453      }      }
# Line 473  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,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
494    
495      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
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 520  Line 531 
531    
532  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
533    
534      my ($fid,$datasets_ref, $attributes_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','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
538    
# Line 531  Line 542 
542                     };                     };
543    
544      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
547          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 553 
553                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
554                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
555                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
556              }              }
557              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
558                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 591 
591  =cut  =cut
592    
593  sub get_pdb_observations{  sub get_pdb_observations{
594      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
595    
596      my $fig = new FIG;      #my $fig = new FIG;
597    
598      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
601          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  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,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
656      my ($dataset);      my ($dataset);
657    
     my %id_list;  
658      foreach my $sim (@sims){      foreach my $sim (@sims){
659          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($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);  
     foreach my $sim (@sims){  
         my $hit = $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 685  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 739  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))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$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 779  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 797  Line 776 
776                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
777                    } @fc_data;                    } @fc_data;
778    
     my ($dataset);  
779      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
780                     'type' => 'fc',                     'type' => 'fc',
781                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 886 
886      return $self->{database};      return $self->{database};
887  }  }
888    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
889  ############################################################  ############################################################
890  ############################################################  ############################################################
891  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 911 
911  =cut  =cut
912    
913  sub display{  sub display{
914      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
915    
916      my $fid = $self->fig_id;      my $fid = $self->fig_id;
917      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 963  Line 935 
935      my $lines = [];      my $lines = [];
936      my $line_data = [];      my $line_data = [];
937      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
938                            'hover_title' => 'PDB',
939                          'short_title' => "best PDB",                          'short_title' => "best PDB",
940                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
941    
942      my $fig = new FIG;      #my $fig = new FIG;
943      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
944      my $fid_stop = length($seq);      my $fid_stop = length($seq);
945    
# Line 1067  Line 1040 
1040    
1041    
1042  sub display_table{  sub display_table{
1043      my ($self) = @_;      my ($self,$fig) = @_;
1044    
1045      my $fig = new FIG;      #my $fig = new FIG;
1046      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1047      my $rows = $self->rows;      my $rows = $self->rows;
1048      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1104 
1104    
1105  sub display_table {  sub display_table {
1106    
1107      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1108      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1109      my $rows = $self->rows;      my $rows = $self->rows;
1110      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1119 
1119          # construct the score link          # construct the score link
1120          my $score = $row->[0];          my $score = $row->[0];
1121          my $toid = $row->[1];          my $toid = $row->[1];
1122          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";
1123          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1124    
1125          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1126          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1219  Line 1192 
1192              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1193          }          }
1194      }      }
1195        elsif($db =~ /PFAM/){
1196            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1197            if(!scalar(@$pfam_objs)){
1198                $name_title = "name";
1199                $name_value = "not available";
1200                $description_title = "description";
1201                $description_value = "not available";
1202            }
1203            else{
1204                my $pfam_obj = $pfam_objs->[0];
1205                $name_title = "name";
1206                $name_value = $pfam_obj->term;
1207                #$description_title = "description";
1208                #$description_value = $pfam_obj->description;
1209            }
1210        }
1211    
1212      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1213                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1214        my $line_config = { 'title' => $name_value,
1215                            'hover_title', => 'Domain',
1216                            'short_title' => $short_title,
1217                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1218    
1219      my $name;      my $name;
1220      $name = {"title" => $name_title,      $name = {"title" => $db,
1221               "value" => $name_value};               "value" => $id};
1222      push(@$descriptions,$name);      push(@$descriptions,$name);
1223    
1224      my $description;  #    my $description;
1225      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1226                               "value" => $description_value};  #                   "value" => $description_value};
1227      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1228    
1229      my $score;      my $score;
1230      $score = {"title" => "score",      $score = {"title" => "score",
1231                "value" => $thing->evalue};                "value" => $thing->evalue};
1232      push(@$descriptions,$score);      push(@$descriptions,$score);
1233    
1234        my $location;
1235        $location = {"title" => "location",
1236                     "value" => $thing->start . " - " . $thing->stop};
1237        push(@$descriptions,$location);
1238    
1239      my $link_id;      my $link_id;
1240      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1241          $link_id = $1;          $link_id = $1;
1242      }      }
1243    
# Line 1255  Line 1252 
1252      push(@$links_list,$link);      push(@$links_list,$link);
1253    
1254      my $element_hash = {      my $element_hash = {
1255          "title" => $thing->type,          "title" => $name_value,
1256          "start" => $thing->start,          "start" => $thing->start,
1257          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1258          "color"=> $color,          "color"=> $color,
# Line 1356  Line 1353 
1353      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1354      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1355      if($cello_location){      if($cello_location){
1356          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1357          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1358      }      }
1359      return ($html);      return ($html);
1360  }  }
1361    
1362  sub display {  sub display {
1363      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1364    
1365      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1366      my $fig= new FIG;      #my $fig= new FIG;
1367      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1368    
1369      my $cleavage_prob;      my $cleavage_prob;
# Line 1394  Line 1391 
1391    
1392          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1393                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1394                                'hover_title' => 'Localization',
1395                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1396    
1397          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1416 
1416          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1417      }      }
1418    
 =cut  
   
1419      $color = "2";      $color = "2";
1420      if($tmpred_score){      if($tmpred_score){
1421          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1445 
1445          }          }
1446          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1447      }      }
1448    =cut
1449    
1450      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1451          my $line_data =[];          my $line_data =[];
1452          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1453                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1454                                'hover_title' => 'Localization',
1455                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1456    
1457          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1458              my $descriptions = [];              my $descriptions = [];
1459              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1460                               "value" => $tm_loc};                               "value" => $tm_loc};
1461              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1462    
1463              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1464    
1465              my $element_hash = {              my $element_hash = {
1466              "title" => "phobius transmembrane location",              "title" => "Phobius",
1467              "start" => $begin + 1,              "start" => $begin + 1,
1468              "end" =>  $end + 1,              "end" =>  $end + 1,
1469              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1497 
1497          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1498      }      }
1499    
1500    =head3
1501      $color = "1";      $color = "1";
1502      if($signal_peptide_score){      if($signal_peptide_score){
1503          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1505 
1505    
1506          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1507                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1508                                'hover_title' => 'Localization',
1509                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1510    
1511          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1530 
1530          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1531          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1532      }      }
1533    =cut
1534    
1535      return ($gd);      return ($gd);
1536    
# Line 1602  Line 1602 
1602      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1603      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1604      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1605        $self->{query} = $dataset->{'query'};
1606      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1607      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1608      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1626 
1626  =cut  =cut
1627    
1628  sub display {  sub display {
1629      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1630        #my $fig = new FIG;
1631    
1632      my $fig = new FIG;      my @ids;
1633      my $peg = $self->acc;      foreach my $thing(@$array){
1634            next if ($thing->class ne "SIM");
1635            push (@ids, $thing->acc);
1636        }
1637    
1638        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1639    
1640        foreach my $thing (@$array){
1641            if ($thing->class eq "SIM"){
1642    
1643                my $peg = $thing->acc;
1644                my $query = $thing->query;
1645    
1646      my $organism = $self->organism;              my $organism = $thing->organism;
1647      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1648      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1649      my $function = $self->function;              my $function = $thing->function;
1650      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1651      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1652      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1653      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1654      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1655    
1656      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1657    
# Line 1655  Line 1668 
1668      my $descriptions = [];      my $descriptions = [];
1669    
1670      # get subsystem information      # get subsystem information
1671      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1672      my $link;      my $link;
1673      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1674               "link" => $url_link};               "link" => $url_link};
1675      push(@$links_list,$link);      push(@$links_list,$link);
1676    
1677      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1678      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1679                my @subsystems;
1680    
1681                foreach my $array (@subs){
1682                    my $subsystem = $$array[0];
1683                    push(@subsystems,$subsystem);
1684          my $link;          my $link;
1685          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1686                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1687          push(@$links_list,$link);          push(@$links_list,$link);
1688      }      }
1689    
1690                $link = {"link_title" => "view blast alignment",
1691                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1692                push (@$links_list,$link);
1693    
1694      my $description_function;      my $description_function;
1695      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1696                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1711 
1711                          "value" => $hit_stop};                          "value" => $hit_stop};
1712      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1713    
1714      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1715      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1716      {      {
1717          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1742 
1742          };          };
1743      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1744      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1745            }
1746        }
1747      return ($gd);      return ($gd);
   
1748  }  }
1749    
1750  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1754 
1754  =cut  =cut
1755    
1756  sub display_domain_composition {  sub display_domain_composition {
1757      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1758    
1759      my $fig = new FIG;      #$fig = new FIG;
1760      my $peg = $self->acc;      my $peg = $self->acc;
1761    
1762      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1764 
1764      my $descriptions = [];      my $descriptions = [];
1765    
1766      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1767        #my @domain_query_results = ();
1768      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1769          my $key = @$dqr[1];          my $key = @$dqr[1];
1770          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1829  Line 1850 
1850      }      }
1851    
1852      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1853                            'hover_title' => 'Domain',
1854                          'short_title' => $peg,                          'short_title' => $peg,
1855                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1856    
# Line 1848  Line 1870 
1870  =cut  =cut
1871    
1872  sub display_table {  sub display_table {
1873      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1874    
1875      my $data = [];      my $data = [];
1876      my $count = 0;      my $count = 0;
1877      my $content;      my $content;
1878      my $fig = new FIG;      #my $fig = new FIG;
1879      my $cgi = new CGI;      my $cgi = new CGI;
1880      my @ids;      my @ids;
1881      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1884 
1884      }      }
1885    
1886      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1887        my @attributes = $fig->get_attributes(\@ids);
1888    
1889      # get the column for the subsystems      # get the column for the subsystems
1890      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1891    
1892      # get the column for the evidence codes      # get the column for the evidence codes
1893      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1894    
1895      # get the column for pfam_domain      # get the column for pfam_domain
1896      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1897    
1898      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1899      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1900        #my $alias_col = {};
1901    
1902      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1903          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1905 
1905          $count++;          $count++;
1906    
1907          my $id = $thing->acc;          my $id = $thing->acc;
1908            my $taxid   = $fig->genome_of($id);
1909          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1910          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1911          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1922 
1922          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1923          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1924          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1925            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1926    
1927          # get the linked fig id          # get the linked fig id
1928          my $fig_col;          my $fig_col;
1929          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1930              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1931          }          }
1932          else{          else{
1933              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1934          }          }
1935    
1936          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1937          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1938          push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
1939          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1940              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1941              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1942              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1943              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1944              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1945              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1946              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1947              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1948              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1949              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1950              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1951              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1952              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1953                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1954                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1955          }          }
1956          push(@$data,$single_domain);          push(@$data,$single_domain);
1957      }      }
   
1958      if ($count >0 ){      if ($count >0 ){
1959          $content = $data;          $content = $data;
1960      }      }
# Line 1955  Line 1976 
1976  }  }
1977    
1978  sub get_subsystems_column{  sub get_subsystems_column{
1979      my ($ids) = @_;      my ($ids,$fig) = @_;
1980    
1981      my $fig = new FIG;      #my $fig = new FIG;
1982      my $cgi = new CGI;      my $cgi = new CGI;
1983      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1984      my %column;      my %column;
# Line 1966  Line 1987 
1987          my @subsystems;          my @subsystems;
1988    
1989          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1990              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1991                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1992                  $count++;                  $ss =~ s/_/ /ig;
1993                    push (@subsystems, "-" . $ss);
1994              }              }
1995              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
1996              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2002 
2002  }  }
2003    
2004  sub get_essentially_identical{  sub get_essentially_identical{
2005      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2006      my $fig = new FIG;      #my $fig = new FIG;
2007    
2008      my %id_list;      my %id_list;
2009      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);
2010    
2011      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2012            if($thing->class eq "IDENTICAL"){
2013                my $rows = $thing->rows;
2014                my $count_identical = 0;
2015                foreach my $row (@$rows) {
2016                    my $id = $row->[0];
2017          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2018              $id_list{$id} = 1;              $id_list{$id} = 1;
2019          }          }
2020      }      }
2021            }
2022        }
2023    
2024    #    foreach my $id (@maps_to) {
2025    #        if (($id ne $fid) && ($fig->function_of($id))) {
2026    #           $id_list{$id} = 1;
2027    #        }
2028    #    }
2029      return(%id_list);      return(%id_list);
2030  }  }
2031    
2032    
2033  sub get_evidence_column{  sub get_evidence_column{
2034      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2035      my $fig = new FIG;      #my $fig = new FIG;
2036      my $cgi = new CGI;      my $cgi = new CGI;
2037      my (%column, %code_attributes);      my (%column, %code_attributes);
2038    
2039      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2040      foreach my $key (@codes){      foreach my $key (@codes){
2041          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2042      }      }
# Line 2010  Line 2044 
2044      foreach my $id (@$ids){      foreach my $id (@$ids){
2045          # add evidence code with tool tip          # add evidence code with tool tip
2046          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2047    
2048          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2049              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2050              foreach my $code (@codes) {              foreach my $code (@codes) {
2051                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2052                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2056 
2056                  }                  }
2057                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2058              }              }
         }  
2059    
2060          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2061              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2039  Line 2069 
2069  }  }
2070    
2071  sub get_pfam_column{  sub get_pfam_column{
2072      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2073      my $fig = new FIG;      #my $fig = new FIG;
2074      my $cgi = new CGI;      my $cgi = new CGI;
2075      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2076      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2077    
2078      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2079      foreach my $key (@codes){      foreach my $key (@codes){
2080          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2081            if ($name =~ /_/){
2082                ($name) = ($key->[1]) =~ /(.*?)_/;
2083            }
2084            push (@{$code_attributes{$key->[0]}}, $name);
2085            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2086      }      }
2087    
2088      foreach my $id (@$ids){      foreach my $id (@$ids){
2089          # add evidence code with tool tip          # add evidence code
2090          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2091          my @pfam_codes = "";          my @pfam_codes = "";
2092          my %description_codes;          my %description_codes;
2093    
2094          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2095              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2096              @pfam_codes = ();              @pfam_codes = ();
2097              foreach my $code (@codes) {  
2098                # get only unique values
2099                my %saw;
2100                foreach my $key (@ncodes) {$saw{$key}=1;}
2101                @ncodes = keys %saw;
2102    
2103                foreach my $code (@ncodes) {
2104                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2105                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2106    
2107                    # get the locations for the domain
2108                    my @locs;
2109                    foreach my $part (@{$attribute_location{$id}{$code}}){
2110                        my ($loc) = ($part) =~ /\;(.*)/;
2111                        push (@locs,$loc);
2112                    }
2113                    my %locsaw;
2114                    foreach my $key (@locs) {$locsaw{$key}=1;}
2115                    @locs = keys %locsaw;
2116    
2117                    my $locations = join (", ", @locs);
2118    
2119                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2120                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2121                  }                  }
2122                  else {                  else {
2123                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2124                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2125                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2126                  }                  }
2127              }              }
2128          }          }
# Line 2080  Line 2133 
2133    
2134  }  }
2135    
2136  sub get_prefer {  sub get_aliases {
2137      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2138    
2139      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2140        foreach my $id (@$ids){
2141            foreach my $alias (@{$$all_aliases{$id}}){
2142          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2143          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2144              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2145          }          }
2146      }      }
2147      return (" ");      return ($aliases);
2148  }  }
2149    
2150  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; $_ }
2151    
2152  sub color {  sub color {
2153      my ($evalue) = @_;      my ($evalue) = @_;
2154        my $palette = WebColors::get_palette('vitamins');
2155      my $color;      my $color;
2156      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2157          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2158      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2159      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2160          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2161      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2162      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2163          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2164      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2165      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){      else{        $color = $palette->[9];    }
         $color = 54;  
     }  
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
     }  
     elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){  
         $color = 56;  
     }  
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
     }  
     elsif (($evalue <= 1) && ($evalue > 1e-5)){  
         $color = 58;  
     }  
     elsif (($evalue <= 10) && ($evalue > 1)){  
         $color = 59;  
     }  
     else{  
         $color = 60;  
     }  
   
   
2166      return ($color);      return ($color);
2167  }  }
2168    
# Line 2152  Line 2182 
2182  }  }
2183    
2184  sub display {  sub display {
2185      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2186    
2187      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2188      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2189      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2190      my $fig = new FIG;      my $range = $gd_window_size;
2191      my $all_regions = [];      my $all_regions = [];
2192      my $gene_associations={};      my $gene_associations={};
2193    
# Line 2182  Line 2212 
2212      my ($region_start, $region_end);      my ($region_start, $region_end);
2213      if ($beg < $end)      if ($beg < $end)
2214      {      {
2215          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2216          $region_end = $end+4000;          $region_end = $end+ ($range);
2217          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2218      }      }
2219      else      else
2220      {      {
2221          $region_start = $end-4000;          $region_start = $end-($range);
2222          $region_end = $beg+4000;          $region_end = $beg+($range);
2223          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2224          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2225          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2227 
2227    
2228      # call genes in region      # call genes in region
2229      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);
2230        #foreach my $feat (@$target_gene_features){
2231        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2232        #}
2233      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2234      my (@start_array_region);      my (@start_array_region);
2235      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2236    
2237      my %all_genes;      my %all_genes;
2238      my %all_genomes;      my %all_genomes;
2239      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2240            #if ($feature =~ /peg/){
2241      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2242      {          #}
         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 = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
2243                  }                  }
2244    
2245                  push (@start_array_region, $offset);      my @selected_sims;
2246    
2247                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
2248          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2249          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2250    
2251          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
2252          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2253              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2254                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2255                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2256                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2257                    #my $genome = $fig->genome_of($sim->[1]);
2258                    my $genome = $fig->genome_of($sim->acc);
2259                    #my ($genome1) = ($genome) =~ /(.*)\./;
2260                    #my $lineage = $taxes->{$genome1};
2261                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2262                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2263                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2264                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2265                            push (@selected_sims, $sim->acc);
2266                      }                      }
2267                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2268              }              }
2269          }          }
2270            else{
2271                my $simcount = 0;
2272                foreach my $sim (@$sims_array){
2273                    next if ($sim->class ne "SIM");
2274                    next if ($sim->acc !~ /fig\|/);
2275    
2276                    push (@selected_sims, $sim->acc);
2277                    $simcount++;
2278                    last if ($simcount > 4);
2279                }
2280            }
2281    
2282            my %saw;
2283            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2284    
2285          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2286          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2304 
2304              my ($region_start, $region_end);              my ($region_start, $region_end);
2305              if ($beg < $end)              if ($beg < $end)
2306              {              {
2307                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2308                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2309                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2310              }              }
2311              else              else
2312              {              {
2313                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2314                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2315                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2316                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2317                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2327 
2327    
2328      }      }
2329    
2330        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2331      # cluster the genes      # cluster the genes
2332      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2333      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2334        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2335        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2336    
2337      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2338          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2339          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2340          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2341          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2342            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2343            #my $lineage = $taxes->{$genome1};
2344            my $lineage = $fig->taxonomy_of($region_genome);
2345            #$region_gs .= "Lineage:$lineage";
2346          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2347                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2348                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2350 
2350    
2351          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2352    
2353          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2354                                     'short_title' => "",                                     'short_title' => "",
2355                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2356                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2374 
2374    
2375              # get subsystem information              # get subsystem information
2376              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2377              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2378    
2379              my $link;              my $link;
2380              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2381                       "link" => $url_link};                       "link" => $url_link};
2382              push(@$links_list,$link);              push(@$links_list,$link);
2383    
2384              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2385              foreach my $subsystem (@subsystems){              my @subsystems;
2386                foreach my $array (@subs){
2387                    my $subsystem = $$array[0];
2388                    my $ss = $subsystem;
2389                    $ss =~ s/_/ /ig;
2390                    push (@subsystems, $ss);
2391                  my $link;                  my $link;
2392                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2393                           "link_title" => $subsystem};                           "link_title" => $ss};
2394                    push(@$links_list,$link);
2395                }
2396    
2397                if ($fid1 eq $fid){
2398                    my $link;
2399                    $link = {"link_title" => "Annotate this sequence",
2400                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2401                  push(@$links_list,$link);                  push(@$links_list,$link);
2402              }              }
2403    
# Line 2406  Line 2436 
2436                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2437                  }                  }
2438    
2439                    my $title = $fid1;
2440                    if ($fid1 eq $fid){
2441                        $title = "My query gene: $fid1";
2442                    }
2443    
2444                  $element_hash = {                  $element_hash = {
2445                      "title" => $fid1,                      "title" => $title,
2446                      "start" => $start,                      "start" => $start,
2447                      "end" =>  $stop,                      "end" =>  $stop,
2448                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2455 
2455                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2456                  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;}
2457                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2458    
2459                    if ($fid1 eq $fid){
2460                        $element_hash = {
2461                            "title" => 'Query',
2462                            "start" => $start,
2463                            "end" =>  $stop,
2464                            "type"=> 'bigbox',
2465                            "color"=> $color,
2466                            "zlayer" => "1"
2467                            };
2468    
2469                        # if there is an overlap, put into second line
2470                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2471                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2472                    }
2473              }              }
2474          }          }
2475          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2476          $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);
2477      }      }
2478      return $gd;      return ($gd, \@selected_sims);
2479  }  }
2480    
2481  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2545 
2545      }      }
2546    
2547      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2548          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2549              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2550                  foreach $y (@$x) {                  foreach $y (@$x) {
2551                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2563 
2563      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2564      return ($i < @$xL);      return ($i < @$xL);
2565  }  }
2566    
2567    #############################################
2568    #############################################
2569    package Observation::Commentary;
2570    
2571    use base qw(Observation);
2572    
2573    =head3 display_protein_commentary()
2574    
2575    =cut
2576    
2577    sub display_protein_commentary {
2578        my ($self,$dataset,$mypeg,$fig) = @_;
2579    
2580        my $all_rows = [];
2581        my $content;
2582        #my $fig = new FIG;
2583        my $cgi = new CGI;
2584        my $count = 0;
2585        my $peg_array = [];
2586        my (%evidence_column, %subsystems_column,  %e_identical);
2587    
2588        if (@$dataset != 1){
2589            foreach my $thing (@$dataset){
2590                if ($thing->class eq "SIM"){
2591                    push (@$peg_array, $thing->acc);
2592                }
2593            }
2594            # get the column for the evidence codes
2595            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2596    
2597            # get the column for the subsystems
2598            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2599    
2600            # get essentially identical seqs
2601            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2602        }
2603        else{
2604            push (@$peg_array, @$dataset);
2605        }
2606    
2607        my $selected_sims = [];
2608        foreach my $id (@$peg_array){
2609            last if ($count > 10);
2610            my $row_data = [];
2611            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2612            $org = $fig->org_of($id);
2613            $function = $fig->function_of($id);
2614            if ($mypeg ne $id){
2615                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2616                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2617                if (defined($e_identical{$id})) { $id_cell .= "*";}
2618            }
2619            else{
2620                $function_cell = "&nbsp;&nbsp;$function";
2621                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2622                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2623            }
2624    
2625            push(@$row_data,$id_cell);
2626            push(@$row_data,$org);
2627            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2628            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2629            push(@$row_data, $fig->translation_length($id));
2630            push(@$row_data,$function_cell);
2631            push(@$all_rows,$row_data);
2632            push (@$selected_sims, $id);
2633            $count++;
2634        }
2635    
2636        if ($count >0){
2637            $content = $all_rows;
2638        }
2639        else{
2640            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2641        }
2642        return ($content,$selected_sims);
2643    }
2644    
2645    sub display_protein_history {
2646        my ($self, $id,$fig) = @_;
2647        my $all_rows = [];
2648        my $content;
2649    
2650        my $cgi = new CGI;
2651        my $count = 0;
2652        foreach my $feat ($fig->feature_annotations($id)){
2653            my $row = [];
2654            my $col1 = $feat->[2];
2655            my $col2 = $feat->[1];
2656            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2657            my $text = $feat->[3];
2658    
2659            push (@$row, $col1);
2660            push (@$row, $col2);
2661            push (@$row, $text);
2662            push (@$all_rows, $row);
2663            $count++;
2664        }
2665        if ($count > 0){
2666            $content = $all_rows;
2667        }
2668        else {
2669            $content = "There is no history for this PEG";
2670        }
2671    
2672        return($content);
2673    }

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.49

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3