[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.36, Thu Aug 30 02:42:29 2007 UTC revision 1.50, Thu Dec 6 18:47:35 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);  
391    
392      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      push (@$row, $org_name);
393      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      push (@$row, $fid);
394      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);      push (@$row, $length);
395      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      push (@$row, $function);
396      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
397      $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;      # initialize the table for commentary and annotations
398      $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);      #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399      if ( @ecs ) {      #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400          $content .= qq(<tr><td>EC:</td><td>);      #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401          foreach my $ec ( @ecs ) {      #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402              my $ec_name = $fig->ec_name($ec);      #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403              $content .= join(" -- ", $ec, $ec_name) . "<br>\n";      #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404          }      #$content .= qq(</table><p>\n);
         $content .= qq(</td></tr>\n);  
     }  
   
     if ( @subsystems ) {  
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\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,"all");      #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);
435          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
436              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax);
437                push (@currLineage, $tax);
438              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
439                $families{lineage}{$tax} = join(";", @currLineage);
440                if (defined ($families{evalue}{$tax})){
441                    if ($sim->[10] < $families{evalue}{$tax}){
442                        $families{evalue}{$tax} = $evalue;
443                        $families{color}{$tax} = &get_taxcolor($evalue);
444                    }
445                }
446                else{
447                    $families{evalue}{$tax} = $evalue;
448                    $families{color}{$tax} = &get_taxcolor($evalue);
449                }
450    
451              $parent_tax = $tax;              $parent_tax = $tax;
452          }          }
453      }      }
# Line 470  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 490  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 517  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 528  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 540  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 579  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 640  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,1e-20,"all");      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 682  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 736  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 776  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 794  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 905  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 936  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 960  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 1064  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 1128  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 1143  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 1216  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 1252  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 1353  Line 1364 
1364      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1365      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1366      if($cello_location){      if($cello_location){
1367          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1368          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1369      }      }
1370      return ($html);      return ($html);
1371  }  }
1372    
1373  sub display {  sub display {
1374      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1375    
1376      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1377      my $fig= new FIG;      #my $fig= new FIG;
1378      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1379    
1380      my $cleavage_prob;      my $cleavage_prob;
# Line 1391  Line 1402 
1402    
1403          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1404                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1405                                'hover_title' => 'Localization',
1406                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1407    
1408          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1415  Line 1427 
1427          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1428      }      }
1429    
 =cut  
   
