[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.39, Thu Sep 13 21:09:40 2007 UTC revision 1.46, Thu Nov 29 19:33:33 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);  
     }  
405    
406      if ( @subsystems ) {      push(@$content, $row);
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\n";  
         }  
     }  
   
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
         }  
   
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
   
   
         $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, $taxes) = @_;      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 ($genome1) = ($genome) =~ /(.*)\./;          my $id      = $thing->acc;
425          my $taxonomy = $taxes->{$genome1};          my $evalue  = $thing->evalue;
426          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated  
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 455  Line 439 
439              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
440              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
441                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($sim->[10] < $families{evalue}{$tax}){
442                      $families{evalue}{$tax} = $sim->[10];                      $families{evalue}{$tax} = $evalue;
443                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                      $families{color}{$tax} = &get_taxcolor($evalue);
444                  }                  }
445              }              }
446              else{              else{
447                  $families{evalue}{$tax} = $sim->[10];                  $families{evalue}{$tax} = $evalue;
448                  $families{color}{$tax} = &get_taxcolor($sim->[10]);                  $families{color}{$tax} = &get_taxcolor($evalue);
449              }              }
450    
451              $parent_tax = $tax;              $parent_tax = $tax;
# Line 506  Line 490 
490  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
491    
492      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
493      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
494    
495      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
496          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
497          my @parts = split("::",$key);          my @parts = split("::",$key);
498          my $class = $parts[0];          my $class = $parts[0];
# Line 550  Line 531 
531    
532  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
533    
534      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
535      my $fig = new FIG;      #my $fig = new FIG;
536    
537      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
538    
# Line 561  Line 542 
542                     };                     };
543    
544      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
547          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 573  Line 553 
553                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
554                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
555                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
556              }              }
557              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
558                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 612  Line 591 
591  =cut  =cut
592    
593  sub get_pdb_observations{  sub get_pdb_observations{
594      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
595    
596      my $fig = new FIG;      #my $fig = new FIG;
597    
598      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
601          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 673  Line 650 
650    
651  sub get_sims_observations{  sub get_sims_observations{
652    
653      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
654      my $fig = new FIG;      #my $fig = new FIG;
655      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
656      my ($dataset);      my ($dataset);
657    
     my %id_list;  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
658      foreach my $sim (@sims){      foreach my $sim (@sims){
659          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($sim->[1]));
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
   
     foreach my $sim (@new_sims){  
660          my $hit = $sim->[1];          my $hit = $sim->[1];
661          my $percent = $sim->[2];          my $percent = $sim->[2];
662          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 715  Line 671 
671          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
672    
673          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
674                        'query' => $sim->[0],
675                      'acc' => $hit,                      'acc' => $hit,
676                      'identity' => $percent,                      'identity' => $percent,
677                      'type' => 'seq',                      'type' => 'seq',
# Line 769  Line 726 
726    
727  sub get_identical_proteins{  sub get_identical_proteins{
728    
729      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
730      my $fig = new FIG;      #my $fig = new FIG;
731      my $funcs_ref;      my $funcs_ref;
732    
 #    my %id_list;  
733      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
734      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
735          my ($tmp, $who);          my ($tmp, $who);
736          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
737              $who = &get_database($id);              $who = &get_database($id);
738              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
739          }          }
740      }      }
741    
     my ($dataset);  
742      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
743                     'type' => 'seq',                     'type' => 'seq',
744                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 809  Line 758 
758    
759  sub get_functional_coupling{  sub get_functional_coupling{
760    
761      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
762      my $fig = new FIG;      #my $fig = new FIG;
763      my @funcs = ();      my @funcs = ();
764    
765      # initialize some variables      # initialize some variables
# Line 969  Line 918 
918  =cut  =cut
919    
920  sub display{  sub display{
921      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
922    
923      my $fid = $self->fig_id;      my $fid = $self->fig_id;
924      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 996  Line 945 
945                          'short_title' => "best PDB",                          'short_title' => "best PDB",
946                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
947    
948      my $fig = new FIG;      #my $fig = new FIG;
949      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
950      my $fid_stop = length($seq);      my $fid_stop = length($seq);
951    
# Line 1097  Line 1046 
1046    
1047    
1048  sub display_table{  sub display_table{
1049      my ($self) = @_;      my ($self,$fig) = @_;
1050    
1051      my $fig = new FIG;      #my $fig = new FIG;
1052      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1053      my $rows = $self->rows;      my $rows = $self->rows;
1054      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1161  Line 1110 
1110    
1111  sub display_table {  sub display_table {
1112    
1113      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1114      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1115      my $rows = $self->rows;      my $rows = $self->rows;
1116      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1176  Line 1125 
1125          # construct the score link          # construct the score link
1126          my $score = $row->[0];          my $score = $row->[0];
1127          my $toid = $row->[1];          my $toid = $row->[1];
1128          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1129          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1130    
1131          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1132          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1249  Line 1198 
1198              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1199          }          }
1200      }      }
1201        elsif($db =~ /PFAM/){
1202            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1203            if(!scalar(@$pfam_objs)){
1204                $name_title = "name";
1205                $name_value = "not available";
1206                $description_title = "description";
1207                $description_value = "not available";
1208            }
1209            else{
1210                my $pfam_obj = $pfam_objs->[0];
1211                $name_title = "name";
1212                $name_value = $pfam_obj->term;
1213                #$description_title = "description";
1214                #$description_value = $pfam_obj->description;
1215            }
1216        }
1217    
1218      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1219                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1220        my $line_config = { 'title' => $name_value,
1221                            'short_title' => $short_title,
1222                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1223    
1224      my $name;      my $name;
1225      $name = {"title" => $name_title,      $name = {"title" => $db,
1226               "value" => $name_value};               "value" => $id};
1227      push(@$descriptions,$name);      push(@$descriptions,$name);
1228    
1229      my $description;  #    my $description;
1230      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1231                               "value" => $description_value};  #                   "value" => $description_value};
1232      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1233    
1234      my $score;      my $score;
1235      $score = {"title" => "score",      $score = {"title" => "score",
1236                "value" => $thing->evalue};                "value" => $thing->evalue};
1237      push(@$descriptions,$score);      push(@$descriptions,$score);
1238    
1239        my $location;
1240        $location = {"title" => "location",
1241                     "value" => $thing->start . " - " . $thing->stop};
1242        push(@$descriptions,$location);
1243    
1244      my $link_id;      my $link_id;
1245      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1246          $link_id = $1;          $link_id = $1;
1247      }      }
1248    
# Line 1285  Line 1257 
1257      push(@$links_list,$link);      push(@$links_list,$link);
1258    
1259      my $element_hash = {      my $element_hash = {
1260          "title" => $thing->type,          "title" => $name_value,
1261          "start" => $thing->start,          "start" => $thing->start,
1262          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1263          "color"=> $color,          "color"=> $color,
# Line 1386  Line 1358 
1358      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1359      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1360      if($cello_location){      if($cello_location){
1361          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1362          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1363      }      }
1364      return ($html);      return ($html);
1365  }  }
1366    
1367  sub display {  sub display {
1368      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1369    
1370      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1371      my $fig= new FIG;      #my $fig= new FIG;
1372      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1373    
1374      my $cleavage_prob;      my $cleavage_prob;
# Line 1448  Line 1420 
1420          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1421      }      }
1422    
 =cut  
   
1423      $color = "2";      $color = "2";
1424      if($tmpred_score){      if($tmpred_score){
1425          my $line_data =[];          my $line_data =[];
# Line 1479  Line 1449 
1449          }          }
1450          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1451      }      }
1452    =cut
1453    
1454      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1455          my $line_data =[];          my $line_data =[];
1456          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1457                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1458                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1459    
1460          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1461              my $descriptions = [];              my $descriptions = [];
1462              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1463                               "value" => $tm_loc};                               "value" => $tm_loc};
1464              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1465    
1466              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1467    
1468              my $element_hash = {              my $element_hash = {
1469              "title" => "phobius transmembrane location",              "title" => "Phobius",
1470              "start" => $begin + 1,              "start" => $begin + 1,
1471              "end" =>  $end + 1,              "end" =>  $end + 1,
1472              "color"=> '6',              "color"=> '6',
# Line 1529  Line 1500 
1500          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1501      }      }
1502    
1503    =head3
1504      $color = "1";      $color = "1";
1505      if($signal_peptide_score){      if($signal_peptide_score){
1506          my $line_data = [];          my $line_data = [];
# Line 1561  Line 1532 
1532          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1533          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1534      }      }
1535    =cut
1536    
1537      return ($gd);      return ($gd);
1538    
# Line 1632  Line 1604 
1604      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1605      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1606      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1607        $self->{query} = $dataset->{'query'};
1608      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1609      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1610      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1655  Line 1628 
1628  =cut  =cut
1629    
1630  sub display {  sub display {
1631      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1632        #my $fig = new FIG;
1633    
1634      my $fig = new FIG;      my @ids;
1635      my $peg = $self->acc;      foreach my $thing(@$array){
1636            next if ($thing->class ne "SIM");
1637            push (@ids, $thing->acc);
1638        }
1639    
1640        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1641    
1642        foreach my $thing (@$array){
1643            if ($thing->class eq "SIM"){
1644    
1645                my $peg = $thing->acc;
1646                my $query = $thing->query;
1647    
1648      my $organism = $self->organism;              my $organism = $thing->organism;
1649      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1650      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1651      my $function = $self->function;              my $function = $thing->function;
1652      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1653      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1654      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1655      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1656      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1657    
1658      my $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;
1659    
# Line 1685  Line 1670 
1670      my $descriptions = [];      my $descriptions = [];
1671    
1672      # get subsystem information      # get subsystem information
1673      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1674      my $link;      my $link;
1675      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1676               "link" => $url_link};               "link" => $url_link};
1677      push(@$links_list,$link);      push(@$links_list,$link);
1678    
1679      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1680      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1681                my @subsystems;
1682    
1683                foreach my $array (@subs){
1684                    my $subsystem = $$array[0];
1685                    push(@subsystems,$subsystem);
1686          my $link;          my $link;
1687          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1688                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1689          push(@$links_list,$link);          push(@$links_list,$link);
1690      }      }
1691    
1692                $link = {"link_title" => "view blast alignment",
1693                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1694                push (@$links_list,$link);
1695    
1696      my $description_function;      my $description_function;
1697      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1698                               "value" => $function};                               "value" => $function};
# Line 1720  Line 1713 
1713                          "value" => $hit_stop};                          "value" => $hit_stop};
1714      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1715    
1716      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1717      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1718      {      {
1719          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1751  Line 1744 
1744          };          };
1745      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1746      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1747            }
1748        }
1749      return ($gd);      return ($gd);
   
