[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.24, Tue Jul 10 20:11:38 2007 UTC revision 1.29, Thu Aug 16 16:49:16 2007 UTC
# Line 151  Line 151 
151  sub type {  sub type {
152    my ($self) = @_;    my ($self) = @_;
153    
154    return $self->{acc};    return $self->{type};
155  }  }
156    
157  =head3 start()  =head3 start()
# Line 308  Line 308 
308    
309      my $objects = [];      my $objects = [];
310      my @matched_datasets=();      my @matched_datasets=();
311        my $fig = new FIG;
312    
313      # call function that fetches attribute based observations      # call function that fetches attribute based observations
314      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 317  Line 318 
318      }      }
319      else{      else{
320          my %domain_classes;          my %domain_classes;
321            my @attributes = $fig->get_attributes($fid);
322          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
323          get_identical_proteins($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets);
324          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);
325          get_sims_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets);
326          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
327          get_attribute_based_location_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);
328          get_pdb_observations($fid,\@matched_datasets);          get_pdb_observations($fid,\@matched_datasets,\@attributes);
329      }      }
330    
331      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 357  Line 359 
359    
360  }  }
361    
362    =head3 display_housekeeping
363    This method returns the housekeeping data for a given peg in a table format
364    
365    =cut
366    sub display_housekeeping {
367        my ($self,$fid) = @_;
368        my $fig = new FIG;
369        my $content;
370    
371        my $org_name = $fig->org_of($fid);
372        my $org_id   = $fig->orgid_of_orgname($org_name);
373        my $loc      = $fig->feature_location($fid);
374        my($contig, $beg, $end) = $fig->boundaries_of($loc);
375        my $strand   = ($beg <= $end)? '+' : '-';
376        my @subsystems = $fig->subsystems_for_peg($fid);
377        my $function = $fig->function_of($fid);
378        my @aliases  = $fig->feature_aliases($fid);
379        my $taxonomy = $fig->taxonomy_of($org_id);
380        my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);
381    
382        $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);
383        $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
384        $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);
385        $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
386        $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);
387        $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;
388        $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
389        if ( @ecs ) {
390            $content .= qq(<tr><td>EC:</td><td>);
391            foreach my $ec ( @ecs ) {
392                my $ec_name = $fig->ec_name($ec);
393                $content .= join(" -- ", $ec, $ec_name) . "<br>\n";
394            }
395            $content .= qq(</td></tr>\n);
396        }
397    
398        if ( @subsystems ) {
399            $content .= qq(<tr><td>Subsystems</td><td>);
400            foreach my $subsystem ( @subsystems ) {
401                $content .= join(" -- ", @$subsystem) . "<br>\n";
402            }
403        }
404    
405        my %groups;
406        if ( @aliases ) {
407            # get the db for each alias
408            foreach my $alias (@aliases){
409                $groups{$alias} = &get_database($alias);
410            }
411    
412            # group ids by aliases
413            my %db_aliases;
414            foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){
415                push (@{$db_aliases{$groups{$key}}}, $key);
416            }
417    
418    
419            $content .= qq(<tr><td>Aliases</td><td><table border="0">);
420            foreach my $key (sort keys %db_aliases){
421                $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);
422            }
423            $content .= qq(</td></tr></table>\n);
424        }
425    
426        $content .= qq(</table><p>\n);
427    
428        return ($content);
429    }
430    
431    =head3 get_sims_summary
432    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
433    
434    =cut
435    
436    sub get_sims_summary {
437        my ($observation, $fid) = @_;
438        my $fig = new FIG;
439        my %families;
440        my @sims= $fig->nsims($fid,20000,10,"all");
441    
442        foreach my $sim (@sims){
443            next if ($sim->[1] !~ /fig\|/);
444            my $genome = $fig->genome_of($sim->[1]);
445            my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));
446            my $parent_tax = "Root";
447            foreach my $tax (split(/\; /, $taxonomy)){
448                push (@{$families{children}{$parent_tax}}, $tax);
449                $families{parent}{$tax} = $parent_tax;
450                $parent_tax = $tax;
451            }
452        }
453    
454        foreach my $key (keys %{$families{children}}){
455            $families{count}{$key} = @{$families{children}{$key}};
456    
457            my %saw;
458            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
459            $families{children}{$key} = \@out;
460        }
461        return (\%families);
462    }
463    
464  =head1 Internal Methods  =head1 Internal Methods
465    
466  These methods are not meant to be used outside of this package.  These methods are not meant to be used outside of this package.
# Line 368  Line 472 
472  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
473    
474      # 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)
475      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
476    
477      my $fig = new FIG;      my $fig = new FIG;
478    
479      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
480    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
481          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
482          my @parts = split("::",$key);          my @parts = split("::",$key);
483          my $class = $parts[0];          my $class = $parts[0];
# Line 411  Line 516 
516    
517  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
518    
519      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
520      my $fig = new FIG;      my $fig = new FIG;
521    
522      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED'];
523    
524      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      my $dataset = {'type' => "loc",
525      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
526                       'fig_id' => $fid
527                       };
528    
529        foreach my $attr_ref (@$attributes_ref){
530    #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
531          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
532            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/));
533          my @parts = split("::",$key);          my @parts = split("::",$key);
534          my $sub_class = $parts[0];          my $sub_class = $parts[0];
535          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 428  Line 539 
539                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
540                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
541                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
542    #               print STDERR "LOC: $value_parts[1]";
543              }              }
544              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
545                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 438  Line 550 
550              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
551          }          }
552          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
553              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
554              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
555              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
556          }          }
# Line 455  Line 567 
567  =cut  =cut
568    
569  sub get_pdb_observations{  sub get_pdb_observations{
570      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
571    
572      my $fig = new FIG;      my $fig = new FIG;
573    
574      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref (@$attributes_ref){
575        #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
576    
577          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
578            next if ( ($key !~ /PDB/));
579          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
580          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
581          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 516  Line 630 
630    
631      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
632      my $fig = new FIG;      my $fig = new FIG;
633      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,500,1e-20,"all");
634      my ($dataset);      my ($dataset);
635    
636        my %id_list;
637      foreach my $sim (@sims){      foreach my $sim (@sims){
638          my $hit = $sim->[1];          my $hit = $sim->[1];
639    
640            next if ($hit !~ /^fig\|/);
641            my @aliases = $fig->feature_aliases($hit);
642            foreach my $alias (@aliases){
643                $id_list{$alias} = 1;
644            }
645        }
646    
647        my %already;
648        my (@new_sims, @uniprot);
649        foreach my $sim (@sims){
650            my $hit = $sim->[1];
651            my ($id) = ($hit) =~ /\|(.*)/;
652            next if (defined($already{$id}));
653            next if (defined($id_list{$hit}));
654            push (@new_sims, $sim);
655            $already{$id} = 1;
656        }
657    
658        foreach my $sim (@new_sims){
659            my $hit = $sim->[1];
660          my $percent = $sim->[2];          my $percent = $sim->[2];
661          my $evalue = $sim->[10];          my $evalue = $sim->[10];
662          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 569  Line 706 
706      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
707      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
708      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
709      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
710      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
711      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
712      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 591  Line 728 
728      my $fig = new FIG;      my $fig = new FIG;
729      my $funcs_ref;      my $funcs_ref;
730    
731        my %id_list;
732      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
733        my @aliases = $fig->feature_aliases($fid);
734        foreach my $alias (@aliases){
735            $id_list{$alias} = 1;
736        }
737    
738      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
739          my ($tmp, $who);          my ($tmp, $who);
740          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
741              $who = &get_database($id);              $who = &get_database($id);
742              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
743          }          }
# Line 788  Line 930 
930    
931      my $acc = $self->acc;      my $acc = $self->acc;
932    
     print STDERR "acc:$acc\n";  
933      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
934      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
935      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 923  Line 1064 
1064          my $id = $row->[0];          my $id = $row->[0];
1065          my $who = $row->[1];          my $who = $row->[1];
1066          my $assignment = $row->[2];          my $assignment = $row->[2];
1067          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1068          my $single_domain = [];          my $single_domain = [];
1069          push(@$single_domain,$who);          push(@$single_domain,$who);
1070          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 1031  Line 1172 
1172  sub display {  sub display {
1173      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1174      my $lines = [];      my $lines = [];
1175      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1176                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1177                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1178      my $color = "4";      my $color = "4";
1179    
1180      my $line_data = [];      my $line_data = [];
# Line 1063  Line 1204 
1204          }          }
1205      }      }
1206    
1207        my $line_config = { 'title' => $thing->acc,
1208                            'short_title' => $name_value,
1209                            'basepair_offset' => '1' };
1210    
1211      my $name;      my $name;
1212      $name = {"title" => $name_title,      $name = {"title" => $name_title,
1213               "value" => $name_value};               "value" => $name_value};
# Line 1109  Line 1254 
1254    
1255  }  }
1256    
1257    sub display_table {
1258        my ($self,$dataset) = @_;
1259        my $cgi = new CGI;
1260        my $data = [];
1261        my $count = 0;
1262        my $content;
1263    
1264        foreach my $thing (@$dataset) {
1265            next if ($thing->type !~ /dom/);
1266            my $single_domain = [];
1267            $count++;
1268    
1269            my $db_and_id = $thing->acc;
1270            my ($db,$id) = split("::",$db_and_id);
1271    
1272            my $dbmaster = DBMaster->new(-database =>'Ontology');
1273    
1274            my ($name_title,$name_value,$description_title,$description_value);
1275            if($db eq "CDD"){
1276                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1277                if(!scalar(@$cdd_objs)){
1278                    $name_title = "name";
1279                    $name_value = "not available";
1280                    $description_title = "description";
1281                    $description_value = "not available";
1282                }
1283                else{
1284                    my $cdd_obj = $cdd_objs->[0];
1285                    $name_title = "name";
1286                    $name_value = $cdd_obj->term;
1287                    $description_title = "description";
1288                    $description_value = $cdd_obj->description;
1289                }
1290            }
1291    
1292            my $location =  $thing->start . " - " . $thing->stop;
1293    
1294            push(@$single_domain,$db);
1295            push(@$single_domain,$thing->acc);
1296            push(@$single_domain,$name_value);
1297            push(@$single_domain,$location);
1298            push(@$single_domain,$thing->evalue);
1299            push(@$single_domain,$description_value);
1300            push(@$data,$single_domain);
1301        }
1302    
1303        if ($count >0){
1304            $content = $data;
1305        }
1306        else
1307        {
1308            $content = "<p>This PEG does not have any similarities to domains</p>";
1309        }
1310    }
1311    
1312    
1313  #########################################  #########################################
1314  #########################################  #########################################
1315  package Observation::Location;  package Observation::Location;
# Line 1148  Line 1349 
1349      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1350    
1351      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1352    
1353      #color is      #color is
1354      my $color = "5";      my $color = "6";
   
     my $line_data = [];  
