[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.41, Tue Oct 9 19:05:29 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=();
324      my $fig = new FIG;      #my $fig = new FIG;
325    
326      # call function that fetches attribute based observations      # call function that fetches attribute based observations
327      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 333 
333          my %domain_classes;          my %domain_classes;
334          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
335          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
336          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
337          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
338          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
339          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
340          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
341          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
342            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
343      }      }
344    
345      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 347 
347          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
348              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
349          }          }
350          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
351              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
352          }          }
353          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
354              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
355          }          }
356          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
357              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
358          }          }
359          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
360              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
361          }          }
362          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
363              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
364          }          }
365          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
366              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
367          }          }
368    
# Line 365  Line 378 
378    
379  =cut  =cut
380  sub display_housekeeping {  sub display_housekeeping {
381      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
382      my $fig = new FIG;      my $content = [];
383      my $content;      my $row = [];
384    
385      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);  
386      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
387      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
388      my $taxonomy = $fig->taxonomy_of($org_id);      my $length = $fig->translation_length($fid);
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
389    
390      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      push (@$row, $org_name);
391      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      push (@$row, $fid);
392      $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);      push (@$row, $length);
393      $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);      push (@$row, $function);
394      $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
395      $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
396      $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);      #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
397      if ( @ecs ) {      #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
398          $content .= qq(<tr><td>EC:</td><td>);      #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
399          foreach my $ec ( @ecs ) {      #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
400              my $ec_name = $fig->ec_name($ec);      #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
401              $content .= join(" -- ", $ec, $ec_name) . "<br>\n";      #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
402          }      #$content .= qq(</table><p>\n);
         $content .= qq(</td></tr>\n);  
     }  
403    
404      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);  
405    
406      return ($content);      return ($content);
407  }  }
# Line 435  Line 412 
412  =cut  =cut
413    
414  sub get_sims_summary {  sub get_sims_summary {
415      my ($observation, $fid) = @_;      my ($observation, $fid, $taxes,$fig) = @_;
416      my $fig = new FIG;      #my $fig = new FIG;
417      my %families;      my %families;
418      my @sims= $fig->nsims($fid,20000,10,"fig");      my @sims= $fig->nsims($fid,20000,10,"fig");
419    
420      foreach my $sim (@sims){      foreach my $sim (@sims){
421          next if ($sim->[1] !~ /fig\|/);          next if ($sim->[1] !~ /fig\|/);
422          my $genome = $fig->genome_of($sim->[1]);          my $genome = $fig->genome_of($sim->[1]);
423          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));          my ($genome1) = ($genome) =~ /(.*)\./;
424            my $taxonomy = $taxes->{$genome1};
425            #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated
426          my $parent_tax = "Root";          my $parent_tax = "Root";
427          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
428          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 451  Line 430 
430              push (@currLineage, $tax);              push (@currLineage, $tax);
431              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
432              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
433                if (defined ($families{evalue}{$tax})){
434                    if ($sim->[10] < $families{evalue}{$tax}){
435                        $families{evalue}{$tax} = $sim->[10];
436                        $families{color}{$tax} = &get_taxcolor($sim->[10]);
437                    }
438                }
439                else{
440                    $families{evalue}{$tax} = $sim->[10];
441                    $families{color}{$tax} = &get_taxcolor($sim->[10]);
442                }
443    
444              $parent_tax = $tax;              $parent_tax = $tax;
445          }          }
446      }      }
# Line 473  Line 463 
463    
464  =cut  =cut
465    
466    sub get_taxcolor{
467        my ($evalue) = @_;
468        my $color;
469        if ($evalue <= 1e-170){        $color = "#FF2000";    }
470        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
471        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
472        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
473        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
474        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
475        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
476        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
477        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
478        else{        $color = "#6666FF";    }
479        return ($color);
480    }
481    
482    
483  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
484    
485      # 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)
486      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
487    
488      my $fig = new FIG;      #my $fig = new FIG;
489    
490      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
491          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
492          my @parts = split("::",$key);          my @parts = split("::",$key);
493          my $class = $parts[0];          my $class = $parts[0];
# Line 520  Line 526 
526    
527  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
528    
529      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
530      my $fig = new FIG;      #my $fig = new FIG;
531    
532      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
533    
# Line 531  Line 537 
537                     };                     };
538    
539      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
540          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
541          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
542          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 548 
548                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
549                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
550                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
551              }              }
552              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
553                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 586 
586  =cut  =cut
587    
588  sub get_pdb_observations{  sub get_pdb_observations{
589      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
590    
591      my $fig = new FIG;      #my $fig = new FIG;
592    
593      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
594          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
595          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
596          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 645 
645    
646  sub get_sims_observations{  sub get_sims_observations{
647    
648      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
649      my $fig = new FIG;      #my $fig = new FIG;
650      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->nsims($fid,500,10,"fig");
651      my ($dataset);      my ($dataset);
652    
     my %id_list;  
653      foreach my $sim (@sims){      foreach my $sim (@sims){
654          my $hit = $sim->[1];          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);  
     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){  
         my $hit = $sim->[1];  
655          my $percent = $sim->[2];          my $percent = $sim->[2];
656          my $evalue = $sim->[10];          my $evalue = $sim->[10];
657          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 685  Line 665 
665          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
666    
667          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
668                        'query' => $sim->[0],
669                      'acc' => $hit,                      'acc' => $hit,
670                      'identity' => $percent,                      'identity' => $percent,
671                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 720 
720    
721  sub get_identical_proteins{  sub get_identical_proteins{
722    
723      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
724      my $fig = new FIG;      #my $fig = new FIG;
725      my $funcs_ref;      my $funcs_ref;
726    
 #    my %id_list;  
727      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;  
 #    }  
   
728      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
729          my ($tmp, $who);          my ($tmp, $who);
730          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}))) {  
731              $who = &get_database($id);              $who = &get_database($id);
732              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
733          }          }
734      }      }
735    
     my ($dataset);  
