[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.51, Thu Dec 6 18:55:37 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];
499            my $name = $parts[1];
500            next if (($class eq "PFAM") && ($name !~ /interpro/));
501    
502          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
503              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 506 
506                  my $from = $2;                  my $from = $2;
507                  my $to = $3;                  my $to = $3;
508                  my $evalue;                  my $evalue;
509                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
510                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
511                      my $part1 = $2/100;                      my $part1 = $2/100;
512                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
513                  }                  }
514                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
515                        $evalue=$raw_evalue;
516                    }
517                  else{                  else{
518                      $evalue = "0.0";                      $evalue = "0.0";
519                  }                  }
# Line 520  Line 536 
536    
537  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
538    
539      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
540      my $fig = new FIG;      #my $fig = new FIG;
541    
542      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
543    
# Line 531  Line 547 
547                     };                     };
548    
549      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
550          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
551          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
552          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 558 
558                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
559                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
560                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
561              }              }
562              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
563                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 596 
596  =cut  =cut
597    
598  sub get_pdb_observations{  sub get_pdb_observations{
599      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
600    
601      my $fig = new FIG;      #my $fig = new FIG;
602    
603      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
604          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
605          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
606          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 655 
655    
656  sub get_sims_observations{  sub get_sims_observations{
657    
658      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
659      my $fig = new FIG;      #my $fig = new FIG;
660      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
661      my ($dataset);      my ($dataset);
662    
     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);  
663      foreach my $sim (@sims){      foreach my $sim (@sims){
664          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){  
665          my $hit = $sim->[1];          my $hit = $sim->[1];
666          my $percent = $sim->[2];          my $percent = $sim->[2];
667          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 676 
676          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
677    
678          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
679                        'query' => $sim->[0],
680                      'acc' => $hit,                      'acc' => $hit,
681                      'identity' => $percent,                      'identity' => $percent,
682                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 731 
731    
732  sub get_identical_proteins{  sub get_identical_proteins{
733    
734      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
735      my $fig = new FIG;      #my $fig = new FIG;
736      my $funcs_ref;      my $funcs_ref;
737    
 #    my %id_list;  
738      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;  
 #    }  
   
739      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
740          my ($tmp, $who);          my ($tmp, $who);
741          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}))) {  
742              $who = &get_database($id);              $who = &get_database($id);
743              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
744          }          }
745      }      }
746    
     my ($dataset);  
747      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
748                     'type' => 'seq',                     'type' => 'seq',
749                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 763 
763    
764  sub get_functional_coupling{  sub get_functional_coupling{
765    
766      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
767      my $fig = new FIG;      #my $fig = new FIG;
768      my @funcs = ();      my @funcs = ();
769    
770      # initialize some variables      # initialize some variables
# Line 797  Line 781 
781                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
782                    } @fc_data;                    } @fc_data;
783    
     my ($dataset);  