1355    
1356      if($cello_location){      if($cello_location){
1357          my $cello_descriptions = [];          my $cello_descriptions = [];
1358            my $line_data =[];
1359    
1360            my $line_config = { 'title' => 'Localization Evidence',
1361                                'short_title' => 'CELLO',
1362                                'basepair_offset' => '1' };
1363    
1364          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1365                                            "value" => $cello_location};                                            "value" => $cello_location};
1366    
# Line 1175  Line 1377 
1377              "end" =>  $length + 1,              "end" =>  $length + 1,
1378              "color"=> $color,              "color"=> $color,
1379              "type" => 'box',              "type" => 'box',
1380              "zlayer" => '2',              "zlayer" => '1',
1381              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1382    
1383          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1384            $gd->add_line($line_data, $line_config);
1385      }      }
1386    
1387      my $color = "6";  
1388        $color = "2";
1389      if($tmpred_score){      if($tmpred_score){
1390            my $line_data =[];
1391            my $line_config = { 'title' => 'Localization Evidence',
1392                                'short_title' => 'Transmembrane',
1393                                'basepair_offset' => '1' };
1394    
1395    
1396          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1397              my $descriptions = [];              my $descriptions = [];
1398              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1201  Line 1411 
1411              "description" => $descriptions};              "description" => $descriptions};
1412    
1413              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1414    
1415          }          }
1416            $gd->add_line($line_data, $line_config);
1417      }      }
1418    
1419      my $color = "1";      $color = "1";
1420      if($signal_peptide_score){      if($signal_peptide_score){
1421            my $line_data = [];
1422          my $descriptions = [];          my $descriptions = [];
1423    
1424            my $line_config = { 'title' => 'Localization Evidence',
1425                                'short_title' => 'SignalP',
1426                                'basepair_offset' => '1' };
1427    
1428          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1429                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1430    
# Line 1220  Line 1438 
1438          my $element_hash = {          my $element_hash = {
1439              "title" => "SignalP",              "title" => "SignalP",
1440              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1441              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1442              "type" => 'bigbox',              "type" => 'bigbox',
1443              "color"=> $color,              "color"=> $color,
1444              "zlayer" => '10',              "zlayer" => '10',
1445              "description" => $descriptions};              "description" => $descriptions};
1446    
1447          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1448      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1449        }
1450    
1451      return ($gd);      return ($gd);
1452    
# Line 1305  Line 1522 
1522      return $self;      return $self;
1523  }  }
1524    
1525    =head3 display()
1526    
1527    If available use the function specified here to display a graphical observation.
1528    This code will display a graphical view of the similarities using the genome drawer object
1529    
1530    =cut
1531    
1532    sub display {
1533        my ($self,$gd) = @_;
1534    
1535        my $fig = new FIG;
1536        my $peg = $self->acc;
1537    
1538        my $organism = $self->organism;
1539        my $genome = $fig->genome_of($peg);
1540        my ($org_tax) = ($genome) =~ /(.*)\./;
1541        my $function = $self->function;
1542        my $abbrev_name = $fig->abbrev($organism);
1543        my $align_start = $self->qstart;
1544        my $align_stop = $self->qstop;
1545        my $hit_start = $self->hstart;
1546        my $hit_stop = $self->hstop;
1547    
1548        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1549    
1550        my $line_config = { 'title' => "$organism [$org_tax]",
1551                            'short_title' => "$abbrev_name",
1552                            'title_link' => '$tax_link',
1553                            'basepair_offset' => '0'
1554                            };
1555    
1556        my $line_data = [];
1557    
1558        my $element_hash;
1559        my $links_list = [];
1560        my $descriptions = [];
1561    
1562        # get subsystem information
1563        my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1564    
1565        my $link;
1566        $link = {"link_title" => $peg,
1567                 "link" => $url_link};
1568        push(@$links_list,$link);
1569    
1570        my @subsystems = $fig->peg_to_subsystems($peg);
1571        foreach my $subsystem (@subsystems){
1572            my $link;
1573            $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1574                     "link_title" => $subsystem};
1575            push(@$links_list,$link);
1576        }
1577    
1578        my $description_function;
1579        $description_function = {"title" => "function",
1580                                 "value" => $function};
1581        push(@$descriptions,$description_function);
1582    
1583        my ($description_ss, $ss_string);
1584        $ss_string = join (",", @subsystems);
1585        $description_ss = {"title" => "subsystems",
1586                           "value" => $ss_string};
1587        push(@$descriptions,$description_ss);
1588    
1589        my $description_loc;
1590        $description_loc = {"title" => "location start",
1591                            "value" => $hit_start};
1592        push(@$descriptions, $description_loc);
1593    
1594        $description_loc = {"title" => "location stop",
1595                            "value" => $hit_stop};
1596        push(@$descriptions, $description_loc);
1597    
1598        my $evalue = $self->evalue;
1599        while ($evalue =~ /-0/)
1600        {
1601            my ($chunk1, $chunk2) = split(/-/, $evalue);
1602            $chunk2 = substr($chunk2,1);
1603            $evalue = $chunk1 . "-" . $chunk2;
1604        }
1605    
1606        my $color = &color($evalue);
1607    
1608        my $description_eval = {"title" => "E-Value",
1609                                "value" => $evalue};
1610        push(@$descriptions, $description_eval);
1611    
1612        my $identity = $self->identity;
1613        my $description_identity = {"title" => "Identity",
1614                                    "value" => $identity};
1615        push(@$descriptions, $description_identity);
1616    
1617        $element_hash = {
1618            "title" => $peg,
1619            "start" => $align_start,
1620            "end" =>  $align_stop,
1621            "type"=> 'box',
1622            "color"=> $color,
1623            "zlayer" => "2",
1624            "links_list" => $links_list,
1625            "description" => $descriptions
1626            };
1627        push(@$line_data,$element_hash);
1628        $gd->add_line($line_data, $line_config);
1629    
1630        return ($gd);
1631    
1632    }
1633    
1634  =head3 display_table()  =head3 display_table()
1635    
1636  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
# Line 1315  Line 1641 
1641  =cut  =cut
1642    
1643  sub display_table {  sub display_table {
1644      my ($self,$dataset) = @_;      my ($self,$dataset, $preference, $columns) = @_;
1645    
1646      my $data = [];      my $data = [];
1647      my $count = 0;      my $count = 0;
1648      my $content;      my $content;
1649      my $fig = new FIG;      my $fig = new FIG;
1650      my $cgi = new CGI;      my $cgi = new CGI;
1651        my @ids;
1652      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
         my $single_domain = [];  
1653          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1654            push (@ids, $thing->acc);
1655        }
1656    
1657        my (%box_column, %subsystems_column, %evidence_column, %code_attributes);
1658        foreach my $col (@$columns){
1659            # get the column for the subsystems
1660            if ($col eq "subsystem"){
1661                %subsystems_column = &get_subsystems_column(\@ids);
1662            }
1663            # get the column for the evidence codes
1664            elsif ($col eq "evidence"){
1665                %evidence_column = &get_evidence_column(\@ids);
1666            }
1667        }
1668    
1669        foreach my $thing (@$dataset) {
1670            next if ($thing->class ne "SIM");
1671            my $single_domain = [];
1672          $count++;          $count++;
1673    
1674          my $id = $thing->acc;          my $id = $thing->acc;
1675    
1676          # add the subsystem information          my $iden    = $thing->identity;
1677          my @in_sub  = $fig->peg_to_subsystems($id);          my $ln1     = $thing->qlength;
1678            my $ln2     = $thing->hlength;
1679            my $b1      = $thing->qstart;
1680            my $e1      = $thing->qstop;
1681            my $b2      = $thing->hstart;
1682            my $e2      = $thing->hstop;
1683            my $d1      = abs($e1 - $b1) + 1;
1684            my $d2      = abs($e2 - $b2) + 1;
1685            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1686            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1687    
1688            # checkbox column
1689            my $field_name = "tables_" . $id;
1690            my $pair_name = "visual_" . $id;
1691            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1692    
1693            my $prefer_id = &get_prefer($thing->acc, $preference);
1694            my $acc_col .= &HTML::set_prot_links($cgi,$prefer_id);
1695            my $db = $thing->database;
1696            if ($preference ne "FIG"){
1697                $db = &Observation::get_database($prefer_id);
1698            }
1699    
1700            push(@$single_domain,$box_col);                        # permanent column
1701            push(@$single_domain,$acc_col);                        # permanent column
1702            push(@$single_domain,$thing->evalue);                  # permanent column
1703            push(@$single_domain,"$iden\%");                       # permanent column
1704            push(@$single_domain,$reg1);                           # permanent column
1705            push(@$single_domain,$reg2);                           # permanent column
1706            push(@$single_domain,$thing->organism);                # permanent column
1707            push(@$single_domain,$thing->function);                # permanent column
1708            push(@$single_domain,$subsystems_column{$id}) if (grep (/subsystem/, @$columns));
1709            push(@$single_domain,$evidence_column{$id}) if (grep (/evidence/, @$columns));
1710            push(@$data,$single_domain);
1711        }
1712    
1713        if ($count >0 ){
1714            $content = $data;
1715        }
1716        else{
1717            $content = "<p>This PEG does not have any similarities</p>";
1718        }
1719        return ($content);
1720    }
1721    
1722    sub get_box_column{
1723        my ($ids) = @_;
1724        my %column;
1725        foreach my $id (@$ids){
1726            my $field_name = "tables_" . $id;
1727            my $pair_name = "visual_" . $id;
1728            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1729        }
1730        return (%column);
1731    }
1732    
1733    sub get_subsystems_column{
1734        my ($ids) = @_;
1735    
1736        my $fig = new FIG;
1737        my $cgi = new CGI;
1738        my %in_subs  = $fig->subsystems_for_pegs($ids);
1739        my %column;
1740        foreach my $id (@$ids){
1741            my @in_sub = $in_subs{$id} if (defined $in_subs{$id});
1742          my $in_sub;          my $in_sub;
1743    
1744          if (@in_sub > 0) {          if (@in_sub > 0) {
# Line 1338  Line 1746 
1746    
1747              # RAE: add a javascript popup with all the subsystems              # RAE: add a javascript popup with all the subsystems
1748              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1749              $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);              $column{$id} = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);
1750          } else {          } else {
1751              $in_sub = "&nbsp;";              $column{$id} = "&nbsp;";
1752            }
1753        }
1754        return (%column);
1755          }          }
1756    
1757    sub get_evidence_column{
1758        my ($ids) = @_;
1759        my $fig = new FIG;
1760        my $cgi = new CGI;
1761        my (%column, %code_attributes);
1762    
1763        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
1764        foreach my $key (@codes){
1765            push (@{$code_attributes{$$key[0]}}, $key);
1766        }
1767    
1768        foreach my $id (@$ids){
1769          # add evidence code with tool tip          # add evidence code with tool tip
1770          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
1771          my @ev_codes = "";          my @ev_codes = "";
1772    
1773          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1774              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);              my @codes;
1775                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
1776              @ev_codes = ();              @ev_codes = ();
1777              foreach my $code (@codes) {              foreach my $code (@codes) {
1778                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
# Line 1366  Line 1791 
1791                                  {                                  {
1792                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
1793          }          }
1794            $column{$id}=$ev_codes;
1795        }
1796        return (%column);
1797    }
1798    
1799          # add the aliases  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
         my $aliases = undef;  
         $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );  
         $aliases = &HTML::set_prot_links( $cgi, $aliases );  
         $aliases ||= "&nbsp;";  