1750  }  }
1751    
1752  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1763  Line 1756 
1756  =cut  =cut
1757    
1758  sub display_domain_composition {  sub display_domain_composition {
1759      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1760    
1761      my $fig = new FIG;      #$fig = new FIG;
1762      my $peg = $self->acc;      my $peg = $self->acc;
1763    
1764      my $line_data = [];      my $line_data = [];
# Line 1773  Line 1766 
1766      my $descriptions = [];      my $descriptions = [];
1767    
1768      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1769        #my @domain_query_results = ();
1770      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1771          my $key = @$dqr[1];          my $key = @$dqr[1];
1772          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1878  Line 1871 
1871  =cut  =cut
1872    
1873  sub display_table {  sub display_table {
1874      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1875    
1876      my $data = [];      my $data = [];
1877      my $count = 0;      my $count = 0;
1878      my $content;      my $content;
1879      my $fig = new FIG;      #my $fig = new FIG;
1880      my $cgi = new CGI;      my $cgi = new CGI;
1881      my @ids;      my @ids;
1882      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1892  Line 1885 
1885      }      }
1886    
1887      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1888        my @attributes = $fig->get_attributes(\@ids);
1889    
1890      # get the column for the subsystems      # get the column for the subsystems
1891      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1892    
1893      # get the column for the evidence codes      # get the column for the evidence codes
1894      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1895    
1896      # get the column for pfam_domain      # get the column for pfam_domain
1897      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1898    
1899      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1900      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1901        #my $alias_col = {};
1902    
1903      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1904          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1911  Line 1906 
1906          $count++;          $count++;
1907    
1908          my $id = $thing->acc;          my $id = $thing->acc;
1909            my $taxid   = $fig->genome_of($id);
1910          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1911          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1912          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1928  Line 1923 
1923          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1924          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1925          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1926            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1927    
1928          # get the linked fig id          # get the linked fig id
1929          my $fig_col;          my $fig_col;
1930          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1931              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1932          }          }
1933          else{          else{
1934              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1935          }          }
1936    
1937          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1938          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1939          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  
1940          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1941              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1942              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1943              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1944              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"});}
1945              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"});}
1946              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"});}
1947              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"});}
1948              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"});}
1949              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"});}
1950              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"});}
1951              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"});}
1952              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"});}
1953              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"});}
1954                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1955                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1956          }          }
1957          push(@$data,$single_domain);          push(@$data,$single_domain);
1958      }      }
   
