[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.28, Tue Aug 14 21:32:57 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) = @_;
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        # get the subsystem information as a batch request
1658        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1659    
1660        # get the evidence information as a batch request
1661        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes(\@ids);
1662        my %code_attributes;
1663        foreach my $key (@codes){
1664            push (@{$code_attributes{$$key[0]}}, $key);
1665        }
1666    
1667        foreach my $thing (@$dataset) {
1668            next if ($thing->class ne "SIM");
1669            my $single_domain = [];
1670          $count++;          $count++;
1671    
1672          my $id = $thing->acc;          my $id = $thing->acc;
1673    
1674          # add the subsystem information          # add the subsystem information
1675          my @in_sub  = $fig->peg_to_subsystems($id);          #my @in_sub  = $fig->peg_to_subsystems($id);
1676            my @in_sub = $in_subs{$id} if (defined $in_subs{$id});
1677          my $in_sub;          my $in_sub;
1678    
1679          if (@in_sub > 0) {          if (@in_sub > 0) {
# Line 1346  Line 1689 
1689          # add evidence code with tool tip          # add evidence code with tool tip
1690          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
1691          my @ev_codes = "";          my @ev_codes = "";
1692    
1693          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1694              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);              my @codes;
1695                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
1696              @ev_codes = ();              @ev_codes = ();
1697              foreach my $code (@codes) {              foreach my $code (@codes) {
1698                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
# Line 1367  Line 1712 
1712                                      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));
1713          }          }
1714    
         # add the aliases  
         my $aliases = undef;  
         $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );  
         $aliases = &HTML::set_prot_links( $cgi, $aliases );  
         $aliases ||= "&nbsp;";  
   
