[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.38, Mon Sep 10 15:10:04 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) = @_;
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 $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));
447            my $parent_tax = "Root";
448            my @currLineage = ($parent_tax);
449            foreach my $tax (split(/\; /, $taxonomy)){
450                push (@{$families{children}{$parent_tax}}, $tax);
451                push (@currLineage, $tax);
452                $families{parent}{$tax} = $parent_tax;
453                $families{lineage}{$tax} = join(";", @currLineage);
454                $parent_tax = $tax;
455            }
456        }
457    
458        foreach my $key (keys %{$families{children}}){
459            $families{count}{$key} = @{$families{children}{$key}};
460    
461            my %saw;
462            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
463            $families{children}{$key} = \@out;
464        }
465        return (\%families);
466    }
467    
468  =head1 Internal Methods  =head1 Internal Methods
469    
470  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 476 
476  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
477    
478      # 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)
479      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
480    
481      my $fig = new FIG;      my $fig = new FIG;
482    
483      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
484    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
485          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
486          my @parts = split("::",$key);          my @parts = split("::",$key);
487          my $class = $parts[0];          my $class = $parts[0];
# Line 411  Line 520 
520    
521  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
522    
523      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
524      my $fig = new FIG;      my $fig = new FIG;
525    
526      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
527    
528        my $dataset = {'type' => "loc",
529                       'class' => 'SIGNALP_CELLO_TMPRED',
530                       'fig_id' => $fid
531                       };
532    
533      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      foreach my $attr_ref (@$attributes_ref){
534      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
535          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
536            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
537          my @parts = split("::",$key);          my @parts = split("::",$key);
538          my $sub_class = $parts[0];          my $sub_class = $parts[0];
539          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 428  Line 543 
543                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
544                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
545                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
546    #               print STDERR "LOC: $value_parts[1]";
547              }              }
548              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
549                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
550              }              }
551          }          }
552    
553          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
554              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
555              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
556          }          }
557    
558            elsif($sub_class eq "Phobius"){
559                if($sub_key eq "transmembrane"){
560                    $dataset->{'phobius_tm_locations'} = $value;
561                }
562                elsif($sub_key eq "signal"){
563                    $dataset->{'phobius_signal_location'} = $value;
564                }
565            }
566    
567          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
568              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
569              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
570              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
571          }          }
# Line 455  Line 582 
582  =cut  =cut
583    
584  sub get_pdb_observations{  sub get_pdb_observations{
585      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
586    
587      my $fig = new FIG;      my $fig = new FIG;
588    
589      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref (@$attributes_ref){
590        #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
591    
592          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
593            next if ( ($key !~ /PDB/));
594          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
595          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
596          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 516  Line 645 
645    
646      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
647      my $fig = new FIG;      my $fig = new FIG;
648      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,500,10,"fig");
649      my ($dataset);      my ($dataset);
650    
651        my %id_list;
652        foreach my $sim (@sims){
653            my $hit = $sim->[1];
654    
655            next if ($hit !~ /^fig\|/);
656            my @aliases = $fig->feature_aliases($hit);
657            foreach my $alias (@aliases){
658                $id_list{$alias} = 1;
659            }
660        }
661    
662        my %already;
663        my (@new_sims, @uniprot);
664      foreach my $sim (@sims){      foreach my $sim (@sims){
665          my $hit = $sim->[1];          my $hit = $sim->[1];
666            my ($id) = ($hit) =~ /\|(.*)/;
667            next if (defined($already{$id}));
668            next if (defined($id_list{$hit}));
669            push (@new_sims, $sim);
670            $already{$id} = 1;
671        }
672    
673        foreach my $sim (@new_sims){
674            my $hit = $sim->[1];
675          my $percent = $sim->[2];          my $percent = $sim->[2];
676          my $evalue = $sim->[10];          my $evalue = $sim->[10];
677          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 569  Line 721 
721      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
722      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
723      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
724      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
725      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
726      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
727      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 591  Line 743 
743      my $fig = new FIG;      my $fig = new FIG;
744      my $funcs_ref;      my $funcs_ref;
745    
746    #    my %id_list;
747      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);
748    #    my @aliases = $fig->feature_aliases($fid);
749    #    foreach my $alias (@aliases){
750    #       $id_list{$alias} = 1;
751    #    }
752    
753      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
754          my ($tmp, $who);          my ($tmp, $who);
755          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
756    #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
757              $who = &get_database($id);              $who = &get_database($id);
758              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
759          }          }
# Line 788  Line 946 
946    
947      my $acc = $self->acc;      my $acc = $self->acc;
948    
     print STDERR "acc:$acc\n";  
949      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
950      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
951      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 923  Line 1080 
1080          my $id = $row->[0];          my $id = $row->[0];
1081          my $who = $row->[1];          my $who = $row->[1];
1082          my $assignment = $row->[2];          my $assignment = $row->[2];
1083          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1084          my $single_domain = [];          my $single_domain = [];
1085          push(@$single_domain,$who);          push(@$single_domain,$who);
1086          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 1031  Line 1188 
1188  sub display {  sub display {
1189      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1190      my $lines = [];      my $lines = [];
1191      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1192                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1193                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1194      my $color = "4";      my $color = "4";
1195    
1196      my $line_data = [];      my $line_data = [];
# Line 1063  Line 1220 
1220          }          }
1221      }      }
1222    
1223        my $line_config = { 'title' => $thing->acc,
1224                            'short_title' => $name_value,
1225                            'basepair_offset' => '1' };
1226    
1227      my $name;      my $name;
1228      $name = {"title" => $name_title,      $name = {"title" => $name_title,
1229               "value" => $name_value};               "value" => $name_value};
# Line 1109  Line 1270 
1270    
1271  }  }
1272    
1273    sub display_table {
1274        my ($self,$dataset) = @_;
1275        my $cgi = new CGI;
1276        my $data = [];
1277        my $count = 0;
1278        my $content;
1279    
1280        foreach my $thing (@$dataset) {
1281            next if ($thing->type !~ /dom/);
1282            my $single_domain = [];
1283            $count++;
1284    
1285            my $db_and_id = $thing->acc;
1286            my ($db,$id) = split("::",$db_and_id);
1287    
1288            my $dbmaster = DBMaster->new(-database =>'Ontology');
1289    
1290            my ($name_title,$name_value,$description_title,$description_value);
1291            if($db eq "CDD"){
1292                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1293                if(!scalar(@$cdd_objs)){
1294                    $name_title = "name";
1295                    $name_value = "not available";
1296                    $description_title = "description";
1297                    $description_value = "not available";
1298                }
1299                else{
1300                    my $cdd_obj = $cdd_objs->[0];
1301                    $name_title = "name";
1302                    $name_value = $cdd_obj->term;
1303                    $description_title = "description";
1304                    $description_value = $cdd_obj->description;
1305                }
1306            }
1307    
1308            my $location =  $thing->start . " - " . $thing->stop;
1309    
1310            push(@$single_domain,$db);
1311            push(@$single_domain,$thing->acc);
1312            push(@$single_domain,$name_value);
1313            push(@$single_domain,$location);
1314            push(@$single_domain,$thing->evalue);
1315            push(@$single_domain,$description_value);
1316            push(@$data,$single_domain);
1317        }
1318    
1319        if ($count >0){
1320            $content = $data;
1321        }
1322        else
1323        {
1324            $content = "<p>This PEG does not have any similarities to domains</p>";
1325        }
1326    }
1327    
1328    
1329  #########################################  #########################################
1330  #########################################  #########################################
1331  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1343 
1343      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1344      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1345      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1346        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1347        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1348    
1349      bless($self,$class);      bless($self,$class);
1350      return $self;      return $self;
1351  }  }
1352    
1353    sub display_cello {
1354        my ($thing) = @_;
1355        my $html;
1356        my $cello_location = $thing->cello_location;
1357        my $cello_score = $thing->cello_score;
1358        if($cello_location){
1359            $html .= "<p>CELLO prediction: $cello_location </p>";
1360            $html .= "<p>CELLO score: $cello_score </p>";
1361        }
1362        return ($html);
1363    }
1364    
1365  sub display {  sub display {
1366      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1367    
# Line 1147  Line 1378 
1378      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1379      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1380    
1381        my $phobius_signal_location = $thing->phobius_signal_location;
1382        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1383    
1384      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1385    
1386      #color is      #color is
1387      my $color = "5";      my $color = "6";
1388    
1389      my $line_data = [];  =pod=
1390    
1391      if($cello_location){      if($cello_location){
1392          my $cello_descriptions = [];          my $cello_descriptions = [];
1393            my $line_data =[];
1394    
1395            my $line_config = { 'title' => 'Localization Evidence',
1396                                'short_title' => 'CELLO',
1397                                'basepair_offset' => '1' };
1398    
1399          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1400                                            "value" => $cello_location};                                            "value" => $cello_location};
1401    
# Line 1171  Line 1408 
1408    
1409          my $element_hash = {          my $element_hash = {
1410              "title" => "CELLO",              "title" => "CELLO",
1411                "color"=> $color,
1412              "start" => "1",              "start" => "1",
1413              "end" =>  $length + 1,              "end" =>  $length + 1,
1414              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1415              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1416    
1417          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1418            $gd->add_line($line_data, $line_config);
1419      }      }
1420    
1421      my $color = "6";  =cut
1422    
1423        $color = "2";
1424      if($tmpred_score){      if($tmpred_score){
1425            my $line_data =[];
1426            my $line_config = { 'title' => 'Localization Evidence',
1427                                'short_title' => 'Transmembrane',
1428                                'basepair_offset' => '1' };
1429    
1430          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1431              my $descriptions = [];              my $descriptions = [];
1432              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1441 
1441              "end" =>  $end + 1,              "end" =>  $end + 1,
1442              "color"=> $color,              "color"=> $color,
1443              "zlayer" => '5',              "zlayer" => '5',
1444              "type" => 'smallbox',              "type" => 'box',
1445                "description" => $descriptions};
1446    
1447                push(@$line_data,$element_hash);
1448    
1449            }
1450            $gd->add_line($line_data, $line_config);
1451        }
1452    
1453        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1454            my $line_data =[];
1455            my $line_config = { 'title' => 'Localization Evidence',
1456                                'short_title' => 'Phobius',
1457                                'basepair_offset' => '1' };
1458    
1459            foreach my $tm_loc (@phobius_tm_locations){
1460                my $descriptions = [];
1461                my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',
1462                                 "value" => $tm_loc};
1463                push(@$descriptions,$description_phobius_tm_locations);
1464    
1465                my ($begin,$end) =split("-",$tm_loc);
1466    
1467                my $element_hash = {
1468                "title" => "phobius transmembrane location",
1469                "start" => $begin + 1,
1470                "end" =>  $end + 1,
1471                "color"=> '6',
1472                "zlayer" => '4',
1473                "type" => 'bigbox',
1474              "description" => $descriptions};              "description" => $descriptions};
1475    
1476              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1477    
1478            }
1479    
1480            if($phobius_signal_location){
1481                my $descriptions = [];
1482                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1483                                 "value" => $phobius_signal_location};
1484                push(@$descriptions,$description_phobius_signal_location);
1485    
1486    
1487                my ($begin,$end) =split("-",$phobius_signal_location);
1488                my $element_hash = {
1489                "title" => "phobius signal locations",
1490                "start" => $begin + 1,
1491                "end" =>  $end + 1,
1492                "color"=> '1',
1493                "zlayer" => '5',
1494                "type" => 'box',
1495                "description" => $descriptions};
1496                push(@$line_data,$element_hash);
1497          }          }
1498    
1499            $gd->add_line($line_data, $line_config);
1500      }      }
1501    
1502      my $color = "1";  
1503        $color = "1";
1504      if($signal_peptide_score){      if($signal_peptide_score){
1505            my $line_data = [];
1506          my $descriptions = [];          my $descriptions = [];
1507    
1508            my $line_config = { 'title' => 'Localization Evidence',
1509                                'short_title' => 'SignalP',
1510                                'basepair_offset' => '1' };
1511    
1512          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1513                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1514    
# Line 1220  Line 1522 
1522          my $element_hash = {          my $element_hash = {
1523              "title" => "SignalP",              "title" => "SignalP",
1524              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1525              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1526              "type" => 'bigbox',              "type" => 'bigbox',
1527              "color"=> $color,              "color"=> $color,
1528              "zlayer" => '10',              "zlayer" => '10',
1529              "description" => $descriptions};              "description" => $descriptions};
1530    
1531          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1532      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1533        }
1534    
1535      return ($gd);      return ($gd);
1536    
# Line 1277  Line 1578 
1578    return $self->{cello_score};    return $self->{cello_score};
1579  }  }
1580    
1581    sub phobius_signal_location {
1582      my ($self) = @_;
1583      return $self->{phobius_signal_location};
1584    }
1585    
1586    sub phobius_tm_locations {
1587      my ($self) = @_;
1588      return $self->{phobius_tm_locations};
1589    }
1590    
1591    
1592    
1593  #########################################  #########################################
1594  #########################################  #########################################
# Line 1305  Line 1617 
1617      return $self;      return $self;
1618  }  }
1619    
1620  =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  
1621    
1622  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.
1623    This code will display a graphical view of the similarities using the genome drawer object
1624    
1625  =cut  =cut
1626    
1627  sub display_table {  sub display {
1628      my ($self,$dataset) = @_;      my ($self,$gd) = @_;
1629    
     my $data = [];  
     my $count = 0;  
     my $content;  
1630      my $fig = new FIG;      my $fig = new FIG;
1631      my $cgi = new CGI;      my $peg = $self->acc;
     foreach my $thing (@$dataset) {  
         my $single_domain = [];  
         next if ($thing->class ne "SIM");  
         $count++;  
1632    
1633          my $id = $thing->acc;      my $organism = $self->organism;
1634        my $genome = $fig->genome_of($peg);
1635        my ($org_tax) = ($genome) =~ /(.*)\./;
1636        my $function = $self->function;
1637        my $abbrev_name = $fig->abbrev($organism);
1638        my $align_start = $self->qstart;
1639        my $align_stop = $self->qstop;
1640        my $hit_start = $self->hstart;
1641        my $hit_stop = $self->hstop;
1642    
1643        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1644    
1645        my $line_config = { 'title' => "$organism [$org_tax]",
1646                            'short_title' => "$abbrev_name",
1647                            'title_link' => '$tax_link',
1648                            'basepair_offset' => '0'
1649                            };
1650    
1651          # add the subsystem information      my $line_data = [];
         my @in_sub  = $fig->peg_to_subsystems($id);  
         my $in_sub;  
1652    
1653          if (@in_sub > 0) {      my $element_hash;
1654              $in_sub = @in_sub;      my $links_list = [];
1655        my $descriptions = [];
1656    
1657              # RAE: add a javascript popup with all the subsystems      # get subsystem information
1658              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;";  
         }  
1659    
1660          # add evidence code with tool tip      my $link;
1661          my $ev_codes=" &nbsp; ";      $link = {"link_title" => $peg,
1662          my @ev_codes = "";               "link" => $url_link};
1663          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {      push(@$links_list,$link);
             my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
             @ev_codes = ();  
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
                 }  
                 push(@ev_codes, $pretty_code);  
             }  
         }  
1664    
1665          if (scalar(@ev_codes) && $ev_codes[0]) {      my @subsystems = $fig->peg_to_subsystems($peg);
1666              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);      foreach my $subsystem (@subsystems){
1667              $ev_codes = $cgi->a(          my $link;
1668                                  {          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1669                                      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));                   "link_title" => $subsystem};
1670            push(@$links_list,$link);
1671          }          }
1672    
1673          # add the aliases      my $description_function;
1674          my $aliases = undef;      $description_function = {"title" => "function",
1675          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );                               "value" => $function};
1676          $aliases = &HTML::set_prot_links( $cgi, $aliases );      push(@$descriptions,$description_function);
1677          $aliases ||= "&nbsp;";  
1678        my ($description_ss, $ss_string);
1679        $ss_string = join (",", @subsystems);
1680        $description_ss = {"title" => "subsystems",
1681                           "value" => $ss_string};
1682        push(@$descriptions,$description_ss);
1683    
1684        my $description_loc;
1685        $description_loc = {"title" => "location start",
1686                            "value" => $hit_start};
1687        push(@$descriptions, $description_loc);
1688    
1689        $description_loc = {"title" => "location stop",
1690                            "value" => $hit_stop};
1691        push(@$descriptions, $description_loc);
1692    
1693        my $evalue = $self->evalue;
1694        while ($evalue =~ /-0/)
1695        {
1696            my ($chunk1, $chunk2) = split(/-/, $evalue);
1697            $chunk2 = substr($chunk2,1);
1698            $evalue = $chunk1 . "-" . $chunk2;
1699        }
1700    
1701        my $color = &color($evalue);
1702    
1703        my $description_eval = {"title" => "E-Value",
1704                                "value" => $evalue};
1705        push(@$descriptions, $description_eval);
1706    
1707        my $identity = $self->identity;
1708        my $description_identity = {"title" => "Identity",
1709                                    "value" => $identity};
1710        push(@$descriptions, $description_identity);
1711    
1712        $element_hash = {
1713            "title" => $peg,
1714            "start" => $align_start,
1715            "end" =>  $align_stop,
1716            "type"=> 'box',
1717            "color"=> $color,
1718            "zlayer" => "2",
1719            "links_list" => $links_list,
1720            "description" => $descriptions
1721            };
1722        push(@$line_data,$element_hash);
1723        $gd->add_line($line_data, $line_config);
1724    
1725        return ($gd);
1726    
1727    }
1728    
1729    =head3 display_domain_composition()
1730    
1731    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
1732    
1733    =cut
1734    
1735    sub display_domain_composition {
1736        my ($self,$gd) = @_;
1737    
1738        my $fig = new FIG;
1739        my $peg = $self->acc;
1740    
1741        my $line_data = [];
1742        my $links_list = [];
1743        my $descriptions = [];
1744    
1745        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1746    
1747        foreach $dqr (@domain_query_results){
1748            my $key = @$dqr[1];
1749            my @parts = split("::",$key);
1750            my $db = $parts[0];
1751            my $id = $parts[1];
1752            my $val = @$dqr[2];
1753            my $from;
1754            my $to;
1755            my $evalue;
1756    
1757            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1758                my $raw_evalue = $1;
1759                $from = $2;
1760                $to = $3;
1761                if($raw_evalue =~/(\d+)\.(\d+)/){
1762                    my $part2 = 1000 - $1;
1763                    my $part1 = $2/100;
1764                    $evalue = $part1."e-".$part2;
1765                }
1766                else{
1767                    $evalue = "0.0";
1768                }
1769            }
1770    
1771            my $dbmaster = DBMaster->new(-database =>'Ontology');
1772            my ($name_value,$description_value);
1773    
1774            if($db eq "CDD"){
1775                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1776                if(!scalar(@$cdd_objs)){
1777                    $name_title = "name";
1778                    $name_value = "not available";
1779                    $description_title = "description";
1780                    $description_value = "not available";
1781                }
1782                else{
1783                    my $cdd_obj = $cdd_objs->[0];
1784                    $name_value = $cdd_obj->term;
1785                    $description_value = $cdd_obj->description;
1786                }
1787            }
1788    
1789            my $domain_name;
1790            $domain_name = {"title" => "name",
1791                     "value" => $name_value};
1792            push(@$descriptions,$domain_name);
1793    
1794            my $description;
1795            $description = {"title" => "description",
1796                            "value" => $description_value};
1797            push(@$descriptions,$description);
1798    
1799            my $score;
1800            $score = {"title" => "score",
1801                      "value" => $evalue};
1802            push(@$descriptions,$score);
1803    
1804            my $link_id = $id;
1805            my $link;
1806            my $link_url;
1807            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"}
1808            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1809            else{$link_url = "NO_URL"}
1810    
1811            $link = {"link_title" => $name_value,
1812                     "link" => $link_url};
1813            push(@$links_list,$link);
1814    
1815            my $domain_element_hash = {
1816                "title" => $peg,
1817                "start" => $from,
1818                "end" =>  $to,
1819                "type"=> 'box',
1820                "zlayer" => '4',
1821                "links_list" => $links_list,
1822                "description" => $descriptions
1823                };
1824    
1825            push(@$line_data,$domain_element_hash);
1826    
1827            #just one CDD domain for now, later will add option for multiple domains from selected DB
1828            last;
1829        }
1830    
1831        my $line_config = { 'title' => $peg,
1832                            'short_title' => $peg,
1833                            'basepair_offset' => '1' };
1834    
1835        $gd->add_line($line_data, $line_config);
1836    
1837        return ($gd);
1838    
1839    }
1840    
1841    =head3 display_table()
1842    
1843    If available use the function specified here to display the "raw" observation.
1844    This code will display a table for the similarities protein
1845    
1846    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.
1847    
1848    =cut
1849    
1850    sub display_table {
1851        my ($self,$dataset, $scroll_list, $query_fid) = @_;
1852    
1853        my $data = [];
1854        my $count = 0;
1855        my $content;
1856        my $fig = new FIG;
1857        my $cgi = new CGI;
1858        my @ids;
1859        foreach my $thing (@$dataset) {
1860            next if ($thing->class ne "SIM");
1861            push (@ids, $thing->acc);
1862        }
1863    
1864        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1865    
1866        # get the column for the subsystems
1867        %subsystems_column = &get_subsystems_column(\@ids);
1868    
1869        # get the column for the evidence codes
1870        %evidence_column = &get_evidence_column(\@ids);
1871    
1872        # get the column for pfam_domain
1873        %pfam_column = &get_pfam_column(\@ids);
1874    
1875        my %e_identical = &get_essentially_identical($query_fid);
1876        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1877    
1878        foreach my $thing (@$dataset) {
1879            next if ($thing->class ne "SIM");
1880            my $single_domain = [];
1881            $count++;
1882    
1883            my $id = $thing->acc;
1884    
1885          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1886          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
# Line 1385  Line 1894 
1894          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1895          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1896    
1897            # checkbox column
1898            my $field_name = "tables_" . $id;
1899            my $pair_name = "visual_" . $id;
1900            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1901    
1902            # get the linked fig id
1903            my $fig_col;
1904            if (defined ($e_identical{$id})){
1905                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1906            }
1907            else{
1908                $fig_col = &HTML::set_prot_links($cgi,$id);
1909            }
1910    
1911          push(@$single_domain,$thing->database);          push(@$single_domain,$box_col);                        # permanent column
1912          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          push(@$single_domain,$fig_col);                        # permanent column
1913          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);                  # permanent column
1914          push(@$single_domain,"$iden\%");          push(@$single_domain,"$iden\%");                       # permanent column
1915          push(@$single_domain,$reg1);          push(@$single_domain,$reg1);                           # permanent column
1916          push(@$single_domain,$reg2);          push(@$single_domain,$reg2);                           # permanent column
1917          push(@$single_domain,$in_sub);          push(@$single_domain,$thing->organism);                # permanent column
1918          push(@$single_domain,$ev_codes);          push(@$single_domain,$thing->function);                # permanent column
1919          push(@$single_domain,$thing->organism);          foreach my $col (sort keys %$scroll_list){
1920          push(@$single_domain,$thing->function);              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1921          push(@$single_domain,$aliases);              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1922                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1923                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}
1924                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}
1925                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}
1926                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}
1927                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}
1928                elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}
1929                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}
1930                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}
1931                elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}
1932                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}
1933            }
1934          push(@$data,$single_domain);          push(@$data,$single_domain);
1935      }      }
1936    
1937      if ($count >0){      if ($count >0){
1938          $content = $data;          $content = $data;
1939      }      }
1940      else      else{
     {  
1941          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
1942      }      }
1943      return ($content);      return ($content);
1944  }  }
1945    
1946    sub get_box_column{
1947        my ($ids) = @_;
1948        my %column;
1949        foreach my $id (@$ids){
1950            my $field_name = "tables_" . $id;
1951            my $pair_name = "visual_" . $id;
1952            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1953        }
1954        return (%column);
1955    }
1956    
1957    sub get_subsystems_column{
1958        my ($ids) = @_;
1959    
1960        my $fig = new FIG;
1961        my $cgi = new CGI;
1962        my %in_subs  = $fig->subsystems_for_pegs($ids);
1963        my %column;
1964        foreach my $id (@$ids){
1965            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1966            my @subsystems;
1967    
1968            if (@in_sub > 0) {
1969                my $count = 1;
1970                foreach my $array(@in_sub){
1971                    push (@subsystems, $count . ". " . $$array[0]);
1972                    $count++;
1973                }
1974                my $in_sub_line = join ("<br>", @subsystems);
1975                $column{$id} = $in_sub_line;
1976            } else {
1977                $column{$id} = "&nbsp;";
1978            }
1979        }
1980        return (%column);
1981    }
1982    
1983    sub get_essentially_identical{
1984        my ($fid) = @_;
1985        my $fig = new FIG;
1986    
1987        my %id_list;
1988        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
1989    
1990        foreach my $id (@maps_to) {
1991            if (($id ne $fid) && ($fig->function_of($id))) {
1992                $id_list{$id} = 1;
1993            }
1994        }
1995        return(%id_list);
1996    }
1997    
1998    
1999    sub get_evidence_column{
2000        my ($ids) = @_;
2001        my $fig = new FIG;
2002        my $cgi = new CGI;
2003        my (%column, %code_attributes);
2004    
2005        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
2006        foreach my $key (@codes){
2007            push (@{$code_attributes{$$key[0]}}, $key);
2008        }
2009    
2010        foreach my $id (@$ids){
2011            # add evidence code with tool tip
2012            my $ev_codes=" &nbsp; ";
2013            my @ev_codes = "";
2014    
2015            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2016                my @codes;
2017                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2018                @ev_codes = ();
2019                foreach my $code (@codes) {
2020                    my $pretty_code = $code->[2];
2021                    if ($pretty_code =~ /;/) {
2022                        my ($cd, $ss) = split(";", $code->[2]);
2023                        $ss =~ s/_/ /g;
2024                        $pretty_code = $cd;# . " in " . $ss;
2025                    }
2026                    push(@ev_codes, $pretty_code);
2027                }
2028            }
2029    
2030            if (scalar(@ev_codes) && $ev_codes[0]) {
2031                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2032                $ev_codes = $cgi->a(
2033                                    {
2034                                        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));
2035            }
2036            $column{$id}=$ev_codes;
2037        }
2038        return (%column);
2039    }
2040    
2041    sub get_pfam_column{
2042        my ($ids) = @_;
2043        my $fig = new FIG;
2044        my $cgi = new CGI;
2045        my (%column, %code_attributes);
2046        my $dbmaster = DBMaster->new(-database =>'Ontology');
2047    
2048        my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
2049        foreach my $key (@codes){
2050            push (@{$code_attributes{$$key[0]}}, $$key[1]);
2051        }
2052    
2053        foreach my $id (@$ids){
2054            # add evidence code with tool tip
2055            my $pfam_codes=" &nbsp; ";
2056            my @pfam_codes = "";
2057            my %description_codes;
2058    
2059            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2060                my @codes;
2061                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2062                @pfam_codes = ();
2063                foreach my $code (@codes) {
2064                    my @parts = split("::",$code);
2065                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2066                    if (defined ($description_codes{$parts[1]})){
2067                        push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
2068                    }
2069                    else {
2070                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2071                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2072                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
2073                    }
2074                }
2075            }
2076    
2077            $column{$id}=join("<br><br>", @pfam_codes);
2078        }
2079        return (%column);
2080    
2081    }
2082    
2083    sub get_prefer {
2084        my ($fid, $db, $all_aliases) = @_;
2085        my $fig = new FIG;
2086        my $cgi = new CGI;
2087    
2088        foreach my $alias (@{$$all_aliases{$fid}}){
2089            my $id_db = &Observation::get_database($alias);
2090            if ($id_db eq $db){
2091                my $acc_col .= &HTML::set_prot_links($cgi,$alias);
2092                return ($acc_col);
2093            }
2094        }
2095        return (" ");
2096    }
2097    
2098  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; $_ }
2099    
2100    sub color {
2101        my ($evalue) = @_;
2102    
2103        my $color;
2104        if ($evalue <= 1e-170){
2105            $color = 51;
2106        }
2107        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
2108            $color = 52;
2109        }
2110        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
2111            $color = 53;
2112        }
2113        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
2114            $color = 54;
2115        }
2116        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
2117            $color = 55;
2118        }
2119        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
2120            $color = 56;
2121        }
2122        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
2123            $color = 57;
2124        }
2125        elsif (($evalue <= 1) && ($evalue > 1e-5)){
2126            $color = 58;
2127        }
2128        elsif (($evalue <= 10) && ($evalue > 1)){
2129            $color = 59;
2130        }
2131        else{
2132            $color = 60;
2133        }
2134    
2135    
2136        return ($color);
2137    }
2138    
2139    
2140  ############################  ############################
# Line 1429  Line 2152 
2152  }  }
2153    
2154  sub display {  sub display {
2155      my ($self,$gd) = @_;      my ($self,$gd,$selected_taxonomies) = @_;
2156    
2157      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2158      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2159      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2160      my $fig = new FIG;      my $fig = new FIG;
2161      my $all_regions = [];      my $all_regions = [];
2162        my $gene_associations={};
2163    
2164      #get the organism genome      #get the organism genome
2165      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2166        $gene_associations->{$fid}->{"organism"} = $target_genome;
2167        $gene_associations->{$fid}->{"main_gene"} = $fid;
2168        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2169    
2170      # get location of the gene      # get location of the gene
2171      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
# Line 1464  Line 2191 
2191          $region_start = $end-4000;          $region_start = $end-4000;
2192          $region_end = $beg+4000;          $region_end = $beg+4000;
2193          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2194          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2195            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2196      }      }
2197    
2198      # call genes in region      # call genes in region
# Line 1475  Line 2203 
2203    
2204      my %all_genes;      my %all_genes;
2205      my %all_genomes;      my %all_genomes;
2206      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;}
2207    
2208      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
2209      {      {
# Line 1499  Line 2227 
2227                  {                  {
2228                      $pair_region_start = $pair_beg - 4000;                      $pair_region_start = $pair_beg - 4000;
2229                      $pair_region_stop = $pair_end+4000;                      $pair_region_stop = $pair_end+4000;
2230                      $offset = ($2+(($3-$2)/2))-($gd_window_size/2);                      $offset = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);
2231                  }                  }
2232                  else                  else
2233                  {                  {
2234                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
2235                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
2236                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);
2237                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
2238                  }                  }
2239    
2240                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 2242 
2242                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
2243                  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);
2244                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
2245                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2246              }              }
2247              $coup_count++;              $coup_count++;
2248          }          }
2249      }      }
2250        elsif ($compare_or_coupling eq "sims"){
2251            # get the selected boxes
2252            #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");
2253            my @selected_taxonomy = @$selected_taxonomies;
2254    
2255            # get the similarities and store only the ones that match the lineages selected
2256            my @selected_sims;
2257            my @sims= $fig->nsims($fid,20000,10,"fig");
2258    
2259      elsif ($compare_or_coupling eq "close")          if (@selected_taxonomy > 0){
2260      {              foreach my $sim (@sims){
2261          # make a hash of genomes that are phylogenetically close                  next if ($sim->[1] !~ /fig\|/);
2262          #my $close_threshold = ".26";                  my $genome = $fig->genome_of($sim->[1]);
2263          #my @genomes = $fig->genomes('complete');                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2264          #my %close_genomes = ();                  foreach my $taxon(@selected_taxonomy){
2265          #foreach my $compared_genome (@genomes)                      if ($lineage =~ /$taxon/){
2266          #{                          push (@selected_sims, $sim->[1]);
         #    my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome);  
         #    #$close_genomes{$compared_genome} = $dist;  
         #    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;  
2267                      }                      }
   
                     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;}  
2268                  }                  }
2269                    my %saw;
2270                    @selected_sims = grep(!$saw{$_}++, @selected_sims);
2271              }              }
2272          }          }
2273    
2274            # get the gene context for the sorted matches
2275            foreach my $sim_fid(@selected_sims){
2276                #get the organism genome
2277                my $sim_genome = $fig->genome_of($sim_fid);
2278                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2279                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2280                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2281    
2282                # get location of the gene
2283                my $data = $fig->feature_location($sim_fid);
2284                my ($contig, $beg, $end);
2285    
2286                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2287                    $contig = $1;
2288                    $beg = $2;
2289                    $end = $3;
2290      }      }
2291    
2292      # get the PCH to each of the genes              my $offset;
2293      my $pch_sets = [];              my ($region_start, $region_end);
2294      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)  
2295          {          {
2296              foreach my $peg (@$good_set){                  $region_start = $beg - 4000;
2297                  if ((!$peg_rank{$peg})){                  $region_end = $end+4000;
2298                      $peg_rank{$peg} = $counter;                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
                     $flag_set = 1;  
                 }  
             }  
             $counter++ if ($flag_set == 1);  
2299          }          }
2300          else          else
2301          {          {
2302              foreach my $peg (@$good_set){                  $region_start = $end-4000;
2303                  $peg_rank{$peg} = 100;                  $region_end = $beg+4000;
2304              }                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2305                    $reverse_flag{$sim_genome} = $sim_fid;
2306                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2307          }          }
2308    
2309                # call genes in region
2310                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2311                push(@$all_regions,$sim_gene_features);
2312                push (@start_array_region, $offset);
2313                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2314                $all_genomes{$sim_genome} = 1;
2315      }      }
2316    
2317        }
2318    
2319  #    my $bbh_sets = [];      # cluster the genes
2320  #    my %already;      my @all_pegs = keys %all_genes;
2321  #    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;  
 #           }  
 #       }  
 #    }  
