[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38, Mon Sep 10 15:10:04 2007 UTC revision 1.43, Tue Oct 16 15:38:50 2007 UTC
# Line 86  Line 86 
86    return $self->{acc};    return $self->{acc};
87  }  }
88    
89    =head3 query()
90    
91    The query id
92    
93    =cut
94    
95    sub query {
96        my ($self) = @_;
97        return $self->{query};
98    }
99    
100    
101  =head3 class()  =head3 class()
102    
103  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 317 
317  =cut  =cut
318    
319  sub get_objects {  sub get_objects {
320      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
321    
322      my $objects = [];      my $objects = [];
323      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
324    
325      # call function that fetches attribute based observations      # call function that fetches attribute based observations
326      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 332 
332          my %domain_classes;          my %domain_classes;
333          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
334          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
335          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
336          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
337          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
338          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
339          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
340          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
341            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
342      }      }
343    
344      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 346 
346          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
347              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
348          }          }
349          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
350              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
351          }          }
352          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
353              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
356              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
359              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
362              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
365              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
366          }          }
367    
# Line 365  Line 377 
377    
378  =cut  =cut
379  sub display_housekeeping {  sub display_housekeeping {
380      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
381      my $fig = new FIG;      my $content = [];
382      my $content;      my $row = [];
383    
384      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
     my $org_id   = $fig->orgid_of_orgname($org_name);  
     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);  
385      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
386      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
387      my $taxonomy = $fig->taxonomy_of($org_id);      my $length = $fig->translation_length($fid);
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
   
     $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);  
     $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);  
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
   
     if ( @subsystems ) {  
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\n";  
         }  
     }  
   
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
         }  
   
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
388    
389        push (@$row, $org_name);
390        push (@$row, $fid);
391        push (@$row, $length);
392        push (@$row, $function);
393    
394        # initialize the table for commentary and annotations
395        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
396        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
397        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
398        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
399        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
400        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
401        #$content .= qq(</table><p>\n);
402    
403          $content .= qq(<tr><td>Aliases</td><td><table border="0">);      push(@$content, $row);
         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);  
