[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.33, Wed Aug 22 22:05:35 2007 UTC
# Line 7  Line 7 
7  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects);
8    
9  use FIG_Config;  use FIG_Config;
10  use strict;  #use strict;
11  #use warnings;  #use warnings;
12  use HTML;  use HTML;
13    
# Line 151  Line 151 
151  sub type {  sub type {
152    my ($self) = @_;    my ($self) = @_;
153    
154    return $self->{acc};    return $self->{type};
155  }  }
156    
157  =head3 start()  =head3 start()
# Line 308  Line 308 
308    
309      my $objects = [];      my $objects = [];
310      my @matched_datasets=();      my @matched_datasets=();
311        my $fig = new FIG;
312    
313      # call function that fetches attribute based observations      # call function that fetches attribute based observations
314      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 317  Line 318 
318      }      }
319      else{      else{
320          my %domain_classes;          my %domain_classes;
321            my @attributes = $fig->get_attributes($fid);
322          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
323          get_identical_proteins($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets);
324          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);
325          get_sims_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets);
326          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
327          get_attribute_based_location_observations($fid,\@matched_datasets);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);
328          get_pdb_observations($fid,\@matched_datasets);          get_pdb_observations($fid,\@matched_datasets,\@attributes);
329      }      }
330    
331      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 357  Line 359 
359    
360  }  }
361    
362    =head3 display_housekeeping
363    This method returns the housekeeping data for a given peg in a table format
364    
365    =cut
366    sub display_housekeeping {
367        my ($self,$fid) = @_;
368        my $fig = new FIG;
369        my $content;
370    
371        my $org_name = $fig->org_of($fid);
372        my $org_id   = $fig->orgid_of_orgname($org_name);
373        my $loc      = $fig->feature_location($fid);
374        my($contig, $beg, $end) = $fig->boundaries_of($loc);
375        my $strand   = ($beg <= $end)? '+' : '-';
376        my @subsystems = $fig->subsystems_for_peg($fid);
377        my $function = $fig->function_of($fid);
378        my @aliases  = $fig->feature_aliases($fid);
379        my $taxonomy = $fig->taxonomy_of($org_id);
380        my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);
381    
382        $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);
383        $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
384        $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);
385        $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
386        $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);
387        $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;
388        $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
389        if ( @ecs ) {
390            $content .= qq(<tr><td>EC:</td><td>);
391            foreach my $ec ( @ecs ) {
392                my $ec_name = $fig->ec_name($ec);
393                $content .= join(" -- ", $ec, $ec_name) . "<br>\n";
394            }
395            $content .= qq(</td></tr>\n);
396        }
397    
398        if ( @subsystems ) {
399            $content .= qq(<tr><td>Subsystems</td><td>);
400            foreach my $subsystem ( @subsystems ) {
401                $content .= join(" -- ", @$subsystem) . "<br>\n";
402            }
403        }
404    
405        my %groups;
406        if ( @aliases ) {
407            # get the db for each alias
408            foreach my $alias (@aliases){
409                $groups{$alias} = &get_database($alias);
410            }
411    
412            # group ids by aliases
413            my %db_aliases;
414            foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){
415                push (@{$db_aliases{$groups{$key}}}, $key);
416            }
417    
418    
419            $content .= qq(<tr><td>Aliases</td><td><table border="0">);
420            foreach my $key (sort keys %db_aliases){
421                $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);
422            }
423            $content .= qq(</td></tr></table>\n);
424        }
425    
426        $content .= qq(</table><p>\n);
427    
428        return ($content);
429    }
430    
431    =head3 get_sims_summary
432    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
433    
434    =cut
435    
436    sub get_sims_summary {
437        my ($observation, $fid) = @_;
438        my $fig = new FIG;
439        my %families;
440        my @sims= $fig->nsims($fid,20000,10,"all");
441    
442        foreach my $sim (@sims){
443            next if ($sim->[1] !~ /fig\|/);
444            my $genome = $fig->genome_of($sim->[1]);
445            my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));
446            my $parent_tax = "Root";
447            foreach my $tax (split(/\; /, $taxonomy)){
448                push (@{$families{children}{$parent_tax}}, $tax);
449                $families{parent}{$tax} = $parent_tax;
450                $parent_tax = $tax;
451            }
452        }
453    
454        foreach my $key (keys %{$families{children}}){
455            $families{count}{$key} = @{$families{children}{$key}};
456    
457            my %saw;
458            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
459            $families{children}{$key} = \@out;
460        }
461        return (\%families);
462    }
463    
464  =head1 Internal Methods  =head1 Internal Methods
465    
466  These methods are not meant to be used outside of this package.  These methods are not meant to be used outside of this package.
# Line 368  Line 472 
472  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
473    
474      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
475      my ($fid,$domain_classes,$datasets_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);
476    
477      my $fig = new FIG;      my $fig = new FIG;
478    
479      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
480    #    foreach my $attr_ref ($fig->get_attributes($fid)) {
481          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
482          my @parts = split("::",$key);          my @parts = split("::",$key);
483          my $class = $parts[0];          my $class = $parts[0];
# Line 411  Line 516 
516    
517  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
518    
519      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
520      my $fig = new FIG;      my $fig = new FIG;
521    
522      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
523    
524        my $dataset = {'type' => "loc",
525                       'class' => 'SIGNALP_CELLO_TMPRED',
526                       'fig_id' => $fid
527                       };
528    
529      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};      foreach my $attr_ref (@$attributes_ref){
530      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
531          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
532            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
533          my @parts = split("::",$key);          my @parts = split("::",$key);
534          my $sub_class = $parts[0];          my $sub_class = $parts[0];
535          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 428  Line 539 
539                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
540                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
541                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
542    #               print STDERR "LOC: $value_parts[1]";
543              }              }
544              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
545                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
546              }              }
547          }          }
548    
549          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
550              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
551              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
552          }          }
553    
554            elsif($sub_class eq "Phobius"){
555                if($sub_key eq "transmembrane"){
556                    $dataset->{'phobius_tm_locations'} = $value;
557                }
558                elsif($sub_key eq "signal"){
559                    $dataset->{'phobius_signal_location'} = $value;
560                }
561            }
562    
563          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
564              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
565              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
566              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
567          }          }
# Line 455  Line 578 
578  =cut  =cut
579    
580  sub get_pdb_observations{  sub get_pdb_observations{
581      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref) = (@_);
582    
583      my $fig = new FIG;      my $fig = new FIG;
584    
585      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref (@$attributes_ref){
586        #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
587    
588          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
589            next if ( ($key !~ /PDB/));
590          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
591          my $value = @$attr_ref[2];          my $value = @$attr_ref[2];
592          my ($evalue,$location) = split(";",$value);          my ($evalue,$location) = split(";",$value);
# Line 516  Line 641 
641    
642      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
643      my $fig = new FIG;      my $fig = new FIG;
644      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,500,1e-20,"all");
645      my ($dataset);      my ($dataset);
646    
647        my %id_list;
648        foreach my $sim (@sims){
649            my $hit = $sim->[1];
650    
651            next if ($hit !~ /^fig\|/);
652            my @aliases = $fig->feature_aliases($hit);
653            foreach my $alias (@aliases){
654                $id_list{$alias} = 1;
655            }
656        }
657    
658        my %already;
659        my (@new_sims, @uniprot);
660      foreach my $sim (@sims){      foreach my $sim (@sims){
661          my $hit = $sim->[1];          my $hit = $sim->[1];
662            my ($id) = ($hit) =~ /\|(.*)/;
663            next if (defined($already{$id}));
664            next if (defined($id_list{$hit}));
665            push (@new_sims, $sim);
666            $already{$id} = 1;
667        }
668    
669        foreach my $sim (@new_sims){
670            my $hit = $sim->[1];
671          my $percent = $sim->[2];          my $percent = $sim->[2];
672          my $evalue = $sim->[10];          my $evalue = $sim->[10];
673          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 569  Line 717 
717      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
718      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
719      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
720      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
721      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
722      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
723      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
# Line 591  Line 739 
739      my $fig = new FIG;      my $fig = new FIG;
740      my $funcs_ref;      my $funcs_ref;
741    
742    #    my %id_list;
743      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);
744    #    my @aliases = $fig->feature_aliases($fid);
745    #    foreach my $alias (@aliases){
746    #       $id_list{$alias} = 1;
747    #    }
748    
749      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
750          my ($tmp, $who);          my ($tmp, $who);
751          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
752    #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
753              $who = &get_database($id);              $who = &get_database($id);
754              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
755          }          }
# Line 788  Line 942 
942    
943      my $acc = $self->acc;      my $acc = $self->acc;
944    
     print STDERR "acc:$acc\n";  
