[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.47, Mon Dec 3 19:53:00 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);  
     }  
   
     if ( @subsystems ) {  
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\n";  
         }  
     }  
   
     my %groups;  
     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);  
         }  
   
391    
392          $content .= qq(<tr><td>Aliases</td><td><table border="0">);      push (@$row, $org_name);
393          foreach my $key (sort keys %db_aliases){      push (@$row, $fid);
394              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      push (@$row, $length);
395          }      push (@$row, $function);
396          $content .= qq(</td></tr></table>\n);  
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      $content .= qq(</table><p>\n);      push(@$content, $row);
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;  
     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 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 939  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 963  Line 942 
942      my $lines = [];      my $lines = [];
943      my $line_data = [];      my $line_data = [];
944      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
945                            'hover_title' => 'PDB',
946                          'short_title' => "best PDB",                          'short_title' => "best PDB",
947                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
948    
949      my $fig = new FIG;      #my $fig = new FIG;
950      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
951      my $fid_stop = length($seq);      my $fid_stop = length($seq);
952    
# Line 1067  Line 1047 
1047    
1048    
1049  sub display_table{  sub display_table{
1050      my ($self) = @_;      my ($self,$fig) = @_;
1051    
1052      my $fig = new FIG;      #my $fig = new FIG;
1053      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1054      my $rows = $self->rows;      my $rows = $self->rows;
1055      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1111 
1111    
1112  sub display_table {  sub display_table {
1113    
1114      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1115      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1116      my $rows = $self->rows;      my $rows = $self->rows;
1117      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1126 
1126          # construct the score link          # construct the score link
1127          my $score = $row->[0];          my $score = $row->[0];
1128          my $toid = $row->[1];          my $toid = $row->[1];
1129          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1130          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1131    
1132          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1133          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1219  Line 1199 
1199              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1200          }          }
1201      }      }
1202        elsif($db =~ /PFAM/){
1203            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1204            if(!scalar(@$pfam_objs)){
1205                $name_title = "name";
1206                $name_value = "not available";
1207                $description_title = "description";
1208                $description_value = "not available";
1209            }
1210            else{
1211                my $pfam_obj = $pfam_objs->[0];
1212                $name_title = "name";
1213                $name_value = $pfam_obj->term;
1214                #$description_title = "description";
1215                #$description_value = $pfam_obj->description;
1216            }
1217        }
1218    
1219      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1220                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1221        my $line_config = { 'title' => $name_value,
1222                            'hover_title', => 'Domain',
1223                            'short_title' => $short_title,
1224                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1225    
1226      my $name;      my $name;
1227      $name = {"title" => $name_title,      $name = {"title" => $db,
1228               "value" => $name_value};               "value" => $id};
1229      push(@$descriptions,$name);      push(@$descriptions,$name);
1230    
1231      my $description;  #    my $description;
1232      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1233                               "value" => $description_value};  #                   "value" => $description_value};
1234      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1235    
1236      my $score;      my $score;
1237      $score = {"title" => "score",      $score = {"title" => "score",
1238                "value" => $thing->evalue};                "value" => $thing->evalue};
1239      push(@$descriptions,$score);      push(@$descriptions,$score);
1240    
1241        my $location;
1242        $location = {"title" => "location",
1243                     "value" => $thing->start . " - " . $thing->stop};
1244        push(@$descriptions,$location);
1245    
1246      my $link_id;      my $link_id;
1247      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1248          $link_id = $1;          $link_id = $1;
1249      }      }
1250    
# Line 1255  Line 1259 
1259      push(@$links_list,$link);      push(@$links_list,$link);
1260    
1261      my $element_hash = {      my $element_hash = {
1262          "title" => $thing->type,          "title" => $name_value,
1263          "start" => $thing->start,          "start" => $thing->start,
1264          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1265          "color"=> $color,          "color"=> $color,
# Line 1356  Line 1360 
1360      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1361      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1362      if($cello_location){      if($cello_location){
1363          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1364          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1365      }      }
1366      return ($html);      return ($html);
1367  }  }
1368    
1369  sub display {  sub display {
1370      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1371    
1372      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1373      my $fig= new FIG;      #my $fig= new FIG;
1374      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1375    
1376      my $cleavage_prob;      my $cleavage_prob;
# Line 1418  Line 1422 
1422          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1423      }      }
1424    
 =cut  
   