784      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
785                     'type' => 'fc',                     'type' => 'fc',
786                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 891 
891      return $self->{database};      return $self->{database};
892  }  }
893    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
894  ############################################################  ############################################################
895  ############################################################  ############################################################
896  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 916 
916  =cut  =cut
917    
918  sub display{  sub display{
919      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
920    
921      my $fid = $self->fig_id;      my $fid = $self->fig_id;
922      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 963  Line 940 
940      my $lines = [];      my $lines = [];
941      my $line_data = [];      my $line_data = [];
942      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
943                            'hover_title' => 'PDB',
944                          'short_title' => "best PDB",                          'short_title' => "best PDB",
945                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
946    
947      my $fig = new FIG;      #my $fig = new FIG;
948      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
949      my $fid_stop = length($seq);      my $fid_stop = length($seq);
950    
# Line 1067  Line 1045 
1045    
1046    
1047  sub display_table{  sub display_table{
1048      my ($self) = @_;      my ($self,$fig) = @_;
1049    
1050      my $fig = new FIG;      #my $fig = new FIG;
1051      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1052      my $rows = $self->rows;      my $rows = $self->rows;
1053      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1109 
1109    
1110  sub display_table {  sub display_table {
1111    
1112      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1113      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1114      my $rows = $self->rows;      my $rows = $self->rows;
1115      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1124 
1124          # construct the score link          # construct the score link
1125          my $score = $row->[0];          my $score = $row->[0];
1126          my $toid = $row->[1];          my $toid = $row->[1];
1127          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";
1128          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1129    
1130          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1131          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1219  Line 1197 
1197              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1198          }          }
1199      }      }
1200        elsif($db =~ /PFAM/){
1201            my ($new_id) = ($id) =~ /(.*?)_/;
1202            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1203            if(!scalar(@$pfam_objs)){
1204                $name_title = "name";
1205                $name_value = "not available";
1206                $description_title = "description";
1207                $description_value = "not available";
1208            }
1209            else{
1210                my $pfam_obj = $pfam_objs->[0];
1211                $name_title = "name";
1212                $name_value = $pfam_obj->term;
1213                #$description_title = "description";
1214                #$description_value = $pfam_obj->description;
1215            }
1216        }
1217    
1218      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1219                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1220        my $new_short_title=$short_title;
1221        if ($short_title =~ /interpro/){
1222            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1223        }
1224        my $line_config = { 'title' => $name_value,
1225                            'hover_title', => 'Domain',
1226                            'short_title' => $new_short_title,
1227                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1228    
1229      my $name;      my $name;
1230      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1231               "value" => $name_value};      $name = {"title" => $db,
1232                 "value" => $new_id};
1233      push(@$descriptions,$name);      push(@$descriptions,$name);
1234    
1235      my $description;  #    my $description;
1236      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1237                               "value" => $description_value};  #                   "value" => $description_value};
1238      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1239    
1240      my $score;      my $score;
1241      $score = {"title" => "score",      $score = {"title" => "score",
1242                "value" => $thing->evalue};                "value" => $thing->evalue};
1243      push(@$descriptions,$score);      push(@$descriptions,$score);
1244    
1245        my $location;
1246        $location = {"title" => "location",
1247                     "value" => $thing->start . " - " . $thing->stop};
1248        push(@$descriptions,$location);
1249    
1250      my $link_id;      my $link_id;
1251      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1252          $link_id = $1;          $link_id = $1;
1253      }      }
1254    
# Line 1255  Line 1263 
1263      push(@$links_list,$link);      push(@$links_list,$link);
1264    
1265      my $element_hash = {      my $element_hash = {
1266          "title" => $thing->type,          "title" => $name_value,
1267          "start" => $thing->start,          "start" => $thing->start,
1268          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1269          "color"=> $color,          "color"=> $color,
# Line 1304  Line 1312 
1312                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1313              }              }
1314          }          }
1315            elsif($db =~ /PFAM/){
1316                my ($new_id) = ($id) =~ /(.*?)_/;
1317                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1318                if(!scalar(@$pfam_objs)){
1319                    $name_title = "name";
1320                    $name_value = "not available";
1321                    $description_title = "description";
1322                    $description_value = "not available";
1323                }
1324                else{
1325                    my $pfam_obj = $pfam_objs->[0];
1326                    $name_title = "name";
1327                    $name_value = $pfam_obj->term;
1328                    #$description_title = "description";
1329                    #$description_value = $pfam_obj->description;
1330                }
1331            }
1332    
1333          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1334    
# Line 1356  Line 1381 
1381      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1382      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1383      if($cello_location){      if($cello_location){
1384          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1385          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1386      }      }
1387      return ($html);      return ($html);
1388  }  }
1389    
1390  sub display {  sub display {
1391      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1392    
1393      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1394      my $fig= new FIG;      #my $fig= new FIG;
1395      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1396    
1397      my $cleavage_prob;      my $cleavage_prob;
# Line 1394  Line 1419 
1419    
1420          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1421                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1422                                'hover_title' => 'Localization',
1423                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1424    
1425          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1444 
1444          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1445      }      }
1446    
 =cut  
   