404    
405      return ($content);      return ($content);
406  }  }
# Line 435  Line 411 
411  =cut  =cut
412    
413  sub get_sims_summary {  sub get_sims_summary {
414      my ($observation, $fid) = @_;      my ($observation, $fid, $taxes, $dataset, $fig) = @_;
     my $fig = new FIG;  
415      my %families;      my %families;
416      my @sims= $fig->nsims($fid,20000,10,"fig");      #my @sims= $fig->nsims($fid,20000,10,"fig");
417    
418      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
419          next if ($sim->[1] !~ /fig\|/);          next if ($thing->class ne "SIM");
420          my $genome = $fig->genome_of($sim->[1]);  
421          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));          my $id      = $thing->acc;
422            my $evalue  = $thing->evalue;
423    
424            next if ($id !~ /fig\|/);
425            next if ($fig->is_deleted_fid($id));
426            my $genome = $fig->genome_of($id);
427            my ($genome1) = ($genome) =~ /(.*)\./;
428            my $taxonomy = $taxes->{$genome1};
429            #my $taxonomy = $fig->taxonomy_of($fig->genome_of($id)); # use this if the taxonomies have been updated
430          my $parent_tax = "Root";          my $parent_tax = "Root";
431          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
432          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 451  Line 434 
434              push (@currLineage, $tax);              push (@currLineage, $tax);
435              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
436              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
437                if (defined ($families{evalue}{$tax})){
438                    if ($sim->[10] < $families{evalue}{$tax}){
439                        $families{evalue}{$tax} = $evalue;
440                        $families{color}{$tax} = &get_taxcolor($evalue);
441                    }
442                }
443                else{
444                    $families{evalue}{$tax} = $evalue;
445                    $families{color}{$tax} = &get_taxcolor($evalue);
446                }
447    
448              $parent_tax = $tax;              $parent_tax = $tax;
449          }          }
450      }      }
# Line 473  Line 467 
467    
468  =cut  =cut
469    
470    sub get_taxcolor{
471        my ($evalue) = @_;
472        my $color;
473        if ($evalue <= 1e-170){        $color = "#FF2000";    }
474        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
475        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
476        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
477        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
478        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
479        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
480        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
481        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
482        else{        $color = "#6666FF";    }
483        return ($color);
484    }
485    
486    
487  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
488    
489      # 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)
490      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
491    
492      my $fig = new FIG;      #my $fig = new FIG;
493    
494      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
495          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
496          my @parts = split("::",$key);          my @parts = split("::",$key);
497          my $class = $parts[0];          my $class = $parts[0];
# Line 520  Line 530 
530    
531  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
532    
533      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
534      my $fig = new FIG;      #my $fig = new FIG;
535    
536      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
537    
# Line 531  Line 541 
541                     };                     };
542    
543      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
544          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
545          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
546          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 552 
552                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
553                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
554                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
555              }              }
556              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
557                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 590 
590  =cut  =cut
591    
592  sub get_pdb_observations{  sub get_pdb_observations{
593      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
594    
595      my $fig = new FIG;      #my $fig = new FIG;
596    
597      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
598          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
599          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
600          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 649 
649    
650  sub get_sims_observations{  sub get_sims_observations{
651    
652      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
653      my $fig = new FIG;      #my $fig = new FIG;
654      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
655      my ($dataset);      my ($dataset);
656    
     my %id_list;  
657      foreach my $sim (@sims){      foreach my $sim (@sims){
658          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($sim->[1]));
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
   
     foreach my $sim (@new_sims){  
659          my $hit = $sim->[1];          my $hit = $sim->[1];
660          my $percent = $sim->[2];          my $percent = $sim->[2];
661          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 670 
670          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
671    
672          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
673                        'query' => $sim->[0],
674                      'acc' => $hit,                      'acc' => $hit,
675                      'identity' => $percent,                      'identity' => $percent,
676                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 725 
725    
726  sub get_identical_proteins{  sub get_identical_proteins{
727    
728      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
729      my $fig = new FIG;      #my $fig = new FIG;
730      my $funcs_ref;      my $funcs_ref;
731    
 #    my %id_list;  
732      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;  
 #    }  
   
733      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
734          my ($tmp, $who);          my ($tmp, $who);
735          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}))) {  
736              $who = &get_database($id);              $who = &get_database($id);
737              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
738          }          }
739      }      }
740    
     my ($dataset);  
741      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
742                     'type' => 'seq',                     'type' => 'seq',
743                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 757 
757    
758  sub get_functional_coupling{  sub get_functional_coupling{
759    
760      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
761      my $fig = new FIG;      #my $fig = new FIG;
762      my @funcs = ();      my @funcs = ();
763    
764      # initialize some variables      # initialize some variables
# Line 939  Line 917 
917  =cut  =cut
918    
919  sub display{  sub display{
920      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
921    
922      my $fid = $self->fig_id;      my $fid = $self->fig_id;
923      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 966  Line 944 
944                          'short_title' => "best PDB",                          'short_title' => "best PDB",
945                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
946    
947      my $fig = new FIG;      #my $fig = new FIG;
948      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
949      my $fid_stop = length($seq);      my $fid_stop = length($seq);
950    
# Line 1067  Line 1045 
1045    
1046    
1047  sub display_table{  sub display_table{
1048      my ($self) = @_;      my ($self,$fig) = @_;
1049    
1050      my $fig = new FIG;      #my $fig = new FIG;
1051      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1052      my $rows = $self->rows;      my $rows = $self->rows;
1053      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1109 
1109    
1110  sub display_table {  sub display_table {
1111    
1112      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1113      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1114      my $rows = $self->rows;      my $rows = $self->rows;
1115      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1219  Line 1197 
1197              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1198          }          }
1199      }      }
1200        elsif($db =~ /PFAM/){
1201            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1202            if(!scalar(@$pfam_objs)){
1203                $name_title = "name";
1204                $name_value = "not available";
1205                $description_title = "description";
1206                $description_value = "not available";
1207            }
1208            else{
1209                my $pfam_obj = $pfam_objs->[0];
1210                $name_title = "name";
1211                $name_value = $pfam_obj->term;
1212                #$description_title = "description";
1213                #$description_value = $pfam_obj->description;
1214            }
1215        }
1216    
1217      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1218                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1219        my $line_config = { 'title' => $name_value,
1220                            'short_title' => $short_title,
1221                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1222    
1223      my $name;      my $name;
1224      $name = {"title" => $name_title,      $name = {"title" => $db,
1225               "value" => $name_value};               "value" => $id};
1226      push(@$descriptions,$name);      push(@$descriptions,$name);
1227    
1228      my $description;  #    my $description;
1229      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1230                               "value" => $description_value};  #                   "value" => $description_value};
1231      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1232    
1233      my $score;      my $score;
1234      $score = {"title" => "score",      $score = {"title" => "score",
1235                "value" => $thing->evalue};                "value" => $thing->evalue};
1236      push(@$descriptions,$score);      push(@$descriptions,$score);
1237    
1238        my $location;
1239        $location = {"title" => "location",
1240                     "value" => $thing->start . " - " . $thing->stop};
1241        push(@$descriptions,$location);
1242    
1243      my $link_id;      my $link_id;
1244      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1245          $link_id = $1;          $link_id = $1;
1246      }      }
1247    
# Line 1255  Line 1256 
1256      push(@$links_list,$link);      push(@$links_list,$link);
1257    
1258      my $element_hash = {      my $element_hash = {
1259          "title" => $thing->type,          "title" => $name_value,
1260          "start" => $thing->start,          "start" => $thing->start,
1261          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1262          "color"=> $color,          "color"=> $color,
# Line 1351  Line 1352 
1352  }  }
1353    
1354  sub display_cello {  sub display_cello {
1355      my ($thing) = @_;      my ($thing,$fig) = @_;
1356      my $html;      my $html;
1357      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1358      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1359      if($cello_location){      if($cello_location){
1360          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1361          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1362      }      }
1363      return ($html);      return ($html);
1364  }  }
1365    
1366  sub display {  sub display {
1367      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1368    
1369      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1370      my $fig= new FIG;      #my $fig= new FIG;
1371      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1372    
1373      my $cleavage_prob;      my $cleavage_prob;
# Line 1418  Line 1419 
1419          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1420      }      }
1421    
 =cut  
   
1422      $color = "2";      $color = "2";
1423      if($tmpred_score){      if($tmpred_score){
1424          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1448 
1448          }          }
1449          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1450      }      }
1451    =cut
1452    
1453      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1454          my $line_data =[];          my $line_data =[];
1455          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1456                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1457                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1458    
1459          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1460              my $descriptions = [];              my $descriptions = [];
1461              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1462                               "value" => $tm_loc};                               "value" => $tm_loc};
1463              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1464    
1465              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1466    
1467              my $element_hash = {              my $element_hash = {
1468              "title" => "phobius transmembrane location",              "title" => "Phobius",
1469              "start" => $begin + 1,              "start" => $begin + 1,
1470              "end" =>  $end + 1,              "end" =>  $end + 1,
1471              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1499 
1499          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1500      }      }
1501    
1502    =head3
1503      $color = "1";      $color = "1";
1504      if($signal_peptide_score){      if($signal_peptide_score){
1505          my $line_data = [];          my $line_data = [];
# Line 1531  Line 1531 
1531          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1532          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1533      }      }
1534    =cut
1535    
1536      return ($gd);      return ($gd);
1537    
# Line 1602  Line 1603 
1603      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1604      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1605      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1606        $self->{query} = $dataset->{'query'};
1607      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1608      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1609      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1627 
1627  =cut  =cut
1628    
1629  sub display {  sub display {
1630      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1631        #my $fig = new FIG;
1632    
1633      my $fig = new FIG;      my @ids;
1634      my $peg = $self->acc;      foreach my $thing(@$array){
1635            next if ($thing->class ne "SIM");
1636            push (@ids, $thing->acc);
1637        }
1638    
1639        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1640    
1641      my $organism = $self->organism;      foreach my $thing (@$array){
1642            if ($thing->class eq "SIM"){
1643    
1644                my $peg = $thing->acc;
1645                my $query = $thing->query;
1646    
1647                my $organism = $thing->organism;
1648      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1649      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1650      my $function = $self->function;              my $function = $thing->function;
1651      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1652      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1653      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1654      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1655      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1656    
1657      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;
1658    
# Line 1656  Line 1670 
1670    
1671      # get subsystem information      # get subsystem information
1672      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
   
1673      my $link;      my $link;
1674      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1675               "link" => $url_link};               "link" => $url_link};
1676      push(@$links_list,$link);      push(@$links_list,$link);
1677    
1678      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1679      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1680                my @subsystems;
1681    
1682                foreach my $array (@subs){
1683                    my $subsystem = $$array[0];
1684                    push(@subsystems,$subsystem);
1685          my $link;          my $link;
1686          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1687                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1688          push(@$links_list,$link);          push(@$links_list,$link);
1689      }      }
1690    
1691                $link = {"link_title" => "view blast alignment",
1692                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1693                push (@$links_list,$link);
1694    
1695      my $description_function;      my $description_function;
1696      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1697                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1712 
1712                          "value" => $hit_stop};                          "value" => $hit_stop};
1713      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1714    
1715      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1716      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1717      {      {
1718          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1743 
1743          };          };
1744      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1745      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1746            }
1747        }
1748      return ($gd);      return ($gd);
   