1800    
1801          my $iden    = $thing->identity;  sub get_prefer {
1802          my $ln1     = $thing->qlength;      my ($fid, $db) = @_;
1803          my $ln2     = $thing->hlength;      my $fig = new FIG;
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
1804    
1805        my @aliases = $fig->feature_aliases($fid);
1806    
1807          push(@$single_domain,$thing->database);      foreach my $alias (@aliases){
1808          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          my $id_db = &Observation::get_database($alias);
1809          push(@$single_domain,$thing->evalue);          if ($id_db eq $db){
1810          push(@$single_domain,"$iden\%");              return ($alias);
1811          push(@$single_domain,$reg1);          }
1812          push(@$single_domain,$reg2);      }
1813          push(@$single_domain,$in_sub);      return ($fid);
         push(@$single_domain,$ev_codes);  
         push(@$single_domain,$thing->organism);  
         push(@$single_domain,$thing->function);  
         push(@$single_domain,$aliases);  
         push(@$data,$single_domain);  
1814      }      }
1815    
1816      if ($count >0){  sub color {
1817          $content = $data;      my ($evalue) = @_;
1818    
1819        my $color;
1820        if ($evalue <= 1e-170){
1821            $color = 51;
1822      }      }
1823      else      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
1824      {          $color = 52;
         $content = "<p>This PEG does not have any similarities</p>";  
1825      }      }
1826      return ($content);      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
1827            $color = 53;
1828        }
1829        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
1830            $color = 54;
1831        }
1832        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
1833            $color = 55;
1834        }
1835        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
1836            $color = 56;
1837        }
1838        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
1839            $color = 57;
1840        }
1841        elsif (($evalue <= 1) && ($evalue > 1e-5)){
1842            $color = 58;
1843        }
1844        elsif (($evalue <= 10) && ($evalue > 1)){
1845            $color = 59;
1846        }
1847        else{
1848            $color = 60;
1849  }  }
1850    
 sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  