1447      $color = "2";      $color = "2";
1448      if($tmpred_score){      if($tmpred_score){
1449          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1473 
1473          }          }
1474          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1475      }      }
1476    =cut
1477    
1478      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1479          my $line_data =[];          my $line_data =[];
1480          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1481                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1482                                'hover_title' => 'Localization',
1483                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1484    
1485          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1486              my $descriptions = [];              my $descriptions = [];
1487              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1488                               "value" => $tm_loc};                               "value" => $tm_loc};
1489              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1490    
1491              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1492    
1493              my $element_hash = {              my $element_hash = {
1494              "title" => "phobius transmembrane location",              "title" => "Phobius",
1495              "start" => $begin + 1,              "start" => $begin + 1,
1496              "end" =>  $end + 1,              "end" =>  $end + 1,
1497              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1525 
1525          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1526      }      }
1527    
1528    =head3
1529      $color = "1";      $color = "1";
1530      if($signal_peptide_score){      if($signal_peptide_score){
1531          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1533 
1533    
1534          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1535                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1536                                'hover_title' => 'Localization',
1537                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1538    
1539          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1558 
1558          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1559          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1560      }      }
1561    =cut
1562    
1563      return ($gd);      return ($gd);
1564    
# Line 1602  Line 1630 
1630      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1631      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1632      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1633        $self->{query} = $dataset->{'query'};
1634      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1635      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1636      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1654 
1654  =cut  =cut
1655    
1656  sub display {  sub display {
1657      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1658        #my $fig = new FIG;
1659    
1660      my $fig = new FIG;      my @ids;
1661      my $peg = $self->acc;      foreach my $thing(@$array){
1662            next if ($thing->class ne "SIM");
1663            push (@ids, $thing->acc);
1664        }
1665    
1666        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1667    
1668        foreach my $thing (@$array){
1669            if ($thing->class eq "SIM"){
1670    
1671                my $peg = $thing->acc;
1672                my $query = $thing->query;
1673    
1674      my $organism = $self->organism;              my $organism = $thing->organism;
1675      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1676      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1677      my $function = $self->function;              my $function = $thing->function;
1678      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1679      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1680      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1681      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1682      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1683    
1684      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;
1685    
# Line 1655  Line 1696 
1696      my $descriptions = [];      my $descriptions = [];
1697    
1698      # get subsystem information      # get subsystem information
1699      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1700      my $link;      my $link;
1701      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1702               "link" => $url_link};               "link" => $url_link};
1703      push(@$links_list,$link);      push(@$links_list,$link);
1704    
1705      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1706      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1707                my @subsystems;
1708    
1709                foreach my $array (@subs){
1710                    my $subsystem = $$array[0];
1711                    push(@subsystems,$subsystem);
1712          my $link;          my $link;
1713          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1714                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1715          push(@$links_list,$link);          push(@$links_list,$link);
1716      }      }
1717    
1718                $link = {"link_title" => "view blast alignment",
1719                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1720                push (@$links_list,$link);
1721    
1722      my $description_function;      my $description_function;
1723      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1724                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1739 
1739                          "value" => $hit_stop};                          "value" => $hit_stop};
1740      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1741    
1742      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1743      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1744      {      {
1745          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1770 
1770          };          };
1771      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1772      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1773            }
1774        }
1775      return ($gd);      return ($gd);
   