1749  }  }
1750    
1751  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1755 
1755  =cut  =cut
1756    
1757  sub display_domain_composition {  sub display_domain_composition {
1758      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1759    
1760      my $fig = new FIG;      #my $fig = new FIG;
1761      my $peg = $self->acc;      my $peg = $self->acc;
1762    
1763      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1765 
1765      my $descriptions = [];      my $descriptions = [];
1766    
1767      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1768        my @domain_query_results = ();
1769      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1770          my $key = @$dqr[1];          my $key = @$dqr[1];
1771          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1848  Line 1870 
1870  =cut  =cut
1871    
1872  sub display_table {  sub display_table {
1873      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1874    
1875      my $data = [];      my $data = [];
1876      my $count = 0;      my $count = 0;
1877      my $content;      my $content;
1878      my $fig = new FIG;      #my $fig = new FIG;
1879      my $cgi = new CGI;      my $cgi = new CGI;
1880      my @ids;      my @ids;
1881      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1884 
1884      }      }
1885    
1886      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1887        my @attributes = $fig->get_attributes(\@ids);
1888    
1889      # get the column for the subsystems      # get the column for the subsystems
1890      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1891    
1892      # get the column for the evidence codes      # get the column for the evidence codes
1893      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1894    
1895      # get the column for pfam_domain      # get the column for pfam_domain
1896      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1897    
1898      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1899      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1900        #my $alias_col = {};
1901    
1902      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1903          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1905 
1905          $count++;          $count++;
1906    
1907          my $id = $thing->acc;          my $id = $thing->acc;
   
1908          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1909          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1910          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1921 
1921          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1922          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1923          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');">);
1924            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1925    
1926          # get the linked fig id          # get the linked fig id
1927          my $fig_col;          my $fig_col;
# Line 1908  Line 1932 
1932              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = &HTML::set_prot_links($cgi,$id);
1933          }          }
1934    
1935          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1936          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1937          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  
1938          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1939              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1940              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1941              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1942              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"});}
1943              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"});}
1944              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"});}
1945              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"});}
1946              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"});}
1947              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"});}
1948              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"});}
1949              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"});}
1950              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"});}
1951              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"});}
1952                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1953          }          }
1954          push(@$data,$single_domain);          push(@$data,$single_domain);
1955      }      }
   