1715          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1716          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1717          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1385  Line 1724 
1724          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1725          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1726    
1727            my $name = $thing->acc;
1728          push(@$single_domain,$thing->database);          my $field_name = "tables_" . $name;
1729          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          my $pair_name = "visual_" . $name;
1730    
1731            my $checkbox_col = qq(<input type=checkbox name=seq value="$name" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1732    
1733            my $prefer_id = &get_prefer($thing->acc, $preference);
1734            my $acc_col .= &HTML::set_prot_links($cgi,$prefer_id);
1735            my $db = $thing->database;
1736            if ($preference ne "FIG"){
1737                $db = &Observation::get_database($prefer_id);
1738            }
1739    
1740            push(@$single_domain,$checkbox_col);
1741            push(@$single_domain,$db);
1742            push(@$single_domain,$acc_col);
1743          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
1744          push(@$single_domain,"$iden\%");          push(@$single_domain,"$iden\%");
1745          push(@$single_domain,$reg1);          push(@$single_domain,$reg1);
# Line 1396  Line 1748 
1748          push(@$single_domain,$ev_codes);          push(@$single_domain,$ev_codes);
1749          push(@$single_domain,$thing->organism);          push(@$single_domain,$thing->organism);
1750          push(@$single_domain,$thing->function);          push(@$single_domain,$thing->function);
         push(@$single_domain,$aliases);  
1751          push(@$data,$single_domain);          push(@$data,$single_domain);
1752    
1753      }      }
1754    
1755      if ($count >0){      if ($count >0){
1756          $content = $data;          $content = $data;
1757      }      }
1758      else      else{
     {  
1759          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
1760      }      }
1761      return ($content);      return ($content);
# Line 1412  Line 1763 
1763    
1764  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; $_ }
1765    
1766    sub get_prefer {
1767        my ($fid, $db) = @_;
1768        my $fig = new FIG;
1769    
1770        my @aliases = $fig->feature_aliases($fid);
1771    
1772        foreach my $alias (@aliases){
1773            my $id_db = &Observation::get_database($alias);
1774            if ($id_db eq $db){
1775                return ($alias);
1776            }
1777        }
1778        return ($fid);
1779    }
1780    
1781    sub color {
1782        my ($evalue) = @_;
1783    
1784        my $color;
1785        if ($evalue <= 1e-170){
1786            $color = 51;
1787        }
1788        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
1789            $color = 52;
1790        }
1791        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
1792            $color = 53;
1793        }
1794        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
1795            $color = 54;
1796        }
1797        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
1798            $color = 55;
1799        }
1800        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
1801            $color = 56;
1802        }
1803        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
1804            $color = 57;
1805        }
1806        elsif (($evalue <= 1) && ($evalue > 1e-5)){
1807            $color = 58;
1808        }
1809        elsif (($evalue <= 10) && ($evalue > 1)){
1810            $color = 59;
1811        }
1812        else{
1813            $color = 60;
1814        }
1815    
1816    
1817        return ($color);
1818    }
1819    
1820    
1821  ############################  ############################
# Line 1464  Line 1868 
1868          $region_start = $end-4000;          $region_start = $end-4000;
1869          $region_end = $beg+4000;          $region_end = $beg+4000;
1870          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1871          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
1872      }      }
1873    
1874      # call genes in region      # call genes in region
# Line 1475  Line 1879 
1879    
1880      my %all_genes;      my %all_genes;
1881      my %all_genomes;      my %all_genomes;
1882      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}
1883    
1884      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
1885      {      {
# Line 1506  Line 1910 
1910                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
1911                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
1912                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1913                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
1914                  }                  }
1915    
1916                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 1918 
1918                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
1919                  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);
1920                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
1921                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
1922              }              }
1923              $coup_count++;              $coup_count++;
1924          }          }
# Line 1566  Line 1970 
1970                          $pair_region_start = $pair_end-4000;                          $pair_region_start = $pair_end-4000;
1971                          $pair_region_stop = $pair_beg+4000;                          $pair_region_stop = $pair_beg+4000;
1972                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1973                          $reverse_flag{$pair_genome} = 1;                          $reverse_flag{$pair_genome} = $peg1;
1974                      }                      }
1975    
1976                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
1977                      $all_genomes{$pair_genome} = 1;                      $all_genomes{$pair_genome} = 1;
1978                      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);
1979                      push(@$all_regions,$pair_features);                      push(@$all_regions,$pair_features);
1980                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
1981                  }                  }
1982              }              }
1983          }          }
# Line 1625  Line 2029 
2029          else          else
2030          {          {
2031              foreach my $peg (@$good_set){              foreach my $peg (@$good_set){
2032                  $peg_rank{$peg} = 100;                  $peg_rank{$peg} = "20";
2033              }              }
2034          }          }
2035      }      }
# Line 1678  Line 2082 
2082  #       else  #       else
2083  #       {  #       {
2084  #           foreach my $peg (@$good_set){  #           foreach my $peg (@$good_set){
2085  #               $peg_rank{$peg} = 100;  #               $peg_rank{$peg} = "20";
2086  #           }  #           }
2087  #       }  #       }
2088  #    }  #    }
# Line 1695  Line 2099 
2099    
2100          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2101    
2102            my $second_line_config = { 'title' => "$region_gs",
2103                                       'short_title' => "",
2104                                       'basepair_offset' => '0'
2105                                       };
2106    
2107          my $line_data = [];          my $line_data = [];
2108            my $second_line_data = [];
2109    
2110            # initialize variables to check for overlap in genes
2111            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2112            my $major_line_flag = 0;
2113            my $prev_second_flag = 0;
2114    
2115          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2116                $second_line_flag = 0;
2117              my $element_hash;              my $element_hash;
2118              my $links_list = [];              my $links_list = [];
2119              my $descriptions = [];              my $descriptions = [];
# Line 1738  Line 2155 
2155                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2156                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2157    
2158                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2159                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2160                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2161                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2162                            $second_line_flag = 1;
2163                            $major_line_flag = 1;
2164                        }
2165                    }
2166                    $prev_start = $start;
2167                    $prev_stop = $stop;
2168                    $prev_fig = $fid1;
2169    
2170                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2171                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2172                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2173                  }                  }
# Line 1753  Line 2182 
2182                      "links_list" => $links_list,                      "links_list" => $links_list,
2183                      "description" => $descriptions                      "description" => $descriptions
2184                  };                  };
2185                  push(@$line_data,$element_hash);  
2186                    # if there is an overlap, put into second line
2187                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2188                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2189    
2190              }              }
2191          }          }
2192          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2193            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2194      }      }
2195      return $gd;      return $gd;
2196  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3