1425      $color = "2";      $color = "2";
1426      if($tmpred_score){      if($tmpred_score){
1427          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1451 
1451          }          }
1452          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1453      }      }
1454    =cut
1455    
1456      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1457          my $line_data =[];          my $line_data =[];
1458          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1459                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1460                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1461    
1462          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1463              my $descriptions = [];              my $descriptions = [];
1464              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1465                               "value" => $tm_loc};                               "value" => $tm_loc};
1466              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1467    
1468              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1469    
1470              my $element_hash = {              my $element_hash = {
1471              "title" => "phobius transmembrane location",              "title" => "Phobius",
1472              "start" => $begin + 1,              "start" => $begin + 1,
1473              "end" =>  $end + 1,              "end" =>  $end + 1,
1474              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1502 
1502          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1503      }      }
1504    
1505    =head3
1506      $color = "1";      $color = "1";
1507      if($signal_peptide_score){      if($signal_peptide_score){
1508          my $line_data = [];          my $line_data = [];
# Line 1531  Line 1534 
1534          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1535          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1536      }      }
1537    =cut
1538    
1539      return ($gd);      return ($gd);
1540    
# Line 1602  Line 1606 
1606      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1607      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1608      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1609        $self->{query} = $dataset->{'query'};
1610      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1611      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1612      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1630 
1630  =cut  =cut
1631    
1632  sub display {  sub display {
1633      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1634        #my $fig = new FIG;
1635    
1636      my $fig = new FIG;      my @ids;
1637      my $peg = $self->acc;      foreach my $thing(@$array){
1638            next if ($thing->class ne "SIM");
1639            push (@ids, $thing->acc);
1640        }
1641    
1642      my $organism = $self->organism;      my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1643    
1644        foreach my $thing (@$array){
1645            if ($thing->class eq "SIM"){
1646    
1647                my $peg = $thing->acc;
1648                my $query = $thing->query;
1649    
1650                my $organism = $thing->organism;
1651      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1652      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1653      my $function = $self->function;              my $function = $thing->function;
1654      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1655      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1656      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1657      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1658      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1659    
1660      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;
1661    
# Line 1655  Line 1672 
1672      my $descriptions = [];      my $descriptions = [];
1673    
1674      # get subsystem information      # get subsystem information
1675      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1676      my $link;      my $link;
1677      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1678               "link" => $url_link};               "link" => $url_link};
1679      push(@$links_list,$link);      push(@$links_list,$link);
1680    
1681      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1682      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1683                my @subsystems;
1684    
1685                foreach my $array (@subs){
1686                    my $subsystem = $$array[0];
1687                    push(@subsystems,$subsystem);
1688          my $link;          my $link;
1689          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1690                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1691          push(@$links_list,$link);          push(@$links_list,$link);
1692      }      }
1693    
1694                $link = {"link_title" => "view blast alignment",
1695                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1696                push (@$links_list,$link);
1697    
1698      my $description_function;      my $description_function;
1699      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1700                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1715 
1715                          "value" => $hit_stop};                          "value" => $hit_stop};
1716      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1717    
1718      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1719      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1720      {      {
1721          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1746 
1746          };          };
1747      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1748      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1749            }
1750        }
1751      return ($gd);      return ($gd);
   