736      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
737                     'type' => 'seq',                     'type' => 'seq',
738                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 752 
752    
753  sub get_functional_coupling{  sub get_functional_coupling{
754    
755      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
756      my $fig = new FIG;      #my $fig = new FIG;
757      my @funcs = ();      my @funcs = ();
758    
759      # initialize some variables      # initialize some variables
# Line 939  Line 912 
912  =cut  =cut
913    
914  sub display{  sub display{
915      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
916    
917      my $fid = $self->fig_id;      my $fid = $self->fig_id;
918      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 966  Line 939 
939                          'short_title' => "best PDB",                          'short_title' => "best PDB",
940                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
941    
942      my $fig = new FIG;      #my $fig = new FIG;
943      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
944      my $fid_stop = length($seq);      my $fid_stop = length($seq);
945    
# Line 1067  Line 1040 
1040    
1041    
1042  sub display_table{  sub display_table{
1043      my ($self) = @_;      my ($self,$fig) = @_;
1044    
1045      my $fig = new FIG;      #my $fig = new FIG;
1046      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1047      my $rows = $self->rows;      my $rows = $self->rows;
1048      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1104 
1104    
1105  sub display_table {  sub display_table {
1106    
1107      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1108      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1109      my $rows = $self->rows;      my $rows = $self->rows;
1110      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1219  Line 1192 
1192              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1193          }          }
1194      }      }
1195        elsif($db =~ /PFAM/){
1196            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1197            if(!scalar(@$pfam_objs)){
1198                $name_title = "name";
1199                $name_value = "not available";
1200                $description_title = "description";
1201                $description_value = "not available";
1202            }
1203            else{
1204                my $pfam_obj = $pfam_objs->[0];
1205                $name_title = "name";
1206                $name_value = $pfam_obj->term;
1207                #$description_title = "description";
1208                #$description_value = $pfam_obj->description;
1209            }
1210        }
1211    
1212      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1213                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1214        my $line_config = { 'title' => $name_value,
1215                            'short_title' => $short_title,
1216                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1217    
1218      my $name;      my $name;
1219      $name = {"title" => $name_title,      $name = {"title" => $db,
1220               "value" => $name_value};               "value" => $id};
1221      push(@$descriptions,$name);      push(@$descriptions,$name);
1222    
1223      my $description;  #    my $description;
1224      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1225                               "value" => $description_value};  #                   "value" => $description_value};
1226      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1227    
1228      my $score;      my $score;
1229      $score = {"title" => "score",      $score = {"title" => "score",
1230                "value" => $thing->evalue};                "value" => $thing->evalue};
1231      push(@$descriptions,$score);      push(@$descriptions,$score);
1232    
1233        my $location;
1234        $location = {"title" => "location",
1235                     "value" => $thing->start . " - " . $thing->stop};
1236        push(@$descriptions,$location);
1237    
1238      my $link_id;      my $link_id;
1239      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1240          $link_id = $1;          $link_id = $1;
1241      }      }
1242    
# Line 1255  Line 1251 
1251      push(@$links_list,$link);      push(@$links_list,$link);
1252    
1253      my $element_hash = {      my $element_hash = {
1254          "title" => $thing->type,          "title" => $name_value,
1255          "start" => $thing->start,          "start" => $thing->start,
1256          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1257          "color"=> $color,          "color"=> $color,
# Line 1351  Line 1347 
1347  }  }
1348    
1349  sub display_cello {  sub display_cello {
1350      my ($thing) = @_;      my ($thing,$fig) = @_;
1351      my $html;      my $html;
1352      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1353      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1354      if($cello_location){      if($cello_location){
1355          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1356          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1357      }      }
1358      return ($html);      return ($html);
1359  }  }
1360    
1361  sub display {  sub display {
1362      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1363    
1364      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1365      my $fig= new FIG;      #my $fig= new FIG;
1366      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1367    
1368      my $cleavage_prob;      my $cleavage_prob;
# Line 1418  Line 1414 
1414          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1415      }      }
1416    
 =cut  
   
1417      $color = "2";      $color = "2";
1418      if($tmpred_score){      if($tmpred_score){
1419          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1443 
1443          }          }
1444          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1445      }      }
1446    =cut
1447    
1448      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1449          my $line_data =[];          my $line_data =[];
1450          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1451                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1452                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1453    
1454          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1455              my $descriptions = [];              my $descriptions = [];
1456              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1457                               "value" => $tm_loc};                               "value" => $tm_loc};
1458              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1459    
1460              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1461    
1462              my $element_hash = {              my $element_hash = {
1463              "title" => "phobius transmembrane location",              "title" => "Phobius",
1464              "start" => $begin + 1,              "start" => $begin + 1,
1465              "end" =>  $end + 1,              "end" =>  $end + 1,
1466              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1494 
1494          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1495      }      }
1496    
1497    =head3
1498      $color = "1";      $color = "1";
1499      if($signal_peptide_score){      if($signal_peptide_score){
1500          my $line_data = [];          my $line_data = [];
# Line 1531  Line 1526 
1526          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1527          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1528      }      }
1529    =cut
1530    
1531      return ($gd);      return ($gd);
1532    
# Line 1602  Line 1598 
1598      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1599      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1600      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1601        $self->{query} = $dataset->{'query'};
1602      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1603      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1604      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1622 
1622  =cut  =cut
1623    
1624  sub display {  sub display {
1625      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1626        #my $fig = new FIG;
1627    
1628      my $fig = new FIG;      my @ids;
1629      my $peg = $self->acc;      foreach my $thing(@$array){
1630            next if ($thing->class ne "SIM");
1631            push (@ids, $thing->acc);
1632        }
1633    
1634        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1635    
1636        foreach my $thing (@$array){
1637            if ($thing->class eq "SIM"){
1638    
1639      my $organism = $self->organism;              my $peg = $thing->acc;
1640                my $query = $thing->query;
1641    
1642                my $organism = $thing->organism;
1643      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1644      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1645      my $function = $self->function;              my $function = $thing->function;
1646      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1647      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1648      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1649      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1650      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1651    
1652      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;
1653    
# Line 1656  Line 1665 
1665    
1666      # get subsystem information      # get subsystem information
1667      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;
   
1668      my $link;      my $link;
1669      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1670               "link" => $url_link};               "link" => $url_link};
1671      push(@$links_list,$link);      push(@$links_list,$link);
1672    
1673      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1674      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1675                my @subsystems;
1676    
1677                foreach my $array (@subs){
1678                    my $subsystem = $$array[0];
1679                    push(@subsystems,$subsystem);
1680          my $link;          my $link;
1681          $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",
1682                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1683          push(@$links_list,$link);          push(@$links_list,$link);
1684      }      }
1685    
1686                $link = {"link_title" => "view blast alignment",
1687                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1688                push (@$links_list,$link);
1689    
1690      my $description_function;      my $description_function;
1691      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1692                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1707 
1707                          "value" => $hit_stop};                          "value" => $hit_stop};
1708      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1709    
1710      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1711      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1712      {      {
1713          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1738 
1738          };          };
1739      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1740      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1741            }
1742        }
1743      return ($gd);      return ($gd);
   