1430      $color = "2";      $color = "2";
1431      if($tmpred_score){      if($tmpred_score){
1432          my $line_data =[];          my $line_data =[];
# Line 1446  Line 1456 
1456          }          }
1457          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1458      }      }
1459    =cut
1460    
1461      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1462          my $line_data =[];          my $line_data =[];
1463          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1464                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1465                                'hover_title' => 'Localization',
1466                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1467    
1468          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1469              my $descriptions = [];              my $descriptions = [];
1470              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1471                               "value" => $tm_loc};                               "value" => $tm_loc};
1472              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1473    
1474              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1475    
1476              my $element_hash = {              my $element_hash = {
1477              "title" => "phobius transmembrane location",              "title" => "Phobius",
1478              "start" => $begin + 1,              "start" => $begin + 1,
1479              "end" =>  $end + 1,              "end" =>  $end + 1,
1480              "color"=> '6',              "color"=> '6',
# Line 1496  Line 1508 
1508          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1509      }      }
1510    
1511    =head3
1512      $color = "1";      $color = "1";
1513      if($signal_peptide_score){      if($signal_peptide_score){
1514          my $line_data = [];          my $line_data = [];
# Line 1504  Line 1516 
1516    
1517          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1518                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1519                                'hover_title' => 'Localization',
1520                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1521    
1522          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1528  Line 1541 
1541          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1542          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1543      }      }
1544    =cut
1545    
1546      return ($gd);      return ($gd);
1547    
# Line 1599  Line 1613 
1613      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1614      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1615      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1616        $self->{query} = $dataset->{'query'};
1617      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1618      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1619      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1622  Line 1637 
1637  =cut  =cut
1638    
1639  sub display {  sub display {
1640      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1641        #my $fig = new FIG;
1642    
1643      my $fig = new FIG;      my @ids;
1644      my $peg = $self->acc;      foreach my $thing(@$array){
1645            next if ($thing->class ne "SIM");
1646            push (@ids, $thing->acc);
1647        }
1648    
1649      my $organism = $self->organism;      my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1650    
1651        foreach my $thing (@$array){
1652            if ($thing->class eq "SIM"){
1653    
1654                my $peg = $thing->acc;
1655                my $query = $thing->query;
1656    
1657                my $organism = $thing->organism;
1658      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1659      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1660      my $function = $self->function;              my $function = $thing->function;
1661      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1662      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1663      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1664      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1665      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1666    
1667      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;
1668    
# Line 1652  Line 1679 
1679      my $descriptions = [];      my $descriptions = [];
1680    
1681      # get subsystem information      # get subsystem information
1682      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1683      my $link;      my $link;
1684      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1685               "link" => $url_link};               "link" => $url_link};
1686      push(@$links_list,$link);      push(@$links_list,$link);
1687    
1688      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1689      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1690                my @subsystems;
1691    
1692                foreach my $array (@subs){
1693                    my $subsystem = $$array[0];
1694                    push(@subsystems,$subsystem);
1695          my $link;          my $link;
1696          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1697                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1698          push(@$links_list,$link);          push(@$links_list,$link);
1699      }      }
1700    
1701                $link = {"link_title" => "view blast alignment",
1702                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1703                push (@$links_list,$link);
1704    
1705      my $description_function;      my $description_function;
1706      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1707                               "value" => $function};                               "value" => $function};
# Line 1687  Line 1722 
1722                          "value" => $hit_stop};                          "value" => $hit_stop};
1723      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1724    
1725      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1726      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1727      {      {
1728          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1718  Line 1753 
1753          };          };
1754      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1755      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1756            }
1757        }
1758      return ($gd);      return ($gd);
   
1759  }  }
1760    
1761  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1730  Line 1765 
1765  =cut  =cut
1766    
1767  sub display_domain_composition {  sub display_domain_composition {
1768      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1769    
1770      my $fig = new FIG;      #$fig = new FIG;
1771      my $peg = $self->acc;      my $peg = $self->acc;
1772    
1773      my $line_data = [];      my $line_data = [];
# Line 1740  Line 1775 
1775      my $descriptions = [];      my $descriptions = [];
1776    
1777      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1778        #my @domain_query_results = ();
1779      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1780          my $key = @$dqr[1];          my $key = @$dqr[1];
1781          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1826  Line 1861 
1861      }      }
1862    
1863      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1864                            'hover_title' => 'Domain',
1865                          'short_title' => $peg,                          'short_title' => $peg,
1866                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1867    
# Line 1845  Line 1881 
1881  =cut  =cut
1882    
1883  sub display_table {  sub display_table {
1884      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1885    
1886      my $data = [];      my $data = [];
1887      my $count = 0;      my $count = 0;
1888      my $content;      my $content;
1889      my $fig = new FIG;      #my $fig = new FIG;
1890      my $cgi = new CGI;      my $cgi = new CGI;
1891      my @ids;      my @ids;
1892      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1859  Line 1895 
1895      }      }
1896    
1897      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1898        my @attributes = $fig->get_attributes(\@ids);
1899    
1900      # get the column for the subsystems      # get the column for the subsystems
1901      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1902    
1903      # get the column for the evidence codes      # get the column for the evidence codes
1904      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1905    
1906      # get the column for pfam_domain      # get the column for pfam_domain
1907      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1908    
1909      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1910      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1911        #my $alias_col = {};
1912    
1913      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1914          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1878  Line 1916 
1916          $count++;          $count++;
1917    
1918          my $id = $thing->acc;          my $id = $thing->acc;
1919            my $taxid   = $fig->genome_of($id);
1920          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1921          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1922          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1895  Line 1933 
1933          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1934          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1935          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');">);
1936            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1937    
1938          # get the linked fig id          # get the linked fig id
1939          my $fig_col;          my $fig_col;
1940          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1941              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1942          }          }
1943          else{          else{
1944              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1945          }          }
1946    
1947          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1948          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1949          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  
1950          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1951              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1952              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1953              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1954              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"});}
1955              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"});}
1956              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"});}
1957              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"});}
1958              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"});}
1959              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"});}
1960              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"});}
1961              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"});}
1962              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"});}
1963              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"});}
1964                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1965                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1966          }          }
1967          push(@$data,$single_domain);          push(@$data,$single_domain);
1968      }      }
   