1956      if ($count >0 ){      if ($count >0 ){
1957          $content = $data;          $content = $data;
1958      }      }
# Line 1955  Line 1974 
1974  }  }
1975    
1976  sub get_subsystems_column{  sub get_subsystems_column{
1977      my ($ids) = @_;      my ($ids,$fig) = @_;
1978    
1979      my $fig = new FIG;      #my $fig = new FIG;
1980      my $cgi = new CGI;      my $cgi = new CGI;
1981      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1982      my %column;      my %column;
# Line 1966  Line 1985 
1985          my @subsystems;          my @subsystems;
1986    
1987          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1988              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1989                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1990                  $count++;                  $ss =~ s/_/ /ig;
1991                    push (@subsystems, "-" . $ss);
1992              }              }
1993              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
1994              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2000 
2000  }  }
2001    
2002  sub get_essentially_identical{  sub get_essentially_identical{
2003      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2004      my $fig = new FIG;      #my $fig = new FIG;
2005    
2006      my %id_list;      my %id_list;
2007      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);
2008    
2009      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2010            if($thing->class eq "IDENTICAL"){
2011                my $rows = $thing->rows;
2012                my $count_identical = 0;
2013                foreach my $row (@$rows) {
2014                    my $id = $row->[0];
2015          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2016              $id_list{$id} = 1;              $id_list{$id} = 1;
2017          }          }
2018      }      }
2019            }
2020        }
2021    
2022    #    foreach my $id (@maps_to) {
2023    #        if (($id ne $fid) && ($fig->function_of($id))) {
2024    #           $id_list{$id} = 1;
2025    #        }
2026    #    }
2027      return(%id_list);      return(%id_list);
2028  }  }
2029    
2030    
2031  sub get_evidence_column{  sub get_evidence_column{
2032      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2033      my $fig = new FIG;      #my $fig = new FIG;
2034      my $cgi = new CGI;      my $cgi = new CGI;
2035      my (%column, %code_attributes);      my (%column, %code_attributes);
2036    
2037      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2038      foreach my $key (@codes){      foreach my $key (@codes){
2039          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2040      }      }
# Line 2010  Line 2042 
2042      foreach my $id (@$ids){      foreach my $id (@$ids){
2043          # add evidence code with tool tip          # add evidence code with tool tip
2044          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2045    
2046          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2047              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2048              foreach my $code (@codes) {              foreach my $code (@codes) {
2049                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2050                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2054 
2054                  }                  }
2055                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2056              }              }
         }  
2057    
2058          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2059              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2039  Line 2067 
2067  }  }
2068    
2069  sub get_pfam_column{  sub get_pfam_column{
2070      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2071      my $fig = new FIG;      #my $fig = new FIG;
2072      my $cgi = new CGI;      my $cgi = new CGI;
2073      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2074      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2075    
2076      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2077      foreach my $key (@codes){      foreach my $key (@codes){
2078          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2079            if ($name =~ /_/){
2080                ($name) = ($key->[1]) =~ /(.*?)_/;
2081            }
2082            push (@{$code_attributes{$key->[0]}}, $name);
2083            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2084      }      }
2085    
2086      foreach my $id (@$ids){      foreach my $id (@$ids){
2087          # add evidence code with tool tip          # add evidence code
2088          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2089          my @pfam_codes = "";          my @pfam_codes = "";
2090          my %description_codes;          my %description_codes;
2091    
2092          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2093              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2094              @pfam_codes = ();              @pfam_codes = ();
2095              foreach my $code (@codes) {  
2096                # get only unique values
2097                my %saw;
2098                foreach my $key (@ncodes) {$saw{$key}=1;}
2099                @ncodes = keys %saw;
2100    
2101                foreach my $code (@ncodes) {
2102                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2103                  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>";
2104    
2105                    # get the locations for the domain
2106                    my @locs;
2107                    foreach my $part (@{$attribute_location{$id}{$code}}){
2108                        my ($loc) = ($part) =~ /\;(.*)/;
2109                        push (@locs,$loc);
2110                    }
2111                    my %locsaw;
2112                    foreach my $key (@locs) {$locsaw{$key}=1;}
2113                    @locs = keys %locsaw;
2114    
2115                    my $locations = join (", ", @locs);
2116    
2117                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2118                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2119                  }                  }
2120                  else {                  else {
2121                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2122                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2123                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2124                  }                  }
2125              }              }
2126          }          }
# Line 2080  Line 2131 
2131    
2132  }  }
2133    
2134  sub get_prefer {  sub get_aliases {
2135      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2136    
2137      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2138        foreach my $id (@$ids){
2139            foreach my $alias (@{$$all_aliases{$id}}){
2140          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2141          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2142              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2143          }          }
2144      }      }
2145      return (" ");      return ($aliases);
2146  }  }
2147    
2148  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; $_ }
2149    
2150  sub color {  sub color {
2151      my ($evalue) = @_;      my ($evalue) = @_;
   
2152      my $color;      my $color;
2153      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = 51;    }
2154          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2155      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2156      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2157          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2158      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2159      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2160          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2161      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2162      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){      else{        $color = 60;    }
         $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;  
     }  
   
   