1752  }  }
1753    
1754  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1758 
1758  =cut  =cut
1759    
1760  sub display_domain_composition {  sub display_domain_composition {
1761      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1762    
1763      my $fig = new FIG;      #$fig = new FIG;
1764      my $peg = $self->acc;      my $peg = $self->acc;
1765    
1766      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1768 
1768      my $descriptions = [];      my $descriptions = [];
1769    
1770      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1771        #my @domain_query_results = ();
1772      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1773          my $key = @$dqr[1];          my $key = @$dqr[1];
1774          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1829  Line 1854 
1854      }      }
1855    
1856      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1857                            'hover_title' => 'Domain',
1858                          'short_title' => $peg,                          'short_title' => $peg,
1859                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1860    
# Line 1848  Line 1874 
1874  =cut  =cut
1875    
1876  sub display_table {  sub display_table {
1877      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1878    
1879      my $data = [];      my $data = [];
1880      my $count = 0;      my $count = 0;
1881      my $content;      my $content;
1882      my $fig = new FIG;      #my $fig = new FIG;
1883      my $cgi = new CGI;      my $cgi = new CGI;
1884      my @ids;      my @ids;
1885      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1888 
1888      }      }
1889    
1890      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1891        my @attributes = $fig->get_attributes(\@ids);
1892    
1893      # get the column for the subsystems      # get the column for the subsystems
1894      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1895    
1896      # get the column for the evidence codes      # get the column for the evidence codes
1897      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1898    
1899      # get the column for pfam_domain      # get the column for pfam_domain
1900      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1901    
1902      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1903      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1904        #my $alias_col = {};
1905    
1906      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1907          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1909 
1909          $count++;          $count++;
1910    
1911          my $id = $thing->acc;          my $id = $thing->acc;
1912            my $taxid   = $fig->genome_of($id);
1913          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1914          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1915          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1926 
1926          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1927          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1928          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1929            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1930    
1931          # get the linked fig id          # get the linked fig id
1932          my $fig_col;          my $fig_col;
1933          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1934              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1935          }          }
1936          else{          else{
1937              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1938          }          }
1939    
1940          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1941          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1942          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  
1943          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1944              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1945              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1946              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1947              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"});}
1948              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"});}
1949              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"});}
1950              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"});}
1951              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"});}
1952              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"});}
1953              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"});}
1954              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"});}
1955              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"});}
1956              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"});}
1957                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1958                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1959          }          }
1960          push(@$data,$single_domain);          push(@$data,$single_domain);
1961      }      }
   