1969      if ($count >0 ){      if ($count >0 ){
1970          $content = $data;          $content = $data;
1971      }      }
# Line 1952  Line 1987 
1987  }  }
1988    
1989  sub get_subsystems_column{  sub get_subsystems_column{
1990      my ($ids) = @_;      my ($ids,$fig) = @_;
1991    
1992      my $fig = new FIG;      #my $fig = new FIG;
1993      my $cgi = new CGI;      my $cgi = new CGI;
1994      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1995      my %column;      my %column;
# Line 1963  Line 1998 
1998          my @subsystems;          my @subsystems;
1999    
2000          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2001              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2002                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2003                  $count++;                  $ss =~ s/_/ /ig;
2004                    push (@subsystems, "-" . $ss);
2005              }              }
2006              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2007              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1978  Line 2013 
2013  }  }
2014    
2015  sub get_essentially_identical{  sub get_essentially_identical{
2016      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2017      my $fig = new FIG;      #my $fig = new FIG;
2018    
2019      my %id_list;      my %id_list;
2020      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);
2021    
2022      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2023            if($thing->class eq "IDENTICAL"){
2024                my $rows = $thing->rows;
2025                my $count_identical = 0;
2026                foreach my $row (@$rows) {
2027                    my $id = $row->[0];
2028          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2029              $id_list{$id} = 1;              $id_list{$id} = 1;
2030          }          }
2031      }      }
2032            }
2033        }
2034    
2035    #    foreach my $id (@maps_to) {
2036    #        if (($id ne $fid) && ($fig->function_of($id))) {
2037    #           $id_list{$id} = 1;
2038    #        }
2039    #    }
2040      return(%id_list);      return(%id_list);
2041  }  }
2042    
2043    
2044  sub get_evidence_column{  sub get_evidence_column{
2045      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2046      my $fig = new FIG;      #my $fig = new FIG;
2047      my $cgi = new CGI;      my $cgi = new CGI;
2048      my (%column, %code_attributes);      my (%column, %code_attributes);
2049    
2050      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2051      foreach my $key (@codes){      foreach my $key (@codes){
2052          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2053      }      }
# Line 2007  Line 2055 
2055      foreach my $id (@$ids){      foreach my $id (@$ids){
2056          # add evidence code with tool tip          # add evidence code with tool tip
2057          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2058    
2059          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2060              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2061              foreach my $code (@codes) {              foreach my $code (@codes) {
2062                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2063                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2022  Line 2067 
2067                  }                  }
2068                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2069              }              }
         }  
2070    
2071          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2072              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 2036  Line 2080 
2080  }  }
2081    
2082  sub get_pfam_column{  sub get_pfam_column{
2083      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2084      my $fig = new FIG;      #my $fig = new FIG;
2085      my $cgi = new CGI;      my $cgi = new CGI;
2086      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2087      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2088    
2089      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2090      foreach my $key (@codes){      foreach my $key (@codes){
2091          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2092            if ($name =~ /_/){
2093                ($name) = ($key->[1]) =~ /(.*?)_/;
2094            }
2095            push (@{$code_attributes{$key->[0]}}, $name);
2096            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2097      }      }
2098    
2099      foreach my $id (@$ids){      foreach my $id (@$ids){
2100          # add evidence code with tool tip          # add evidence code
2101          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2102          my @pfam_codes = "";          my @pfam_codes = "";
2103          my %description_codes;          my %description_codes;
2104    
2105          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2106              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2107              @pfam_codes = ();              @pfam_codes = ();
2108              foreach my $code (@codes) {  
2109                # get only unique values
2110                my %saw;
2111                foreach my $key (@ncodes) {$saw{$key}=1;}
2112                @ncodes = keys %saw;
2113    
2114                foreach my $code (@ncodes) {
2115                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2116                  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>";
2117    
2118                    # get the locations for the domain
2119                    my @locs;
2120                    foreach my $part (@{$attribute_location{$id}{$code}}){
2121                        my ($loc) = ($part) =~ /\;(.*)/;
2122                        push (@locs,$loc);
2123                    }
2124                    my %locsaw;
2125                    foreach my $key (@locs) {$locsaw{$key}=1;}
2126                    @locs = keys %locsaw;
2127    
2128                    my $locations = join (", ", @locs);
2129    
2130                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2131                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2132                  }                  }
2133                  else {                  else {
2134                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2135                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2136                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2137                  }                  }
2138              }              }
2139          }          }
# Line 2077  Line 2144 
2144    
2145  }  }
2146    
2147  sub get_prefer {  sub get_aliases {
2148      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2149    
2150      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2151        foreach my $id (@$ids){
2152            foreach my $alias (@{$$all_aliases{$id}}){
2153          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2154          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2155              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2156          }          }
2157      }      }
2158      return (" ");      return ($aliases);
2159  }  }
2160    
2161  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; $_ }
2162    
2163  sub color {  sub color {
2164      my ($evalue) = @_;      my ($evalue) = @_;
2165        my $palette = WebColors::get_palette('vitamins');
2166      my $color;      my $color;
2167      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2168          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2169      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2170      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2171          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2172      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2173      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2174          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2175      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2176      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;  
     }  
   
   
2177      return ($color);      return ($color);
2178  }  }
2179    
# Line 2149  Line 2193 
2193  }  }
2194    
2195  sub display {  sub display {
2196      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2197    
2198      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2199      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2200      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2201      my $fig = new FIG;      my $range = $gd_window_size;
2202      my $all_regions = [];      my $all_regions = [];
2203        my $gene_associations={};
2204    
2205      #get the organism genome      #get the organism genome
2206      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2207        $gene_associations->{$fid}->{"organism"} = $target_genome;
2208        $gene_associations->{$fid}->{"main_gene"} = $fid;
2209        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2210    
2211      # get location of the gene      # get location of the gene
2212      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 2175  Line 2223 
2223      my ($region_start, $region_end);      my ($region_start, $region_end);
2224      if ($beg < $end)      if ($beg < $end)
2225      {      {
2226          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2227          $region_end = $end+4000;          $region_end = $end+ ($range);
2228          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2229      }      }
2230      else      else
2231      {      {
2232          $region_start = $end-4000;          $region_start = $end-($range);
2233          $region_end = $beg+4000;          $region_end = $beg+($range);
2234          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2235          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2236            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2237      }      }
2238    
2239      # call genes in region      # call genes in region
2240      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);
2241        #foreach my $feat (@$target_gene_features){
2242        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2243        #}
2244      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2245      my (@start_array_region);      my (@start_array_region);
2246      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2247    
2248      my %all_genes;      my %all_genes;
2249      my %all_genomes;      my %all_genomes;
2250      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}      foreach my $feature (@$target_gene_features){
2251            #if ($feature =~ /peg/){
2252      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2253      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
2254                  }                  }
2255    
2256                  push (@start_array_region, $offset);      my @selected_sims;
2257    
2258                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
2259                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);          # get the selected boxes
2260                  push(@$all_regions,$pair_features);          my @selected_taxonomy = @$selected_taxonomies;
2261                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
2262              }          # get the similarities and store only the ones that match the lineages selected
2263              $coup_count++;          if (@selected_taxonomy > 0){
2264                foreach my $sim (@$sims_array){
2265                    next if ($sim->class ne "SIM");
2266                    next if ($sim->acc !~ /fig\|/);
2267    
2268                    #my $genome = $fig->genome_of($sim->[1]);
2269                    my $genome = $fig->genome_of($sim->acc);
2270                    #my ($genome1) = ($genome) =~ /(.*)\./;
2271                    #my $lineage = $taxes->{$genome1};
2272                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2273                    foreach my $taxon(@selected_taxonomy){
2274                        if ($lineage =~ /$taxon/){
2275                            #push (@selected_sims, $sim->[1]);
2276                            push (@selected_sims, $sim->acc);
2277          }          }
2278      }      }
   
     elsif ($compare_or_coupling eq "close")  
     {  
         # make a hash of genomes that are phylogenetically close  
         #my $close_threshold = ".26";  
         #my @genomes = $fig->genomes('complete');  
         #my %close_genomes = ();  
         #foreach my $compared_genome (@genomes)  
         #{  
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
2279                      }                      }
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = $peg1;  
                     }  
   
                     push (@start_array_region, $offset);  
                     $all_genomes{$pair_genome} = 1;  
                     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;}  
