[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.37, Tue Sep 4 18:34:13 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,"all");
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            foreach my $tax (split(/\; /, $taxonomy)){
449                push (@{$families{children}{$parent_tax}}, $tax);
450                $families{parent}{$tax} = $parent_tax;
451                $parent_tax = $tax;
452            }
453        }
454    
455        foreach my $key (keys %{$families{children}}){
456            $families{count}{$key} = @{$families{children}{$key}};
457    
458            my %saw;
459            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
460            $families{children}{$key} = \@out;
461        }
462        return (\%families);
463    }
464    
465  =head1 Internal Methods  =head1 Internal Methods
466    
467  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 473 
473  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
474    
475      # 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)
476      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
477    
478      my $fig = new FIG;      my $fig = new FIG;
479    
480      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
481    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
482          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
483          my @parts = split("::",$key);          my @parts = split("::",$key);
484          my $class = $parts[0];          my $class = $parts[0];
# Line 411  Line 517 
517    
518  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
519    
520      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
521      my $fig = new FIG;      my $fig = new FIG;
522    
523      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
524    
525      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      my $dataset = {'type' => "loc",
526      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
527                       'fig_id' => $fid
528                       };
529    
530        foreach my $attr_ref (@$attributes_ref){
531    #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
532          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
533            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
534          my @parts = split("::",$key);          my @parts = split("::",$key);
535          my $sub_class = $parts[0];          my $sub_class = $parts[0];
536          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 428  Line 540 
540                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
541                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
542                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
543    #               print STDERR "LOC: $value_parts[1]";
544              }              }
545              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
546                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
547              }              }
548          }          }
549    
550          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
551              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
552              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
553          }          }
554    
555            elsif($sub_class eq "Phobius"){
556                if($sub_key eq "transmembrane"){
557                    $dataset->{'phobius_tm_locations'} = $value;
558                }
559                elsif($sub_key eq "signal"){
560                    $dataset->{'phobius_signal_location'} = $value;
561                }
562            }
563    
564          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
565              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
566              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
567              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
568          }          }
# Line 455  Line 579 
579  =cut  =cut
580    
581  sub get_pdb_observations{  sub get_pdb_observations{
582      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
583    
584      my $fig = new FIG;      my $fig = new FIG;
585    
586      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref (@$attributes_ref){
587        #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
588    
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590            next if ( ($key !~ /PDB/));
591          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
592          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
593          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 516  Line 642 
642    
643      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
644      my $fig = new FIG;      my $fig = new FIG;
645      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,500,1e-20,"all");
646      my ($dataset);      my ($dataset);
647    
648        my %id_list;
649        foreach my $sim (@sims){
650            my $hit = $sim->[1];
651    
652            next if ($hit !~ /^fig\|/);
653            my @aliases = $fig->feature_aliases($hit);
654            foreach my $alias (@aliases){
655                $id_list{$alias} = 1;
656            }
657        }
658    
659        my %already;
660        my (@new_sims, @uniprot);
661      foreach my $sim (@sims){      foreach my $sim (@sims){
662          my $hit = $sim->[1];          my $hit = $sim->[1];
663            my ($id) = ($hit) =~ /\|(.*)/;
664            next if (defined($already{$id}));
665            next if (defined($id_list{$hit}));
666            push (@new_sims, $sim);
667            $already{$id} = 1;
668        }
669    
670        foreach my $sim (@new_sims){
671            my $hit = $sim->[1];
672          my $percent = $sim->[2];          my $percent = $sim->[2];
673          my $evalue = $sim->[10];          my $evalue = $sim->[10];
674          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 569  Line 718 
718      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
719      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
720      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
721      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
722      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
723      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
724      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 591  Line 740 
740      my $fig = new FIG;      my $fig = new FIG;
741      my $funcs_ref;      my $funcs_ref;
742    
743    #    my %id_list;
744      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);
745    #    my @aliases = $fig->feature_aliases($fid);
746    #    foreach my $alias (@aliases){
747    #       $id_list{$alias} = 1;
748    #    }
749    
750      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
751          my ($tmp, $who);          my ($tmp, $who);
752          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
753    #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
754              $who = &get_database($id);              $who = &get_database($id);
755              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
756          }          }
# Line 788  Line 943 
943    
944      my $acc = $self->acc;      my $acc = $self->acc;
945    
     print STDERR "acc:$acc\n";  
946      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
947      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
948      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 923  Line 1077 
1077          my $id = $row->[0];          my $id = $row->[0];
1078          my $who = $row->[1];          my $who = $row->[1];
1079          my $assignment = $row->[2];          my $assignment = $row->[2];
1080          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1081          my $single_domain = [];          my $single_domain = [];
1082          push(@$single_domain,$who);          push(@$single_domain,$who);
1083          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 1031  Line 1185 
1185  sub display {  sub display {
1186      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1187      my $lines = [];      my $lines = [];
1188      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1189                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1190                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1191      my $color = "4";      my $color = "4";
1192    
1193      my $line_data = [];      my $line_data = [];
# Line 1063  Line 1217 
1217          }          }
1218      }      }
1219    
1220        my $line_config = { 'title' => $thing->acc,
1221                            'short_title' => $name_value,
1222                            'basepair_offset' => '1' };
1223    
1224      my $name;      my $name;
1225      $name = {"title" => $name_title,      $name = {"title" => $name_title,
1226               "value" => $name_value};               "value" => $name_value};
# Line 1109  Line 1267 
1267    
1268  }  }
1269    
1270    sub display_table {
1271        my ($self,$dataset) = @_;
1272        my $cgi = new CGI;
1273        my $data = [];
1274        my $count = 0;
1275        my $content;
1276    
1277        foreach my $thing (@$dataset) {
1278            next if ($thing->type !~ /dom/);
1279            my $single_domain = [];
1280            $count++;
1281    
1282            my $db_and_id = $thing->acc;
1283            my ($db,$id) = split("::",$db_and_id);
1284    
1285            my $dbmaster = DBMaster->new(-database =>'Ontology');
1286    
1287            my ($name_title,$name_value,$description_title,$description_value);
1288            if($db eq "CDD"){
1289                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1290                if(!scalar(@$cdd_objs)){
1291                    $name_title = "name";
1292                    $name_value = "not available";
1293                    $description_title = "description";
1294                    $description_value = "not available";
1295                }
1296                else{
1297                    my $cdd_obj = $cdd_objs->[0];
1298                    $name_title = "name";
1299                    $name_value = $cdd_obj->term;
1300                    $description_title = "description";
1301                    $description_value = $cdd_obj->description;
1302                }
1303            }
1304    
1305            my $location =  $thing->start . " - " . $thing->stop;
1306    
1307            push(@$single_domain,$db);
1308            push(@$single_domain,$thing->acc);
1309            push(@$single_domain,$name_value);
1310            push(@$single_domain,$location);
1311            push(@$single_domain,$thing->evalue);
1312            push(@$single_domain,$description_value);
1313            push(@$data,$single_domain);
1314        }
1315    
1316        if ($count >0){
1317            $content = $data;
1318        }
1319        else
1320        {
1321            $content = "<p>This PEG does not have any similarities to domains</p>";
1322        }
1323    }
1324    
1325    
1326  #########################################  #########################################
1327  #########################################  #########################################
1328  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1340 
1340      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1341      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1342      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1343        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1344        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1345    
1346      bless($self,$class);      bless($self,$class);
1347      return $self;      return $self;
1348  }  }
1349    
1350    sub display_cello {
1351        my ($thing) = @_;
1352        my $html;
1353        my $cello_location = $thing->cello_location;
1354        my $cello_score = $thing->cello_score;
1355        if($cello_location){
1356            $html .= "<p>CELLO prediction: $cello_location </p>";
1357            $html .= "<p>CELLO score: $cello_score </p>";
1358        }
1359        return ($html);
1360    }
1361    
1362  sub display {  sub display {
1363      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1364    
# Line 1147  Line 1375 
1375      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1376      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1377    
1378        my $phobius_signal_location = $thing->phobius_signal_location;
1379        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1380    
1381      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1382    
1383      #color is      #color is
1384      my $color = "5";      my $color = "6";
1385    
1386      my $line_data = [];  =pod=
1387    
1388      if($cello_location){      if($cello_location){
1389          my $cello_descriptions = [];          my $cello_descriptions = [];
1390            my $line_data =[];
1391    
1392            my $line_config = { 'title' => 'Localization Evidence',
1393                                'short_title' => 'CELLO',
1394                                'basepair_offset' => '1' };
1395    
1396          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1397                                            "value" => $cello_location};                                            "value" => $cello_location};
1398    
# Line 1171  Line 1405 
1405    
1406          my $element_hash = {          my $element_hash = {
1407              "title" => "CELLO",              "title" => "CELLO",
1408                "color"=> $color,
1409              "start" => "1",              "start" => "1",
1410              "end" =>  $length + 1,              "end" =>  $length + 1,
1411              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1412              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1413    
1414          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1415            $gd->add_line($line_data, $line_config);
1416      }      }
1417    
1418      my $color = "6";  =cut
1419    
1420        $color = "2";
1421      if($tmpred_score){      if($tmpred_score){
1422            my $line_data =[];
1423            my $line_config = { 'title' => 'Localization Evidence',
1424                                'short_title' => 'Transmembrane',
1425                                'basepair_offset' => '1' };
1426    
1427          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1428              my $descriptions = [];              my $descriptions = [];
1429              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1197  Line 1438 
1438              "end" =>  $end + 1,              "end" =>  $end + 1,
1439              "color"=> $color,              "color"=> $color,
1440              "zlayer" => '5',              "zlayer" => '5',
1441              "type" => 'smallbox',              "type" => 'box',
1442                "description" => $descriptions};
1443    
1444                push(@$line_data,$element_hash);
1445    
1446            }
1447            $gd->add_line($line_data, $line_config);
1448        }
1449    
1450        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1451            my $line_data =[];
1452            my $line_config = { 'title' => 'Localization Evidence',
1453                                'short_title' => 'Phobius',
1454                                'basepair_offset' => '1' };
1455    
1456            foreach my $tm_loc (@phobius_tm_locations){
1457                my $descriptions = [];
1458                my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',
1459                                 "value" => $tm_loc};
1460                push(@$descriptions,$description_phobius_tm_locations);
1461    
1462                my ($begin,$end) =split("-",$tm_loc);
1463    
1464                my $element_hash = {
1465                "title" => "phobius transmembrane location",
1466                "start" => $begin + 1,
1467                "end" =>  $end + 1,
1468                "color"=> '6',
1469                "zlayer" => '4',
1470                "type" => 'bigbox',
1471              "description" => $descriptions};              "description" => $descriptions};
1472    
1473              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1474    
1475            }
1476    
1477            if($phobius_signal_location){
1478                my $descriptions = [];
1479                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1480                                 "value" => $phobius_signal_location};
1481                push(@$descriptions,$description_phobius_signal_location);
1482    
1483    
1484                my ($begin,$end) =split("-",$phobius_signal_location);
1485                my $element_hash = {
1486                "title" => "phobius signal locations",
1487                "start" => $begin + 1,
1488                "end" =>  $end + 1,
1489                "color"=> '1',
1490                "zlayer" => '5',
1491                "type" => 'box',
1492                "description" => $descriptions};
1493                push(@$line_data,$element_hash);
1494          }          }
1495    
1496            $gd->add_line($line_data, $line_config);
1497      }      }
1498    
1499      my $color = "1";  
1500        $color = "1";
1501      if($signal_peptide_score){      if($signal_peptide_score){
1502            my $line_data = [];
1503          my $descriptions = [];          my $descriptions = [];
1504    
1505            my $line_config = { 'title' => 'Localization Evidence',
1506                                'short_title' => 'SignalP',
1507                                'basepair_offset' => '1' };
1508    
1509          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1510                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1511    
# Line 1220  Line 1519 
1519          my $element_hash = {          my $element_hash = {
1520              "title" => "SignalP",              "title" => "SignalP",
1521              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1522              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1523              "type" => 'bigbox',              "type" => 'bigbox',
1524              "color"=> $color,              "color"=> $color,
1525              "zlayer" => '10',              "zlayer" => '10',
1526              "description" => $descriptions};              "description" => $descriptions};
1527    
1528          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1529      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1530        }
1531    
1532      return ($gd);      return ($gd);
1533    
# Line 1277  Line 1575 
1575    return $self->{cello_score};    return $self->{cello_score};
1576  }  }
1577    
1578    sub phobius_signal_location {
1579      my ($self) = @_;
1580      return $self->{phobius_signal_location};
1581    }
1582    
1583    sub phobius_tm_locations {
1584      my ($self) = @_;
1585      return $self->{phobius_tm_locations};
1586    }
1587    
1588    
1589    
1590  #########################################  #########################################
1591  #########################################  #########################################
# Line 1305  Line 1614 
1614      return $self;      return $self;
1615  }  }
1616    
1617    =head3 display()
1618    
1619    If available use the function specified here to display a graphical observation.
1620    This code will display a graphical view of the similarities using the genome drawer object
1621    
1622    =cut
1623    
1624    sub display {
1625        my ($self,$gd) = @_;
1626    
1627        my $fig = new FIG;
1628        my $peg = $self->acc;
1629    
1630        my $organism = $self->organism;
1631        my $genome = $fig->genome_of($peg);
1632        my ($org_tax) = ($genome) =~ /(.*)\./;
1633        my $function = $self->function;
1634        my $abbrev_name = $fig->abbrev($organism);
1635        my $align_start = $self->qstart;
1636        my $align_stop = $self->qstop;
1637        my $hit_start = $self->hstart;
1638        my $hit_stop = $self->hstop;
1639    
1640        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1641    
1642        my $line_config = { 'title' => "$organism [$org_tax]",
1643                            'short_title' => "$abbrev_name",
1644                            'title_link' => '$tax_link',
1645                            'basepair_offset' => '0'
1646                            };
1647    
1648        my $line_data = [];
1649    
1650        my $element_hash;
1651        my $links_list = [];
1652        my $descriptions = [];
1653    
1654        # get subsystem information
1655        my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1656    
1657        my $link;
1658        $link = {"link_title" => $peg,
1659                 "link" => $url_link};
1660        push(@$links_list,$link);
1661    
1662        my @subsystems = $fig->peg_to_subsystems($peg);
1663        foreach my $subsystem (@subsystems){
1664            my $link;
1665            $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1666                     "link_title" => $subsystem};
1667            push(@$links_list,$link);
1668        }
1669    
1670        my $description_function;
1671        $description_function = {"title" => "function",
1672                                 "value" => $function};
1673        push(@$descriptions,$description_function);
1674    
1675        my ($description_ss, $ss_string);
1676        $ss_string = join (",", @subsystems);
1677        $description_ss = {"title" => "subsystems",
1678                           "value" => $ss_string};
1679        push(@$descriptions,$description_ss);
1680    
1681        my $description_loc;
1682        $description_loc = {"title" => "location start",
1683                            "value" => $hit_start};
1684        push(@$descriptions, $description_loc);
1685    
1686        $description_loc = {"title" => "location stop",
1687                            "value" => $hit_stop};
1688        push(@$descriptions, $description_loc);
1689    
1690        my $evalue = $self->evalue;
1691        while ($evalue =~ /-0/)
1692        {
1693            my ($chunk1, $chunk2) = split(/-/, $evalue);
1694            $chunk2 = substr($chunk2,1);
1695            $evalue = $chunk1 . "-" . $chunk2;
1696        }
1697    
1698        my $color = &color($evalue);
1699    
1700        my $description_eval = {"title" => "E-Value",
1701                                "value" => $evalue};
1702        push(@$descriptions, $description_eval);
1703    
1704        my $identity = $self->identity;
1705        my $description_identity = {"title" => "Identity",
1706                                    "value" => $identity};
1707        push(@$descriptions, $description_identity);
1708    
1709        $element_hash = {
1710            "title" => $peg,
1711            "start" => $align_start,
1712            "end" =>  $align_stop,
1713            "type"=> 'box',
1714            "color"=> $color,
1715            "zlayer" => "2",
1716            "links_list" => $links_list,
1717            "description" => $descriptions
1718            };
1719        push(@$line_data,$element_hash);
1720        $gd->add_line($line_data, $line_config);
1721    
1722        return ($gd);
1723    
1724    }
1725    
1726    =head3 display_domain_composition()
1727    
1728    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
1729    
1730    =cut
1731    
1732    sub display_domain_composition {
1733        my ($self,$gd) = @_;
1734    
1735        my $fig = new FIG;
1736        my $peg = $self->acc;
1737    
1738        my $line_data = [];
1739        my $links_list = [];
1740        my $descriptions = [];
1741    
1742        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1743    
1744        foreach $dqr (@domain_query_results){
1745            my $key = @$dqr[1];
1746            my @parts = split("::",$key);
1747            my $db = $parts[0];
1748            my $id = $parts[1];
1749            my $val = @$dqr[2];
1750            my $from;
1751            my $to;
1752            my $evalue;
1753    
1754            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1755                my $raw_evalue = $1;
1756                $from = $2;
1757                $to = $3;
1758                if($raw_evalue =~/(\d+)\.(\d+)/){
1759                    my $part2 = 1000 - $1;
1760                    my $part1 = $2/100;
1761                    $evalue = $part1."e-".$part2;
1762                }
1763                else{
1764                    $evalue = "0.0";
1765                }
1766            }
1767    
1768            my $dbmaster = DBMaster->new(-database =>'Ontology');
1769            my ($name_value,$description_value);
1770    
1771            if($db eq "CDD"){
1772                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1773                if(!scalar(@$cdd_objs)){
1774                    $name_title = "name";
1775                    $name_value = "not available";
1776                    $description_title = "description";
1777                    $description_value = "not available";
1778                }
1779                else{
1780                    my $cdd_obj = $cdd_objs->[0];
1781                    $name_value = $cdd_obj->term;
1782                    $description_value = $cdd_obj->description;
1783                }
1784            }
1785    
1786            my $domain_name;
1787            $domain_name = {"title" => "name",
1788                     "value" => $name_value};
1789            push(@$descriptions,$domain_name);
1790    
1791            my $description;
1792            $description = {"title" => "description",
1793                            "value" => $description_value};
1794            push(@$descriptions,$description);
1795    
1796            my $score;
1797            $score = {"title" => "score",
1798                      "value" => $evalue};
1799            push(@$descriptions,$score);
1800    
1801            my $link_id = $id;
1802            my $link;
1803            my $link_url;
1804            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"}
1805            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1806            else{$link_url = "NO_URL"}
1807    
1808            $link = {"link_title" => $name_value,
1809                     "link" => $link_url};
1810            push(@$links_list,$link);
1811    
1812            my $domain_element_hash = {
1813                "title" => $peg,
1814                "start" => $from,
1815                "end" =>  $to,
1816                "type"=> 'box',
1817                "zlayer" => '4',
1818                "links_list" => $links_list,
1819                "description" => $descriptions
1820                };
1821    
1822            push(@$line_data,$domain_element_hash);
1823    
1824            #just one CDD domain for now, later will add option for multiple domains from selected DB
1825            last;
1826        }
1827    
1828        my $line_config = { 'title' => $peg,
1829                            'short_title' => $peg,
1830                            'basepair_offset' => '1' };
1831    
1832        $gd->add_line($line_data, $line_config);
1833    
1834        return ($gd);
1835    
1836    }
1837    
1838  =head3 display_table()  =head3 display_table()
1839    
1840  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
# Line 1315  Line 1845 
1845  =cut  =cut
1846    
1847  sub display_table {  sub display_table {
1848      my ($self,$dataset) = @_;      my ($self,$dataset, $scroll_list, $query_fid) = @_;
1849    
1850      my $data = [];      my $data = [];
1851      my $count = 0;      my $count = 0;
1852      my $content;      my $content;
1853      my $fig = new FIG;      my $fig = new FIG;
1854      my $cgi = new CGI;      my $cgi = new CGI;
1855        my @ids;
1856        foreach my $thing (@$dataset) {
1857            next if ($thing->class ne "SIM");
1858            push (@ids, $thing->acc);
1859        }
1860    
1861        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1862    
1863        # get the column for the subsystems
1864        %subsystems_column = &get_subsystems_column(\@ids);
1865    
1866        # get the column for the evidence codes
1867        %evidence_column = &get_evidence_column(\@ids);
1868    
1869        # get the column for pfam_domain
1870        %pfam_column = &get_pfam_column(\@ids);
1871    
1872        my %e_identical = &get_essentially_identical($query_fid);
1873        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1874    
1875      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
         my $single_domain = [];  
1876          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1877            my $single_domain = [];
1878          $count++;          $count++;
1879    
1880          my $id = $thing->acc;          my $id = $thing->acc;
1881    
1882          # add the subsystem information          my $iden    = $thing->identity;
1883          my @in_sub  = $fig->peg_to_subsystems($id);          my $ln1     = $thing->qlength;
1884          my $in_sub;          my $ln2     = $thing->hlength;
1885            my $b1      = $thing->qstart;
1886            my $e1      = $thing->qstop;
1887            my $b2      = $thing->hstart;
1888            my $e2      = $thing->hstop;
1889            my $d1      = abs($e1 - $b1) + 1;
1890            my $d2      = abs($e2 - $b2) + 1;
1891            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1892            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1893    
1894            # checkbox column
1895            my $field_name = "tables_" . $id;
1896            my $pair_name = "visual_" . $id;
1897            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1898    
1899            # get the linked fig id
1900            my $fig_col;
1901            if (defined ($e_identical{$id})){
1902                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1903            }
1904            else{
1905                $fig_col = &HTML::set_prot_links($cgi,$id);
1906            }
1907    
1908          if (@in_sub > 0) {          push(@$single_domain,$box_col);                        # permanent column
1909              $in_sub = @in_sub;          push(@$single_domain,$fig_col);                        # permanent column
1910            push(@$single_domain,$thing->evalue);                  # permanent column
1911            push(@$single_domain,"$iden\%");                       # permanent column
1912            push(@$single_domain,$reg1);                           # permanent column
1913            push(@$single_domain,$reg2);                           # permanent column
1914            push(@$single_domain,$thing->organism);                # permanent column
1915            push(@$single_domain,$thing->function);                # permanent column
1916            foreach my $col (sort keys %$scroll_list){
1917                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1918                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1919                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1920                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}
1921                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}
1922                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}
1923                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}
1924                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}
1925                elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}
1926                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}
1927                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}
1928                elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}
1929                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}
1930            }
1931            push(@$data,$single_domain);
1932        }
1933    
1934        if ($count >0 ){
1935            $content = $data;
1936        }
1937        else{
1938            $content = "<p>This PEG does not have any similarities</p>";
1939        }
1940        return ($content);
1941    }
1942    
1943    sub get_box_column{
1944        my ($ids) = @_;
1945        my %column;
1946        foreach my $id (@$ids){
1947            my $field_name = "tables_" . $id;
1948            my $pair_name = "visual_" . $id;
1949            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1950        }
1951        return (%column);
1952    }
1953    
1954    sub get_subsystems_column{
1955        my ($ids) = @_;
1956    
1957        my $fig = new FIG;
1958        my $cgi = new CGI;
1959        my %in_subs  = $fig->subsystems_for_pegs($ids);
1960        my %column;
1961        foreach my $id (@$ids){
1962            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1963            my @subsystems;
1964    
1965              # RAE: add a javascript popup with all the subsystems          if (@in_sub > 0) {
1966              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;              my $count = 1;
1967              $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);              foreach my $array(@in_sub){
1968                    push (@subsystems, $count . ". " . $$array[0]);
1969                    $count++;
1970                }
1971                my $in_sub_line = join ("<br>", @subsystems);
1972                $column{$id} = $in_sub_line;
1973          } else {          } else {
1974              $in_sub = "&nbsp;";              $column{$id} = "&nbsp;";
1975            }
1976        }
1977        return (%column);
1978    }
1979    
1980    sub get_essentially_identical{
1981        my ($fid) = @_;
1982        my $fig = new FIG;
1983    
1984        my %id_list;
1985        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
1986    
1987        foreach my $id (@maps_to) {
1988            if (($id ne $fid) && ($fig->function_of($id))) {
1989                $id_list{$id} = 1;
1990            }
1991        }
1992        return(%id_list);
1993    }
1994    
1995    
1996    sub get_evidence_column{
1997        my ($ids) = @_;
1998        my $fig = new FIG;
1999        my $cgi = new CGI;
2000        my (%column, %code_attributes);
2001    
2002        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
2003        foreach my $key (@codes){
2004            push (@{$code_attributes{$$key[0]}}, $key);
2005          }          }
2006    
2007        foreach my $id (@$ids){
2008          # add evidence code with tool tip          # add evidence code with tool tip
2009          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
2010          my @ev_codes = "";          my @ev_codes = "";
2011    
2012          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2013              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);              my @codes;
2014                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2015              @ev_codes = ();              @ev_codes = ();
2016              foreach my $code (@codes) {              foreach my $code (@codes) {
2017                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
# Line 1366  Line 2030 
2030                                  {                                  {
2031                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2032          }          }
2033            $column{$id}=$ev_codes;
2034        }
2035        return (%column);
2036    }
2037    
2038          # add the aliases  sub get_pfam_column{
2039          my $aliases = undef;      my ($ids) = @_;
2040          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      my $fig = new FIG;
2041          $aliases = &HTML::set_prot_links( $cgi, $aliases );      my $cgi = new CGI;
2042          $aliases ||= "&nbsp;";      my (%column, %code_attributes);
2043        my $dbmaster = DBMaster->new(-database =>'Ontology');
2044    
2045          my $iden    = $thing->identity;      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
2046          my $ln1     = $thing->qlength;      foreach my $key (@codes){
2047          my $ln2     = $thing->hlength;          push (@{$code_attributes{$$key[0]}}, $$key[1]);
2048          my $b1      = $thing->qstart;      }
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
2049    
2050        foreach my $id (@$ids){
2051            # add evidence code with tool tip
2052            my $pfam_codes=" &nbsp; ";
2053            my @pfam_codes = "";
2054            my %description_codes;
2055    
2056          push(@$single_domain,$thing->database);          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2057          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));              my @codes;
2058          push(@$single_domain,$thing->evalue);              @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2059          push(@$single_domain,"$iden\%");              @pfam_codes = ();
2060          push(@$single_domain,$reg1);              foreach my $code (@codes) {
2061          push(@$single_domain,$reg2);                  my @parts = split("::",$code);
2062          push(@$single_domain,$in_sub);                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2063          push(@$single_domain,$ev_codes);                  if (defined ($description_codes{$parts[1]})){
2064          push(@$single_domain,$thing->organism);                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
2065          push(@$single_domain,$thing->function);                  }
2066          push(@$single_domain,$aliases);                  else {
2067          push(@$data,$single_domain);                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2068                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2069                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
2070                    }
2071                }
2072      }      }
2073    
2074      if ($count >0){          $column{$id}=join("<br><br>", @pfam_codes);
         $content = $data;  
2075      }      }
2076      else      return (%column);
2077      {  
         $content = "<p>This PEG does not have any similarities</p>";  
2078      }      }
2079      return ($content);  
2080    sub get_prefer {
2081        my ($fid, $db, $all_aliases) = @_;
2082        my $fig = new FIG;
2083        my $cgi = new CGI;
2084    
2085        foreach my $alias (@{$$all_aliases{$fid}}){
2086            my $id_db = &Observation::get_database($alias);
2087            if ($id_db eq $db){
2088                my $acc_col .= &HTML::set_prot_links($cgi,$alias);
2089                return ($acc_col);
2090            }
2091        }
2092        return (" ");
2093  }  }
2094    
2095  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; $_ }
2096    
2097    sub color {
2098        my ($evalue) = @_;
2099    
2100        my $color;
2101        if ($evalue <= 1e-170){
2102            $color = 51;
2103        }
2104        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
2105            $color = 52;
2106        }
2107        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
2108            $color = 53;
2109        }
2110        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
2111            $color = 54;
2112        }
2113        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
2114            $color = 55;
2115        }
2116        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
2117            $color = 56;
2118        }
2119        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
2120            $color = 57;
2121        }
2122        elsif (($evalue <= 1) && ($evalue > 1e-5)){
2123            $color = 58;
2124        }
2125        elsif (($evalue <= 10) && ($evalue > 1)){
2126            $color = 59;
2127        }
2128        else{
2129            $color = 60;
2130        }
2131    
2132    
2133        return ($color);
2134    }
2135    
2136    
2137  ############################  ############################
# Line 1464  Line 2184 
2184          $region_start = $end-4000;          $region_start = $end-4000;
2185          $region_end = $beg+4000;          $region_end = $beg+4000;
2186          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2187          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2188      }      }
2189    
2190      # call genes in region      # call genes in region
# Line 1475  Line 2195 
2195    
2196      my %all_genes;      my %all_genes;
2197      my %all_genomes;      my %all_genomes;
2198      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}
2199    
2200      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
2201      {      {
# Line 1506  Line 2226 
2226                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
2227                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
2228                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2229                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
2230                  }                  }
2231    
2232                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 2234 
2234                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
2235                  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);
2236                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
2237                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2238              }              }
2239              $coup_count++;              $coup_count++;
2240          }          }
2241      }      }
2242        elsif ($compare_or_coupling eq "sims"){
2243            # get the selected boxes
2244            my @selected_taxonomoy = ("Deltaproteobacteria", "Vibrionales", "Viridiplantae");
2245    
2246            # get the similarities and store only the ones that match the lineages selected
2247            my @selected_sims;
2248            my @sims= $fig->nsims($fid,20000,10,"all");
2249    
2250            foreach my $sim (@sims){
2251                next if ($sim->[1] !~ /fig\|/);
2252                my $genome = $fig->genome_of($sim->[1]);
2253                my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2254                foreach my $taxon(@selected_taxonomy){
2255                    if ($lineage =~ /$taxon/){
2256                        push (@selected_sims, $sim->[1]);
2257                    }
2258                }
2259                my %saw;
2260                @selected_sims = grep(!$saw{$_}++, @selected_sims);
2261            }
2262    
2263            # get the gene context for the sorted matches
2264            foreach my $sim_fid(@selected_sims){
2265                #get the organism genome
2266                my $sim_genome = $fig->genome_of($sim_fid);
2267    
2268                # get location of the gene
2269                my $data = $fig->feature_location($sim_fid);
2270                my ($contig, $beg, $end);
2271                my %reverse_flag;
2272    
2273                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2274                    $contig = $1;
2275                    $beg = $2;
2276                    $end = $3;
2277                }
2278    
2279                my $offset;
2280                my ($region_start, $region_end);
2281                if ($beg < $end)
2282                {
2283                    $region_start = $beg - 4000;
2284                    $region_end = $end+4000;
2285                    $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2286                }
2287                else
2288                {
2289                    $region_start = $end-4000;
2290                    $region_end = $beg+4000;
2291                    $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2292                    $reverse_flag{$target_genome} = $sim_fid;
2293                }
2294    
2295                # call genes in region
2296                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2297                push(@$all_regions,$sim_gene_features);
2298                my (@start_array_region);
2299                push (@start_array_region, $offset);
2300    
2301                my %all_genes;
2302                my %all_genomes;
2303                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;}
2304            }
2305        }
2306    
2307      elsif ($compare_or_coupling eq "close")      elsif ($compare_or_coupling eq "close")
2308      {      {
# Line 1566  Line 2350 
2350                          $pair_region_start = $pair_end-4000;                          $pair_region_start = $pair_end-4000;
2351                          $pair_region_stop = $pair_beg+4000;                          $pair_region_stop = $pair_beg+4000;
2352                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2353                          $reverse_flag{$pair_genome} = 1;                          $reverse_flag{$pair_genome} = $peg1;
2354                      }                      }
2355    
2356                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
2357                      $all_genomes{$pair_genome} = 1;                      $all_genomes{$pair_genome} = 1;
2358                      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);
2359                      push(@$all_regions,$pair_features);                      push(@$all_regions,$pair_features);
2360                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2361                  }                  }
2362              }              }
2363          }          }
# Line 1584  Line 2368 
2368      my %pch_already;      my %pch_already;
2369      foreach my $gene_peg (keys %all_genes)      foreach my $gene_peg (keys %all_genes)
2370      {      {
2371          if ($pch_already{$gene_peg}){next;};          if ($pch_already{$gene_peg}){(next);};
2372          my $gene_set = [$gene_peg];          my $gene_set = [$gene_peg];
2373          foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {          foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {
2374              $pch_peg =~ s/,.*$//;              $pch_peg =~ s/,.*$//;
# Line 1625  Line 2409 
2409          else          else
2410          {          {
2411              foreach my $peg (@$good_set){              foreach my $peg (@$good_set){
2412                  $peg_rank{$peg} = 100;                  $peg_rank{$peg} = "20";
2413              }              }
2414          }          }
2415      }      }
# Line 1634  Line 2418 
2418  #    my $bbh_sets = [];  #    my $bbh_sets = [];
2419  #    my %already;  #    my %already;
2420  #    foreach my $gene_key (keys(%all_genes)){  #    foreach my $gene_key (keys(%all_genes)){
2421  #       if($already{$gene_key}){next;}  #       if($already{$gene_key}){(next);}
2422  #       my $gene_set = [$gene_key];  #       my $gene_set = [$gene_key];
2423  #  #
2424  #       my $gene_key_genome = $fig->genome_of($gene_key);  #       my $gene_key_genome = $fig->genome_of($gene_key);
2425  #  #
2426  #       foreach my $genome_key (keys(%all_genomes)){  #       foreach my $genome_key (keys(%all_genomes)){
2427  #           #next if ($gene_key_genome eq $genome_key);  #           #(next) if ($gene_key_genome eq $genome_key);
2428  #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  #           my $return = $fig->bbh_list($genome_key,[$gene_key]);
2429  #  #
2430  #           my $feature_list = $return->{$gene_key};  #           my $feature_list = $return->{$gene_key};
# Line 1678  Line 2462 
2462  #       else  #       else
2463  #       {  #       {
2464  #           foreach my $peg (@$good_set){  #           foreach my $peg (@$good_set){
2465  #               $peg_rank{$peg} = 100;  #               $peg_rank{$peg} = "20";
2466  #           }  #           }
2467  #       }  #       }
2468  #    }  #    }
# Line 1695  Line 2479 
2479    
2480          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2481    
2482            my $second_line_config = { 'title' => "$region_gs",
2483                                       'short_title' => "",
2484                                       'basepair_offset' => '0'
2485                                       };
2486    
2487          my $line_data = [];          my $line_data = [];
2488            my $second_line_data = [];
2489    
2490            # initialize variables to check for overlap in genes
2491            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2492            my $major_line_flag = 0;
2493            my $prev_second_flag = 0;
2494    
2495          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2496                $second_line_flag = 0;
2497              my $element_hash;              my $element_hash;
2498              my $links_list = [];              my $links_list = [];
2499              my $descriptions = [];              my $descriptions = [];
# Line 1738  Line 2535 
2535                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2536                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2537    
2538                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2539                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2540                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2541                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2542                            $second_line_flag = 1;
2543                            $major_line_flag = 1;
2544                        }
2545                    }
2546                    $prev_start = $start;
2547                    $prev_stop = $stop;
2548                    $prev_fig = $fid1;
2549    
2550                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2551                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2552                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2553                  }                  }
# Line 1753  Line 2562 
2562                      "links_list" => $links_list,                      "links_list" => $links_list,
2563                      "description" => $descriptions                      "description" => $descriptions
2564                  };                  };
2565                  push(@$line_data,$element_hash);  
2566                    # if there is an overlap, put into second line
2567                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2568                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2569    
2570              }              }
2571          }          }
2572          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2573            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2574      }      }
2575      return $gd;      return $gd;
2576  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3