[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.41, Tue Oct 9 19:05:29 2007 UTC
# Line 317  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 333  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 346  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 377  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);  
   
     $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);  
     $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);  
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
   
     if ( @subsystems ) {  
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\n";  
         }  
     }  
   
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
         }  
   
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
389    
390        push (@$row, $org_name);
391        push (@$row, $fid);
392        push (@$row, $length);
393        push (@$row, $function);
394    
395        # initialize the table for commentary and annotations
396        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
397        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
398        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
399        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
400        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
401        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
402        #$content .= qq(</table><p>\n);
403    
404          $content .= qq(<tr><td>Aliases</td><td><table border="0">);      push(@$content, $row);
         foreach my $key (sort keys %db_aliases){  
             $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);  
         }  
         $content .= qq(</td></tr></table>\n);  
     }  
   
     $content .= qq(</table><p>\n);  
405    
406      return ($content);      return ($content);
407  }  }
# Line 447  Line 412 
412  =cut  =cut
413    
414  sub get_sims_summary {  sub get_sims_summary {
415      my ($observation, $fid, $taxes) = @_;      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    
# Line 518  Line 483 
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 562  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 573  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 585  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 624  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 685  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;  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
653      foreach my $sim (@sims){      foreach my $sim (@sims){
654          my $hit = $sim->[1];          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 782  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 822  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 982  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 1009  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 1110  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 1174  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 1262  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 1298  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 1394  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;
# Line 1406  Line 1359 
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 1669  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      my $query = $self->query;          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 1701  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" => "blast against query",              $link = {"link_title" => "view blast alignment",
1687               "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"};
1688      push (@$links_list,$link);      push (@$links_list,$link);
1689    
1690      my $description_function;      my $description_function;
# Line 1739  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 1770  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 1782  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 1897  Line 1865 
1865  =cut  =cut
1866    
1867  sub display_table {  sub display_table {
1868      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;      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 1911  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 1930  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 1958  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});}              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1947          }          }
1948          push(@$data,$single_domain);          push(@$data,$single_domain);
# Line 2006  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 2017  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 2032  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 2061  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 2076  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 2090  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, %attribute_locations);      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          push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);          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;
# Line 2127  Line 2103 
2103                      my ($loc) = ($part) =~ /\;(.*)/;                      my ($loc) = ($part) =~ /\;(.*)/;
2104                      push (@locs,$loc);                      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);                  my $locations = join (", ", @locs);
2111    
2112                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
# Line 2146  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; $_ }
# Line 2195  Line 2174 
2174  }  }
2175    
2176  sub display {  sub display {
2177      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      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 2225  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 2247  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 "sims"){      if ($compare_or_coupling eq "sims"){
2233          # get the selected boxes          # get the selected boxes
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    
2242                    #my $genome = $fig->genome_of($sim->[1]);
2243                    my $genome = $fig->genome_of($sim->acc);
2244                  my ($genome1) = ($genome) =~ /(.*)\./;                  my ($genome1) = ($genome) =~ /(.*)\./;
2245                  my $lineage = $taxes->{$genome1};                  my $lineage = $taxes->{$genome1};
2246                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  #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                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2253              }              }
2254          }          }
2255          else{          else{
2256              my $simcount = 0;              my $simcount = 0;
2257              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2258                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2259                  push (@selected_sims, $sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2260    
2261                    push (@selected_sims, $sim->acc);
2262                  $simcount++;                  $simcount++;
2263                  last if ($simcount > 4);                  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 2304  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 2327  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];
# Line 2377  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 2420  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 2434  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 2527  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.40  
changed lines
  Added in v.1.41

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3