1776  }  }
1777    
1778  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1782 
1782  =cut  =cut
1783    
1784  sub display_domain_composition {  sub display_domain_composition {
1785      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1786    
1787      my $fig = new FIG;      #$fig = new FIG;
1788      my $peg = $self->acc;      my $peg = $self->acc;
1789    
1790      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1792 
1792      my $descriptions = [];      my $descriptions = [];
1793    
1794      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1795        #my @domain_query_results = ();
1796      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1797          my $key = @$dqr[1];          my $key = @$dqr[1];
1798          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1829  Line 1878 
1878      }      }
1879    
1880      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1881                            'hover_title' => 'Domain',
1882                          'short_title' => $peg,                          'short_title' => $peg,
1883                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1884    
# Line 1848  Line 1898 
1898  =cut  =cut
1899    
1900  sub display_table {  sub display_table {
1901      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1902    
1903      my $data = [];      my $data = [];
1904      my $count = 0;      my $count = 0;
1905      my $content;      my $content;
1906      my $fig = new FIG;      #my $fig = new FIG;
1907      my $cgi = new CGI;      my $cgi = new CGI;
1908      my @ids;      my @ids;
1909      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1912 
1912      }      }
1913    
1914      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1915        my @attributes = $fig->get_attributes(\@ids);
1916    
1917      # get the column for the subsystems      # get the column for the subsystems
1918      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1919    
1920      # get the column for the evidence codes      # get the column for the evidence codes
1921      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1922    
1923      # get the column for pfam_domain      # get the column for pfam_domain
1924      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1925    
1926      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1927      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1928        #my $alias_col = {};
1929    
1930      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1931          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1933 
1933          $count++;          $count++;
1934    
1935          my $id = $thing->acc;          my $id = $thing->acc;
1936            my $taxid   = $fig->genome_of($id);
1937          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1938          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1939          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1950 
1950          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1951          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1952          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');">);
1953            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1954    
1955          # get the linked fig id          # get the linked fig id
1956          my $fig_col;          my $fig_col;
1957          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1958              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1959          }          }
1960          else{          else{
1961              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1962          }          }
1963    
1964          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1965          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1966          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  
1967          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1968              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1969              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1970              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1971              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"});}
1972              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"});}
1973              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"});}
1974              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"});}
1975              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"});}
1976              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"});}
1977              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"});}
1978              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"});}
1979              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"});}
1980              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"});}
1981                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1982                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1983          }          }
1984          push(@$data,$single_domain);          push(@$data,$single_domain);
1985      }      }
   