2280                  }                  }
2281            else{
2282                my $simcount = 0;
2283                foreach my $sim (@$sims_array){
2284                    next if ($sim->class ne "SIM");
2285                    next if ($sim->acc !~ /fig\|/);
2286    
2287                    push (@selected_sims, $sim->acc);
2288                    $simcount++;
2289                    last if ($simcount > 4);
2290              }              }
2291          }          }
2292    
2293            my %saw;
2294            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2295    
2296            # get the gene context for the sorted matches
2297            foreach my $sim_fid(@selected_sims){
2298                #get the organism genome
2299                my $sim_genome = $fig->genome_of($sim_fid);
2300                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2301                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2302                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2303    
2304                # get location of the gene
2305                my $data = $fig->feature_location($sim_fid);
2306                my ($contig, $beg, $end);
2307    
2308                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2309                    $contig = $1;
2310                    $beg = $2;
2311                    $end = $3;
2312      }      }
2313    
2314      # get the PCH to each of the genes              my $offset;
2315      my $pch_sets = [];              my ($region_start, $region_end);
2316      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){(next);};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
2317          {          {
2318              foreach my $peg (@$good_set){                  $region_start = $beg - ($range/2);
2319                  if ((!$peg_rank{$peg})){                  $region_end = $end+($range/2);
2320                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2321          }          }
2322          else          else
2323          {          {
2324              foreach my $peg (@$good_set){                  $region_start = $end-($range/2);
2325                  $peg_rank{$peg} = "20";                  $region_end = $beg+($range/2);
2326              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2327                    $reverse_flag{$sim_genome} = $sim_fid;
2328                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2329          }          }
2330    
2331                # call genes in region
2332                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2333                push(@$all_regions,$sim_gene_features);
2334                push (@start_array_region, $offset);
2335                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2336                $all_genomes{$sim_genome} = 1;
2337      }      }
2338    
2339        }
2340    
2341  #    my $bbh_sets = [];      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2342  #    my %already;      # cluster the genes
2343  #    foreach my $gene_key (keys(%all_genes)){      my @all_pegs = keys %all_genes;
2344  #       if($already{$gene_key}){(next);}      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2345  #       my $gene_set = [$gene_key];      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2346  #      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #(next) if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = "20";  
 #           }  
 #       }  
 #    }  