1962      if ($count >0 ){      if ($count >0 ){
1963          $content = $data;          $content = $data;
1964      }      }
# Line 1955  Line 1980 
1980  }  }
1981    
1982  sub get_subsystems_column{  sub get_subsystems_column{
1983      my ($ids) = @_;      my ($ids,$fig) = @_;
1984    
1985      my $fig = new FIG;      #my $fig = new FIG;
1986      my $cgi = new CGI;      my $cgi = new CGI;
1987      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1988      my %column;      my %column;
# Line 1966  Line 1991 
1991          my @subsystems;          my @subsystems;
1992    
1993          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1994              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1995                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1996                  $count++;                  $ss =~ s/_/ /ig;
1997                    push (@subsystems, "-" . $ss);
1998              }              }
1999              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2000              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2006 
2006  }  }
2007    
2008  sub get_essentially_identical{  sub get_essentially_identical{
2009      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2010      my $fig = new FIG;      #my $fig = new FIG;
2011    
2012      my %id_list;      my %id_list;
2013      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);
2014    
2015      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2016            if($thing->class eq "IDENTICAL"){
2017                my $rows = $thing->rows;
2018                my $count_identical = 0;
2019                foreach my $row (@$rows) {
2020                    my $id = $row->[0];
2021          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2022              $id_list{$id} = 1;              $id_list{$id} = 1;
2023          }          }
2024      }      }
2025            }
2026        }
2027    
2028    #    foreach my $id (@maps_to) {
2029    #        if (($id ne $fid) && ($fig->function_of($id))) {
2030    #           $id_list{$id} = 1;
2031    #        }
2032    #    }
2033      return(%id_list);      return(%id_list);
2034  }  }
2035    
2036    
2037  sub get_evidence_column{  sub get_evidence_column{
2038      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2039      my $fig = new FIG;      #my $fig = new FIG;
2040      my $cgi = new CGI;      my $cgi = new CGI;
2041      my (%column, %code_attributes);      my (%column, %code_attributes);
2042    
2043      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2044      foreach my $key (@codes){      foreach my $key (@codes){
2045          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2046      }      }
# Line 2010  Line 2048 
2048      foreach my $id (@$ids){      foreach my $id (@$ids){
2049          # add evidence code with tool tip          # add evidence code with tool tip
2050          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2051    
2052          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2053              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2054              foreach my $code (@codes) {              foreach my $code (@codes) {
2055                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2056                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2060 
2060                  }                  }
2061                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2062              }              }
         }  
2063    
2064          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2065              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 2073 
2073  }  }
2074    
2075  sub get_pfam_column{  sub get_pfam_column{
2076      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2077      my $fig = new FIG;      #my $fig = new FIG;
2078      my $cgi = new CGI;      my $cgi = new CGI;
2079      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2080      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2081    
2082      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2083      foreach my $key (@codes){      foreach my $key (@codes){
2084          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2085            if ($name =~ /_/){
2086                ($name) = ($key->[1]) =~ /(.*?)_/;
2087            }
2088            push (@{$code_attributes{$key->[0]}}, $name);
2089            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2090      }      }
2091    
2092      foreach my $id (@$ids){      foreach my $id (@$ids){
2093          # add evidence code with tool tip          # add evidence code
2094          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2095          my @pfam_codes = "";          my @pfam_codes = "";
2096          my %description_codes;          my %description_codes;
2097    
2098          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2099              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2100              @pfam_codes = ();              @pfam_codes = ();
2101              foreach my $code (@codes) {  
2102                # get only unique values
2103                my %saw;
2104                foreach my $key (@ncodes) {$saw{$key}=1;}
2105                @ncodes = keys %saw;
2106    
2107                foreach my $code (@ncodes) {
2108                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2109                  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>";
2110    
2111                    # get the locations for the domain
2112                    my @locs;
2113                    foreach my $part (@{$attribute_location{$id}{$code}}){
2114                        my ($loc) = ($part) =~ /\;(.*)/;
2115                        push (@locs,$loc);
2116                    }
2117                    my %locsaw;
2118                    foreach my $key (@locs) {$locsaw{$key}=1;}
2119                    @locs = keys %locsaw;
2120    
2121                    my $locations = join (", ", @locs);
2122    
2123                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2124                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2125                  }                  }
2126                  else {                  else {
2127                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2128                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2129                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2130                  }                  }
2131              }              }
2132          }          }
# Line 2080  Line 2137 
2137    
2138  }  }
2139    
2140  sub get_prefer {  sub get_aliases {
2141      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2142    
2143      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2144        foreach my $id (@$ids){
2145            foreach my $alias (@{$$all_aliases{$id}}){
2146          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2147          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2148              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2149          }          }
2150      }      }
2151      return (" ");      return ($aliases);
2152  }  }
2153    
2154  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2155    
2156  sub color {  sub color {
2157      my ($evalue) = @_;      my ($evalue) = @_;
2158        my $palette = WebColors::get_palette('vitamins');
2159      my $color;      my $color;
2160      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2161          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2162      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2163      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2164          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2165      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2166      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2167          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2168      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2169      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;  
     }  
   
   
2170      return ($color);      return ($color);
2171  }  }
2172    
# Line 2152  Line 2186 
2186  }  }
2187    
2188  sub display {  sub display {
2189      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2190    
2191      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2192      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2193      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2194      my $fig = new FIG;      my $range = $gd_window_size;
2195      my $all_regions = [];      my $all_regions = [];
2196      my $gene_associations={};      my $gene_associations={};
2197    
# Line 2182  Line 2216 
2216      my ($region_start, $region_end);      my ($region_start, $region_end);
2217      if ($beg < $end)      if ($beg < $end)
2218      {      {
2219          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2220          $region_end = $end+4000;          $region_end = $end+ ($range);
2221          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2222      }      }
2223      else      else
2224      {      {
2225          $region_start = $end-4000;          $region_start = $end-($range);
2226          $region_end = $beg+4000;          $region_end = $beg+($range);
2227          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2228          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2229          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2231 
2231    
2232      # call genes in region      # call genes in region
2233      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2234        #foreach my $feat (@$target_gene_features){
2235        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2236        #}
2237      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2238      my (@start_array_region);      my (@start_array_region);
2239      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2240    
2241      my %all_genes;      my %all_genes;
2242      my %all_genomes;      my %all_genomes;
2243      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2244            #if ($feature =~ /peg/){
2245      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2246      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($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;  
2247                  }                  }
2248    
2249                  push (@start_array_region, $offset);      my @selected_sims;
2250    
2251                  $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"){  
2252          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2253          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2254    
2255          # 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");  
   
2256          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2257              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2258                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2259                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2260                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2261                    #my $genome = $fig->genome_of($sim->[1]);
2262                    my $genome = $fig->genome_of($sim->acc);
2263                    #my ($genome1) = ($genome) =~ /(.*)\./;
2264                    #my $lineage = $taxes->{$genome1};
2265                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2266                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2267                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2268                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2269                            push (@selected_sims, $sim->acc);
2270                      }                      }
2271                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2272              }              }
2273          }          }
2274            else{
2275                my $simcount = 0;
2276                foreach my $sim (@$sims_array){
2277                    next if ($sim->class ne "SIM");
2278                    next if ($sim->acc !~ /fig\|/);
2279    
2280                    push (@selected_sims, $sim->acc);
2281                    $simcount++;
2282                    last if ($simcount > 4);
2283                }
2284            }
2285    
2286            my %saw;
2287            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2288    
2289          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2290          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2308 
2308              my ($region_start, $region_end);              my ($region_start, $region_end);
2309              if ($beg < $end)              if ($beg < $end)
2310              {              {
2311                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2312                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2313                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2314              }              }
2315              else              else
2316              {              {
2317                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2318                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2319                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2320                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2321                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2331 
2331    
2332      }      }
2333    
2334        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2335      # cluster the genes      # cluster the genes
2336      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2337      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2338        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2339        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2340    
2341      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2342          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2343          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2344          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2345          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2346            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2347            #my $lineage = $taxes->{$genome1};
2348            my $lineage = $fig->taxonomy_of($region_genome);
2349            #$region_gs .= "Lineage:$lineage";
2350          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2351                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2352                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2354 
2354    
2355          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2356    
2357          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2358                                     'short_title' => "",                                     'short_title' => "",
2359                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2360                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2378 
2378    
2379              # get subsystem information              # get subsystem information
2380              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2381              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2382    
2383              my $link;              my $link;
2384              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2385                       "link" => $url_link};                       "link" => $url_link};
2386              push(@$links_list,$link);              push(@$links_list,$link);
2387    
2388              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2389              foreach my $subsystem (@subsystems){              my @subsystems;
2390                foreach my $array (@subs){
2391                    my $subsystem = $$array[0];
2392                    my $ss = $subsystem;
2393                    $ss =~ s/_/ /ig;
2394                    push (@subsystems, $ss);
2395                  my $link;                  my $link;
2396                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2397                           "link_title" => $subsystem};                           "link_title" => $ss};
2398                    push(@$links_list,$link);
2399                }
2400    
2401                if ($fid1 eq $fid){
2402                    my $link;
2403                    $link = {"link_title" => "Annotate this sequence",
2404                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2405                  push(@$links_list,$link);                  push(@$links_list,$link);
2406              }              }
2407    
# Line 2406  Line 2440 
2440                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2441                  }                  }
2442    
2443                    my $title = $fid1;
2444                    if ($fid1 eq $fid){
2445                        $title = "My query gene: $fid1";
2446                    }
2447    
2448                  $element_hash = {                  $element_hash = {
2449                      "title" => $fid1,                      "title" => $title,
2450                      "start" => $start,                      "start" => $start,
2451                      "end" =>  $stop,                      "end" =>  $stop,
2452                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2459 
2459                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2460                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2461                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2462    
2463                    if ($fid1 eq $fid){
2464                        $element_hash = {
2465                            "title" => 'Query',
2466                            "start" => $start,
2467                            "end" =>  $stop,
2468                            "type"=> 'bigbox',
2469                            "color"=> $color,
2470                            "zlayer" => "1"
2471                            };
2472    
2473                        # if there is an overlap, put into second line
2474                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2475                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2476                    }
2477              }              }
2478          }          }
2479          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2480          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2481      }      }
2482      return $gd;      return ($gd, \@selected_sims);
2483  }  }
2484    
2485  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2549 
2549      }      }
2550    
2551      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2552          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2553              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2554                  foreach $y (@$x) {                  foreach $y (@$x) {
2555                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2567 
2567      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2568      return ($i < @$xL);      return ($i < @$xL);
2569  }  }
2570    
2571    #############################################
2572    #############################################
2573    package Observation::Commentary;
2574    
2575    use base qw(Observation);
2576    
2577    =head3 display_protein_commentary()
2578    
2579    =cut
2580    
2581    sub display_protein_commentary {
2582        my ($self,$dataset,$mypeg,$fig) = @_;
2583    
2584        my $all_rows = [];
2585        my $content;
2586        #my $fig = new FIG;
2587        my $cgi = new CGI;
2588        my $count = 0;
2589        my $peg_array = [];
2590        my (%evidence_column, %subsystems_column,  %e_identical);
2591    
2592        if (@$dataset != 1){
2593            foreach my $thing (@$dataset){
2594                if ($thing->class eq "SIM"){
2595                    push (@$peg_array, $thing->acc);
2596                }
2597            }
2598            # get the column for the evidence codes
2599            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2600    
2601            # get the column for the subsystems
2602            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2603    
2604            # get essentially identical seqs
2605            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2606        }
2607        else{
2608            push (@$peg_array, @$dataset);
2609        }
2610    
2611        my $selected_sims = [];
2612        foreach my $id (@$peg_array){
2613            last if ($count > 10);
2614            my $row_data = [];
2615            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2616            $org = $fig->org_of($id);
2617            $function = $fig->function_of($id);
2618            if ($mypeg ne $id){
2619                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2620                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2621                if (defined($e_identical{$id})) { $id_cell .= "*";}
2622            }
2623            else{
2624                $function_cell = "&nbsp;&nbsp;$function";
2625                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2626                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2627            }
2628    
2629            push(@$row_data,$id_cell);
2630            push(@$row_data,$org);
2631            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2632            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2633            push(@$row_data, $fig->translation_length($id));
2634            push(@$row_data,$function_cell);
2635            push(@$all_rows,$row_data);
2636            push (@$selected_sims, $id);
2637            $count++;
2638        }
2639    
2640        if ($count >0){
2641            $content = $all_rows;
2642        }
2643        else{
2644            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2645        }
2646        return ($content,$selected_sims);
2647    }
2648    
2649    sub display_protein_history {
2650        my ($self, $id,$fig) = @_;
2651        my $all_rows = [];
2652        my $content;
2653    
2654        my $cgi = new CGI;
2655        my $count = 0;
2656        foreach my $feat ($fig->feature_annotations($id)){
2657            my $row = [];
2658            my $col1 = $feat->[2];
2659            my $col2 = $feat->[1];
2660            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2661            my $text = $feat->[3];
2662    
2663            push (@$row, $col1);
2664            push (@$row, $col2);
2665            push (@$row, $text);
2666            push (@$all_rows, $row);
2667            $count++;
2668        }
2669        if ($count > 0){
2670            $content = $all_rows;
2671        }
2672        else {
2673            $content = "There is no history for this PEG";
2674        }
2675    
2676        return($content);
2677    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3