945      my ($pdb_description,$pdb_source,$pdb_ligand);      my ($pdb_description,$pdb_source,$pdb_ligand);
946      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
947      if(!scalar(@$pdb_objs)){      if(!scalar(@$pdb_objs)){
# Line 923  Line 1076 
1076          my $id = $row->[0];          my $id = $row->[0];
1077          my $who = $row->[1];          my $who = $row->[1];
1078          my $assignment = $row->[2];          my $assignment = $row->[2];
1079          my $organism = $fig->org_of($fid);          my $organism = $fig->org_of($id);
1080          my $single_domain = [];          my $single_domain = [];
1081          push(@$single_domain,$who);          push(@$single_domain,$who);
1082          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
# Line 1031  Line 1184 
1184  sub display {  sub display {
1185      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1186      my $lines = [];      my $lines = [];
1187      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1188                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1189                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1190      my $color = "4";      my $color = "4";
1191    
1192      my $line_data = [];      my $line_data = [];
# Line 1063  Line 1216 
1216          }          }
1217      }      }
1218    
1219        my $line_config = { 'title' => $thing->acc,
1220                            'short_title' => $name_value,
1221                            'basepair_offset' => '1' };
1222    
1223      my $name;      my $name;
1224      $name = {"title" => $name_title,      $name = {"title" => $name_title,
1225               "value" => $name_value};               "value" => $name_value};
# Line 1109  Line 1266 
1266    
1267  }  }
1268    
1269    sub display_table {
1270        my ($self,$dataset) = @_;
1271        my $cgi = new CGI;
1272        my $data = [];
1273        my $count = 0;
1274        my $content;
1275    
1276        foreach my $thing (@$dataset) {
1277            next if ($thing->type !~ /dom/);
1278            my $single_domain = [];
1279            $count++;
1280    
1281            my $db_and_id = $thing->acc;
1282            my ($db,$id) = split("::",$db_and_id);
1283    
1284            my $dbmaster = DBMaster->new(-database =>'Ontology');
1285    
1286            my ($name_title,$name_value,$description_title,$description_value);
1287            if($db eq "CDD"){
1288                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1289                if(!scalar(@$cdd_objs)){
1290                    $name_title = "name";
1291                    $name_value = "not available";
1292                    $description_title = "description";
1293                    $description_value = "not available";
1294                }
1295                else{
1296                    my $cdd_obj = $cdd_objs->[0];
1297                    $name_title = "name";
1298                    $name_value = $cdd_obj->term;
1299                    $description_title = "description";
1300                    $description_value = $cdd_obj->description;
1301                }
1302            }
1303    
1304            my $location =  $thing->start . " - " . $thing->stop;
1305    
1306            push(@$single_domain,$db);
1307            push(@$single_domain,$thing->acc);
1308            push(@$single_domain,$name_value);
1309            push(@$single_domain,$location);
1310            push(@$single_domain,$thing->evalue);
1311            push(@$single_domain,$description_value);
1312            push(@$data,$single_domain);
1313        }
1314    
1315        if ($count >0){
1316            $content = $data;
1317        }
1318        else
1319        {
1320            $content = "<p>This PEG does not have any similarities to domains</p>";
1321        }
1322    }
1323    
1324    
1325  #########################################  #########################################
1326  #########################################  #########################################
1327  package Observation::Location;  package Observation::Location;
# Line 1126  Line 1339 
1339      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1340      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1341      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1342        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1343        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1344    
1345      bless($self,$class);      bless($self,$class);
1346      return $self;      return $self;
# Line 1147  Line 1362 
1362      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1363      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1364    
1365        my $phobius_signal_location = $thing->phobius_signal_location;
1366        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1367    
1368      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1369    
1370      #color is      #color is
1371      my $color = "5";      my $color = "6";
   
     my $line_data = [];  