2322    
2323      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2324          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
# Line 1695  Line 2332 
2332    
2333          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2334    
2335            my $second_line_config = { 'title' => "$region_gs",
2336                                       'short_title' => "",
2337                                       'basepair_offset' => '0',
2338                                       'no_middle_line' => '1'
2339                                       };
2340    
2341          my $line_data = [];          my $line_data = [];
2342            my $second_line_data = [];
2343    
2344            # initialize variables to check for overlap in genes
2345            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2346            my $major_line_flag = 0;
2347            my $prev_second_flag = 0;
2348    
2349          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2350                $second_line_flag = 0;
2351              my $element_hash;              my $element_hash;
2352              my $links_list = [];              my $links_list = [];
2353              my $descriptions = [];              my $descriptions = [];
2354    
2355              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
2356    
2357              # get subsystem information              # get subsystem information
2358              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
# Line 1738  Line 2389 
2389                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2390                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2391    
2392                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2393                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2394                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2395                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2396                            $second_line_flag = 1;
2397                            $major_line_flag = 1;
2398                        }
2399                    }
2400                    $prev_start = $start;
2401                    $prev_stop = $stop;
2402                    $prev_fig = $fid1;
2403    
2404                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2405                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2406                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2407                  }                  }
# Line 1753  Line 2416 
2416                      "links_list" => $links_list,                      "links_list" => $links_list,
2417                      "description" => $descriptions                      "description" => $descriptions
2418                  };                  };
2419                  push(@$line_data,$element_hash);  
2420                    # if there is an overlap, put into second line
2421                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2422                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2423              }              }
2424          }          }
2425          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2426            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2427      }      }
2428      return $gd;      return $gd;
2429  }  }
2430    
2431    sub cluster_genes {
2432        my($fig,$all_pegs,$peg) = @_;
2433        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2434    
2435        my @color_sets = ();
2436    
2437        $conn = &get_connections_by_similarity($fig,$all_pegs);
2438    
2439        for ($i=0; ($i < @$all_pegs); $i++) {
2440            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2441            if (! $seen{$i}) {
2442                $cluster = [$i];
2443                $seen{$i} = 1;
2444                for ($j=0; ($j < @$cluster); $j++) {
2445                    $x = $conn->{$cluster->[$j]};
2446                    foreach $k (@$x) {
2447                        if (! $seen{$k}) {
2448                            push(@$cluster,$k);
2449                            $seen{$k} = 1;
2450                        }
2451                    }
2452                }
2453    
2454                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2455                    push(@color_sets,$cluster);
2456                }
2457            }
2458        }
2459        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2460        $red_set = $color_sets[$i];
2461        splice(@color_sets,$i,1);
2462        @color_sets = sort { @$b <=> @$a } @color_sets;
2463        unshift(@color_sets,$red_set);
2464    
2465        my $color_sets = {};
2466        for ($i=0; ($i < @color_sets); $i++) {
2467            foreach $x (@{$color_sets[$i]}) {
2468                $color_sets->{$all_pegs->[$x]} = $i;
2469            }
2470        }
2471        return $color_sets;
2472    }
2473    
2474    sub get_connections_by_similarity {
2475        my($fig,$all_pegs) = @_;
2476        my($i,$j,$tmp,$peg,%pos_of);
2477        my($sim,%conn,$x,$y);
2478    
2479        for ($i=0; ($i < @$all_pegs); $i++) {
2480            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2481            push(@{$pos_of{$tmp}},$i);
2482            if ($tmp ne $all_pegs->[$i]) {
2483                push(@{$pos_of{$all_pegs->[$i]}},$i);
2484            }
2485        }
2486    
2487        foreach $y (keys(%pos_of)) {
2488            $x = $pos_of{$y};
2489            for ($i=0; ($i < @$x); $i++) {
2490                for ($j=$i+1; ($j < @$x); $j++) {
2491                    push(@{$conn{$x->[$i]}},$x->[$j]);
2492                    push(@{$conn{$x->[$j]}},$x->[$i]);
2493                }
2494            }
2495        }
2496    
2497        for ($i=0; ($i < @$all_pegs); $i++) {
2498            foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {
2499                if (defined($x = $pos_of{$sim->id2})) {
2500                    foreach $y (@$x) {
2501                        push(@{$conn{$i}},$y);
2502                    }
2503                }
2504            }
2505        }
2506        return \%conn;
2507    }
2508    
2509    sub in {
2510        my($x,$xL) = @_;
2511        my($i);
2512    
2513        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2514        return ($i < @$xL);
2515    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3