1986      if ($count >0 ){      if ($count >0 ){
1987          $content = $data;          $content = $data;
1988      }      }
# Line 1955  Line 2004 
2004  }  }
2005    
2006  sub get_subsystems_column{  sub get_subsystems_column{
2007      my ($ids) = @_;      my ($ids,$fig) = @_;
2008    
2009      my $fig = new FIG;      #my $fig = new FIG;
2010      my $cgi = new CGI;      my $cgi = new CGI;
2011      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2012      my %column;      my %column;
# Line 1966  Line 2015 
2015          my @subsystems;          my @subsystems;
2016    
2017          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2018              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2019                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2020                  $count++;                  $ss =~ s/_/ /ig;
2021                    push (@subsystems, "-" . $ss);
2022              }              }
2023              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2024              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2030 
2030  }  }
2031    
2032  sub get_essentially_identical{  sub get_essentially_identical{
2033      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2034      my $fig = new FIG;      #my $fig = new FIG;
2035    
2036      my %id_list;      my %id_list;
2037      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);
2038    
2039      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2040            if($thing->class eq "IDENTICAL"){
2041                my $rows = $thing->rows;
2042                my $count_identical = 0;
2043                foreach my $row (@$rows) {
2044                    my $id = $row->[0];
2045          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2046              $id_list{$id} = 1;              $id_list{$id} = 1;
2047          }          }
2048      }      }
2049            }
2050        }
2051    
2052    #    foreach my $id (@maps_to) {
2053    #        if (($id ne $fid) && ($fig->function_of($id))) {
2054    #           $id_list{$id} = 1;
2055    #        }
2056    #    }
2057      return(%id_list);      return(%id_list);
2058  }  }
2059    
2060    
2061  sub get_evidence_column{  sub get_evidence_column{
2062      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2063      my $fig = new FIG;      #my $fig = new FIG;
2064      my $cgi = new CGI;      my $cgi = new CGI;
2065      my (%column, %code_attributes);      my (%column, %code_attributes);
2066    
2067      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2068      foreach my $key (@codes){      foreach my $key (@codes){
2069          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2070      }      }
# Line 2010  Line 2072 
2072      foreach my $id (@$ids){      foreach my $id (@$ids){
2073          # add evidence code with tool tip          # add evidence code with tool tip
2074          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2075    
2076          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2077              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2078              foreach my $code (@codes) {              foreach my $code (@codes) {
2079                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2080                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2084 
2084                  }                  }
2085                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2086              }              }
         }  
2087    
2088          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2089              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 2097 
2097  }  }
2098    
2099  sub get_pfam_column{  sub get_pfam_column{
2100      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2101      my $fig = new FIG;      #my $fig = new FIG;
2102      my $cgi = new CGI;      my $cgi = new CGI;
2103      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2104      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2105    
2106      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2107      foreach my $key (@codes){      foreach my $key (@codes){
2108          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2109            if ($name =~ /_/){
2110                ($name) = ($key->[1]) =~ /(.*?)_/;
2111            }
2112            push (@{$code_attributes{$key->[0]}}, $name);
2113            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2114      }      }
2115    
2116      foreach my $id (@$ids){      foreach my $id (@$ids){
2117          # add evidence code with tool tip          # add evidence code
2118          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2119          my @pfam_codes = "";          my @pfam_codes = "";
2120          my %description_codes;          my %description_codes;
2121    
2122          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2123              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2124              @pfam_codes = ();              @pfam_codes = ();
2125              foreach my $code (@codes) {  
2126                # get only unique values
2127                my %saw;
2128                foreach my $key (@ncodes) {$saw{$key}=1;}
2129                @ncodes = keys %saw;
2130    
2131                foreach my $code (@ncodes) {
2132                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2133                  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>";
2134    
2135                    # get the locations for the domain
2136                    my @locs;
2137                    foreach my $part (@{$attribute_location{$id}{$code}}){
2138                        my ($loc) = ($part) =~ /\;(.*)/;
2139                        push (@locs,$loc);
2140                    }
2141                    my %locsaw;
2142                    foreach my $key (@locs) {$locsaw{$key}=1;}
2143                    @locs = keys %locsaw;
2144    
2145                    my $locations = join (", ", @locs);
2146    
2147                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2148                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2149                  }                  }
2150                  else {                  else {
2151                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2152                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2153                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2154                  }                  }
2155              }              }
2156          }          }
# Line 2080  Line 2161 
2161    
2162  }  }
2163    
2164  sub get_prefer {  sub get_aliases {
2165      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2166    
2167      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2168        foreach my $id (@$ids){
2169            foreach my $alias (@{$$all_aliases{$id}}){
2170          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2171          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2172              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2173          }          }
2174      }      }
2175      return (" ");      return ($aliases);
2176  }  }
2177    
2178  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; $_ }
2179    
2180  sub color {  sub color {
2181      my ($evalue) = @_;      my ($evalue) = @_;
2182        my $palette = WebColors::get_palette('vitamins');
2183      my $color;      my $color;
2184      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2185          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2186      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2187      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2188          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2189      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2190      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2191          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2192      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2193      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;  
     }  
   
   
2194      return ($color);      return ($color);
2195  }  }
2196    
# Line 2152  Line 2210 
2210  }  }
2211    
2212  sub display {  sub display {
2213      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2214    
2215      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2216      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2217      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2218      my $fig = new FIG;      my $range = $gd_window_size;
2219      my $all_regions = [];      my $all_regions = [];
2220      my $gene_associations={};      my $gene_associations={};
2221    
# Line 2182  Line 2240 
2240      my ($region_start, $region_end);      my ($region_start, $region_end);
2241      if ($beg < $end)      if ($beg < $end)
2242      {      {
2243          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2244          $region_end = $end+4000;          $region_end = $end+ ($range);
2245          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2246      }      }
2247      else      else
2248      {      {
2249          $region_start = $end-4000;          $region_start = $end-($range);
2250          $region_end = $beg+4000;          $region_end = $beg+($range);
2251          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2252          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2253          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2255 
2255    
2256      # call genes in region      # call genes in region
2257      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);
2258        #foreach my $feat (@$target_gene_features){
2259        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2260        #}
2261      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2262      my (@start_array_region);      my (@start_array_region);
2263      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2264    
2265      my %all_genes;      my %all_genes;
2266      my %all_genomes;      my %all_genomes;
2267      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2268            #if ($feature =~ /peg/){
2269      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2270      {          #}
         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;  
2271                  }                  }
2272    
2273                  push (@start_array_region, $offset);      my @selected_sims;
2274    
2275                  $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"){  
2276          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2277          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2278    
2279          # 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");  
   
2280          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2281              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2282                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2283                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2284                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2285                    #my $genome = $fig->genome_of($sim->[1]);
2286                    my $genome = $fig->genome_of($sim->acc);
2287                    #my ($genome1) = ($genome) =~ /(.*)\./;
2288                    #my $lineage = $taxes->{$genome1};
2289                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2290                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2291                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2292                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2293                            push (@selected_sims, $sim->acc);
2294                      }                      }
2295                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2296              }              }
2297          }          }
2298            else{
2299                my $simcount = 0;
2300                foreach my $sim (@$sims_array){
2301                    next if ($sim->class ne "SIM");
2302                    next if ($sim->acc !~ /fig\|/);
2303    
2304                    push (@selected_sims, $sim->acc);
2305                    $simcount++;
2306                    last if ($simcount > 4);
2307                }
2308            }
2309    
2310            my %saw;
2311            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2312    
2313          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2314          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2332 
2332              my ($region_start, $region_end);              my ($region_start, $region_end);
2333              if ($beg < $end)              if ($beg < $end)
2334              {              {
2335                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2336                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2337                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2338              }              }
2339              else              else
2340              {              {
2341                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2342                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2343                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2344                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2345                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2355 
2355    
2356      }      }
2357    
2358        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2359      # cluster the genes      # cluster the genes
2360      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2361      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2362        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2363        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2364    
2365      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2366          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2367          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2368          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2369          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2370            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2371            #my $lineage = $taxes->{$genome1};
2372            my $lineage = $fig->taxonomy_of($region_genome);
2373            #$region_gs .= "Lineage:$lineage";
2374          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2375                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2376                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2378 
2378    
2379          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2380    
2381          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2382                                     'short_title' => "",                                     'short_title' => "",
2383                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2384                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2402 
2402    
2403              # get subsystem information              # get subsystem information
2404              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2405              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2406    
2407              my $link;              my $link;
2408              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2409                       "link" => $url_link};                       "link" => $url_link};
2410              push(@$links_list,$link);              push(@$links_list,$link);
2411    
2412              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2413              foreach my $subsystem (@subsystems){              my @subsystems;
2414                foreach my $array (@subs){
2415                    my $subsystem = $$array[0];
2416                    my $ss = $subsystem;
2417                    $ss =~ s/_/ /ig;
2418                    push (@subsystems, $ss);
2419                  my $link;                  my $link;
2420                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2421                           "link_title" => $subsystem};                           "link_title" => $ss};
2422                    push(@$links_list,$link);
2423                }
2424    
2425                if ($fid1 eq $fid){
2426                    my $link;
2427                    $link = {"link_title" => "Annotate this sequence",
2428                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2429                  push(@$links_list,$link);                  push(@$links_list,$link);
2430              }              }
2431    
# Line 2406  Line 2464 
2464                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2465                  }                  }
2466    
2467                    my $title = $fid1;
2468                    if ($fid1 eq $fid){
2469                        $title = "My query gene: $fid1";
2470                    }
2471    
2472                  $element_hash = {                  $element_hash = {
2473                      "title" => $fid1,                      "title" => $title,
2474                      "start" => $start,                      "start" => $start,
2475                      "end" =>  $stop,                      "end" =>  $stop,
2476                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2483 
2483                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2484                  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;}
2485                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2486    
2487                    if ($fid1 eq $fid){
2488                        $element_hash = {
2489                            "title" => 'Query',
2490                            "start" => $start,
2491                            "end" =>  $stop,
2492                            "type"=> 'bigbox',
2493                            "color"=> $color,
2494                            "zlayer" => "1"
2495                            };
2496    
2497                        # if there is an overlap, put into second line
2498                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2499                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2500                    }
2501              }              }
2502          }          }
2503          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2504          $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);
2505      }      }
2506      return $gd;      return ($gd, \@selected_sims);
2507  }  }
2508    
2509  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2573 
2573      }      }
2574    
2575      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2576          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2577              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2578                  foreach $y (@$x) {                  foreach $y (@$x) {
2579                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2591 
2591      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2592      return ($i < @$xL);      return ($i < @$xL);
2593  }  }
2594    
2595    #############################################
2596    #############################################
2597    package Observation::Commentary;
2598    
2599    use base qw(Observation);
2600    
2601    =head3 display_protein_commentary()
2602    
2603    =cut
2604    
2605    sub display_protein_commentary {
2606        my ($self,$dataset,$mypeg,$fig) = @_;
2607    
2608        my $all_rows = [];
2609        my $content;
2610        #my $fig = new FIG;
2611        my $cgi = new CGI;
2612        my $count = 0;
2613        my $peg_array = [];
2614        my (%evidence_column, %subsystems_column,  %e_identical);
2615    
2616        if (@$dataset != 1){
2617            foreach my $thing (@$dataset){
2618                if ($thing->class eq "SIM"){
2619                    push (@$peg_array, $thing->acc);
2620                }
2621            }
2622            # get the column for the evidence codes
2623            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2624    
2625            # get the column for the subsystems
2626            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2627    
2628            # get essentially identical seqs
2629            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2630        }
2631        else{
2632            push (@$peg_array, @$dataset);
2633        }
2634    
2635        my $selected_sims = [];
2636        foreach my $id (@$peg_array){
2637            last if ($count > 10);
2638            my $row_data = [];
2639            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2640            $org = $fig->org_of($id);
2641            $function = $fig->function_of($id);
2642            if ($mypeg ne $id){
2643                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2644                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2645                if (defined($e_identical{$id})) { $id_cell .= "*";}
2646            }
2647            else{
2648                $function_cell = "&nbsp;&nbsp;$function";
2649                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2650                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2651            }
2652    
2653            push(@$row_data,$id_cell);
2654            push(@$row_data,$org);
2655            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2656            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2657            push(@$row_data, $fig->translation_length($id));
2658            push(@$row_data,$function_cell);
2659            push(@$all_rows,$row_data);
2660            push (@$selected_sims, $id);
2661            $count++;
2662        }
2663    
2664        if ($count >0){
2665            $content = $all_rows;
2666        }
2667        else{
2668            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2669        }
2670        return ($content,$selected_sims);
2671    }
2672    
2673    sub display_protein_history {
2674        my ($self, $id,$fig) = @_;
2675        my $all_rows = [];
2676        my $content;
2677    
2678        my $cgi = new CGI;
2679        my $count = 0;
2680        foreach my $feat ($fig->feature_annotations($id)){
2681            my $row = [];
2682            my $col1 = $feat->[2];
2683            my $col2 = $feat->[1];
2684            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2685            my $text = $feat->[3];
2686    
2687            push (@$row, $col1);
2688            push (@$row, $col2);
2689            push (@$row, $text);
2690            push (@$all_rows, $row);
2691            $count++;
2692        }
2693        if ($count > 0){
2694            $content = $all_rows;
2695        }
2696        else {
2697            $content = "There is no history for this PEG";
2698        }
2699    
2700        return($content);
2701    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3