1959      if ($count >0 ){      if ($count >0 ){
1960          $content = $data;          $content = $data;
1961      }      }
# Line 1985  Line 1977 
1977  }  }
1978    
1979  sub get_subsystems_column{  sub get_subsystems_column{
1980      my ($ids) = @_;      my ($ids,$fig) = @_;
1981    
1982      my $fig = new FIG;      #my $fig = new FIG;
1983      my $cgi = new CGI;      my $cgi = new CGI;
1984      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1985      my %column;      my %column;
# Line 1996  Line 1988 
1988          my @subsystems;          my @subsystems;
1989    
1990          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1991              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1992                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1993                  $count++;                  $ss =~ s/_/ /ig;
1994                    push (@subsystems, "-" . $ss);
1995              }              }
1996              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
1997              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 2011  Line 2003 
2003  }  }
2004    
2005  sub get_essentially_identical{  sub get_essentially_identical{
2006      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2007      my $fig = new FIG;      #my $fig = new FIG;
2008    
2009      my %id_list;      my %id_list;
2010      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);
2011    
2012      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2013            if($thing->class eq "IDENTICAL"){
2014                my $rows = $thing->rows;
2015                my $count_identical = 0;
2016                foreach my $row (@$rows) {
2017                    my $id = $row->[0];
2018          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2019              $id_list{$id} = 1;              $id_list{$id} = 1;
2020          }          }
2021      }      }
2022            }
2023        }
2024    
2025    #    foreach my $id (@maps_to) {
2026    #        if (($id ne $fid) && ($fig->function_of($id))) {
2027    #           $id_list{$id} = 1;
2028    #        }
2029    #    }
2030      return(%id_list);      return(%id_list);
2031  }  }
2032    
2033    
2034  sub get_evidence_column{  sub get_evidence_column{
2035      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2036      my $fig = new FIG;      #my $fig = new FIG;
2037      my $cgi = new CGI;      my $cgi = new CGI;
2038      my (%column, %code_attributes);      my (%column, %code_attributes);
2039    
2040      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2041      foreach my $key (@codes){      foreach my $key (@codes){
2042          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2043      }      }
# Line 2040  Line 2045 
2045      foreach my $id (@$ids){      foreach my $id (@$ids){
2046          # add evidence code with tool tip          # add evidence code with tool tip
2047          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2048    
2049          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2050              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2051              foreach my $code (@codes) {              foreach my $code (@codes) {
2052                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2053                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2055  Line 2057 
2057                  }                  }
2058                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2059              }              }
         }  
2060    
2061          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2062              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 2069  Line 2070 
2070  }  }
2071    
2072  sub get_pfam_column{  sub get_pfam_column{
2073      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2074      my $fig = new FIG;      #my $fig = new FIG;
2075      my $cgi = new CGI;      my $cgi = new CGI;
2076      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2077      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2078    
2079      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2080      foreach my $key (@codes){      foreach my $key (@codes){
2081          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2082            if ($name =~ /_/){
2083                ($name) = ($key->[1]) =~ /(.*?)_/;
2084            }
2085            push (@{$code_attributes{$key->[0]}}, $name);
2086            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2087      }      }
2088    
2089      foreach my $id (@$ids){      foreach my $id (@$ids){
2090          # add evidence code with tool tip          # add evidence code
2091          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2092          my @pfam_codes = "";          my @pfam_codes = "";
2093          my %description_codes;          my %description_codes;
2094    
2095          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2096              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2097              @pfam_codes = ();              @pfam_codes = ();
2098              foreach my $code (@codes) {  
2099                # get only unique values
2100                my %saw;
2101                foreach my $key (@ncodes) {$saw{$key}=1;}
2102                @ncodes = keys %saw;
2103    
2104                foreach my $code (@ncodes) {
2105                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2106                  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>";
2107    
2108                    # get the locations for the domain
2109                    my @locs;
2110                    foreach my $part (@{$attribute_location{$id}{$code}}){
2111                        my ($loc) = ($part) =~ /\;(.*)/;
2112                        push (@locs,$loc);
2113                    }
2114                    my %locsaw;
2115                    foreach my $key (@locs) {$locsaw{$key}=1;}
2116                    @locs = keys %locsaw;
2117    
2118                    my $locations = join (", ", @locs);
2119    
2120                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2121                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2122                  }                  }
2123                  else {                  else {
2124                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2125                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2126                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2127                  }                  }
2128              }              }
2129          }          }
# Line 2110  Line 2134 
2134    
2135  }  }
2136    
2137  sub get_prefer {  sub get_aliases {
2138      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2139    
2140      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2141        foreach my $id (@$ids){
2142            foreach my $alias (@{$$all_aliases{$id}}){
2143          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2144          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2145              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2146          }          }
2147      }      }
2148      return (" ");      return ($aliases);
2149  }  }
2150    
2151  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; $_ }
2152    
2153  sub color {  sub color {
2154      my ($evalue) = @_;      my ($evalue) = @_;
2155        my $palette = WebColors::get_palette('vitamins');
2156      my $color;      my $color;
2157      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2158      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2159      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2160      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2161      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2162      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2163      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2164      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2165      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2166      else{        $color = 60;    }      else{        $color = $palette->[9];    }
2167      return ($color);      return ($color);
2168  }  }
2169    
# Line 2159  Line 2183 
2183  }  }
2184    
2185  sub display {  sub display {
2186      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2187    
2188      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2189      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2190      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2191      my $fig = new FIG;      my $range = $gd_window_size;
2192      my $all_regions = [];      my $all_regions = [];
2193      my $gene_associations={};      my $gene_associations={};
2194    
# Line 2189  Line 2213 
2213      my ($region_start, $region_end);      my ($region_start, $region_end);
2214      if ($beg < $end)      if ($beg < $end)
2215      {      {
2216          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2217          $region_end = $end+4000;          $region_end = $end+ ($range);
2218          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2219      }      }
2220      else      else
2221      {      {
2222          $region_start = $end-4000;          $region_start = $end-($range);
2223          $region_end = $beg+4000;          $region_end = $beg+($range);
2224          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2225          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2226          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2204  Line 2228 
2228    
2229      # call genes in region      # call genes in region
2230      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2231        #foreach my $feat (@$target_gene_features){
2232        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2233        #}
2234      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2235      my (@start_array_region);      my (@start_array_region);
2236      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2237    
2238      my %all_genes;      my %all_genes;
2239      my %all_genomes;      my %all_genomes;
2240      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2241            #if ($feature =~ /peg/){
2242      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2243      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($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;  
2244                  }                  }
2245    
2246                  push (@start_array_region, $offset);      my @selected_sims;
2247    
2248                  $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"){  
2249          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2250          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2251    
2252          # 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");  
   
2253          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2254              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2255                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2256                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2257                  my ($genome1) = ($genome) =~ /(.*)\./;  
2258                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
2259                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
2260                    #my ($genome1) = ($genome) =~ /(.*)\./;
2261                    #my $lineage = $taxes->{$genome1};
2262                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2263                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2264                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2265                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2266                            push (@selected_sims, $sim->acc);
2267                      }                      }
2268                  }                  }
2269                  my %saw;              }
2270                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2271            else{
2272                my $simcount = 0;
2273                foreach my $sim (@$sims_array){
2274                    next if ($sim->class ne "SIM");
2275                    next if ($sim->acc !~ /fig\|/);
2276    
2277                    push (@selected_sims, $sim->acc);
2278                    $simcount++;
2279                    last if ($simcount > 4);
2280              }              }
2281          }          }
2282    
2283            my %saw;
2284            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2285    
2286          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2287          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2288              #get the organism genome              #get the organism genome
# Line 2302  Line 2305 
2305              my ($region_start, $region_end);              my ($region_start, $region_end);
2306              if ($beg < $end)              if ($beg < $end)
2307              {              {
2308                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2309                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2310                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2311              }              }
2312              else              else
2313              {              {
2314                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2315                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2316                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2317                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2318                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2325  Line 2328 
2328    
2329      }      }
2330    
2331        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2332      # cluster the genes      # cluster the genes
2333      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2334      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2335        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2336        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2337    
2338      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2339          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2340          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2341          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2342          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2343            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2344            #my $lineage = $taxes->{$genome1};
2345            my $lineage = $fig->taxonomy_of($region_genome);
2346            #$region_gs .= "Lineage:$lineage";
2347          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2348                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2349                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2341  Line 2351 
2351    
2352          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2353    
2354          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2355                                     'short_title' => "",                                     'short_title' => "",
2356                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2357                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2365  Line 2375 
2375    
2376              # get subsystem information              # get subsystem information
2377              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2378              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2379    
2380              my $link;              my $link;
2381              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2382                       "link" => $url_link};                       "link" => $url_link};
2383              push(@$links_list,$link);              push(@$links_list,$link);
2384    
2385              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2386              foreach my $subsystem (@subsystems){              my @subsystems;
2387                foreach my $array (@subs){
2388                    my $subsystem = $$array[0];
2389                    my $ss = $subsystem;
2390                    $ss =~ s/_/ /ig;
2391                    push (@subsystems, $ss);
2392                  my $link;                  my $link;
2393                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2394                           "link_title" => $subsystem};                           "link_title" => $ss};
2395                    push(@$links_list,$link);
2396                }
2397    
2398                if ($fid1 eq $fid){
2399                    my $link;
2400                    $link = {"link_title" => "Annotate this sequence",
2401                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2402                  push(@$links_list,$link);                  push(@$links_list,$link);
2403              }              }
2404    
# Line 2415  Line 2437 
2437                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2438                  }                  }
2439    
2440                    my $title = $fid1;
2441                    if ($fid1 eq $fid){
2442                        $title = "My query gene: $fid1";
2443                    }
2444    
2445                  $element_hash = {                  $element_hash = {
2446                      "title" => $fid1,                      "title" => $title,
2447                      "start" => $start,                      "start" => $start,
2448                      "end" =>  $stop,                      "end" =>  $stop,
2449                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2429  Line 2456 
2456                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2457                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2458                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2459    
2460                    if ($fid1 eq $fid){
2461                        $element_hash = {
2462                            "title" => 'Query',
2463                            "start" => $start,
2464                            "end" =>  $stop,
2465                            "type"=> 'bigbox',
2466                            "color"=> $color,
2467                            "zlayer" => "1"
2468                            };
2469    
2470                        # if there is an overlap, put into second line
2471                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2472                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2473                    }
2474              }              }
2475          }          }
2476          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2477          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2478      }      }
2479      return $gd;      return ($gd, \@selected_sims);
2480  }  }
2481    
2482  sub cluster_genes {  sub cluster_genes {
# Line 2504  Line 2546 
2546      }      }
2547    
2548      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2549          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2550              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2551                  foreach $y (@$x) {                  foreach $y (@$x) {
2552                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2522  Line 2564 
2564      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2565      return ($i < @$xL);      return ($i < @$xL);
2566  }  }
2567    
2568    #############################################
2569    #############################################
2570    package Observation::Commentary;
2571    
2572    use base qw(Observation);
2573    
2574    =head3 display_protein_commentary()
2575    
2576    =cut
2577    
2578    sub display_protein_commentary {
2579        my ($self,$dataset,$mypeg,$fig) = @_;
2580    
2581        my $all_rows = [];
2582        my $content;
2583        #my $fig = new FIG;
2584        my $cgi = new CGI;
2585        my $count = 0;
2586        my $peg_array = [];
2587        my (%evidence_column, %subsystems_column,  %e_identical);
2588    
2589        if (@$dataset != 1){
2590            foreach my $thing (@$dataset){
2591                if ($thing->class eq "SIM"){
2592                    push (@$peg_array, $thing->acc);
2593                }
2594            }
2595            # get the column for the evidence codes
2596            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2597    
2598            # get the column for the subsystems
2599            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2600    
2601            # get essentially identical seqs
2602            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2603        }
2604        else{
2605            push (@$peg_array, @$dataset);
2606        }
2607    
2608        my $selected_sims = [];
2609        foreach my $id (@$peg_array){
2610            last if ($count > 10);
2611            my $row_data = [];
2612            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2613            $org = $fig->org_of($id);
2614            $function = $fig->function_of($id);
2615            if ($mypeg ne $id){
2616                $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";
2617                $id_cell .= &HTML::set_prot_links($cgi,$id);
2618                if (defined($e_identical{$id})) { $id_cell .= "*";}
2619            }
2620            else{
2621                $function_cell = "&nbsp;&nbsp;$function";
2622                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2623                $id_cell .= &HTML::set_prot_links($cgi,$id);
2624            }
2625    
2626            push(@$row_data,$id_cell);
2627            push(@$row_data,$org);
2628            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2629            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2630            push(@$row_data, $fig->translation_length($id));
2631            push(@$row_data,$function_cell);
2632            push(@$all_rows,$row_data);
2633            push (@$selected_sims, $id);
2634            $count++;
2635        }
2636    
2637        if ($count >0){
2638            $content = $all_rows;
2639        }
2640        else{
2641            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2642        }
2643        return ($content,$selected_sims);
2644    }
2645    
2646    sub display_protein_history {
2647        my ($self, $id,$fig) = @_;
2648        my $all_rows = [];
2649        my $content;
2650    
2651        my $cgi = new CGI;
2652        my $count = 0;
2653        foreach my $feat ($fig->feature_annotations($id)){
2654            my $row = [];
2655            my $col1 = $feat->[2];
2656            my $col2 = $feat->[1];
2657            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2658            my $text = $feat->[3];
2659    
2660            push (@$row, $col1);
2661            push (@$row, $col2);
2662            push (@$row, $text);
2663            push (@$all_rows, $row);
2664            $count++;
2665        }
2666        if ($count > 0){
2667            $content = $all_rows;
2668        }
2669        else {
2670            $content = "There is no history for this PEG";
2671        }
2672    
2673        return($content);
2674    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3