2163      return ($color);      return ($color);
2164  }  }
2165    
# Line 2152  Line 2179 
2179  }  }
2180    
2181  sub display {  sub display {
2182      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2183    
2184      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2185      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2186      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2187      my $fig = new FIG;      my $range = $gd_window_size;
2188      my $all_regions = [];      my $all_regions = [];
2189      my $gene_associations={};      my $gene_associations={};
2190    
# Line 2182  Line 2209 
2209      my ($region_start, $region_end);      my ($region_start, $region_end);
2210      if ($beg < $end)      if ($beg < $end)
2211      {      {
2212          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2213          $region_end = $end+4000;          $region_end = $end+ ($range);
2214          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2215      }      }
2216      else      else
2217      {      {
2218          $region_start = $end-4000;          $region_start = $end-($range);
2219          $region_end = $beg+4000;          $region_end = $beg+($range);
2220          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2221          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2222          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2224 
2224    
2225      # call genes in region      # call genes in region
2226      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);
2227        #foreach my $feat (@$target_gene_features){
2228        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2229        #}
2230      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2231      my (@start_array_region);      my (@start_array_region);
2232      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2233    
2234      my %all_genes;      my %all_genes;
2235      my %all_genomes;      my %all_genomes;
2236      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2237            #if ($feature =~ /peg/){
2238      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2239      {          #}
         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;  
2240                  }                  }
2241    
2242                  push (@start_array_region, $offset);      my @selected_sims;
2243    
2244                  $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"){  
2245          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2246          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2247    
2248          # 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");  
   
2249          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2250              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2251                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2252                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2253                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2254                    #my $genome = $fig->genome_of($sim->[1]);
2255                    my $genome = $fig->genome_of($sim->acc);
2256                    my ($genome1) = ($genome) =~ /(.*)\./;
2257                    my $lineage = $taxes->{$genome1};
2258                    #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2259                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2260                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2261                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2262                            push (@selected_sims, $sim->acc);
2263                      }                      }
2264                  }                  }
2265                  my %saw;              }
2266                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2267            else{
2268                my $simcount = 0;
2269                foreach my $sim (@$sims_array){
2270                    next if ($sim->class ne "SIM");
2271                    next if ($sim->acc !~ /fig\|/);
2272    
2273                    push (@selected_sims, $sim->acc);
2274                    $simcount++;
2275                    last if ($simcount > 4);
2276              }              }
2277          }          }
2278    
2279            my %saw;
2280            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2281    
2282          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2283          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2284              #get the organism genome              #get the organism genome
# Line 2293  Line 2301 
2301              my ($region_start, $region_end);              my ($region_start, $region_end);
2302              if ($beg < $end)              if ($beg < $end)
2303              {              {
2304                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2305                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2306                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2307              }              }
2308              else              else
2309              {              {
2310                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2311                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2312                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2313                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2314                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2324 
2324    
2325      }      }
2326    
2327        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2328      # cluster the genes      # cluster the genes
2329      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2330      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2331        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2332        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2333    
2334      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2335          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2336          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2337          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2338          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2339            my ($genome1) = ($region_genome) =~ /(.*?)\./;
2340            my $lineage = $taxes->{$genome1};
2341            #$region_gs .= "Lineage:$lineage";
2342          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2343                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2344                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2346 
2346    
2347          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2348    
2349          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2350                                     'short_title' => "",                                     'short_title' => "",
2351                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2352                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2363  Line 2377 
2377                       "link" => $url_link};                       "link" => $url_link};
2378              push(@$links_list,$link);              push(@$links_list,$link);
2379    
2380              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2381              foreach my $subsystem (@subsystems){              my @subsystems;
2382                foreach my $array (@subs){
2383                    my $subsystem = $$array[0];
2384                    my $ss = $subsystem;
2385                    $ss =~ s/_/ /ig;
2386                    push (@subsystems, $ss);
2387                  my $link;                  my $link;
2388                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
2389                           "link_title" => $subsystem};                           "link_title" => $ss};
2390                    push(@$links_list,$link);
2391                }
2392    
2393                if ($fid1 eq $fid){
2394                    my $link;
2395                    $link = {"link_title" => "Annotate this sequence",
2396                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2397                  push(@$links_list,$link);                  push(@$links_list,$link);
2398              }              }
2399    
# Line 2406  Line 2432 
2432                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2433                  }                  }
2434    
2435                    my $title = $fid1;
2436                    if ($fid1 eq $fid){
2437                        $title = "My query gene: $fid1";
2438                    }
2439    
2440                  $element_hash = {                  $element_hash = {
2441                      "title" => $fid1,                      "title" => $title,
2442                      "start" => $start,                      "start" => $start,
2443                      "end" =>  $stop,                      "end" =>  $stop,
2444                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2451 
2451                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2452                  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;}
2453                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2454    
2455                    if ($fid1 eq $fid){
2456                        $element_hash = {
2457                            "title" => 'Query',
2458                            "start" => $start,
2459                            "end" =>  $stop,
2460                            "type"=> 'bigbox',
2461                            "color"=> $color,
2462                            "zlayer" => "1"
2463                            };
2464    
2465                        # if there is an overlap, put into second line
2466                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2467                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2468                    }
2469              }              }
2470          }          }
2471          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2472          $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);
2473      }      }
2474      return $gd;      return ($gd, \@selected_sims);
2475  }  }
2476    
2477  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2541 
2541      }      }
2542    
2543      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2544          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2545              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2546                  foreach $y (@$x) {                  foreach $y (@$x) {
2547                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2559 
2559      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2560      return ($i < @$xL);      return ($i < @$xL);
2561  }  }
2562    
2563    #############################################
2564    #############################################
2565    package Observation::Commentary;
2566    
2567    use base qw(Observation);
2568    
2569    =head3 display_protein_commentary()
2570    
2571    =cut
2572    
2573    sub display_protein_commentary {
2574        my ($self,$dataset,$mypeg,$fig) = @_;
2575    
2576        my $all_rows = [];
2577        my $content;
2578        #my $fig = new FIG;
2579        my $cgi = new CGI;
2580        my $count = 0;
2581        my $peg_array = [];
2582        my (%evidence_column, %subsystems_column,  %e_identical);
2583    
2584        if (@$dataset != 1){
2585            foreach my $thing (@$dataset){
2586                if ($thing->class eq "SIM"){
2587                    push (@$peg_array, $thing->acc);
2588                }
2589            }
2590            # get the column for the evidence codes
2591            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2592    
2593            # get the column for the subsystems
2594            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2595    
2596            # get essentially identical seqs
2597            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2598        }
2599        else{
2600            push (@$peg_array, @$dataset);
2601        }
2602    
2603        my $selected_sims = [];
2604        foreach my $id (@$peg_array){
2605            last if ($count > 10);
2606            my $row_data = [];
2607            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2608            $org = $fig->org_of($id);
2609            $function = $fig->function_of($id);
2610            if ($mypeg ne $id){
2611                $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";
2612                $id_cell .= &HTML::set_prot_links($cgi,$id);
2613                if (defined($e_identical{$id})) { $id_cell .= "*";}
2614            }
2615            else{
2616                $function_cell = "&nbsp;&nbsp;$function";
2617                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2618                $id_cell .= &HTML::set_prot_links($cgi,$id);
2619            }
2620    
2621            push(@$row_data,$id_cell);
2622            push(@$row_data,$org);
2623            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2624            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2625            push(@$row_data, $fig->translation_length($id));
2626            push(@$row_data,$function_cell);
2627            push(@$all_rows,$row_data);
2628            push (@$selected_sims, $id);
2629            $count++;
2630        }
2631    
2632        if ($count >0){
2633            $content = $all_rows;
2634        }
2635        else{
2636            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2637        }
2638        return ($content,$selected_sims);
2639    }
2640    
2641    sub display_protein_history {
2642        my ($self, $id,$fig) = @_;
2643        my $all_rows = [];
2644        my $content;
2645    
2646        my $cgi = new CGI;
2647        my $count = 0;
2648        foreach my $feat ($fig->feature_annotations($id)){
2649            my $row = [];
2650            my $col1 = $feat->[2];
2651            my $col2 = $feat->[1];
2652            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2653            my $text = $feat->[3];
2654    
2655            push (@$row, $col1);
2656            push (@$row, $col2);
2657            push (@$row, $text);
2658            push (@$all_rows, $row);
2659            $count++;
2660        }
2661        if ($count > 0){
2662            $content = $all_rows;
2663        }
2664        else {
2665            $content = "There is no history for this PEG";
2666        }
2667    
2668        return($content);
2669    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3