1851    
1852        return ($color);
1853    }
1854    
1855    
1856  ############################  ############################
# Line 1464  Line 1903 
1903          $region_start = $end-4000;          $region_start = $end-4000;
1904          $region_end = $beg+4000;          $region_end = $beg+4000;
1905          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1906          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
1907      }      }
1908    
1909      # call genes in region      # call genes in region
# Line 1475  Line 1914 
1914    
1915      my %all_genes;      my %all_genes;
1916      my %all_genomes;      my %all_genomes;
1917      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}
1918    
1919      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
1920      {      {
# Line 1506  Line 1945 
1945                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
1946                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
1947                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1948                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
1949                  }                  }
1950    
1951                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 1953 
1953                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
1954                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1955                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
1956                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
1957              }              }
1958              $coup_count++;              $coup_count++;
1959          }          }
# Line 1566  Line 2005 
2005                          $pair_region_start = $pair_end-4000;                          $pair_region_start = $pair_end-4000;
2006                          $pair_region_stop = $pair_beg+4000;                          $pair_region_stop = $pair_beg+4000;
2007                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2008                          $reverse_flag{$pair_genome} = 1;                          $reverse_flag{$pair_genome} = $peg1;
2009                      }                      }
2010    
2011                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
2012                      $all_genomes{$pair_genome} = 1;                      $all_genomes{$pair_genome} = 1;
2013                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
2014                      push(@$all_regions,$pair_features);                      push(@$all_regions,$pair_features);
2015                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2016                  }                  }
2017              }              }
2018          }          }
# Line 1625  Line 2064 
2064          else          else
2065          {          {
2066              foreach my $peg (@$good_set){              foreach my $peg (@$good_set){
2067                  $peg_rank{$peg} = 100;                  $peg_rank{$peg} = "20";
2068              }              }
2069          }          }
2070      }      }
# Line 1678  Line 2117 
2117  #       else  #       else
2118  #       {  #       {
2119  #           foreach my $peg (@$good_set){  #           foreach my $peg (@$good_set){
2120  #               $peg_rank{$peg} = 100;  #               $peg_rank{$peg} = "20";
2121  #           }  #           }
2122  #       }  #       }
2123  #    }  #    }
# Line 1695  Line 2134 
2134    
2135          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2136    
2137            my $second_line_config = { 'title' => "$region_gs",
2138                                       'short_title' => "",
2139                                       'basepair_offset' => '0'
2140                                       };
2141    
2142          my $line_data = [];          my $line_data = [];
2143            my $second_line_data = [];
2144    
2145            # initialize variables to check for overlap in genes
2146            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2147            my $major_line_flag = 0;
2148            my $prev_second_flag = 0;
2149    
2150          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2151                $second_line_flag = 0;
2152              my $element_hash;              my $element_hash;
2153              my $links_list = [];              my $links_list = [];
2154              my $descriptions = [];              my $descriptions = [];
# Line 1738  Line 2190 
2190                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2191                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2192    
2193                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2194                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2195                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2196                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2197                            $second_line_flag = 1;
2198                            $major_line_flag = 1;
2199                        }
2200                    }
2201                    $prev_start = $start;
2202                    $prev_stop = $stop;
2203                    $prev_fig = $fid1;
2204    
2205                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2206                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2207                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2208                  }                  }
# Line 1753  Line 2217 
2217                      "links_list" => $links_list,                      "links_list" => $links_list,
2218                      "description" => $descriptions                      "description" => $descriptions
2219                  };                  };
2220                  push(@$line_data,$element_hash);  
2221                    # if there is an overlap, put into second line
2222                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2223                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2224    
2225              }              }
2226          }          }
2227          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2228            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2229      }      }
2230      return $gd;      return $gd;
2231  }  }

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.29

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3