1744  }  }
1745    
1746  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1750 
1750  =cut  =cut
1751    
1752  sub display_domain_composition {  sub display_domain_composition {
1753      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1754    
1755      my $fig = new FIG;      #my $fig = new FIG;
1756      my $peg = $self->acc;      my $peg = $self->acc;
1757    
1758      my $line_data = [];      my $line_data = [];
# Line 1848  Line 1865 
1865  =cut  =cut
1866    
1867  sub display_table {  sub display_table {
1868      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1869    
1870      my $data = [];      my $data = [];
1871      my $count = 0;      my $count = 0;
1872      my $content;      my $content;
1873      my $fig = new FIG;      #my $fig = new FIG;
1874      my $cgi = new CGI;      my $cgi = new CGI;
1875      my @ids;      my @ids;
1876      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1879 
1879      }      }
1880    
1881      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1882        my @attributes = $fig->get_attributes(\@ids);
1883    
1884      # get the column for the subsystems      # get the column for the subsystems
1885      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1886    
1887      # get the column for the evidence codes      # get the column for the evidence codes
1888      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1889    
1890      # get the column for pfam_domain      # get the column for pfam_domain
1891      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1892    
1893      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1894      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1895    
1896      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1897          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1899 
1899          $count++;          $count++;
1900    
1901          my $id = $thing->acc;          my $id = $thing->acc;
   
1902          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1903          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1904          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1915 
1915          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1916          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1917          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');">);
1918            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1919    
1920          # get the linked fig id          # get the linked fig id
1921          my $fig_col;          my $fig_col;
# Line 1908  Line 1926 
1926              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = &HTML::set_prot_links($cgi,$id);
1927          }          }
1928    
1929          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1930          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1931          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  
1932          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1933              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1934              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1935              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1936              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"});}
1937              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"});}
1938              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"});}
1939              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"});}
1940              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"});}
1941              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"});}
1942              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"});}
1943              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"});}
1944              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"});}
1945              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"});}
1946                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1947          }          }
1948          push(@$data,$single_domain);          push(@$data,$single_domain);
1949      }      }
# Line 1955  Line 1969 
1969  }  }
1970    
1971  sub get_subsystems_column{  sub get_subsystems_column{
1972      my ($ids) = @_;      my ($ids,$fig) = @_;
1973    
1974      my $fig = new FIG;      #my $fig = new FIG;
1975      my $cgi = new CGI;      my $cgi = new CGI;
1976      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1977      my %column;      my %column;
# Line 1966  Line 1980 
1980          my @subsystems;          my @subsystems;
1981    
1982          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1983              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1984                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1985                  $count++;                  $ss =~ s/_/ /ig;
1986                    push (@subsystems, "-" . $ss);
1987              }              }
1988              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
1989              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 1995 
1995  }  }
1996    
1997  sub get_essentially_identical{  sub get_essentially_identical{
1998      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
1999      my $fig = new FIG;      #my $fig = new FIG;
2000    
2001      my %id_list;      my %id_list;
2002      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);
2003    
2004      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2005            if($thing->class eq "IDENTICAL"){
2006                my $rows = $thing->rows;
2007                my $count_identical = 0;
2008                foreach my $row (@$rows) {
2009                    my $id = $row->[0];
2010          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2011              $id_list{$id} = 1;              $id_list{$id} = 1;
2012          }          }
2013      }      }
2014            }
2015        }
2016    
2017    #    foreach my $id (@maps_to) {
2018    #        if (($id ne $fid) && ($fig->function_of($id))) {
2019    #           $id_list{$id} = 1;
2020    #        }
2021    #    }
2022      return(%id_list);      return(%id_list);
2023  }  }
2024    
2025    
2026  sub get_evidence_column{  sub get_evidence_column{
2027      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2028      my $fig = new FIG;      #my $fig = new FIG;
2029      my $cgi = new CGI;      my $cgi = new CGI;
2030      my (%column, %code_attributes);      my (%column, %code_attributes);
2031    
2032      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2033      foreach my $key (@codes){      foreach my $key (@codes){
2034          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2035      }      }
# Line 2010  Line 2037 
2037      foreach my $id (@$ids){      foreach my $id (@$ids){
2038          # add evidence code with tool tip          # add evidence code with tool tip
2039          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2040    
2041          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2042              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2043              foreach my $code (@codes) {              foreach my $code (@codes) {
2044                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2045                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2049 
2049                  }                  }
2050                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2051              }              }
         }  
2052    
2053          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2054              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 2062 
2062  }  }
2063    
2064  sub get_pfam_column{  sub get_pfam_column{
2065      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2066      my $fig = new FIG;      #my $fig = new FIG;
2067      my $cgi = new CGI;      my $cgi = new CGI;
2068      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2069      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2070    
2071      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2072      foreach my $key (@codes){      foreach my $key (@codes){
2073          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2074            if ($name =~ /_/){
2075                ($name) = ($key->[1]) =~ /(.*?)_/;
2076            }
2077            push (@{$code_attributes{$key->[0]}}, $name);
2078            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2079      }      }
2080    
2081      foreach my $id (@$ids){      foreach my $id (@$ids){
2082          # add evidence code with tool tip          # add evidence code
2083          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2084          my @pfam_codes = "";          my @pfam_codes = "";
2085          my %description_codes;          my %description_codes;
2086    
2087          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2088              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2089              @pfam_codes = ();              @pfam_codes = ();
2090              foreach my $code (@codes) {  
2091                # get only unique values
2092                my %saw;
2093                foreach my $key (@ncodes) {$saw{$key}=1;}
2094                @ncodes = keys %saw;
2095    
2096                foreach my $code (@ncodes) {
2097                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2098                  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>";
2099    
2100                    # get the locations for the domain
2101                    my @locs;
2102                    foreach my $part (@{$attribute_location{$id}{$code}}){
2103                        my ($loc) = ($part) =~ /\;(.*)/;
2104                        push (@locs,$loc);
2105                    }
2106                    my %locsaw;
2107                    foreach my $key (@locs) {$locsaw{$key}=1;}
2108                    @locs = keys %locsaw;
2109    
2110                    my $locations = join (", ", @locs);
2111    
2112                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2113                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2114                  }                  }
2115                  else {                  else {
2116                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2117                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2118                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2119                  }                  }
2120              }              }
2121          }          }
# Line 2080  Line 2126 
2126    
2127  }  }
2128    
2129  sub get_prefer {  sub get_aliases {
2130      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2131    
2132      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2133        foreach my $id (@$ids){
2134            foreach my $alias (@{$$all_aliases{$id}}){
2135          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2136          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2137              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2138          }          }
2139      }      }
2140      return (" ");      return ($aliases);
2141  }  }
2142    
2143  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; $_ }
2144    
2145  sub color {  sub color {
2146      my ($evalue) = @_;      my ($evalue) = @_;
   
2147      my $color;      my $color;
2148      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = 51;    }
2149          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2150      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2151      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2152          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2153      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2154      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2155          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2156      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2157      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;  
     }  
   
   