2347    
2348      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2349          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2350          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2351          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2352          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2353            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2354            #my $lineage = $taxes->{$genome1};
2355            my $lineage = $fig->taxonomy_of($region_genome);
2356            #$region_gs .= "Lineage:$lineage";
2357          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2358                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2359                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2415  Line 2361 
2361    
2362          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2363    
2364          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2365                                     'short_title' => "",                                     'short_title' => "",
2366                                     'basepair_offset' => '0'                                     'basepair_offset' => '0',
2367                                       'no_middle_line' => '1'
2368                                     };                                     };
2369    
2370          my $line_data = [];          my $line_data = [];
# Line 2434  Line 2381 
2381              my $links_list = [];              my $links_list = [];
2382              my $descriptions = [];              my $descriptions = [];
2383    
2384              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2385    
2386              # get subsystem information              # get subsystem information
2387              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2388              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2389    
2390              my $link;              my $link;
2391              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2392                       "link" => $url_link};                       "link" => $url_link};
2393              push(@$links_list,$link);              push(@$links_list,$link);
2394    
2395              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2396              foreach my $subsystem (@subsystems){              my @subsystems;
2397                foreach my $array (@subs){
2398                    my $subsystem = $$array[0];
2399                    my $ss = $subsystem;
2400                    $ss =~ s/_/ /ig;
2401                    push (@subsystems, $ss);
2402                  my $link;                  my $link;
2403                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2404                           "link_title" => $subsystem};                           "link_title" => $ss};
2405                    push(@$links_list,$link);
2406                }
2407    
2408                if ($fid1 eq $fid){
2409                    my $link;
2410                    $link = {"link_title" => "Annotate this sequence",
2411                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2412                  push(@$links_list,$link);                  push(@$links_list,$link);
2413              }              }
2414    
# Line 2488  Line 2447 
2447                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2448                  }                  }
2449    
2450                    my $title = $fid1;
2451                    if ($fid1 eq $fid){
2452                        $title = "My query gene: $fid1";
2453                    }
2454    
2455                  $element_hash = {                  $element_hash = {
2456                      "title" => $fid1,                      "title" => $title,
2457                      "start" => $start,                      "start" => $start,
2458                      "end" =>  $stop,                      "end" =>  $stop,
2459                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2503  Line 2467 
2467                  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;}
2468                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2469    
2470                    if ($fid1 eq $fid){
2471                        $element_hash = {
2472                            "title" => 'Query',
2473                            "start" => $start,
2474                            "end" =>  $stop,
2475                            "type"=> 'bigbox',
2476                            "color"=> $color,
2477                            "zlayer" => "1"
2478                            };
2479    
2480                        # if there is an overlap, put into second line
2481                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2482                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2483                    }
2484              }              }
2485          }          }
2486          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2487          $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);
2488      }      }
2489      return $gd;      return ($gd, \@selected_sims);
2490    }
2491    
2492    sub cluster_genes {
2493        my($fig,$all_pegs,$peg) = @_;
2494        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2495    
2496        my @color_sets = ();
2497    
2498        $conn = &get_connections_by_similarity($fig,$all_pegs);
2499    
2500        for ($i=0; ($i < @$all_pegs); $i++) {
2501            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2502            if (! $seen{$i}) {
2503                $cluster = [$i];
2504                $seen{$i} = 1;
2505                for ($j=0; ($j < @$cluster); $j++) {
2506                    $x = $conn->{$cluster->[$j]};
2507                    foreach $k (@$x) {
2508                        if (! $seen{$k}) {
2509                            push(@$cluster,$k);
2510                            $seen{$k} = 1;
2511                        }
2512                    }
2513                }
2514    
2515                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2516                    push(@color_sets,$cluster);
2517                }
2518            }
2519        }
2520        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2521        $red_set = $color_sets[$i];
2522        splice(@color_sets,$i,1);
2523        @color_sets = sort { @$b <=> @$a } @color_sets;
2524        unshift(@color_sets,$red_set);
2525    
2526        my $color_sets = {};
2527        for ($i=0; ($i < @color_sets); $i++) {
2528            foreach $x (@{$color_sets[$i]}) {
2529                $color_sets->{$all_pegs->[$x]} = $i;
2530            }
2531        }
2532        return $color_sets;
2533    }
2534    
2535    sub get_connections_by_similarity {
2536        my($fig,$all_pegs) = @_;
2537        my($i,$j,$tmp,$peg,%pos_of);
2538        my($sim,%conn,$x,$y);
2539    
2540        for ($i=0; ($i < @$all_pegs); $i++) {
2541            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2542            push(@{$pos_of{$tmp}},$i);
2543            if ($tmp ne $all_pegs->[$i]) {
2544                push(@{$pos_of{$all_pegs->[$i]}},$i);
2545            }
2546        }
2547    
2548        foreach $y (keys(%pos_of)) {
2549            $x = $pos_of{$y};
2550            for ($i=0; ($i < @$x); $i++) {
2551                for ($j=$i+1; ($j < @$x); $j++) {
2552                    push(@{$conn{$x->[$i]}},$x->[$j]);
2553                    push(@{$conn{$x->[$j]}},$x->[$i]);
2554                }
2555            }
2556        }
2557    
2558        for ($i=0; ($i < @$all_pegs); $i++) {
2559            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2560                if (defined($x = $pos_of{$sim->id2})) {
2561                    foreach $y (@$x) {
2562                        push(@{$conn{$i}},$y);
2563                    }
2564                }
2565            }
2566        }
2567        return \%conn;
2568    }
2569    
2570    sub in {
2571        my($x,$xL) = @_;
2572        my($i);
2573    
2574        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2575        return ($i < @$xL);
2576    }
2577    
2578    #############################################
2579    #############################################
2580    package Observation::Commentary;
2581    
2582    use base qw(Observation);
2583    
2584    =head3 display_protein_commentary()
2585    
2586    =cut
2587    
2588    sub display_protein_commentary {
2589        my ($self,$dataset,$mypeg,$fig) = @_;
2590    
2591        my $all_rows = [];
2592        my $content;
2593        #my $fig = new FIG;
2594        my $cgi = new CGI;
2595        my $count = 0;
2596        my $peg_array = [];
2597        my (%evidence_column, %subsystems_column,  %e_identical);
2598    
2599        if (@$dataset != 1){
2600            foreach my $thing (@$dataset){
2601                if ($thing->class eq "SIM"){
2602                    push (@$peg_array, $thing->acc);
2603                }
2604            }
2605            # get the column for the evidence codes
2606            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2607    
2608            # get the column for the subsystems
2609            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2610    
2611            # get essentially identical seqs
2612            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2613        }
2614        else{
2615            push (@$peg_array, @$dataset);
2616        }
2617    
2618        my $selected_sims = [];
2619        foreach my $id (@$peg_array){
2620            last if ($count > 10);
2621            my $row_data = [];
2622            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2623            $org = $fig->org_of($id);
2624            $function = $fig->function_of($id);
2625            if ($mypeg ne $id){
2626                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2627                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2628                if (defined($e_identical{$id})) { $id_cell .= "*";}
2629            }
2630            else{
2631                $function_cell = "&nbsp;&nbsp;$function";
2632                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2633                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2634  }  }
2635    
2636            push(@$row_data,$id_cell);
2637            push(@$row_data,$org);
2638            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2639            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2640            push(@$row_data, $fig->translation_length($id));
2641            push(@$row_data,$function_cell);
2642            push(@$all_rows,$row_data);
2643            push (@$selected_sims, $id);
2644            $count++;
2645        }
2646    
2647        if ($count >0){
2648            $content = $all_rows;
2649        }
2650        else{
2651            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2652        }
2653        return ($content,$selected_sims);
2654    }
2655    
2656    sub display_protein_history {
2657        my ($self, $id,$fig) = @_;
2658        my $all_rows = [];
2659        my $content;
2660    
2661        my $cgi = new CGI;
2662        my $count = 0;
2663        foreach my $feat ($fig->feature_annotations($id)){
2664            my $row = [];
2665            my $col1 = $feat->[2];
2666            my $col2 = $feat->[1];
2667            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2668            my $text = $feat->[3];
2669    
2670            push (@$row, $col1);
2671            push (@$row, $col2);
2672            push (@$row, $text);
2673            push (@$all_rows, $row);
2674            $count++;
2675        }
2676        if ($count > 0){
2677            $content = $all_rows;
2678        }
2679        else {
2680            $content = "There is no history for this PEG";
2681        }
2682    
2683        return($content);
2684    }

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.50

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3