[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.40, Thu Sep 20 22:27:20 2007 UTC revision 1.46, Thu Nov 29 19:33:33 2007 UTC
# Line 7  Line 7 
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10    use WebColors;
11    
12  use FIG_Config;  use FIG_Config;
13  #use strict;  #use strict;
14  #use warnings;  #use warnings;
# Line 317  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 333  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 346  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 377  Line 379 
379    
380  =cut  =cut
381  sub display_housekeeping {  sub display_housekeeping {
382      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
383      my $fig = new FIG;      my $content = [];
384      my $content;      my $row = [];
385    
386      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
387      my $org_id   = $fig->orgid_of_orgname($org_name);      my $org_id = $fig->genome_of($fid);
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
388      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
389      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
390      my $taxonomy = $fig->taxonomy_of($org_id);      my $length = $fig->translation_length($fid);
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
   
     $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);  
     $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);  
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
   
     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);  
         }  
391    
392          # group ids by aliases      push (@$row, $org_name);
393          my %db_aliases;      push (@$row, $fid);
394          foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){      push (@$row, $length);
395              push (@{$db_aliases{$groups{$key}}}, $key);      push (@$row, $function);
396          }  
397        # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
         $content .= qq(<tr><td>Aliases</td><td><table border="0">);  
         foreach my $key (sort keys %db_aliases){  
             $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);  
         }  
         $content .= qq(</td></tr></table>\n);  
     }  
   
     $content .= qq(</table><p>\n);  
