[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.39, Thu Sep 13 21:09:40 2007 UTC
# Line 2  Line 2 
2    
3  use lib '/vol/ontologies';  use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5    use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
9    
10  use FIG_Config;  use FIG_Config;
11  use strict;  #use strict;
12  #use warnings;  #use warnings;
13  use HTML;  use HTML;
14    
# Line 151  Line 152 
152  sub type {  sub type {
153    my ($self) = @_;    my ($self) = @_;
154    
155    return $self->{acc};    return $self->{type};
156  }  }
157    
158  =head3 start()  =head3 start()
# Line 308  Line 309 
309    
310      my $objects = [];      my $objects = [];
311      my @matched_datasets=();      my @matched_datasets=();
312        my $fig = new FIG;
313    
314      # call function that fetches attribute based observations      # call function that fetches attribute based observations
315      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 317  Line 319 
319      }      }
320      else{      else{
321          my %domain_classes;          my %domain_classes;
322            my @attributes = $fig->get_attributes($fid);
323          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
324          get_identical_proteins($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets);
325          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);
326          get_sims_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets);
327          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
328          get_attribute_based_location_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);
329          get_pdb_observations($fid,\@matched_datasets);          get_pdb_observations($fid,\@matched_datasets,\@attributes);
330      }      }
331    
332      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 357  Line 360 
360    
361  }  }
362    
363    =head3 display_housekeeping
364    This method returns the housekeeping data for a given peg in a table format
365    
366    =cut
367    sub display_housekeeping {
368        my ($self,$fid) = @_;
369        my $fig = new FIG;
370        my $content;
371    
372        my $org_name = $fig->org_of($fid);
373        my $org_id   = $fig->orgid_of_orgname($org_name);
374        my $loc      = $fig->feature_location($fid);
375        my($contig, $beg, $end) = $fig->boundaries_of($loc);
376        my $strand   = ($beg <= $end)? '+' : '-';
377        my @subsystems = $fig->subsystems_for_peg($fid);
378        my $function = $fig->function_of($fid);
379        my @aliases  = $fig->feature_aliases($fid);
380        my $taxonomy = $fig->taxonomy_of($org_id);
381        my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);
382    
383        $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);
384        $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
385        $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);
386        $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
387        $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);
388        $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;
389        $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
390        if ( @ecs ) {
391            $content .= qq(<tr><td>EC:</td><td>);
392            foreach my $ec ( @ecs ) {
393                my $ec_name = $fig->ec_name($ec);
394                $content .= join(" -- ", $ec, $ec_name) . "<br>\n";
395            }
396            $content .= qq(</td></tr>\n);
397        }
398    
399        if ( @subsystems ) {
400            $content .= qq(<tr><td>Subsystems</td><td>);
401            foreach my $subsystem ( @subsystems ) {
402                $content .= join(" -- ", @$subsystem) . "<br>\n";
403            }
404        }
405    
406        my %groups;
407        if ( @aliases ) {
408            # get the db for each alias
409            foreach my $alias (@aliases){
410                $groups{$alias} = &get_database($alias);
411            }
412    
413            # group ids by aliases
414            my %db_aliases;
415            foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){
416                push (@{$db_aliases{$groups{$key}}}, $key);
417            }
418    
419    
420            $content .= qq(<tr><td>Aliases</td><td><table border="0">);
421            foreach my $key (sort keys %db_aliases){
422                $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);
423            }
424            $content .= qq(</td></tr></table>\n);
425        }
426    
427        $content .= qq(</table><p>\n);
428    
429        return ($content);
430    }
431    
432    =head3 get_sims_summary
433    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
434    
435    =cut
436    
437    sub get_sims_summary {
438        my ($observation, $fid, $taxes) = @_;
439        my $fig = new FIG;
440        my %families;
441        my @sims= $fig->nsims($fid,20000,10,"fig");
442    
443        foreach my $sim (@sims){
444            next if ($sim->[1] !~ /fig\|/);
445            my $genome = $fig->genome_of($sim->[1]);
446            my ($genome1) = ($genome) =~ /(.*)\./;
447            my $taxonomy = $taxes->{$genome1};
448            #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated
449            my $parent_tax = "Root";
450            my @currLineage = ($parent_tax);
451            foreach my $tax (split(/\; /, $taxonomy)){
452                push (@{$families{children}{$parent_tax}}, $tax);
453                push (@currLineage, $tax);
454                $families{parent}{$tax} = $parent_tax;
455                $families{lineage}{$tax} = join(";", @currLineage);
456                if (defined ($families{evalue}{$tax})){
457                    if ($sim->[10] < $families{evalue}{$tax}){
458                        $families{evalue}{$tax} = $sim->[10];
459                        $families{color}{$tax} = &get_taxcolor($sim->[10]);
460                    }
461                }
462                else{
463                    $families{evalue}{$tax} = $sim->[10];
464                    $families{color}{$tax} = &get_taxcolor($sim->[10]);
465                }
466    
467                $parent_tax = $tax;
468            }
469        }
470    
471        foreach my $key (keys %{$families{children}}){
472            $families{count}{$key} = @{$families{children}{$key}};
473    
474            my %saw;
475            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
476            $families{children}{$key} = \@out;
477        }
478        return (\%families);
479    }
480    
481  =head1 Internal Methods  =head1 Internal Methods
482    
483  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 365  Line 486 
486    
487  =cut  =cut
488    
489    sub get_taxcolor{
490        my ($evalue) = @_;
491        my $color;
492        if ($evalue <= 1e-170){        $color = "#FF2000";    }
493        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
494        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
495        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
496        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
497        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
498        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
499        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
500        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
501        else{        $color = "#6666FF";    }
502        return ($color);
503    }
504    
505    
506  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
507    
508      # 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)
509      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
510    
511      my $fig = new FIG;      my $fig = new FIG;
512    
513      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
514    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
515          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
516          my @parts = split("::",$key);          my @parts = split("::",$key);
517          my $class = $parts[0];          my $class = $parts[0];
# Line 411  Line 550 
550    
551  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
552    
553      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
554      my $fig = new FIG;      my $fig = new FIG;
555    
556      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
557    
558      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      my $dataset = {'type' => "loc",
559      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
560                       'fig_id' => $fid
561                       };
562    
563        foreach my $attr_ref (@$attributes_ref){
564    #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
565          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
566            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
567          my @parts = split("::",$key);          my @parts = split("::",$key);
568          my $sub_class = $parts[0];          my $sub_class = $parts[0];
569          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 428  Line 573 
573                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
574                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
575                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
576    #               print STDERR "LOC: $value_parts[1]";
577              }              }
578              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
579                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
580              }              }
581          }          }
582    
583          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
584              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
585              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
586          }          }
587    
588            elsif($sub_class eq "Phobius"){
589                if($sub_key eq "transmembrane"){
590                    $dataset->{'phobius_tm_locations'} = $value;
591                }
592                elsif($sub_key eq "signal"){
593                    $dataset->{'phobius_signal_location'} = $value;
594                }
595            }
596    
597          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
598              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
599              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
600              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
601          }          }
# Line 455  Line 612 
612  =cut  =cut
613    
614  sub get_pdb_observations{  sub get_pdb_observations{
615      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
616    
617      my $fig = new FIG;      my $fig = new FIG;
618    
619      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref (@$attributes_ref){
620        #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
621    
622          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
623            next if ( ($key !~ /PDB/));
624          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
625          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
626          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 516  Line 675 
675    
676      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
677      my $fig = new FIG;      my $fig = new FIG;
678      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,500,10,"fig");
679      my ($dataset);      my ($dataset);
680    
681        my %id_list;
682        foreach my $sim (@sims){
683            my $hit = $sim->[1];
684    
685            next if ($hit !~ /^fig\|/);
686            my @aliases = $fig->feature_aliases($hit);
687            foreach my $alias (@aliases){
688                $id_list{$alias} = 1;
689            }
690        }
691    
692        my %already;
693        my (@new_sims, @uniprot);
694      foreach my $sim (@sims){      foreach my $sim (@sims){
695          my $hit = $sim->[1];          my $hit = $sim->[1];
696            my ($id) = ($hit) =~ /\|(.*)/;
697            next if (defined($already{$id}));
698            next if (defined($id_list{$hit}));
699            push (@new_sims, $sim);
700            $already{$id} = 1;
701        }
702    
703        foreach my $sim (@new_sims){
704            my $hit = $sim->[1];
705          my $percent = $sim->[2];          my $percent = $sim->[2];
706          my $evalue = $sim->[10];          my $evalue = $sim->[10];
707          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 569  Line 751 
751      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
752      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
753      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
754      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
755      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
756      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
757      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 591  Line 773 
773      my $fig = new FIG;      my $fig = new FIG;
774      my $funcs_ref;      my $funcs_ref;
775    
776    #    my %id_list;
777      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);
778    #    my @aliases = $fig->feature_aliases($fid);
779    #    foreach my $alias (@aliases){
780    #       $id_list{$alias} = 1;
781    #    }
782    
783      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
784          my ($tmp, $who);          my ($tmp, $who);
785          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
786    #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
787              $who = &get_database($id);              $who = &get_database($id);
788              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
789          }          }
# Line 788  Line 976 
976    
977      my $acc = $self->acc;      my $acc = $self->acc;
978    
     print STDERR "acc:$acc\n";  
979      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
980      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
981      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 923  Line 1110 
1110          my $id = $row->[0];          my $id = $row->[0];
1111          my $who = $row->[1];          my $who = $row->[1];
1112          my $assignment = $row->[2];          my $assignment = $row->[2];
1113          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1114          my $single_domain = [];          my $single_domain = [];
1115          push(@$single_domain,$who);          push(@$single_domain,$who);
1116          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 1031  Line 1218 
1218  sub display {  sub display {
1219      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1220      my $lines = [];      my $lines = [];
1221      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1222                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1223                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1224      my $color = "4";      my $color = "4";
1225    
1226      my $line_data = [];      my $line_data = [];
# Line 1063  Line 1250 
1250          }          }
1251      }      }
1252    
1253        my $line_config = { 'title' => $thing->acc,
1254                            'short_title' => $name_value,
1255                            'basepair_offset' => '1' };
1256    
1257      my $name;      my $name;
1258      $name = {"title" => $name_title,      $name = {"title" => $name_title,
1259               "value" => $name_value};               "value" => $name_value};
# Line 1109  Line 1300 
1300    
1301  }  }
1302    
1303    sub display_table {
1304        my ($self,$dataset) = @_;
1305        my $cgi = new CGI;
1306        my $data = [];
1307        my $count = 0;
1308        my $content;
1309    
1310        foreach my $thing (@$dataset) {
1311            next if ($thing->type !~ /dom/);
1312            my $single_domain = [];
1313            $count++;
1314    
1315            my $db_and_id = $thing->acc;
1316            my ($db,$id) = split("::",$db_and_id);
1317    
1318            my $dbmaster = DBMaster->new(-database =>'Ontology');
1319    
1320            my ($name_title,$name_value,$description_title,$description_value);
1321            if($db eq "CDD"){
1322                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1323                if(!scalar(@$cdd_objs)){
1324                    $name_title = "name";
1325                    $name_value = "not available";
1326                    $description_title = "description";
1327                    $description_value = "not available";
1328                }
1329                else{
1330                    my $cdd_obj = $cdd_objs->[0];
1331                    $name_title = "name";
1332                    $name_value = $cdd_obj->term;
1333                    $description_title = "description";
1334                    $description_value = $cdd_obj->description;
1335                }
1336            }
1337    
1338            my $location =  $thing->start . " - " . $thing->stop;
1339    
1340            push(@$single_domain,$db);
1341            push(@$single_domain,$thing->acc);
1342            push(@$single_domain,$name_value);
1343            push(@$single_domain,$location);
1344            push(@$single_domain,$thing->evalue);
1345            push(@$single_domain,$description_value);
1346            push(@$data,$single_domain);
1347        }
1348    
1349        if ($count >0){
1350            $content = $data;
1351        }
1352        else
1353        {
1354            $content = "<p>This PEG does not have any similarities to domains</p>";
1355        }
1356    }
1357    
1358    
1359  #########################################  #########################################
1360  #########################################  #########################################
1361  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1373 
1373      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1374      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1375      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1376        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1377        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1378    
1379      bless($self,$class);      bless($self,$class);
1380      return $self;      return $self;
1381  }  }
1382    
1383    sub display_cello {
1384        my ($thing) = @_;
1385        my $html;
1386        my $cello_location = $thing->cello_location;
1387        my $cello_score = $thing->cello_score;
1388        if($cello_location){
1389            $html .= "<p>CELLO prediction: $cello_location </p>";
1390            $html .= "<p>CELLO score: $cello_score </p>";
1391        }
1392        return ($html);
1393    }
1394    
1395  sub display {  sub display {
1396      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1397    
# Line 1147  Line 1408 
1408      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1409      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1410    
1411        my $phobius_signal_location = $thing->phobius_signal_location;
1412        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1413    
1414      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1415    
1416      #color is      #color is
1417      my $color = "5";      my $color = "6";
1418    
1419      my $line_data = [];  =pod=
1420    
1421      if($cello_location){      if($cello_location){
1422          my $cello_descriptions = [];          my $cello_descriptions = [];
1423            my $line_data =[];
1424    
1425            my $line_config = { 'title' => 'Localization Evidence',
1426                                'short_title' => 'CELLO',
1427                                'basepair_offset' => '1' };
1428    
1429          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1430                                            "value" => $cello_location};                                            "value" => $cello_location};
1431    
# Line 1171  Line 1438 
1438    
1439          my $element_hash = {          my $element_hash = {
1440              "title" => "CELLO",              "title" => "CELLO",
1441                "color"=> $color,
1442              "start" => "1",              "start" => "1",
1443              "end" =>  $length + 1,              "end" =>  $length + 1,
1444              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1445              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1446    
1447          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1448            $gd->add_line($line_data, $line_config);
1449      }      }
1450    
1451      my $color = "6";  =cut
1452    
1453        $color = "2";
1454      if($tmpred_score){      if($tmpred_score){
1455            my $line_data =[];
1456            my $line_config = { 'title' => 'Localization Evidence',
1457                                'short_title' => 'Transmembrane',
1458                                'basepair_offset' => '1' };
1459    
1460          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1461              my $descriptions = [];              my $descriptions = [];
1462              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1471 
1471              "end" =>  $end + 1,              "end" =>  $end + 1,
1472              "color"=> $color,              "color"=> $color,
1473              "zlayer" => '5',              "zlayer" => '5',
1474              "type" => 'smallbox',              "type" => 'box',
1475                "description" => $descriptions};
1476    
1477                push(@$line_data,$element_hash);
1478    
1479            }
1480            $gd->add_line($line_data, $line_config);
1481        }
1482    
1483        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1484            my $line_data =[];
1485            my $line_config = { 'title' => 'Localization Evidence',
1486                                'short_title' => 'Phobius',
1487                                'basepair_offset' => '1' };
1488    
1489            foreach my $tm_loc (@phobius_tm_locations){
1490                my $descriptions = [];
1491                my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',
1492                                 "value" => $tm_loc};
1493                push(@$descriptions,$description_phobius_tm_locations);
1494    
1495                my ($begin,$end) =split("-",$tm_loc);
1496    
1497                my $element_hash = {
1498                "title" => "phobius transmembrane location",
1499                "start" => $begin + 1,
1500                "end" =>  $end + 1,
1501                "color"=> '6',
1502                "zlayer" => '4',
1503                "type" => 'bigbox',
1504              "description" => $descriptions};              "description" => $descriptions};
1505    
1506              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1507    
1508            }
1509    
1510            if($phobius_signal_location){
1511                my $descriptions = [];
1512                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1513                                 "value" => $phobius_signal_location};
1514                push(@$descriptions,$description_phobius_signal_location);
1515    
1516    
1517                my ($begin,$end) =split("-",$phobius_signal_location);
1518                my $element_hash = {
1519                "title" => "phobius signal locations",
1520                "start" => $begin + 1,
1521                "end" =>  $end + 1,
1522                "color"=> '1',
1523                "zlayer" => '5',
1524                "type" => 'box',
1525                "description" => $descriptions};
1526                push(@$line_data,$element_hash);
1527          }          }
1528    
1529            $gd->add_line($line_data, $line_config);
1530      }      }
1531    
1532      my $color = "1";  
1533        $color = "1";
1534      if($signal_peptide_score){      if($signal_peptide_score){
1535            my $line_data = [];
1536          my $descriptions = [];          my $descriptions = [];
1537    
1538            my $line_config = { 'title' => 'Localization Evidence',
1539                                'short_title' => 'SignalP',
1540                                'basepair_offset' => '1' };
1541    
1542          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1543                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1544    
# Line 1220  Line 1552 
1552          my $element_hash = {          my $element_hash = {
1553              "title" => "SignalP",              "title" => "SignalP",
1554              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1555              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1556              "type" => 'bigbox',              "type" => 'bigbox',
1557              "color"=> $color,              "color"=> $color,
1558              "zlayer" => '10',              "zlayer" => '10',
1559              "description" => $descriptions};              "description" => $descriptions};
1560    
1561          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1562      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1563        }
1564    
1565      return ($gd);      return ($gd);
1566    
# Line 1277  Line 1608 
1608    return $self->{cello_score};    return $self->{cello_score};
1609  }  }
1610    
1611    sub phobius_signal_location {
1612      my ($self) = @_;
1613      return $self->{phobius_signal_location};
1614    }
1615    
1616    sub phobius_tm_locations {
1617      my ($self) = @_;
1618      return $self->{phobius_tm_locations};
1619    }
1620    
1621    
1622    
1623  #########################################  #########################################
1624  #########################################  #########################################
# Line 1305  Line 1647 
1647      return $self;      return $self;
1648  }  }
1649    
1650  =head3 display_table()  =head3 display()
   
 If available use the function specified here to display the "raw" observation.  
 This code will display a table for the similarities protein  