1372    
1373      if($cello_location){      if($cello_location){
1374          my $cello_descriptions = [];          my $cello_descriptions = [];
1375            my $line_data =[];
1376    
1377            my $line_config = { 'title' => 'Localization Evidence',
1378                                'short_title' => 'CELLO',
1379                                'basepair_offset' => '1' };
1380    
1381          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1382                                            "value" => $cello_location};                                            "value" => $cello_location};
1383    
# Line 1175  Line 1394 
1394              "end" =>  $length + 1,              "end" =>  $length + 1,
1395              "color"=> $color,              "color"=> $color,
1396              "type" => 'box',              "type" => 'box',
1397              "zlayer" => '2',              "zlayer" => '1',
1398              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1399    
1400          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1401            $gd->add_line($line_data, $line_config);
1402      }      }
1403    
1404      my $color = "6";  
1405        $color = "2";
1406      if($tmpred_score){      if($tmpred_score){
1407            my $line_data =[];
1408            my $line_config = { 'title' => 'Localization Evidence',
1409                                'short_title' => 'Transmembrane',
1410                                'basepair_offset' => '1' };
1411    
1412    
1413          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1414              my $descriptions = [];              my $descriptions = [];
1415              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1201  Line 1428 
1428              "description" => $descriptions};              "description" => $descriptions};
1429    
1430              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1431    
1432            }
1433            $gd->add_line($line_data, $line_config);
1434        }
1435    
1436        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1437            my $line_data =[];
1438            my $line_config = { 'title' => 'Localization Evidence',
1439                                'short_title' => 'Phobius',
1440                                'basepair_offset' => '1' };
1441    
1442            foreach my $tm_loc (@phobius_tm_locations){
1443                my $descriptions = [];
1444                my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',
1445                                 "value" => $tm_loc};
1446                push(@$descriptions,$description_phobius_tm_locations);
1447    
1448                my ($begin,$end) =split("-",$tm_loc);
1449    
1450                my $element_hash = {
1451                "title" => "phobius transmembrane location",
1452                "start" => $begin + 1,
1453                "end" =>  $end + 1,
1454                "color"=> '6',
1455                "zlayer" => '4',
1456                "type" => 'bigbox',
1457                "description" => $descriptions};
1458    
1459                push(@$line_data,$element_hash);
1460    
1461            }
1462    
1463            if($phobius_signal_location){
1464                my $descriptions = [];
1465                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1466                                 "value" => $phobius_signal_location};
1467                push(@$descriptions,$description_phobius_signal_location);
1468    
1469    
1470                my ($begin,$end) =split("-",$phobius_signal_location);
1471                my $element_hash = {
1472                "title" => "phobius signal locations",
1473                "start" => $begin + 1,
1474                "end" =>  $end + 1,
1475                "color"=> '1',
1476                "zlayer" => '5',
1477                "type" => 'box',
1478                "description" => $descriptions};
1479                push(@$line_data,$element_hash);
1480          }          }
1481    
1482            $gd->add_line($line_data, $line_config);
1483      }      }
1484    
1485      my $color = "1";  
1486        $color = "1";
1487      if($signal_peptide_score){      if($signal_peptide_score){
1488            my $line_data = [];
1489          my $descriptions = [];          my $descriptions = [];
1490    
1491            my $line_config = { 'title' => 'Localization Evidence',
1492                                'short_title' => 'SignalP',
1493                                'basepair_offset' => '1' };
1494    
1495          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1496                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1497    
# Line 1220  Line 1505 
1505          my $element_hash = {          my $element_hash = {
1506              "title" => "SignalP",              "title" => "SignalP",
1507              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1508              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1509              "type" => 'bigbox',              "type" => 'bigbox',
1510              "color"=> $color,              "color"=> $color,
1511              "zlayer" => '10',              "zlayer" => '10',
1512              "description" => $descriptions};              "description" => $descriptions};
1513    
1514          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1515      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1516        }
1517    
1518      return ($gd);      return ($gd);
1519    
# Line 1277  Line 1561 
1561    return $self->{cello_score};    return $self->{cello_score};
1562  }  }
1563    
1564    sub phobius_signal_location {
1565      my ($self) = @_;
1566      return $self->{phobius_signal_location};
1567    }
1568    
1569    sub phobius_tm_locations {
1570      my ($self) = @_;
1571      return $self->{phobius_tm_locations};
1572    }
1573    
1574    
1575    
1576  #########################################  #########################################
1577  #########################################  #########################################
# Line 1305  Line 1600 
1600      return $self;      return $self;
1601  }  }
1602    
1603    =head3 display()
1604    
1605    If available use the function specified here to display a graphical observation.
1606    This code will display a graphical view of the similarities using the genome drawer object
1607    
1608    =cut
1609    
1610    sub display {
1611        my ($self,$gd) = @_;
1612    
1613        my $fig = new FIG;
1614        my $peg = $self->acc;
1615    
1616        my $organism = $self->organism;
1617        my $genome = $fig->genome_of($peg);
1618        my ($org_tax) = ($genome) =~ /(.*)\./;
1619        my $function = $self->function;
1620        my $abbrev_name = $fig->abbrev($organism);
1621        my $align_start = $self->qstart;
1622        my $align_stop = $self->qstop;
1623        my $hit_start = $self->hstart;
1624        my $hit_stop = $self->hstop;
1625    
1626        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1627    
1628        my $line_config = { 'title' => "$organism [$org_tax]",
1629                            'short_title' => "$abbrev_name",
1630                            'title_link' => '$tax_link',
1631                            'basepair_offset' => '0'
1632                            };
1633    
1634        my $line_data = [];
1635    
1636        my $element_hash;
1637        my $links_list = [];
1638        my $descriptions = [];
1639    
1640        # get subsystem information
1641        my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1642    
1643        my $link;
1644        $link = {"link_title" => $peg,
1645                 "link" => $url_link};
1646        push(@$links_list,$link);
1647    
1648        my @subsystems = $fig->peg_to_subsystems($peg);
1649        foreach my $subsystem (@subsystems){
1650            my $link;
1651            $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1652                     "link_title" => $subsystem};
1653            push(@$links_list,$link);
1654        }
1655    
1656        my $description_function;
1657        $description_function = {"title" => "function",
1658                                 "value" => $function};
1659        push(@$descriptions,$description_function);
1660    
1661        my ($description_ss, $ss_string);
1662        $ss_string = join (",", @subsystems);
1663        $description_ss = {"title" => "subsystems",
1664                           "value" => $ss_string};
1665        push(@$descriptions,$description_ss);
1666    
1667        my $description_loc;
1668        $description_loc = {"title" => "location start",
1669                            "value" => $hit_start};
1670        push(@$descriptions, $description_loc);
1671    
1672        $description_loc = {"title" => "location stop",
1673                            "value" => $hit_stop};
1674        push(@$descriptions, $description_loc);
1675    
1676        my $evalue = $self->evalue;
1677        while ($evalue =~ /-0/)
1678        {
1679            my ($chunk1, $chunk2) = split(/-/, $evalue);
1680            $chunk2 = substr($chunk2,1);
1681            $evalue = $chunk1 . "-" . $chunk2;
1682        }
1683    
1684        my $color = &color($evalue);
1685    
1686        my $description_eval = {"title" => "E-Value",
1687                                "value" => $evalue};
1688        push(@$descriptions, $description_eval);
1689    
1690        my $identity = $self->identity;
1691        my $description_identity = {"title" => "Identity",
1692                                    "value" => $identity};
1693        push(@$descriptions, $description_identity);
1694    
1695        $element_hash = {
1696            "title" => $peg,
1697            "start" => $align_start,
1698            "end" =>  $align_stop,
1699            "type"=> 'box',
1700            "color"=> $color,
1701            "zlayer" => "2",
1702            "links_list" => $links_list,
1703            "description" => $descriptions
1704            };
1705        push(@$line_data,$element_hash);
1706        $gd->add_line($line_data, $line_config);
1707    
1708        return ($gd);
1709    
1710    }
1711    
1712  =head3 display_table()  =head3 display_table()
1713    
1714  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 1719 
1719  =cut  =cut
1720    
1721  sub display_table {  sub display_table {
1722      my ($self,$dataset) = @_;      my ($self,$dataset, $columns, $query_fid) = @_;
1723    
1724      my $data = [];      my $data = [];
1725      my $count = 0;      my $count = 0;
1726      my $content;      my $content;
1727      my $fig = new FIG;      my $fig = new FIG;
1728      my $cgi = new CGI;      my $cgi = new CGI;
1729        my @ids;
1730        foreach my $thing (@$dataset) {
1731            next if ($thing->class ne "SIM");
1732            push (@ids, $thing->acc);
1733        }
1734    
1735        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1736        foreach my $col (@$columns){
1737            # get the column for the subsystems
1738            if ($col eq "subsystem"){
1739                %subsystems_column = &get_subsystems_column(\@ids);
1740            }
1741            # get the column for the evidence codes
1742            elsif ($col eq "evidence"){
1743                %evidence_column = &get_evidence_column(\@ids);
1744            }
1745            # get the column for pfam_domain
1746            elsif ($col eq "pfam_domains"){
1747                %pfam_column = &get_pfam_column(\@ids);
1748            }
1749        }
1750    
1751        my %e_identical = &get_essentially_identical($query_fid);
1752        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1753    
1754      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
         my $single_domain = [];  
1755          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1756            my $single_domain = [];
1757          $count++;          $count++;
1758    
1759          my $id = $thing->acc;          my $id = $thing->acc;
1760    
1761          # add the subsystem information          my $iden    = $thing->identity;
1762          my @in_sub  = $fig->peg_to_subsystems($id);          my $ln1     = $thing->qlength;
1763          my $in_sub;          my $ln2     = $thing->hlength;
1764            my $b1      = $thing->qstart;
1765            my $e1      = $thing->qstop;
1766            my $b2      = $thing->hstart;
1767            my $e2      = $thing->hstop;
1768            my $d1      = abs($e1 - $b1) + 1;
1769            my $d2      = abs($e2 - $b2) + 1;
1770            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1771            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1772    
1773            # checkbox column
1774            my $field_name = "tables_" . $id;
1775            my $pair_name = "visual_" . $id;
1776            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1777    
1778            # get the linked fig id
1779            my $fig_col;
1780            if (defined ($e_identical{$id})){
1781                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1782            }
1783            else{
1784                $fig_col = &HTML::set_prot_links($cgi,$id);
1785            }
1786    
1787          if (@in_sub > 0) {          push(@$single_domain,$box_col);                        # permanent column
1788              $in_sub = @in_sub;          push(@$single_domain,$fig_col);                        # permanent column
1789            push(@$single_domain,$thing->evalue);                  # permanent column
1790            push(@$single_domain,"$iden\%");                       # permanent column
1791            push(@$single_domain,$reg1);                           # permanent column
1792            push(@$single_domain,$reg2);                           # permanent column
1793            push(@$single_domain,$thing->organism);                # permanent column
1794            push(@$single_domain,$thing->function);                # permanent column
1795            foreach my $col (@$columns){
1796                (push(@$single_domain,$subsystems_column{$id}) && (next)) if ($col eq "subsystem");
1797                (push(@$single_domain,$evidence_column{$id}) && (next)) if ($col eq "evidence");
1798                (push(@$single_domain,$pfam_column{$id}) && (next)) if ($col eq "pfam_domains");
1799    #           (push(@$single_domain,@{$$all_aliases{$id}}[0]) && (next)) if ($col eq "ncbi_id");
1800                (push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases)) && (next)) if ($col eq "ncbi_id");
1801                (push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases)) && (next)) if ($col eq "refseq_id");
1802                (push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases)) && (next)) if ($col eq "swissprot_id");
1803                (push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases)) && (next)) if ($col eq "uniprot_id");
1804                (push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases)) && (next)) if ($col eq "tigr_id");
1805                (push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases)) && (next)) if ($col eq "pir_id");
1806                (push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases)) && (next)) if ($col eq "kegg_id");
1807                (push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases)) && (next)) if ($col eq "trembl_id");
1808                (push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases)) && (next)) if ($col eq "asap_id");
1809                (push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases)) && (next)) if ($col eq "jgi_id");
1810            }
1811            push(@$data,$single_domain);
1812        }
1813    
1814              # RAE: add a javascript popup with all the subsystems      if ($count >0 ){
1815              my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;          $content = $data;
1816              $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);      }
1817        else{
1818            $content = "<p>This PEG does not have any similarities</p>";
1819        }
1820        return ($content);
1821    }
1822    
1823    sub get_box_column{
1824        my ($ids) = @_;
1825        my %column;
1826        foreach my $id (@$ids){
1827            my $field_name = "tables_" . $id;
1828            my $pair_name = "visual_" . $id;
1829            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1830        }
1831        return (%column);
1832    }
1833    
1834    sub get_subsystems_column{
1835        my ($ids) = @_;
1836    
1837        my $fig = new FIG;
1838        my $cgi = new CGI;
1839        my %in_subs  = $fig->subsystems_for_pegs($ids);
1840        my %column;
1841        foreach my $id (@$ids){
1842            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1843            my @subsystems;
1844    
1845            if (@in_sub > 0) {
1846                my $count = 1;
1847                foreach my $array(@in_sub){
1848                    push (@subsystems, $count . ". " . $$array[0]);
1849                    $count++;
1850                }
1851                my $in_sub_line = join ("<br>", @subsystems);
1852                $column{$id} = $in_sub_line;
1853          } else {          } else {
1854              $in_sub = "&nbsp;";              $column{$id} = "&nbsp;";
1855            }
1856        }
1857        return (%column);
1858    }
1859    
1860    sub get_essentially_identical{
1861        my ($fid) = @_;
1862        my $fig = new FIG;
1863    
1864        my %id_list;
1865        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
1866    
1867        foreach my $id (@maps_to) {
1868            if (($id ne $fid) && ($fig->function_of($id))) {
1869                $id_list{$id} = 1;
1870            }
1871        }
1872        return(%id_list);
1873    }
1874    
1875    
1876    sub get_evidence_column{
1877        my ($ids) = @_;
1878        my $fig = new FIG;
1879        my $cgi = new CGI;
1880        my (%column, %code_attributes);
1881    
1882        my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);
1883        foreach my $key (@codes){
1884            push (@{$code_attributes{$$key[0]}}, $key);
1885          }          }
1886    
1887        foreach my $id (@$ids){
1888          # add evidence code with tool tip          # add evidence code with tool tip
1889          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
1890          my @ev_codes = "";          my @ev_codes = "";
1891    
1892          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1893              my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);              my @codes;
1894                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
1895              @ev_codes = ();              @ev_codes = ();
1896              foreach my $code (@codes) {              foreach my $code (@codes) {
1897                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
# Line 1366  Line 1910 
1910                                  {                                  {
1911                                      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));
1912          }          }
1913            $column{$id}=$ev_codes;
1914        }
1915        return (%column);
1916    }
1917    
1918          # add the aliases  sub get_pfam_column{
1919          my $aliases = undef;      my ($ids) = @_;
1920          $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );      my $fig = new FIG;
1921          $aliases = &HTML::set_prot_links( $cgi, $aliases );      my $cgi = new CGI;
1922          $aliases ||= "&nbsp;";      my (%column, %code_attributes);
1923        my $dbmaster = DBMaster->new(-database =>'Ontology');
1924    
1925          my $iden    = $thing->identity;      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
1926          my $ln1     = $thing->qlength;      foreach my $key (@codes){
1927          my $ln2     = $thing->hlength;          push (@{$code_attributes{$$key[0]}}, $$key[1]);
1928          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>)";  
1929    
1930        foreach my $id (@$ids){
1931            # add evidence code with tool tip
1932            my $pfam_codes=" &nbsp; ";
1933            my @pfam_codes = "";
1934            my %description_codes;
1935    
1936          push(@$single_domain,$thing->database);          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1937          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));              my @codes;
1938          push(@$single_domain,$thing->evalue);              @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
1939          push(@$single_domain,"$iden\%");              @pfam_codes = ();
1940          push(@$single_domain,$reg1);              foreach my $code (@codes) {
1941          push(@$single_domain,$reg2);                  my @parts = split("::",$code);
1942          push(@$single_domain,$in_sub);                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
1943          push(@$single_domain,$ev_codes);                  if (defined ($description_codes{$parts[1]})){
1944          push(@$single_domain,$thing->organism);                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
1945          push(@$single_domain,$thing->function);                  }
1946          push(@$single_domain,$aliases);                  else {
1947          push(@$data,$single_domain);                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
1948                        $description_codes{$parts[1]} = ${$$description[0]}{term};
1949                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
1950                    }
1951                }
1952      }      }
1953    
1954      if ($count >0){          $column{$id}=join("<br><br>", @pfam_codes);
         $content = $data;  
1955      }      }
1956      else      return (%column);
1957      {  
         $content = "<p>This PEG does not have any similarities</p>";  
1958      }      }
1959      return ($content);  
1960    sub get_prefer {
1961        my ($fid, $db, $all_aliases) = @_;
1962        my $fig = new FIG;
1963        my $cgi = new CGI;
1964    
1965        foreach my $alias (@{$$all_aliases{$fid}}){
1966            my $id_db = &Observation::get_database($alias);
1967            if ($id_db eq $db){
1968                my $acc_col .= &HTML::set_prot_links($cgi,$alias);
1969                return ($acc_col);
1970            }
1971        }
1972        return (" ");
1973  }  }
1974    
1975  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; $_ }
1976    
1977    sub color {
1978        my ($evalue) = @_;
1979    
1980        my $color;
1981        if ($evalue <= 1e-170){
1982            $color = 51;
1983        }
1984        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){
1985            $color = 52;
1986        }
1987        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){
1988            $color = 53;
1989        }
1990        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){
1991            $color = 54;
1992        }
1993        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){
1994            $color = 55;
1995        }
1996        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){
1997            $color = 56;
1998        }
1999        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){
2000            $color = 57;
2001        }
2002        elsif (($evalue <= 1) && ($evalue > 1e-5)){
2003            $color = 58;
2004        }
2005        elsif (($evalue <= 10) && ($evalue > 1)){
2006            $color = 59;
2007        }
2008        else{
2009            $color = 60;
2010        }
2011    
2012    
2013        return ($color);
2014    }
2015    
2016    
2017  ############################  ############################
# Line 1464  Line 2064 
2064          $region_start = $end-4000;          $region_start = $end-4000;
2065          $region_end = $beg+4000;          $region_end = $beg+4000;
2066          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2067          $reverse_flag{$target_genome} = 1;          $reverse_flag{$target_genome} = $fid;
2068      }      }
2069    
2070      # call genes in region      # call genes in region
# Line 1475  Line 2075 
2075    
2076      my %all_genes;      my %all_genes;
2077      my %all_genomes;      my %all_genomes;
2078      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;}
2079    
2080      if ($compare_or_coupling eq "diverse")      if ($compare_or_coupling eq "diverse")
2081      {      {
# Line 1506  Line 2106 
2106                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
2107                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
2108                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                      $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2109                      $reverse_flag{$pair_genome} = 1;                      $reverse_flag{$pair_genome} = $peg1;
2110                  }                  }
2111    
2112                  push (@start_array_region, $offset);                  push (@start_array_region, $offset);
# Line 1514  Line 2114 
2114                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
2115                  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);
2116                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
2117                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                  foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2118              }              }
2119              $coup_count++;              $coup_count++;
2120          }          }
# Line 1566  Line 2166 
2166                          $pair_region_start = $pair_end-4000;                          $pair_region_start = $pair_end-4000;
2167                          $pair_region_stop = $pair_beg+4000;                          $pair_region_stop = $pair_beg+4000;
2168                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2169                          $reverse_flag{$pair_genome} = 1;                          $reverse_flag{$pair_genome} = $peg1;
2170                      }                      }
2171    
2172                      push (@start_array_region, $offset);                      push (@start_array_region, $offset);
2173                      $all_genomes{$pair_genome} = 1;                      $all_genomes{$pair_genome} = 1;
2174                      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);
2175                      push(@$all_regions,$pair_features);                      push(@$all_regions,$pair_features);
2176                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}                      foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}
2177                  }                  }
2178              }              }
2179          }          }
# Line 1584  Line 2184 
2184      my %pch_already;      my %pch_already;
2185      foreach my $gene_peg (keys %all_genes)      foreach my $gene_peg (keys %all_genes)
2186      {      {
2187          if ($pch_already{$gene_peg}){next;};          if ($pch_already{$gene_peg}){(next);};
2188          my $gene_set = [$gene_peg];          my $gene_set = [$gene_peg];
2189          foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {          foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) {
2190              $pch_peg =~ s/,.*$//;              $pch_peg =~ s/,.*$//;
# Line 1625  Line 2225 
2225          else          else
2226          {          {
2227              foreach my $peg (@$good_set){              foreach my $peg (@$good_set){
2228                  $peg_rank{$peg} = 100;                  $peg_rank{$peg} = "20";
2229              }              }
2230          }          }
2231      }      }
# Line 1634  Line 2234 
2234  #    my $bbh_sets = [];  #    my $bbh_sets = [];
2235  #    my %already;  #    my %already;
2236  #    foreach my $gene_key (keys(%all_genes)){  #    foreach my $gene_key (keys(%all_genes)){
2237  #       if($already{$gene_key}){next;}  #       if($already{$gene_key}){(next);}
2238  #       my $gene_set = [$gene_key];  #       my $gene_set = [$gene_key];
2239  #  #
2240  #       my $gene_key_genome = $fig->genome_of($gene_key);  #       my $gene_key_genome = $fig->genome_of($gene_key);
2241  #  #
2242  #       foreach my $genome_key (keys(%all_genomes)){  #       foreach my $genome_key (keys(%all_genomes)){
2243  #           #next if ($gene_key_genome eq $genome_key);  #           #(next) if ($gene_key_genome eq $genome_key);
2244  #           my $return = $fig->bbh_list($genome_key,[$gene_key]);  #           my $return = $fig->bbh_list($genome_key,[$gene_key]);
2245  #  #
2246  #           my $feature_list = $return->{$gene_key};  #           my $feature_list = $return->{$gene_key};
# Line 1678  Line 2278 
2278  #       else  #       else
2279  #       {  #       {
2280  #           foreach my $peg (@$good_set){  #           foreach my $peg (@$good_set){
2281  #               $peg_rank{$peg} = 100;  #               $peg_rank{$peg} = "20";
2282  #           }  #           }
2283  #       }  #       }
2284  #    }  #    }
# Line 1695  Line 2295 
2295    
2296          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2297    
2298            my $second_line_config = { 'title' => "$region_gs",
2299                                       'short_title' => "",
2300                                       'basepair_offset' => '0'
2301                                       };
2302    
2303          my $line_data = [];          my $line_data = [];
2304            my $second_line_data = [];
2305    
2306            # initialize variables to check for overlap in genes
2307            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2308            my $major_line_flag = 0;
2309            my $prev_second_flag = 0;
2310    
2311          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
2312                $second_line_flag = 0;
2313              my $element_hash;              my $element_hash;
2314              my $links_list = [];              my $links_list = [];
2315              my $descriptions = [];              my $descriptions = [];
# Line 1738  Line 2351 
2351                  $start = $2 - $offsetting;                  $start = $2 - $offsetting;
2352                  $stop = $3 - $offsetting;                  $stop = $3 - $offsetting;
2353    
2354                  if (defined($reverse_flag{$region_genome})){                  if ( (($prev_start) && ($prev_stop) ) &&
2355                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2356                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2357                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2358                            $second_line_flag = 1;
2359                            $major_line_flag = 1;
2360                        }
2361                    }
2362                    $prev_start = $start;
2363                    $prev_stop = $stop;
2364                    $prev_fig = $fid1;
2365    
2366                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2367                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2368                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2369                  }                  }
# Line 1753  Line 2378 
2378                      "links_list" => $links_list,                      "links_list" => $links_list,
2379                      "description" => $descriptions                      "description" => $descriptions
2380                  };                  };
2381                  push(@$line_data,$element_hash);  
2382                    # if there is an overlap, put into second line
2383                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2384                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2385    
2386              }              }
2387          }          }
2388          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2389            $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);
2390      }      }
2391      return $gd;      return $gd;
2392  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3