407    
408      return ($content);      return ($content);
409  }  }
# Line 447  Line 414 
414  =cut  =cut
415    
416  sub get_sims_summary {  sub get_sims_summary {
417      my ($observation, $fid, $taxes) = @_;      my ($observation, $fid, $taxes, $dataset, $fig) = @_;
     my $fig = new FIG;  
418      my %families;      my %families;
419      my @sims= $fig->nsims($fid,20000,10,"fig");      #my @sims= $fig->nsims($fid,20000,10,"fig");
420    
421      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
422          next if ($sim->[1] !~ /fig\|/);          next if ($thing->class ne "SIM");
423          my $genome = $fig->genome_of($sim->[1]);  
424          my ($genome1) = ($genome) =~ /(.*)\./;          my $id      = $thing->acc;
425          my $taxonomy = $taxes->{$genome1};          my $evalue  = $thing->evalue;
426          #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated  
427            next if ($id !~ /fig\|/);
428            next if ($fig->is_deleted_fid($id));
429            my $genome = $fig->genome_of($id);
430            #my ($genome1) = ($genome) =~ /(.*)\./;
431            #my $taxonomy = $taxes->{$genome1};
432            my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated
433          my $parent_tax = "Root";          my $parent_tax = "Root";
434          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
435          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 467  Line 439 
439              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
440              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
441                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($sim->[10] < $families{evalue}{$tax}){
442                      $families{evalue}{$tax} = $sim->[10];                      $families{evalue}{$tax} = $evalue;
443                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                      $families{color}{$tax} = &get_taxcolor($evalue);
444                  }                  }
445              }              }
446              else{              else{
447                  $families{evalue}{$tax} = $sim->[10];                  $families{evalue}{$tax} = $evalue;
448                  $families{color}{$tax} = &get_taxcolor($sim->[10]);                  $families{color}{$tax} = &get_taxcolor($evalue);
449              }              }
450    
451              $parent_tax = $tax;              $parent_tax = $tax;
# Line 518  Line 490 
490  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
491    
492      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
493      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
494    
495      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
496          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
497          my @parts = split("::",$key);          my @parts = split("::",$key);
498          my $class = $parts[0];          my $class = $parts[0];
# Line 562  Line 531 
531    
532  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
533    
534      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
535      my $fig = new FIG;      #my $fig = new FIG;
536    
537      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
538    
# Line 573  Line 542 
542                     };                     };
543    
544      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
547          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 585  Line 553 
553                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
554                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
555                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
556              }              }
557              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
558                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 624  Line 591 
591  =cut  =cut
592    
593  sub get_pdb_observations{  sub get_pdb_observations{
594      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
595    
596      my $fig = new FIG;      #my $fig = new FIG;
597    
598      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
599          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
600          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
601          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 685  Line 650 
650    
651  sub get_sims_observations{  sub get_sims_observations{
652    
653      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
654      my $fig = new FIG;      #my $fig = new FIG;
655      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
656      my ($dataset);      my ($dataset);
657    
     my %id_list;  
658      foreach my $sim (@sims){      foreach my $sim (@sims){
659          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){  
660          my $hit = $sim->[1];          my $hit = $sim->[1];
661          my $percent = $sim->[2];          my $percent = $sim->[2];
662          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 782  Line 726 
726    
727  sub get_identical_proteins{  sub get_identical_proteins{
728    
729      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
730      my $fig = new FIG;      #my $fig = new FIG;
731      my $funcs_ref;      my $funcs_ref;
732    
 #    my %id_list;  
733      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
734      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
735          my ($tmp, $who);          my ($tmp, $who);
736          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
737              $who = &get_database($id);              $who = &get_database($id);
738              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
739          }          }
740      }      }
741    
     my ($dataset);  
742      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
743                     'type' => 'seq',                     'type' => 'seq',
744                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 822  Line 758 
758    
759  sub get_functional_coupling{  sub get_functional_coupling{
760    
761      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
762      my $fig = new FIG;      #my $fig = new FIG;
763      my @funcs = ();      my @funcs = ();
764    
765      # initialize some variables      # initialize some variables
# Line 982  Line 918 
918  =cut  =cut
919    
920  sub display{  sub display{
921      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
922    
923      my $fid = $self->fig_id;      my $fid = $self->fig_id;
924      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
# Line 1009  Line 945 
945                          'short_title' => "best PDB",                          'short_title' => "best PDB",
946                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
947    
948      my $fig = new FIG;      #my $fig = new FIG;
949      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
950      my $fid_stop = length($seq);      my $fid_stop = length($seq);
951    
# Line 1110  Line 1046 
1046    
1047    
1048  sub display_table{  sub display_table{
1049      my ($self) = @_;      my ($self,$fig) = @_;
1050    
1051      my $fig = new FIG;      #my $fig = new FIG;
1052      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1053      my $rows = $self->rows;      my $rows = $self->rows;
1054      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1174  Line 1110 
1110    
1111  sub display_table {  sub display_table {
1112    
1113      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1114      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1115      my $rows = $self->rows;      my $rows = $self->rows;
1116      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1189  Line 1125 
1125          # construct the score link          # construct the score link
1126          my $score = $row->[0];          my $score = $row->[0];
1127          my $toid = $row->[1];          my $toid = $row->[1];
1128          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1129          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1130    
1131          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1132          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1262  Line 1198 
1198              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1199          }          }
1200      }      }
1201        elsif($db =~ /PFAM/){
1202            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1203            if(!scalar(@$pfam_objs)){
1204                $name_title = "name";
1205                $name_value = "not available";
1206                $description_title = "description";
1207                $description_value = "not available";
1208            }
1209            else{
1210                my $pfam_obj = $pfam_objs->[0];
1211                $name_title = "name";
1212                $name_value = $pfam_obj->term;
1213                #$description_title = "description";
1214                #$description_value = $pfam_obj->description;
1215            }
1216        }
1217    
1218      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1219                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1220        my $line_config = { 'title' => $name_value,
1221                            'short_title' => $short_title,
1222                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1223    
1224      my $name;      my $name;
1225      $name = {"title" => $name_title,      $name = {"title" => $db,
1226               "value" => $name_value};               "value" => $id};
1227      push(@$descriptions,$name);      push(@$descriptions,$name);
1228    
1229      my $description;  #    my $description;
1230      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1231                               "value" => $description_value};  #                   "value" => $description_value};
1232      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1233    
1234      my $score;      my $score;
1235      $score = {"title" => "score",      $score = {"title" => "score",
1236                "value" => $thing->evalue};                "value" => $thing->evalue};
1237      push(@$descriptions,$score);      push(@$descriptions,$score);
1238    
1239        my $location;
1240        $location = {"title" => "location",
1241                     "value" => $thing->start . " - " . $thing->stop};
1242        push(@$descriptions,$location);
1243    
1244      my $link_id;      my $link_id;
1245      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1246          $link_id = $1;          $link_id = $1;
1247      }      }
1248    
# Line 1298  Line 1257 
1257      push(@$links_list,$link);      push(@$links_list,$link);
1258    
1259      my $element_hash = {      my $element_hash = {
1260          "title" => $thing->type,          "title" => $name_value,
1261          "start" => $thing->start,          "start" => $thing->start,
1262          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1263          "color"=> $color,          "color"=> $color,
# Line 1406  Line 1365 
1365  }  }
1366    
1367  sub display {  sub display {
1368      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1369    
1370      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1371      my $fig= new FIG;      #my $fig= new FIG;
1372      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1373    
1374      my $cleavage_prob;      my $cleavage_prob;
# Line 1669  Line 1628 
1628  =cut  =cut
1629    
1630  sub display {  sub display {
1631      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1632        #my $fig = new FIG;
1633    
1634      my $fig = new FIG;      my @ids;
1635      my $peg = $self->acc;      foreach my $thing(@$array){
1636      my $query = $self->query;          next if ($thing->class ne "SIM");
1637            push (@ids, $thing->acc);
1638        }
1639    
1640        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1641    
1642        foreach my $thing (@$array){
1643            if ($thing->class eq "SIM"){
1644    
1645      my $organism = $self->organism;              my $peg = $thing->acc;
1646                my $query = $thing->query;
1647    
1648                my $organism = $thing->organism;
1649      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1650      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1651      my $function = $self->function;              my $function = $thing->function;
1652      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1653      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1654      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1655      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1656      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1657    
1658      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1659    
# Line 1700  Line 1670 
1670      my $descriptions = [];      my $descriptions = [];
1671    
1672      # get subsystem information      # get subsystem information
1673      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1674      my $link;      my $link;
1675      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1676               "link" => $url_link};               "link" => $url_link};
1677      push(@$links_list,$link);      push(@$links_list,$link);
1678    
1679      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1680      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1681                my @subsystems;
1682    
1683                foreach my $array (@subs){
1684                    my $subsystem = $$array[0];
1685                    push(@subsystems,$subsystem);
1686          my $link;          my $link;
1687          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1688                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1689          push(@$links_list,$link);          push(@$links_list,$link);
1690      }      }
1691    
1692      $link = {"link_title" => "blast against query",              $link = {"link_title" => "view blast alignment",
1693               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=tool_result&tool=bl2seq&peg1=$query&peg2=$peg"};                       "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1694      push (@$links_list,$link);      push (@$links_list,$link);
1695    
1696      my $description_function;      my $description_function;
# Line 1739  Line 1713 
1713                          "value" => $hit_stop};                          "value" => $hit_stop};
1714      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1715    
1716      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1717      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1718      {      {
1719          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1770  Line 1744 
1744          };          };
1745      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1746      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1747            }
1748        }
1749      return ($gd);      return ($gd);
   
1750  }  }
1751    
1752  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1782  Line 1756 
1756  =cut  =cut
1757    
1758  sub display_domain_composition {  sub display_domain_composition {
1759      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1760    
1761      my $fig = new FIG;      #$fig = new FIG;
1762      my $peg = $self->acc;      my $peg = $self->acc;
1763    
1764      my $line_data = [];      my $line_data = [];
# Line 1792  Line 1766 
1766      my $descriptions = [];      my $descriptions = [];
1767    
1768      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1769        #my @domain_query_results = ();
1770      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1771          my $key = @$dqr[1];          my $key = @$dqr[1];
1772          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1897  Line 1871 
1871  =cut  =cut
1872    
1873  sub display_table {  sub display_table {
1874      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1875    
1876      my $data = [];      my $data = [];
1877      my $count = 0;      my $count = 0;
1878      my $content;      my $content;
1879      my $fig = new FIG;      #my $fig = new FIG;
1880      my $cgi = new CGI;      my $cgi = new CGI;
1881      my @ids;      my @ids;
1882      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1911  Line 1885 
1885      }      }
1886    
1887      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1888        my @attributes = $fig->get_attributes(\@ids);
1889    
1890      # get the column for the subsystems      # get the column for the subsystems
1891      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1892    
1893      # get the column for the evidence codes      # get the column for the evidence codes
1894      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1895    
1896      # get the column for pfam_domain      # get the column for pfam_domain
1897      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1898    
1899      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1900      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1901        #my $alias_col = {};
1902    
1903      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1904          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1930  Line 1906 
1906          $count++;          $count++;
1907    
1908          my $id = $thing->acc;          my $id = $thing->acc;
1909            my $taxid   = $fig->genome_of($id);
1910          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1911          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1912          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1952  Line 1928 
1928          # get the linked fig id          # get the linked fig id
1929          my $fig_col;          my $fig_col;
1930          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1931              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1932          }          }
1933          else{          else{
1934              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1935          }          }
1936    
1937          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1938          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1939          push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
1940          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1941              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1942              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1943              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1944              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1945              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1946              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1947              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1948              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1949              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1950              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1951              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1952              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1953              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1954              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1955                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1956          }          }
1957          push(@$data,$single_domain);          push(@$data,$single_domain);
1958      }      }
   
1959      if ($count >0 ){      if ($count >0 ){
1960          $content = $data;          $content = $data;
1961      }      }
# Line 2006  Line 1977 
1977  }  }
1978    
1979  sub get_subsystems_column{  sub get_subsystems_column{
1980      my ($ids) = @_;      my ($ids,$fig) = @_;
1981    
1982      my $fig = new FIG;      #my $fig = new FIG;
1983      my $cgi = new CGI;      my $cgi = new CGI;
1984      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
1985      my %column;      my %column;
# Line 2017  Line 1988 
1988          my @subsystems;          my @subsystems;
1989    
1990          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
1991              foreach my $array(@in_sub){              foreach my $array(@in_sub){
1992                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
1993                  $count++;                  $ss =~ s/_/ /ig;
1994                    push (@subsystems, "-" . $ss);
1995              }              }
1996              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
1997              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 2032  Line 2003 
2003  }  }
2004    
2005  sub get_essentially_identical{  sub get_essentially_identical{
2006      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2007      my $fig = new FIG;      #my $fig = new FIG;
2008    
2009      my %id_list;      my %id_list;
2010      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2011    
2012      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2013            if($thing->class eq "IDENTICAL"){
2014                my $rows = $thing->rows;
2015                my $count_identical = 0;
2016                foreach my $row (@$rows) {
2017                    my $id = $row->[0];
2018          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2019              $id_list{$id} = 1;              $id_list{$id} = 1;
2020          }          }
2021      }      }
2022            }
2023        }
2024    
2025    #    foreach my $id (@maps_to) {
2026    #        if (($id ne $fid) && ($fig->function_of($id))) {
2027    #           $id_list{$id} = 1;
2028    #        }
2029    #    }
2030      return(%id_list);      return(%id_list);
2031  }  }
2032    
2033    
2034  sub get_evidence_column{  sub get_evidence_column{
2035      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2036      my $fig = new FIG;      #my $fig = new FIG;
2037      my $cgi = new CGI;      my $cgi = new CGI;
2038      my (%column, %code_attributes);      my (%column, %code_attributes);
2039    
2040      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2041      foreach my $key (@codes){      foreach my $key (@codes){
2042          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2043      }      }
# Line 2061  Line 2045 
2045      foreach my $id (@$ids){      foreach my $id (@$ids){
2046          # add evidence code with tool tip          # add evidence code with tool tip
2047          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2048    
2049          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2050              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2051              foreach my $code (@codes) {              foreach my $code (@codes) {
2052                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2053                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2076  Line 2057 
2057                  }                  }
2058                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2059              }              }
         }  
2060    
2061          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2062              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2090  Line 2070 
2070  }  }
2071    
2072  sub get_pfam_column{  sub get_pfam_column{
2073      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2074      my $fig = new FIG;      #my $fig = new FIG;
2075      my $cgi = new CGI;      my $cgi = new CGI;
2076      my (%column, %code_attributes, %attribute_locations);      my (%column, %code_attributes, %attribute_locations);
2077      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
2078    
2079      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2080      foreach my $key (@codes){      foreach my $key (@codes){
2081          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2082          push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);          if ($name =~ /_/){
2083                ($name) = ($key->[1]) =~ /(.*?)_/;
2084            }
2085            push (@{$code_attributes{$key->[0]}}, $name);
2086            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2087      }      }
2088    
2089      foreach my $id (@$ids){      foreach my $id (@$ids){
2090          # add evidence code with tool tip          # add evidence code
2091          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2092          my @pfam_codes = "";          my @pfam_codes = "";
2093          my %description_codes;          my %description_codes;
# Line 2127  Line 2111 
2111                      my ($loc) = ($part) =~ /\;(.*)/;                      my ($loc) = ($part) =~ /\;(.*)/;
2112                      push (@locs,$loc);                      push (@locs,$loc);
2113                  }                  }
2114                    my %locsaw;
2115                    foreach my $key (@locs) {$locsaw{$key}=1;}
2116                    @locs = keys %locsaw;
2117    
2118                  my $locations = join (", ", @locs);                  my $locations = join (", ", @locs);
2119    
2120                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
# Line 2146  Line 2134 
2134    
2135  }  }
2136    
2137  sub get_prefer {  sub get_aliases {
2138      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2139    
2140      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2141        foreach my $id (@$ids){
2142            foreach my $alias (@{$$all_aliases{$id}}){
2143          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2144          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2145              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2146          }          }
2147      }      }
2148      return (" ");      return ($aliases);
2149  }  }
2150    
2151  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2152    
2153  sub color {  sub color {
2154      my ($evalue) = @_;      my ($evalue) = @_;
2155        my $palette = WebColors::get_palette('vitamins');
2156      my $color;      my $color;
2157      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2158      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2159      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2160      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2161      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2162      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2163      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2164      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2165      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2166      else{        $color = 60;    }      else{        $color = $palette->[9];    }
2167      return ($color);      return ($color);
2168  }  }
2169    
# Line 2195  Line 2183 
2183  }  }
2184    
2185  sub display {  sub display {
2186      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2187    
2188      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2189      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2190      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2191      my $fig = new FIG;      my $range = $gd_window_size;
2192      my $all_regions = [];      my $all_regions = [];
2193      my $gene_associations={};      my $gene_associations={};
2194    
# Line 2225  Line 2213 
2213      my ($region_start, $region_end);      my ($region_start, $region_end);
2214      if ($beg < $end)      if ($beg < $end)
2215      {      {
2216          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2217          $region_end = $end+4000;          $region_end = $end+ ($range);
2218          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2219      }      }
2220      else      else
2221      {      {
2222          $region_start = $end-4000;          $region_start = $end-($range);
2223          $region_end = $beg+4000;          $region_end = $beg+($range);
2224          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2225          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2226          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2240  Line 2228 
2228    
2229      # call genes in region      # call genes in region
2230      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2231        #foreach my $feat (@$target_gene_features){
2232        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2233        #}
2234      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2235      my (@start_array_region);      my (@start_array_region);
2236      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2237    
2238      my %all_genes;      my %all_genes;
2239      my %all_genomes;      my %all_genomes;
2240      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2241            #if ($feature =~ /peg/){
2242                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2243            #}
2244        }
2245    
2246        my @selected_sims;
2247    
2248      if ($compare_or_coupling eq "sims"){      if ($compare_or_coupling eq "sims"){
2249          # get the selected boxes          # get the selected boxes
2250          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2251    
2252          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
2253          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2254              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2255                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2256                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2257                  my ($genome1) = ($genome) =~ /(.*)\./;  
2258                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
2259                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
2260                    #my ($genome1) = ($genome) =~ /(.*)\./;
2261                    #my $lineage = $taxes->{$genome1};
2262                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2263                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2264                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2265                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2266                            push (@selected_sims, $sim->acc);
2267                      }                      }
2268                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2269              }              }
2270          }          }
2271          else{          else{
2272              my $simcount = 0;              my $simcount = 0;
2273              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2274                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2275                  push (@selected_sims, $sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2276    
2277                    push (@selected_sims, $sim->acc);
2278                  $simcount++;                  $simcount++;
2279                  last if ($simcount > 4);                  last if ($simcount > 4);
2280              }              }
2281          }          }
2282    
2283            my %saw;
2284            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2285    
2286          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2287          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2288              #get the organism genome              #get the organism genome
# Line 2304  Line 2305 
2305              my ($region_start, $region_end);              my ($region_start, $region_end);
2306              if ($beg < $end)              if ($beg < $end)
2307              {              {
2308                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2309                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2310                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2311              }              }
2312              else              else
2313              {              {
2314                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2315                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2316                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2317                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2318                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2327  Line 2328 
2328    
2329      }      }
2330    
2331        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2332      # cluster the genes      # cluster the genes
2333      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2334      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2335        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2336        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2337    
2338      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2339          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2340          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2341          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2342          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2343          my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2344          my $lineage = $taxes->{$genome1};          #my $lineage = $taxes->{$genome1};
2345            my $lineage = $fig->taxonomy_of($region_genome);
2346          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2347          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2348                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2370  Line 2375 
2375    
2376              # get subsystem information              # get subsystem information
2377              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2378              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2379    
2380              my $link;              my $link;
2381              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2382                       "link" => $url_link};                       "link" => $url_link};
2383              push(@$links_list,$link);              push(@$links_list,$link);
2384    
2385              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2386              foreach my $subsystem (@subsystems){              my @subsystems;
2387                foreach my $array (@subs){
2388                    my $subsystem = $$array[0];
2389                    my $ss = $subsystem;
2390                    $ss =~ s/_/ /ig;
2391                    push (@subsystems, $ss);
2392                  my $link;                  my $link;
2393                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2394                           "link_title" => $subsystem};                           "link_title" => $ss};
2395                    push(@$links_list,$link);
2396                }
2397    
2398                if ($fid1 eq $fid){
2399                    my $link;
2400                    $link = {"link_title" => "Annotate this sequence",
2401                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2402                  push(@$links_list,$link);                  push(@$links_list,$link);
2403              }              }
2404    
# Line 2420  Line 2437 
2437                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2438                  }                  }
2439    
2440                    my $title = $fid1;
2441                    if ($fid1 eq $fid){
2442                        $title = "My query gene: $fid1";
2443                    }
2444    
2445                  $element_hash = {                  $element_hash = {
2446                      "title" => $fid1,                      "title" => $title,
2447                      "start" => $start,                      "start" => $start,
2448                      "end" =>  $stop,                      "end" =>  $stop,
2449                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2434  Line 2456 
2456                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2457                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2458                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2459    
2460                    if ($fid1 eq $fid){
2461                        $element_hash = {
2462                            "title" => 'Query',
2463                            "start" => $start,
2464                            "end" =>  $stop,
2465                            "type"=> 'bigbox',
2466                            "color"=> $color,
2467                            "zlayer" => "1"
2468                            };
2469    
2470                        # if there is an overlap, put into second line
2471                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2472                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2473                    }
2474              }              }
2475          }          }
2476          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2477          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2478      }      }
2479      return $gd;      return ($gd, \@selected_sims);
2480  }  }
2481    
2482  sub cluster_genes {  sub cluster_genes {
# Line 2509  Line 2546 
2546      }      }
2547    
2548      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2549          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2550              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2551                  foreach $y (@$x) {                  foreach $y (@$x) {
2552                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2527  Line 2564 
2564      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2565      return ($i < @$xL);      return ($i < @$xL);
2566  }  }
2567    
2568    #############################################
2569    #############################################
2570    package Observation::Commentary;
2571    
2572    use base qw(Observation);
2573    
2574    =head3 display_protein_commentary()
2575    
2576    =cut
2577    
2578    sub display_protein_commentary {
2579        my ($self,$dataset,$mypeg,$fig) = @_;
2580    
2581        my $all_rows = [];
2582        my $content;
2583        #my $fig = new FIG;
2584        my $cgi = new CGI;
2585        my $count = 0;
2586        my $peg_array = [];
2587        my (%evidence_column, %subsystems_column,  %e_identical);
2588    
2589        if (@$dataset != 1){
2590            foreach my $thing (@$dataset){
2591                if ($thing->class eq "SIM"){
2592                    push (@$peg_array, $thing->acc);
2593                }
2594            }
2595            # get the column for the evidence codes
2596            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2597    
2598            # get the column for the subsystems
2599            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2600    
2601            # get essentially identical seqs
2602            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2603        }
2604        else{
2605            push (@$peg_array, @$dataset);
2606        }
2607    
2608        my $selected_sims = [];
2609        foreach my $id (@$peg_array){
2610            last if ($count > 10);
2611            my $row_data = [];
2612            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2613            $org = $fig->org_of($id);
2614            $function = $fig->function_of($id);
2615            if ($mypeg ne $id){
2616                $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";
2617                $id_cell .= &HTML::set_prot_links($cgi,$id);
2618                if (defined($e_identical{$id})) { $id_cell .= "*";}
2619            }
2620            else{
2621                $function_cell = "&nbsp;&nbsp;$function";
2622                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2623                $id_cell .= &HTML::set_prot_links($cgi,$id);
2624            }
2625    
2626            push(@$row_data,$id_cell);
2627            push(@$row_data,$org);
2628            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2629            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2630            push(@$row_data, $fig->translation_length($id));
2631            push(@$row_data,$function_cell);
2632            push(@$all_rows,$row_data);
2633            push (@$selected_sims, $id);
2634            $count++;
2635        }
2636    
2637        if ($count >0){
2638            $content = $all_rows;
2639        }
2640        else{
2641            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2642        }
2643        return ($content,$selected_sims);
2644    }
2645    
2646    sub display_protein_history {
2647        my ($self, $id,$fig) = @_;
2648        my $all_rows = [];
2649        my $content;
2650    
2651        my $cgi = new CGI;
2652        my $count = 0;
2653        foreach my $feat ($fig->feature_annotations($id)){
2654            my $row = [];
2655            my $col1 = $feat->[2];
2656            my $col2 = $feat->[1];
2657            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2658            my $text = $feat->[3];
2659    
2660            push (@$row, $col1);
2661            push (@$row, $col2);
2662            push (@$row, $text);
2663            push (@$all_rows, $row);
2664            $count++;
2665        }
2666        if ($count > 0){
2667            $content = $all_rows;
2668        }
2669        else {
2670            $content = "There is no history for this PEG";
2671        }
2672    
2673        return($content);
2674    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3