1651    
1652  B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  If available use the function specified here to display a graphical observation.
1653    This code will display a graphical view of the similarities using the genome drawer object
1654    
1655  =cut  =cut
1656    
1657  sub display_table {  sub display {
1658      my ($self,$dataset) = @_;      my ($self,$gd) = @_;
1659    
     my $data = [];  
     my $count = 0;  
     my $content;  
1660      my $fig = new FIG;      my $fig = new FIG;
1661      my $cgi = new CGI;      my $peg = $self->acc;
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
         next if ($thing->class ne "SIM");  
         $count++;  
1662    
1663          my $id = $thing->acc;      my $organism = $self->organism;
1664        my $genome = $fig->genome_of($peg);
1665        my ($org_tax) = ($genome) =~ /(.*)\./;
1666        my $function = $self->function;
1667        my $abbrev_name = $fig->abbrev($organism);
1668        my $align_start = $self->qstart;
1669        my $align_stop = $self->qstop;
1670        my $hit_start = $self->hstart;
1671        my $hit_stop = $self->hstop;
1672    
1673        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1674    
1675        my $line_config = { 'title' => "$organism [$org_tax]",
1676                            'short_title' => "$abbrev_name",
1677                            'title_link' => '$tax_link',
1678                            'basepair_offset' => '0'
1679                            };
1680    
1681          # add the subsystem information      my $line_data = [];
         my @in_sub  = $fig->peg_to_subsystems($id);  
         my $in_sub;  
1682    
1683          if (@in_sub > 0) {      my $element_hash;
1684              $in_sub = @in_sub;      my $links_list = [];
1685        my $descriptions = [];
1686    
1687              # RAE: add a javascript popup with all the subsystems      # get subsystem information
1688              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
             $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);  
         } else {  
             $in_sub = "&nbsp;";  
         }  
1689    
1690          # add evidence code with tool tip      my $link;
1691          my $ev_codes=" &nbsp; ";      $link = {"link_title" => $peg,
1692          my @ev_codes = "";               "link" => $url_link};
1693          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {      push(@$links_list,$link);
1694              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
1695              @ev_codes = ();      my @subsystems = $fig->peg_to_subsystems($peg);
1696              foreach my $code (@codes) {      foreach my $subsystem (@subsystems){
1697                  my $pretty_code = $code->[2];          my $link;
1698                  if ($pretty_code =~ /;/) {          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1699                      my ($cd, $ss) = split(";", $code->[2]);                   "link_title" => $subsystem};
1700                      $ss =~ s/_/ /g;          push(@$links_list,$link);
                     $pretty_code = $cd;# . " in " . $ss;  
                 }  
                 push(@ev_codes, $pretty_code);  
             }  
1701          }          }
1702    
1703          if (scalar(@ev_codes) && $ev_codes[0]) {      my $description_function;
1704              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);      $description_function = {"title" => "function",
1705              $ev_codes = $cgi->a(                               "value" => $function};
1706        push(@$descriptions,$description_function);
1707    
1708        my ($description_ss, $ss_string);
1709        $ss_string = join (",", @subsystems);
1710        $description_ss = {"title" => "subsystems",
1711                           "value" => $ss_string};
1712        push(@$descriptions,$description_ss);
1713    
1714        my $description_loc;
1715        $description_loc = {"title" => "location start",
1716                            "value" => $hit_start};
1717        push(@$descriptions, $description_loc);
1718    
1719        $description_loc = {"title" => "location stop",
1720                            "value" => $hit_stop};
1721        push(@$descriptions, $description_loc);
1722    
1723        my $evalue = $self->evalue;
1724        while ($evalue =~ /-0/)
1725                                  {                                  {
1726                                      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));          my ($chunk1, $chunk2) = split(/-/, $evalue);
1727            $chunk2 = substr($chunk2,1);
1728            $evalue = $chunk1 . "-" . $chunk2;
1729          }          }
1730    
1731          # add the aliases      my $color = &color($evalue);
1732          my $aliases = undef;  
1733          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      my $description_eval = {"title" => "E-Value",
1734          $aliases = &HTML::set_prot_links( $cgi, $aliases );                              "value" => $evalue};
1735          $aliases ||= "&nbsp;";      push(@$descriptions, $description_eval);
1736    
1737        my $identity = $self->identity;
1738        my $description_identity = {"title" => "Identity",
1739                                    "value" => $identity};
1740        push(@$descriptions, $description_identity);
1741    
1742        $element_hash = {
1743            "title" => $peg,
1744            "start" => $align_start,
1745            "end" =>  $align_stop,
1746            "type"=> 'box',
1747            "color"=> $color,
1748            "zlayer" => "2",
1749            "links_list" => $links_list,
1750            "description" => $descriptions
1751            };
1752        push(@$line_data,$element_hash);
1753        $gd->add_line($line_data, $line_config);
1754    
1755        return ($gd);
1756    
1757    }
1758    
1759    =head3 display_domain_composition()
1760    
1761    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1762    
1763    =cut
1764    
1765    sub display_domain_composition {
1766        my ($self,$gd) = @_;
1767    
1768        my $fig = new FIG;
1769        my $peg = $self->acc;
1770    
1771        my $line_data = [];
1772        my $links_list = [];
1773        my $descriptions = [];
1774    
1775        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1776    
1777        foreach $dqr (@domain_query_results){
1778            my $key = @$dqr[1];
1779            my @parts = split("::",$key);
1780            my $db = $parts[0];
1781            my $id = $parts[1];
1782            my $val = @$dqr[2];
1783            my $from;
1784            my $to;
1785            my $evalue;
1786    
1787            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1788                my $raw_evalue = $1;
1789                $from = $2;
1790                $to = $3;
1791                if($raw_evalue =~/(\d+)\.(\d+)/){
1792                    my $part2 = 1000 - $1;
1793                    my $part1 = $2/100;
1794                    $evalue = $part1."e-".$part2;
1795                }
1796                else{
1797                    $evalue = "0.0";
1798                }
1799            }
1800    
1801            my $dbmaster = DBMaster->new(-database =>'Ontology');
1802            my ($name_value,$description_value);
1803    
1804            if($db eq "CDD"){
1805                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1806                if(!scalar(@$cdd_objs)){
1807                    $name_title = "name";
1808                    $name_value = "not available";
1809                    $description_title = "description";
1810                    $description_value = "not available";
1811                }
1812                else{
1813                    my $cdd_obj = $cdd_objs->[0];
1814                    $name_value = $cdd_obj->term;
1815                    $description_value = $cdd_obj->description;
1816                }
1817            }
1818    
1819            my $domain_name;
1820            $domain_name = {"title" => "name",
1821                     "value" => $name_value};
1822            push(@$descriptions,$domain_name);
1823    
1824            my $description;
1825            $description = {"title" => "description",
1826                            "value" => $description_value};
1827            push(@$descriptions,$description);
1828    
1829            my $score;
1830            $score = {"title" => "score",
1831                      "value" => $evalue};
1832            push(@$descriptions,$score);
1833    
1834            my $link_id = $id;
1835            my $link;
1836            my $link_url;
1837            if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1838            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1839            else{$link_url = "NO_URL"}
1840    
1841            $link = {"link_title" => $name_value,
1842                     "link" => $link_url};
1843            push(@$links_list,$link);
1844    
1845            my $domain_element_hash = {
1846                "title" => $peg,
1847                "start" => $from,
1848                "end" =>  $to,
1849                "type"=> 'box',
1850                "zlayer" => '4',
1851                "links_list" => $links_list,
1852                "description" => $descriptions
1853                };
1854    
1855            push(@$line_data,$domain_element_hash);
1856    
1857            #just one CDD domain for now, later will add option for multiple domains from selected DB
1858            last;
1859        }
1860    
1861        my $line_config = { 'title' => $peg,
1862                            'short_title' => $peg,
1863                            'basepair_offset' => '1' };
1864    
1865        $gd->add_line($line_data, $line_config);
1866    
1867        return ($gd);
1868    
1869    }
1870    
1871    =head3 display_table()
1872    
1873    If available use the function specified here to display the "raw" observation.
1874    This code will display a table for the similarities protein
1875    
1876    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
1877    
1878    =cut
1879    
1880    sub display_table {
1881        my ($self,$dataset, $scroll_list, $query_fid) = @_;
1882    
1883        my $data = [];
1884        my $count = 0;
1885        my $content;
1886        my $fig = new FIG;
1887        my $cgi = new CGI;
1888        my @ids;
1889        foreach my $thing (@$dataset) {
1890            next if ($thing->class ne "SIM");
1891            push (@ids, $thing->acc);
1892        }
1893    
1894        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1895    
1896        # get the column for the subsystems
1897        %subsystems_column = &get_subsystems_column(\@ids);
1898    
1899        # get the column for the evidence codes
1900        %evidence_column = &get_evidence_column(\@ids);
1901    
1902        # get the column for pfam_domain
1903        %pfam_column = &get_pfam_column(\@ids);
1904    
1905        my %e_identical = &get_essentially_identical($query_fid);
1906        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1907    
1908        foreach my $thing (@$dataset) {
1909            next if ($thing->class ne "SIM");
1910            my $single_domain = [];
1911            $count++;
1912    
1913            my $id = $thing->acc;
1914    
1915          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1916          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
# Line 1385  Line 1924 
1924          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1925          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1926    
1927            # checkbox column
1928            my $field_name = "tables_" . $id;
1929            my $pair_name = "visual_" . $id;
1930            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1931    
1932            # get the linked fig id
1933            my $fig_col;
1934            if (defined ($e_identical{$id})){
1935                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1936            }
1937            else{
1938                $fig_col = &HTML::set_prot_links($cgi,$id);
1939            }
1940    
1941          push(@$single_domain,$thing->database);          push(@$single_domain,$box_col);                        # permanent column
1942          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          push(@$single_domain,$fig_col);                        # permanent column
1943          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);                  # permanent column
1944          push(@$single_domain,"$iden\%");          push(@$single_domain,"$iden\%");                       # permanent column
1945          push(@$single_domain,$reg1);          push(@$single_domain,$reg1);                           # permanent column
1946          push(@$single_domain,$reg2);          push(@$single_domain,$reg2);                           # permanent column
1947          push(@$single_domain,$in_sub);          push(@$single_domain,$thing->organism);                # permanent column
1948          push(@$single_domain,$ev_codes);          push(@$single_domain,$thing->function);                # permanent column
1949          push(@$single_domain,$thing->organism);          foreach my $col (sort keys %$scroll_list){
1950          push(@$single_domain,$thing->function);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1951          push(@$single_domain,$aliases);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1952                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1953                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}
1954                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}
1955                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}
1956                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}
1957                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}
1958                elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}
1959                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}
1960                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}
1961                elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}
1962                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}
1963            }
1964          push(@$data,$single_domain);          push(@$data,$single_domain);
1965      }      }
1966    
1967      if ($count >0){      if ($count >0){
1968          $content = $data;          $content = $data;
1969      }      }
1970      else      else{
     {  
1971          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
1972      }      }
1973      return ($content);      return ($content);
1974  }  }
1975    
1976    sub get_box_column{
1977        my ($ids) = @_;
1978        my %column;
1979        foreach my $id (@$ids){
1980            my $field_name = "tables_" . $id;
1981            my $pair_name = "visual_" . $id;
1982            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1983        }
1984        return (%column);
1985    }
1986    
1987    sub get_subsystems_column{
1988        my ($ids) = @_;
1989    
1990        my $fig = new FIG;
1991        my $cgi = new CGI;
1992        my %in_subs  = $fig->subsystems_for_pegs($ids);
1993        my %column;
1994        foreach my $id (@$ids){
1995            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1996            my @subsystems;
1997    
1998            if (@in_sub > 0) {
1999                my $count = 1;
2000                foreach my $array(@in_sub){
2001                    push (@subsystems, $count . ". " . $$array[0]);
2002                    $count++;
2003                }
2004                my $in_sub_line = join ("<br>", @subsystems);
2005                $column{$id} = $in_sub_line;
2006            } else {
2007                $column{$id} = "&nbsp;";
2008            }
2009        }
2010        return (%column);
2011    }
2012    
2013    sub get_essentially_identical{
2014        my ($fid) = @_;
2015        my $fig = new FIG;
2016    
2017        my %id_list;
2018        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2019    
2020        foreach my $id (@maps_to) {
2021            if (($id ne $fid) && ($fig->function_of($id))) {
2022                $id_list{$id} = 1;
2023            }
2024        }
2025        return(%id_list);
2026    }
2027    
2028    
2029    sub get_evidence_column{
2030        my ($ids) = @_;
2031        my $fig = new FIG;
2032        my $cgi = new CGI;
2033        my (%column, %code_attributes);
2034    
2035        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
2036        foreach my $key (@codes){
2037            push (@{$code_attributes{$$key[0]}}, $key);
2038        }
2039    
2040        foreach my $id (@$ids){
2041            # add evidence code with tool tip
2042            my $ev_codes=" &nbsp; ";
2043            my @ev_codes = "";
2044    
2045            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2046                my @codes;
2047                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2048                @ev_codes = ();
2049                foreach my $code (@codes) {
2050                    my $pretty_code = $code->[2];
2051                    if ($pretty_code =~ /;/) {
2052                        my ($cd, $ss) = split(";", $code->[2]);
2053                        $ss =~ s/_/ /g;
2054                        $pretty_code = $cd;# . " in " . $ss;
2055                    }
2056                    push(@ev_codes, $pretty_code);
2057                }
2058            }
2059    
2060            if (scalar(@ev_codes) && $ev_codes[0]) {
2061                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2062                $ev_codes = $cgi->a(
2063                                    {
2064                                        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));
2065            }
2066            $column{$id}=$ev_codes;
2067        }
2068        return (%column);
2069    }
2070    
2071    sub get_pfam_column{
2072        my ($ids) = @_;
2073        my $fig = new FIG;
2074        my $cgi = new CGI;
2075        my (%column, %code_attributes);
2076        my $dbmaster = DBMaster->new(-database =>'Ontology');
2077    
2078        my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
2079        foreach my $key (@codes){
2080            push (@{$code_attributes{$$key[0]}}, $$key[1]);
2081        }
2082    
2083        foreach my $id (@$ids){
2084            # add evidence code with tool tip
2085            my $pfam_codes=" &nbsp; ";
2086            my @pfam_codes = "";
2087            my %description_codes;
2088    
2089            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2090                my @codes;
2091                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2092                @pfam_codes = ();
2093                foreach my $code (@codes) {
2094                    my @parts = split("::",$code);
2095                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2096                    if (defined ($description_codes{$parts[1]})){
2097                        push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
2098                    }
2099                    else {
2100                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2101                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2102                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
2103                    }
2104                }
2105            }
2106    
2107            $column{$id}=join("<br><br>", @pfam_codes);
2108        }
2109        return (%column);
2110    
2111    }
2112    
2113    sub get_prefer {
2114        my ($fid, $db, $all_aliases) = @_;
2115        my $fig = new FIG;
2116        my $cgi = new CGI;
2117    
2118        foreach my $alias (@{$$all_aliases{$fid}}){
2119            my $id_db = &Observation::get_database($alias);
2120            if ($id_db eq $db){
2121                my $acc_col .= &HTML::set_prot_links($cgi,$alias);
2122                return ($acc_col);
2123            }
2124        }
2125        return (" ");
2126    }
2127    
2128  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; $_ }
2129    
2130    sub color {
2131        my ($evalue) = @_;
2132        my $color;
2133        if ($evalue <= 1e-170){        $color = 51;    }
2134        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2135        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2136        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2137        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2138        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2139        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2140        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2141        elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2142        else{        $color = 60;    }
2143        return ($color);
2144    }
2145    
2146    
2147  ############################  ############################
# Line 1429  Line 2159 
2159  }  }
2160    
2161  sub display {  sub display {
2162      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies,$taxes) = @_;
2163    
2164      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2165      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2166      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2167      my $fig = new FIG;      my $fig = new FIG;
2168      my $all_regions = [];      my $all_regions = [];
2169        my $gene_associations={};
2170    
2171      #get the organism genome      #get the organism genome
2172      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2173        $gene_associations->{$fid}->{"organism"} = $target_genome;
2174        $gene_associations->{$fid}->{"main_gene"} = $fid;
2175        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2176    
2177      # get location of the gene      # get location of the gene
2178      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1464  Line 2198 
2198          $region_start = $end-4000;          $region_start = $end-4000;
2199          $region_end = $beg+4000;          $region_end = $beg+4000;
2200          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2201          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2202            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2203      }      }
2204    
2205      # call genes in region      # call genes in region
# Line 1475  Line 2210 
2210    
2211      my %all_genes;      my %all_genes;
2212      my %all_genomes;      my %all_genomes;
2213      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}
2214    
2215      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
2216      {      {
# Line 1499  Line 2234 
2234                  {                  {
2235                      $pair_region_start = $pair_beg - 4000;                      $pair_region_start = $pair_beg - 4000;
2236                      $pair_region_stop = $pair_end+4000;                      $pair_region_stop = $pair_end+4000;
2237                      $offset = ($2+(($3-$2)/2))-($gd_window_size/2);                      $offset = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);
2238                  }                  }
2239                  else                  else
2240                  {                  {
2241                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
2242                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
2243                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);
2244                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
2245                  }                  }
2246    
2247                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 2249 
2249                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
2250                  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);
2251                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
2252                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2253              }              }
2254              $coup_count++;              $coup_count++;
2255          }          }
2256      }      }
2257        elsif ($compare_or_coupling eq "sims"){
2258            # get the selected boxes
2259            #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");
2260            my @selected_taxonomy = @$selected_taxonomies;
2261    
2262            # get the similarities and store only the ones that match the lineages selected
2263            my @selected_sims;
2264            my @sims= $fig->nsims($fid,20000,10,"fig");
2265    
2266      elsif ($compare_or_coupling eq "close")          if (@selected_taxonomy > 0){
2267      {              foreach my $sim (@sims){
2268          # make a hash of genomes that are phylogenetically close                  next if ($sim->[1] !~ /fig\|/);
2269          #my $close_threshold = ".26";                  my $genome = $fig->genome_of($sim->[1]);
2270          #my @genomes = $fig->genomes('complete');                  my ($genome1) = ($genome) =~ /(.*)\./;
2271          #my %close_genomes = ();                  my $lineage = $taxes->{$genome1};
2272          #foreach my $compared_genome (@genomes)                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2273          #{                  foreach my $taxon(@selected_taxonomy){
2274          #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);                      if ($lineage =~ /$taxon/){
2275          #    #$close_genomes{$compared_genome} = $dist;                          push (@selected_sims, $sim->[1]);
         #    if ($dist <= $close_threshold)  
         #    {  
         #       $all_genomes{$compared_genome} = 1;  
         #    }  
         #}  
         $all_genomes{"216592.1"} = 1;  
         $all_genomes{"79967.1"} = 1;  
         $all_genomes{"199310.1"} = 1;  
         $all_genomes{"216593.1"} = 1;  
         $all_genomes{"155864.1"} = 1;  
         $all_genomes{"83334.1"} = 1;  
         $all_genomes{"316407.3"} = 1;  
   
         foreach my $comp_genome (keys %all_genomes){  
             my $return = $fig->bbh_list($comp_genome,[$fid]);  
             my $feature_list = $return->{$fid};  
             foreach my $peg1 (@$feature_list){  
                 my $location = $fig->feature_location($peg1);  
                 my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
                 $pair_genome = $fig->genome_of($peg1);  
   
                 if($location =~/(.*)_(\d+)_(\d+)$/){  
                     $pair_contig = $1;  
                     $pair_beg = $2;  
                     $pair_end = $3;  
                     if ($pair_beg < $pair_end)  
                     {  
                         $pair_region_start = $pair_beg - 4000;  
                         $pair_region_stop = $pair_end + 4000;  
                         $offset = ($2+(($3-$2)/2))-($gd_window_size/2);  
                     }  
                     else  
                     {  
                         $pair_region_start = $pair_end-4000;  
                         $pair_region_stop = $pair_beg+4000;  
                         $offset = ($3+(($2-$3)/2))-($gd_window_size/2);  
                         $reverse_flag{$pair_genome} = 1;  
2276                      }                      }
   
                     push (@start_array_region, $offset);  
                     $all_genomes{$pair_genome} = 1;  
                     my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                     push(@$all_regions,$pair_features);  
                     foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2277                  }                  }
2278                    my %saw;
2279                    @selected_sims = grep(!$saw{$_}++, @selected_sims);
2280              }              }
2281          }          }
2282    
2283            # get the gene context for the sorted matches
2284            foreach my $sim_fid(@selected_sims){
2285                #get the organism genome
2286                my $sim_genome = $fig->genome_of($sim_fid);
2287                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2288                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2289                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2290    
2291                # get location of the gene
2292                my $data = $fig->feature_location($sim_fid);
2293                my ($contig, $beg, $end);
2294    
2295                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2296                    $contig = $1;
2297                    $beg = $2;
2298                    $end = $3;
2299      }      }
2300    
2301      # get the PCH to each of the genes              my $offset;
2302      my $pch_sets = [];              my ($region_start, $region_end);
2303      my %pch_already;              if ($beg < $end)
     foreach my $gene_peg (keys %all_genes)  
     {  
         if ($pch_already{$gene_peg}){next;};  
         my $gene_set = [$gene_peg];  
         foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {  
             $pch_peg =~ s/,.*$//;  
             my $pch_genome = $fig->genome_of($pch_peg);  
             if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) {  
                 push(@$gene_set,$pch_peg);  
                 $pch_already{$pch_peg}=1;  
             }  
             $pch_already{$gene_peg}=1;  
         }  
         push(@$pch_sets,$gene_set);  
     }  
   
     #create a rank of the pch's  
     my %pch_set_rank;  
     my $order = 0;  
     foreach my $set (@$pch_sets){  
         my $count = scalar(@$set);  
         $pch_set_rank{$order} = $count;  
         $order++;  
     }  
   
     my %peg_rank;  
     my $counter =  1;  
     foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){  
         my $good_set = @$pch_sets[$pch_order];  
         my $flag_set = 0;  
         if (scalar (@$good_set) > 1)  
2304          {          {
2305              foreach my $peg (@$good_set){                  $region_start = $beg - 4000;
2306                  if ((!$peg_rank{$peg})){                  $region_end = $end+4000;
2307                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2308          }          }
2309          else          else
2310          {          {
2311              foreach my $peg (@$good_set){                  $region_start = $end-4000;
2312                  $peg_rank{$peg} = 100;                  $region_end = $beg+4000;
2313              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2314                    $reverse_flag{$sim_genome} = $sim_fid;
2315                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2316          }          }
2317    
2318                # call genes in region
2319                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2320                push(@$all_regions,$sim_gene_features);
2321                push (@start_array_region, $offset);
2322                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2323                $all_genomes{$sim_genome} = 1;
2324      }      }
2325    
2326        }
2327    
2328  #    my $bbh_sets = [];      # cluster the genes
2329  #    my %already;      my @all_pegs = keys %all_genes;
2330  #    foreach my $gene_key (keys(%all_genes)){      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
 #       if($already{$gene_key}){next;}  
 #       my $gene_set = [$gene_key];  
 #  
 #       my $gene_key_genome = $fig->genome_of($gene_key);  
 #  
 #       foreach my $genome_key (keys(%all_genomes)){  
 #           #next if ($gene_key_genome eq $genome_key);  
 #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  
 #  
 #           my $feature_list = $return->{$gene_key};  
 #           foreach my $fl (@$feature_list){  
 #               push(@$gene_set,$fl);  
 #           }  
 #       }  
 #       $already{$gene_key} = 1;  
 #       push(@$bbh_sets,$gene_set);  
 #    }  
 #  
 #    my %bbh_set_rank;  
 #    my $order = 0;  
 #    foreach my $set (@$bbh_sets){  
 #       my $count = scalar(@$set);  
 #       $bbh_set_rank{$order} = $count;  
 #       $order++;  
 #    }  
 #  
 #    my %peg_rank;  
 #    my $counter =  1;  
 #    foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
 #       my $good_set = @$bbh_sets[$bbh_order];  
 #       my $flag_set = 0;  
 #       if (scalar (@$good_set) > 1)  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               if ((!$peg_rank{$peg})){  
 #                   $peg_rank{$peg} = $counter;  
 #                   $flag_set = 1;  
 #               }  
 #           }  
 #           $counter++ if ($flag_set == 1);  
 #       }  
 #       else  
 #       {  
 #           foreach my $peg (@$good_set){  
 #               $peg_rank{$peg} = 100;  
 #           }  
 #       }  
 #    }  
2331    
2332      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2333          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
# Line 1695  Line 2341 
2341    
2342          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2343    
2344            my $second_line_config = { 'title' => "$region_gs",
2345                                       'short_title' => "",
2346                                       'basepair_offset' => '0',
2347                                       'no_middle_line' => '1'
2348                                       };
2349    
2350          my $line_data = [];          my $line_data = [];
2351            my $second_line_data = [];
2352    
2353            # initialize variables to check for overlap in genes
2354            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2355            my $major_line_flag = 0;
2356            my $prev_second_flag = 0;
2357    
2358          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2359                $second_line_flag = 0;
2360              my $element_hash;              my $element_hash;
2361              my $links_list = [];              my $links_list = [];
2362              my $descriptions = [];              my $descriptions = [];
2363    
2364              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2365    
2366              # get subsystem information              # get subsystem information
2367              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
# Line 1738  Line 2398 
2398                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2399                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2400    
2401                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2402                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2403                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2404                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2405                            $second_line_flag = 1;
2406                            $major_line_flag = 1;
2407                        }
2408                    }
2409                    $prev_start = $start;
2410                    $prev_stop = $stop;
2411                    $prev_fig = $fid1;
2412    
2413                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2414                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2415                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2416                  }                  }
# Line 1753  Line 2425 
2425                      "links_list" => $links_list,                      "links_list" => $links_list,
2426                      "description" => $descriptions                      "description" => $descriptions
2427                  };                  };
2428                  push(@$line_data,$element_hash);  
2429                    # if there is an overlap, put into second line
2430                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2431                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2432              }              }
2433          }          }
2434          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2435            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2436      }      }
2437      return $gd;      return $gd;
2438  }  }
2439    
2440    sub cluster_genes {
2441        my($fig,$all_pegs,$peg) = @_;
2442        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2443    
2444        my @color_sets = ();
2445    
2446        $conn = &get_connections_by_similarity($fig,$all_pegs);
2447    
2448        for ($i=0; ($i < @$all_pegs); $i++) {
2449            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2450            if (! $seen{$i}) {
2451                $cluster = [$i];
2452                $seen{$i} = 1;
2453                for ($j=0; ($j < @$cluster); $j++) {
2454                    $x = $conn->{$cluster->[$j]};
2455                    foreach $k (@$x) {
2456                        if (! $seen{$k}) {
2457                            push(@$cluster,$k);
2458                            $seen{$k} = 1;
2459                        }
2460                    }
2461                }
2462    
2463                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2464                    push(@color_sets,$cluster);
2465                }
2466            }
2467        }
2468        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2469        $red_set = $color_sets[$i];
2470        splice(@color_sets,$i,1);
2471        @color_sets = sort { @$b <=> @$a } @color_sets;
2472        unshift(@color_sets,$red_set);
2473    
2474        my $color_sets = {};
2475        for ($i=0; ($i < @color_sets); $i++) {
2476            foreach $x (@{$color_sets[$i]}) {
2477                $color_sets->{$all_pegs->[$x]} = $i;
2478            }
2479        }
2480        return $color_sets;
2481    }
2482    
2483    sub get_connections_by_similarity {
2484        my($fig,$all_pegs) = @_;
2485        my($i,$j,$tmp,$peg,%pos_of);
2486        my($sim,%conn,$x,$y);
2487    
2488        for ($i=0; ($i < @$all_pegs); $i++) {
2489            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2490            push(@{$pos_of{$tmp}},$i);
2491            if ($tmp ne $all_pegs->[$i]) {
2492                push(@{$pos_of{$all_pegs->[$i]}},$i);
2493            }
2494        }
2495    
2496        foreach $y (keys(%pos_of)) {
2497            $x = $pos_of{$y};
2498            for ($i=0; ($i < @$x); $i++) {
2499                for ($j=$i+1; ($j < @$x); $j++) {
2500                    push(@{$conn{$x->[$i]}},$x->[$j]);
2501                    push(@{$conn{$x->[$j]}},$x->[$i]);
2502                }
2503            }
2504        }
2505    
2506        for ($i=0; ($i < @$all_pegs); $i++) {
2507            foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {
2508                if (defined($x = $pos_of{$sim->id2})) {
2509                    foreach $y (@$x) {
2510                        push(@{$conn{$i}},$y);
2511                    }
2512                }
2513            }
2514        }
2515        return \%conn;
2516    }
2517    
2518    sub in {
2519        my($x,$xL) = @_;
2520        my($i);
2521    
2522        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2523        return ($i < @$xL);
2524    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3