2158      return ($color);      return ($color);
2159  }  }
2160    
# Line 2152  Line 2174 
2174  }  }
2175    
2176  sub display {  sub display {
2177      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2178    
2179      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2180      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2181      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2182      my $fig = new FIG;      my $range = $gd_window_size;
2183        #my $fig = new FIG;
2184      my $all_regions = [];      my $all_regions = [];
2185      my $gene_associations={};      my $gene_associations={};
2186    
# Line 2182  Line 2205 
2205      my ($region_start, $region_end);      my ($region_start, $region_end);
2206      if ($beg < $end)      if ($beg < $end)
2207      {      {
2208          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2209          $region_end = $end+4000;          $region_end = $end+ ($range);
2210          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2211      }      }
2212      else      else
2213      {      {
2214          $region_start = $end-4000;          $region_start = $end-($range);
2215          $region_end = $beg+4000;          $region_end = $beg+($range);
2216          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2217          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2218          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2204  Line 2227 
2227      my %all_genes;      my %all_genes;
2228      my %all_genomes;      my %all_genomes;
2229      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}
2230        my @selected_sims;
2231    
2232      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "sims"){
     {  
         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;  
                 }  
   
                 push (@start_array_region, $offset);  
   
                 $all_genomes{$pair_genome} = 1;  
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
2233          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2234          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2235    
2236          # 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");  
   
2237          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2238              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2239                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2240                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2241                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2242                    #my $genome = $fig->genome_of($sim->[1]);
2243                    my $genome = $fig->genome_of($sim->acc);
2244                    my ($genome1) = ($genome) =~ /(.*)\./;
2245                    my $lineage = $taxes->{$genome1};
2246                    #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2247                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2248                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2249                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2250                            push (@selected_sims, $sim->acc);
2251                      }                      }
2252                  }                  }
2253                  my %saw;              }
2254                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2255            else{
2256                my $simcount = 0;
2257                foreach my $sim (@$sims_array){
2258                    next if ($sim->class ne "SIM");
2259                    next if ($sim->acc !~ /fig\|/);
2260    
2261                    push (@selected_sims, $sim->acc);
2262                    $simcount++;
2263                    last if ($simcount > 4);
2264              }              }
2265          }          }
2266    
2267            my %saw;
2268            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2269    
2270          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2271          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2272              #get the organism genome              #get the organism genome
# Line 2293  Line 2289 
2289              my ($region_start, $region_end);              my ($region_start, $region_end);
2290              if ($beg < $end)              if ($beg < $end)
2291              {              {
2292                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2293                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2294                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2295              }              }
2296              else              else
2297              {              {
2298                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2299                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2300                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2301                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2302                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2312 
2312    
2313      }      }
2314    
2315        print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2316      # cluster the genes      # cluster the genes
2317      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2318      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2319        print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2320        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2321    
2322      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2323          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2324          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2325          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2326          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2327            my ($genome1) = ($region_genome) =~ /(.*?)\./;
2328            my $lineage = $taxes->{$genome1};
2329            #$region_gs .= "Lineage:$lineage";
2330          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2331                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2332                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2334 
2334    
2335          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2336    
2337          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2338                                     'short_title' => "",                                     'short_title' => "",
2339                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2340                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2363  Line 2365 
2365                       "link" => $url_link};                       "link" => $url_link};
2366              push(@$links_list,$link);              push(@$links_list,$link);
2367    
2368              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2369              foreach my $subsystem (@subsystems){              my @subsystems;
2370                foreach my $array (@subs){
2371                    my $subsystem = $$array[0];
2372                    my $ss = $subsystem;
2373                    $ss =~ s/_/ /ig;
2374                    push (@subsystems, $ss);
2375                  my $link;                  my $link;
2376                  $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",
2377                           "link_title" => $subsystem};                           "link_title" => $ss};
2378                    push(@$links_list,$link);
2379                }
2380    
2381                if ($fid1 eq $fid){
2382                    my $link;
2383                    $link = {"link_title" => "Annotate this sequence",
2384                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2385                  push(@$links_list,$link);                  push(@$links_list,$link);
2386              }              }
2387    
# Line 2406  Line 2420 
2420                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2421                  }                  }
2422    
2423                    my $title = $fid1;
2424                    if ($fid1 eq $fid){
2425                        $title = "My query gene: $fid1";
2426                    }
2427    
2428                  $element_hash = {                  $element_hash = {
2429                      "title" => $fid1,                      "title" => $title,
2430                      "start" => $start,                      "start" => $start,
2431                      "end" =>  $stop,                      "end" =>  $stop,
2432                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2439 
2439                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2440                  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;}
2441                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2442    
2443                    if ($fid1 eq $fid){
2444                        $element_hash = {
2445                            "title" => 'Query',
2446                            "start" => $start,
2447                            "end" =>  $stop,
2448                            "type"=> 'bigbox',
2449                            "color"=> $color,
2450                            "zlayer" => "1"
2451                            };
2452    
2453                        # if there is an overlap, put into second line
2454                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2455                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2456                    }
2457              }              }
2458          }          }
2459          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2460          $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);
2461      }      }
2462      return $gd;      return ($gd, \@selected_sims);
2463  }  }
2464    
2465  sub cluster_genes {  sub cluster_genes {
# Line 2513  Line 2547 
2547      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2548      return ($i < @$xL);      return ($i < @$xL);
2549  }  }
2550    
2551    #############################################
2552    #############################################
2553    package Observation::Commentary;
2554    
2555    use base qw(Observation);
2556    
2557    =head3 display_protein_commentary()
2558    
2559    =cut
2560    
2561    sub display_protein_commentary {
2562        my ($self,$dataset,$mypeg,$fig) = @_;
2563    
2564        my $all_rows = [];
2565        my $content;
2566        #my $fig = new FIG;
2567        my $cgi = new CGI;
2568        my $count = 0;
2569        my $peg_array = [];
2570        my (%evidence_column, %subsystems_column,  %e_identical);
2571    
2572        if (@$dataset != 1){
2573            foreach my $thing (@$dataset){
2574                if ($thing->class eq "SIM"){
2575                    push (@$peg_array, $thing->acc);
2576                }
2577            }
2578            # get the column for the evidence codes
2579            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2580    
2581            # get the column for the subsystems
2582            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2583    
2584            # get essentially identical seqs
2585            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2586        }
2587        else{
2588            push (@$peg_array, @$dataset);
2589        }
2590    
2591        my $selected_sims = [];
2592        foreach my $id (@$peg_array){
2593            last if ($count > 10);
2594            my $row_data = [];
2595            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2596            $org = $fig->org_of($id);
2597            $function = $fig->function_of($id);
2598            if ($mypeg ne $id){
2599                $function_cell = qq(<input type=radio name=function id=$id value=$id onClick="clearText('newAnnotation');">&nbsp;&nbsp;$function);
2600                $id_cell .= &HTML::set_prot_links($cgi,$id);
2601                if (defined($e_identical{$id})) { $id_cell .= "*";}
2602            }
2603            else{
2604                $function_cell = "&nbsp;&nbsp;$function";
2605                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2606                $id_cell .= &HTML::set_prot_links($cgi,$id);
2607            }
2608    
2609            push(@$row_data,$id_cell);
2610            push(@$row_data,$org);
2611            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2612            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2613            push(@$row_data, $fig->translation_length($id));
2614            push(@$row_data,$function_cell);
2615            push(@$all_rows,$row_data);
2616            push (@$selected_sims, $id);
2617            $count++;
2618        }
2619    
2620        if ($count >0){
2621            $content = $all_rows;
2622        }
2623        else{
2624            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2625        }
2626        return ($content,$selected_sims);
2627    }
2628    
2629    sub display_protein_history {
2630        my ($self, $id,$fig) = @_;
2631        my $all_rows = [];
2632        my $content;
2633    
2634        my $cgi = new CGI;
2635        my $count = 0;
2636        foreach my $feat ($fig->feature_annotations($id)){
2637            my $row = [];
2638            my $col1 = $feat->[2];
2639            my $col2 = $feat->[1];
2640            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2641            my $text = $feat->[3];
2642    
2643            push (@$row, $col1);
2644            push (@$row, $col2);
2645            push (@$row, $text);
2646            push (@$all_rows, $row);
2647            $count++;
2648        }
2649        if ($count > 0){
2650            $content = $all_rows;
2651        }
2652        else {
2653            $content = "There is no history for this PEG";
2654        }
2655    
2656        return($content);
2657    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3