[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.46, Thu Nov 29 19:33:33 2007 UTC revision 1.64, Tue Jul 15 20:06:55 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5  use Data::Dumper;  use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10  use WebColors;  use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 374  Line 374 
374    
375  }  }
376    
377    =head
378        provides layer of abstraction between tools and underlying access method to Attribute Server
379    =cut
380    
381    sub get_attributes{
382        my ($self,$fig,$search_set,$search_term,$value_array_ref) = @_;
383        my @attributes = $fig->get_attributes($search_set,$search_term,@$value_array_ref);
384        return @attributes;
385    }
386    
387    =head3 get_sims_objects()
388    
389    This is the B<REAL WORKHORSE> method of this Package.
390    
391    =cut
392    
393    sub get_sims_objects {
394        my ($self,$fid,$fig,$parameters) = @_;
395    
396        my $objects = [];
397        my @matched_datasets=();
398    
399        # call function that fetches attribute based observations
400        # returns an array of arrays of hashes
401        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
402    
403        foreach my $dataset (@matched_datasets) {
404            my $object;
405            if ($dataset->{'class'} eq "SIM"){
406                $object = Observation::Sims->new($dataset);
407            }
408            push (@$objects, $object);
409        }
410        return $objects;
411    }
412    
413    
414  =head3 display_housekeeping  =head3 display_housekeeping
415  This method returns the housekeeping data for a given peg in a table format  This method returns the housekeeping data for a given peg in a table format
416    
# Line 414  Line 451 
451  =cut  =cut
452    
453  sub get_sims_summary {  sub get_sims_summary {
454      my ($observation, $fid, $taxes, $dataset, $fig) = @_;      my ($observation, $dataset, $fig) = @_;
455      my %families;      my %families;
456      #my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
457    
458      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
459            my ($id, $evalue);
460            if ($thing =~ /fig\|/){
461                $id = $thing;
462                $evalue = -1;
463            }
464            else{
465          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
466                $id      = $thing->acc;
467          my $id      = $thing->acc;              $evalue  = $thing->evalue;
468          my $evalue  = $thing->evalue;          }
   
469          next if ($id !~ /fig\|/);          next if ($id !~ /fig\|/);
470          next if ($fig->is_deleted_fid($id));          next if ($fig->is_deleted_fid($id));
471    
472          my $genome = $fig->genome_of($id);          my $genome = $fig->genome_of($id);
473          #my ($genome1) = ($genome) =~ /(.*)\./;          #my ($genome1) = ($genome) =~ /(.*)\./;
474          #my $taxonomy = $taxes->{$genome1};          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated  
475          my $parent_tax = "Root";          my $parent_tax = "Root";
476          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
477            push (@{$families{figs}{$parent_tax}}, $id);
478            my $level = 2;
479          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
480              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
481                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
482                $families{level}{$tax} = $level;
483              push (@currLineage, $tax);              push (@currLineage, $tax);
484              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
485              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
486              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
487                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($evalue < $families{evalue}{$tax}){
488                      $families{evalue}{$tax} = $evalue;                      $families{evalue}{$tax} = $evalue;
489                      $families{color}{$tax} = &get_taxcolor($evalue);                      $families{color}{$tax} = &get_taxcolor($evalue);
490                  }                  }
# Line 449  Line 495 
495              }              }
496    
497              $parent_tax = $tax;              $parent_tax = $tax;
498                $level++;
499          }          }
500      }      }
501    
# Line 459  Line 506 
506          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
507          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
508      }      }
509      return (\%families);  
510        return \%families;
511  }  }
512    
513  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 521 
521  sub get_taxcolor{  sub get_taxcolor{
522      my ($evalue) = @_;      my ($evalue) = @_;
523      my $color;      my $color;
524      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
525        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
526      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
527      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
528      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 496  Line 545 
545          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
546          my @parts = split("::",$key);          my @parts = split("::",$key);
547          my $class = $parts[0];          my $class = $parts[0];
548            my $name = $parts[1];
549            #next if (($class eq "PFAM") && ($name !~ /interpro/));
550    
551          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
552              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 504  Line 555 
555                  my $from = $2;                  my $from = $2;
556                  my $to = $3;                  my $to = $3;
557                  my $evalue;                  my $evalue;
558                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
559                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
560                      my $part1 = $2/100;                      my $part1 = $2/100;
561                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
562                  }                  }
563                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
564                        $evalue=$raw_evalue;
565                    }
566                  else{                  else{
567                      $evalue = "0.0";                      $evalue = "0.0";
568                  }                  }
# Line 649  Line 703 
703  =cut  =cut
704    
705  sub get_sims_observations{  sub get_sims_observations{
706        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
707    
708      my ($fid,$datasets_ref,$fig) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
709      #my $fig = new FIG;      if ($parameters->{flag}){
710      my @sims= $fig->sims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
711          $max_expand = $parameters->{max_expand};
712          $max_eval = $parameters->{max_eval};
713          $db_filter = $parameters->{db_filter};
714          $sim_filters->{ sort_by } = $parameters->{sim_order};
715          #$sim_order = $parameters->{sim_order};
716          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
717        }
718        else{
719          $max_sims = 50;
720          $max_expand = 5;
721          $max_eval = 1e-5;
722          $db_filter = "figx";
723          $sim_filters->{ sort_by } = 'id';
724          #$sim_order = "id";
725        }
726    
727        my($id, $genome, @genomes, %sims);
728        my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
729        @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
730      my ($dataset);      my ($dataset);
731    
732      foreach my $sim (@sims){      if ($group_by_genome){
733          next if ($fig->is_deleted_fid($sim->[1]));        #  Collect all sims from genome with the first occurance of the genome:
734          foreach $sim ( @tmp ){
735            $id = $sim->id2;
736            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
737            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
738            push @{ $sims{ $genome } }, $sim;
739          }
740          @tmp = map { @{ $sims{$_} } } @genomes;
741        }
742    
743        foreach my $sim (@tmp){
744          my $hit = $sim->[1];          my $hit = $sim->[1];
745          my $percent = $sim->[2];          my $percent = $sim->[2];
746          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 701  Line 785 
785      my ($id) = (@_);      my ($id) = (@_);
786    
787      my ($db);      my ($db);
788      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
789      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
790        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
791      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
792        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
793      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
794      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
795      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 712  Line 798 
798      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
799      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
800      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
801        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
802        elsif ($id =~ /^img\|/)           { $db = "IMG" }
803        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
804        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
805    
806      return ($db);      return ($db);
807    
# Line 776  Line 866 
866                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
867                    } @fc_data;                    } @fc_data;
868    
     my ($dataset);  
869      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
870                     'type' => 'fc',                     'type' => 'fc',
871                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 887  Line 976 
976      return $self->{database};      return $self->{database};
977  }  }
978    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
979  ############################################################  ############################################################
980  ############################################################  ############################################################
981  package Observation::PDB;  package Observation::PDB;
# Line 921  Line 1004 
1004      my ($self,$gd,$fig) = @_;      my ($self,$gd,$fig) = @_;
1005    
1006      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1007      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1008                                    -host     => $WebConfig::DBHOST,
1009                                    -user     => $WebConfig::DBUSER,
1010                                    -password => $WebConfig::DBPWD);
1011    
1012      my $acc = $self->acc;      my $acc = $self->acc;
1013    
# Line 942  Line 1028 
1028      my $lines = [];      my $lines = [];
1029      my $line_data = [];      my $line_data = [];
1030      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1031                            'hover_title' => 'PDB',
1032                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1033                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1034    
# Line 1062  Line 1149 
1149          my $organism = $fig->org_of($id);          my $organism = $fig->org_of($id);
1150          my $single_domain = [];          my $single_domain = [];
1151          push(@$single_domain,$who);          push(@$single_domain,$who);
1152          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1153          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1154          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1155          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1179  Line 1266 
1266      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1267      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1268    
1269      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1270                                    -host     => $WebConfig::DBHOST,
1271                                    -user     => $WebConfig::DBUSER,
1272                                    -password => $WebConfig::DBPWD);
1273    
1274      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1275      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1199  Line 1289 
1289          }          }
1290      }      }
1291      elsif($db =~ /PFAM/){      elsif($db =~ /PFAM/){
1292          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );          my ($new_id) = ($id) =~ /(.*?)_/;
1293            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1294          if(!scalar(@$pfam_objs)){          if(!scalar(@$pfam_objs)){
1295              $name_title = "name";              $name_title = "name";
1296              $name_value = "not available";              $name_value = "not available";
# Line 1217  Line 1308 
1308    
1309      my $short_title = $thing->acc;      my $short_title = $thing->acc;
1310      $short_title =~ s/::/ - /ig;      $short_title =~ s/::/ - /ig;
1311        my $new_short_title=$short_title;
1312        if ($short_title =~ /interpro/){
1313            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1314        }
1315      my $line_config = { 'title' => $name_value,      my $line_config = { 'title' => $name_value,
1316                          'short_title' => $short_title,                          'hover_title', => 'Domain',
1317                            'short_title' => $new_short_title,
1318                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1319    
1320      my $name;      my $name;
1321        my ($new_id) = ($id) =~ /(.*?)_/;
1322      $name = {"title" => $db,      $name = {"title" => $db,
1323               "value" => $id};               "value" => $new_id};
1324      push(@$descriptions,$name);      push(@$descriptions,$name);
1325    
1326  #    my $description;  #    my $description;
# Line 1249  Line 1346 
1346      my $link;      my $link;
1347      my $link_url;      my $link_url;
1348      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1349      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1350      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1351    
1352      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1287  Line 1384 
1384          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1385          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1386    
1387          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1388                                    -host     => $WebConfig::DBHOST,
1389                                    -user     => $WebConfig::DBUSER,
1390                                    -password => $WebConfig::DBPWD);
1391    
1392          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1393          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1306  Line 1406 
1406                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1407              }              }
1408          }          }
1409            elsif($db =~ /PFAM/){
1410                my ($new_id) = ($id) =~ /(.*?)_/;
1411                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1412                if(!scalar(@$pfam_objs)){
1413                    $name_title = "name";
1414                    $name_value = "not available";
1415                    $description_title = "description";
1416                    $description_value = "not available";
1417                }
1418                else{
1419                    my $pfam_obj = $pfam_objs->[0];
1420                    $name_title = "name";
1421                    $name_value = $pfam_obj->term;
1422                    #$description_title = "description";
1423                    #$description_value = $pfam_obj->description;
1424                }
1425            }
1426    
1427          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1428    
# Line 1388  Line 1505 
1505      #color is      #color is
1506      my $color = "6";      my $color = "6";
1507    
1508  =pod=  =head3
1509    
1510      if($cello_location){      if($cello_location){
1511          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1396  Line 1513 
1513    
1514          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1515                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1516                                'hover_title' => 'Localization',
1517                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1518    
1519          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1455  Line 1573 
1573          my $line_data =[];          my $line_data =[];
1574          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1575                              'short_title' => 'TM and SP',                              'short_title' => 'TM and SP',
1576                                'hover_title' => 'Localization',
1577                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1578    
1579          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
# Line 1508  Line 1627 
1627    
1628          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1629                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1630                                'hover_title' => 'Localization',
1631                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1632    
1633          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1628  Line 1748 
1748  =cut  =cut
1749    
1750  sub display {  sub display {
1751      my ($self,$gd,$array,$fig) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
     #my $fig = new FIG;  
   
     my @ids;  
     foreach my $thing(@$array){  
         next if ($thing->class ne "SIM");  
         push (@ids, $thing->acc);  
     }  
   
     my %in_subs  = $fig->subsystems_for_pegs(\@ids);  
   
     foreach my $thing (@$array){  
         if ($thing->class eq "SIM"){  
1752    
1753        # declare variables
1754        my $window_size = $gd->window_size;
1755              my $peg = $thing->acc;              my $peg = $thing->acc;
1756              my $query = $thing->query;      my $query_id = $thing->query;
   
1757              my $organism = $thing->organism;              my $organism = $thing->organism;
1758        my $abbrev_name = $fig->abbrev($organism);
1759        if (!$organism){
1760          $organism = $peg;
1761          $abbrev_name = $peg;
1762        }
1763              my $genome = $fig->genome_of($peg);              my $genome = $fig->genome_of($peg);
1764              my ($org_tax) = ($genome) =~ /(.*)\./;              my ($org_tax) = ($genome) =~ /(.*)\./;
1765              my $function = $thing->function;              my $function = $thing->function;
1766              my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1767              my $align_start = $thing->qstart;      my $query_stop = $thing->qstop;
             my $align_stop = $thing->qstop;  
1768              my $hit_start = $thing->hstart;              my $hit_start = $thing->hstart;
1769              my $hit_stop = $thing->hstop;              my $hit_stop = $thing->hstop;
1770        my $ln_query = $thing->qlength;
1771        my $ln_hit = $thing->hlength;
1772    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1773    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1774        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1775        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1776    
1777              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;              my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1778    
1779        # hit sequence title
1780              my $line_config = { 'title' => "$organism [$org_tax]",              my $line_config = { 'title' => "$organism [$org_tax]",
1781                                  'short_title' => "$abbrev_name",                                  'short_title' => "$abbrev_name",
1782                                  'title_link' => '$tax_link',                                  'title_link' => '$tax_link',
1783                                  'basepair_offset' => '0'                          'basepair_offset' => '0',
1784                            'no_middle_line' => '1'
1785                                  };                                  };
1786    
1787        # query sequence title
1788        my $replace_id = $peg;
1789        $replace_id =~ s/\|/_/ig;
1790        my $anchor_name = "anchor_". $replace_id;
1791        my $query_config = { 'title' => "Query",
1792                             'short_title' => "Query",
1793                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1794                             'basepair_offset' => '0',
1795                             'no_middle_line' => '1'
1796                             };
1797              my $line_data = [];              my $line_data = [];
1798        my $query_data = [];
1799    
1800              my $element_hash;              my $element_hash;
1801              my $links_list = [];      my $hit_links_list = [];
1802              my $descriptions = [];      my $hit_descriptions = [];
1803        my $query_descriptions = [];
1804              # get subsystem information  
1805              my $url_link = "?page=Annotation&feature=".$peg;      # get sequence information
1806              my $link;      # evidence link
1807              $link = {"link_title" => $peg,      my $evidence_link;
1808                       "link" => $url_link};      if ($peg =~ /^fig\|/){
1809              push(@$links_list,$link);        $evidence_link = "?page=Evidence&feature=".$peg;
1810        }
1811        else{
1812          my $db = &Observation::get_database($peg);
1813          my ($link_id) = ($peg) =~ /\|(.*)/;
1814          $evidence_link = &HTML::alias_url($link_id, $db);
1815          #print STDERR "LINK: $db    $evidence_link";
1816        }
1817        my $link = {"link_title" => $peg,
1818                    "link" => $evidence_link};
1819        push(@$hit_links_list,$link) if ($evidence_link);
1820    
1821              #my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1822              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1823              my @subsystems;              my @subsystems;
1824        foreach my $array (@$subs){
             foreach my $array (@subs){  
1825                  my $subsystem = $$array[0];                  my $subsystem = $$array[0];
1826                  push(@subsystems,$subsystem);                  push(@subsystems,$subsystem);
1827                  my $link;          my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
                 $link = {"link" => "?page=Subsystems&subsystem=$subsystem",  
1828                           "link_title" => $subsystem};                           "link_title" => $subsystem};
1829                  push(@$links_list,$link);          push(@$hit_links_list,$link);
1830              }              }
1831    
1832        # blast alignment
1833              $link = {"link_title" => "view blast alignment",              $link = {"link_title" => "view blast alignment",
1834                       "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1835              push (@$links_list,$link);      push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1836    
1837        # description data
1838              my $description_function;              my $description_function;
1839              $description_function = {"title" => "function",              $description_function = {"title" => "function",
1840                                       "value" => $function};                                       "value" => $function};
1841              push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1842    
1843              my ($description_ss, $ss_string);      # subsystem description
1844              $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1845              $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1846        my $description_ss = {"title" => "subsystems",
1847                                 "value" => $ss_string};                                 "value" => $ss_string};
1848              push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1849    
1850        # location description
1851        # hit
1852              my $description_loc;              my $description_loc;
1853              $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1854                                  "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1855              push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1856    
1857              $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1858                                  "value" => $hit_stop};                          "value" => $ln_hit};
1859              push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1860    
1861        # query
1862        $description_loc = {"title" => "Hit Location",
1863                            "value" => $query_start . " - " . $query_stop};
1864        push(@$query_descriptions, $description_loc);
1865    
1866        $description_loc = {"title" => "Sequence Length",
1867                            "value" => $ln_query};
1868        push(@$query_descriptions, $description_loc);
1869    
1870    
1871    
1872        # evalue score description
1873              my $evalue = $thing->evalue;              my $evalue = $thing->evalue;
1874              while ($evalue =~ /-0/)              while ($evalue =~ /-0/)
1875              {              {
# Line 1722  Line 1879 
1879              }              }
1880    
1881              my $color = &color($evalue);              my $color = &color($evalue);
   
1882              my $description_eval = {"title" => "E-Value",              my $description_eval = {"title" => "E-Value",
1883                                      "value" => $evalue};                                      "value" => $evalue};
1884              push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1885        push(@$query_descriptions, $description_eval);
1886    
1887              my $identity = $self->identity;              my $identity = $self->identity;
1888              my $description_identity = {"title" => "Identity",              my $description_identity = {"title" => "Identity",
1889                                          "value" => $identity};                                          "value" => $identity};
1890              push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1891        push(@$query_descriptions, $description_identity);
1892    
1893    
1894        my $number = $base_start + ($query_start-$hit_start);
1895        #print STDERR "START: $number";
1896        $element_hash = {
1897            "title" => $query_id,
1898            "start" => $base_start,
1899            "end" => $base_start+$ln_query,
1900            "type"=> 'box',
1901            "color"=> $color,
1902            "zlayer" => "2",
1903            "links_list" => $query_links_list,
1904            "description" => $query_descriptions
1905            };
1906        push(@$query_data,$element_hash);
1907    
1908        $element_hash = {
1909            "title" => $query_id . ': HIT AREA',
1910            "start" => $base_start + $query_start,
1911            "end" =>  $base_start + $query_stop,
1912            "type"=> 'smallbox',
1913            "color"=> $query_color,
1914            "zlayer" => "3",
1915            "links_list" => $query_links_list,
1916            "description" => $query_descriptions
1917            };
1918        push(@$query_data,$element_hash);
1919    
1920        $gd->add_line($query_data, $query_config);
1921    
1922    
1923              $element_hash = {              $element_hash = {
1924                  "title" => $peg,                  "title" => $peg,
1925                  "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1926                  "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1927                  "type"=> 'box',                  "type"=> 'box',
1928                  "color"=> $color,                  "color"=> $color,
1929                  "zlayer" => "2",                  "zlayer" => "2",
1930                  "links_list" => $links_list,                  "links_list" => $hit_links_list,
1931                  "description" => $descriptions                  "description" => $hit_descriptions
1932                  };                  };
1933              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1934    
1935        $element_hash = {
1936            "title" => $peg . ': HIT AREA',
1937            "start" => $base_start + $query_start,
1938            "end" =>  $base_start + $query_stop,
1939            "type"=> 'smallbox',
1940            "color"=> $hit_color,
1941            "zlayer" => "3",
1942            "links_list" => $hit_links_list,
1943            "description" => $hit_descriptions
1944            };
1945        push(@$line_data,$element_hash);
1946    
1947              $gd->add_line($line_data, $line_config);              $gd->add_line($line_data, $line_config);
1948          }  
1949      }      my $breaker = [];
1950        my $breaker_hash = {};
1951        my $breaker_config = { 'no_middle_line' => "1" };
1952    
1953        push (@$breaker, $breaker_hash);
1954        $gd->add_line($breaker, $breaker_config);
1955    
1956      return ($gd);      return ($gd);
1957  }  }
1958    
# Line 1791  Line 1998 
1998              }              }
1999          }          }
2000    
2001          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2002                                    -host     => $WebConfig::DBHOST,
2003                                    -user     => $WebConfig::DBUSER,
2004                                    -password => $WebConfig::DBPWD);
2005          my ($name_value,$description_value);          my ($name_value,$description_value);
2006    
2007          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1828  Line 2038 
2038          my $link;          my $link;
2039          my $link_url;          my $link_url;
2040          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"}          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"}
2041          elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}          elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2042          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2043    
2044          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1852  Line 2062 
2062      }      }
2063    
2064      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2065                            'hover_title' => 'Domain',
2066                          'short_title' => $peg,                          'short_title' => $peg,
2067                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2068    
# Line 1871  Line 2082 
2082  =cut  =cut
2083    
2084  sub display_table {  sub display_table {
2085      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2086        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2087    
2088      my $data = [];      my $scroll_list;
2089      my $count = 0;      foreach my $col (@$show_columns){
2090      my $content;          push (@$scroll_list, $col->{key});
2091      #my $fig = new FIG;      }
2092      my $cgi = new CGI;  
2093      my @ids;      push (@ids, $query_fid);
2094      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2095          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2096          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2097      }      }
2098    
2099      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2100      my @attributes = $fig->get_attributes(\@ids);      my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2101    
2102      # get the column for the subsystems      # get the column for the subsystems
2103      %subsystems_column = &get_subsystems_column(\@ids,$fig);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2104    
2105      # get the column for the evidence codes      # get the column for the evidence codes
2106      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2107    
2108      # get the column for pfam_domain      # get the column for pfam_domain
2109      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2110    
2111        # get the column for molecular weight
2112        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2113    
2114        # get the column for organism's habitat
2115        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2116    
2117        # get the column for organism's temperature optimum
2118        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2119    
2120        # get the column for organism's temperature range
2121        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2122    
2123        # get the column for organism's oxygen requirement
2124        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2125    
2126        # get the column for organism's pathogenicity
2127        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2128    
2129        # get the column for organism's pathogenicity host
2130        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2131    
2132        # get the column for organism's salinity
2133        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2134    
2135        # get the column for organism's motility
2136        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2137    
2138        # get the column for organism's gram stain
2139        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2140    
2141        # get the column for organism's endospores
2142        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2143    
2144        # get the column for organism's shape
2145        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2146    
2147        # get the column for organism's disease
2148        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2149    
2150        # get the column for organism's disease
2151        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2152    
2153        # get the column for transmembrane domains
2154        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2155    
2156        # get the column for similar to human
2157        my $similar_to_human_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2158    
2159        # get the column for signal peptide
2160        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2161    
2162        # get the column for transmembrane domains
2163        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2164    
2165        # get the column for conserved neighborhood
2166        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2167    
2168        # get the column for cellular location
2169        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2170    
2171        # get the aliases
2172        my $alias_col;
2173        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2174             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2175             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2176             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2177             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2178            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2179        }
2180    
2181        # get the colors for the function cell
2182        my $functions = $fig->function_of_bulk(\@ids,1);
2183        $functional_color = &get_function_color_cell($functions, $fig);
2184        my $query_function = $fig->function_of($query_fid);
2185    
2186      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
     my $alias_col = &get_aliases(\@ids,$fig);  
     #my $alias_col = {};  
2187    
2188        my $figfam_data = &FIG::get_figfams_data();
2189        my $figfams = new FFs($figfam_data);
2190    
2191        my $func_color_offset=0;
2192        unshift(@$dataset, $query_fid);
2193      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2194            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2195            if ($thing eq $query_fid){
2196                $id = $thing;
2197                $taxid   = $fig->genome_of($id);
2198                $organism = $fig->genus_species($taxid);
2199                $current_function = $fig->function_of($id);
2200            }
2201            else{
2202          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2203    
2204                $id      = $thing->acc;
2205                $evalue  = $thing->evalue;
2206                $taxid   = $fig->genome_of($id);
2207                $iden    = $thing->identity;
2208                $organism= $thing->organism;
2209                $ln1     = $thing->qlength;
2210                $ln2     = $thing->hlength;
2211                $b1      = $thing->qstart;
2212                $e1      = $thing->qstop;
2213                $b2      = $thing->hstart;
2214                $e2      = $thing->hstop;
2215                $d1      = abs($e1 - $b1) + 1;
2216                $d2      = abs($e2 - $b2) + 1;
2217                $color1  = match_color( $b1, $e1, $ln1 );
2218                $color2  = match_color( $b2, $e2, $ln2 );
2219                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2220                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2221                $current_function = $thing->function;
2222            }
2223    
2224          my $single_domain = [];          my $single_domain = [];
2225          $count++;          $count++;
2226    
2227          my $id      = $thing->acc;          # organisms cell
2228          my $taxid   = $fig->genome_of($id);          my ($org, $org_color) = $fig->org_and_color_of($id);
2229          my $iden    = $thing->identity;          my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         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>)";  
2230    
2231          # checkbox column          # checkbox cell
2232            my ($box_cell,$tax, $radio_cell);
2233          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2234          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2235          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_". $id;
2236          my ($tax) = ($id) =~ /fig\|(.*?)\./;          my $replace_id = $id;
2237            $replace_id =~ s/\|/_/ig;
2238            my $white = '#ffffff';
2239            $white = '#999966' if ($id eq $query_fid);
2240            $org_color = '#999966' if ($id eq $query_fid);
2241            my $anchor_name = "anchor_". $replace_id;
2242            my $checked = ""; $checked = "checked" if ($id eq $query_fid);
2243            if ($id =~ /^fig\|/){
2244              my $box = qq(<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>);
2245              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2246              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2247              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2248              $tax = $fig->genome_of($id);
2249            }
2250            else{
2251              my $box = qq(<a name="$anchor_name"></a>);
2252              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2253            }
2254    
2255          # get the linked fig id          # get the linked fig id
2256          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2257          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2258              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";          $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2259          }          my $fig_col = {'data'=> $fig_data,
2260          else{                         'highlight'=>$white};
2261              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);  
2262          }          $replace_id = $peg;
2263            $replace_id =~ s/\|/_/ig;
2264          push (@$single_domain, $box_col, $fig_col, $thing->evalue,          $anchor_name = "anchor_". $replace_id;
2265                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns          my $query_config = { 'title' => "Query",
2266                                 'short_title' => "Query",
2267          foreach my $col (sort keys %$scroll_list){                               'title_link' => "changeSimsLocation('$replace_id')",
2268              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                               'basepair_offset' => '0'
2269              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                               };
2270              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2271              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}          # function cell
2272              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2273              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2274              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2275              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}  
2276              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}          my $function_color;
2277              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}          if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2278              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}              $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2279              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}          }
2280              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}          else{
2281              #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2282              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}          }
2283            my $function_cell;
2284            if ($current_function){
2285              if ($current_function eq $query_function){
2286                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2287                $func_color_offset=1;
2288              }
2289              else{
2290                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2291              }
2292            }
2293            else{
2294              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2295            }
2296    
2297            if ($id eq $query_fid){
2298                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2299                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2300                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2301            }
2302            else{
2303                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2304                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2305            }
2306    
2307            if ( ( $application->session->user) ){
2308                my $user = $application->session->user;
2309                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2310                    push (@$single_domain,$radio_cell);
2311                }
2312            }
2313    
2314            my ($ff) = $figfams->families_containing_peg($id);
2315    
2316            foreach my $col (@$scroll_list){
2317                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2318                else { $highlight_color = "#ffffff"; }
2319    
2320                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2340                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2341                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2342                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2343                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2344                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2345                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2346                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2347                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2348                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2349                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2350                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2351                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2352                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2353                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2354          }          }
2355          push(@$data,$single_domain);          push(@$data,$single_domain);
2356      }      }
# Line 1962  Line 2360 
2360      else{      else{
2361          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2362      }      }
2363        shift(@$dataset);
2364      return ($content);      return ($content);
2365  }  }
2366    
# Line 1971  Line 2370 
2370      foreach my $id (@$ids){      foreach my $id (@$ids){
2371          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2372          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2373          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2374            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2375      }      }
2376      return (%column);      return (%column);
2377  }  }
2378    
2379    sub get_figfam_column{
2380        my ($ids, $fig, $cgi) = @_;
2381        my $column;
2382    
2383        my $figfam_data = &FIG::get_figfams_data();
2384        my $figfams = new FFs($figfam_data);
2385    
2386        foreach my $id (@$ids){
2387            my ($ff) =  $figfams->families_containing_peg($id);
2388            if ($ff){
2389                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2390            }
2391            else{
2392                push (@$column, " ");
2393            }
2394        }
2395    
2396        return $column;
2397    }
2398    
2399  sub get_subsystems_column{  sub get_subsystems_column{
2400      my ($ids,$fig) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2401    
     #my $fig = new FIG;  
     my $cgi = new CGI;  
2402      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2403      my %column;      my ($column, $ss);
2404      foreach my $id (@$ids){      foreach my $id (@$ids){
2405          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2406          my @subsystems;          my @subsystems;
2407    
2408          if (@in_sub > 0) {          if (@in_sub > 0) {
2409              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2410                  my $ss = $$array[0];                  my $ss = $array->[0];
2411                  $ss =~ s/_/ /ig;                  $ss =~ s/_/ /ig;
2412                  push (@subsystems, "-" . $ss);                  push (@subsystems, "-" . $ss);
2413              }              }
2414              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2415              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2416          } else {          } else {
2417              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2418          }          }
2419            push (@$column, $ss->{$id});
2420      }      }
2421      return (%column);  
2422        if ($returnType eq 'hash') { return $ss; }
2423        elsif ($returnType eq 'array') { return $column; }
2424    }
2425    
2426    sub get_lineage_column{
2427        my ($ids, $fig, $cgi) = @_;
2428    
2429        my $lineages = $fig->taxonomy_list();
2430    
2431        foreach my $id (@$ids){
2432            my $genome = $fig->genome_of($id);
2433            if ($lineages->{$genome}){
2434    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2435                push (@$column, $lineages->{$genome});
2436            }
2437            else{
2438                push (@$column, " ");
2439            }
2440        }
2441        return $column;
2442    }
2443    
2444    sub match_color {
2445        my ( $b, $e, $n , $rgb) = @_;
2446        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2447        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2448        my $cov = ( $r - $l + 1 ) / $n;
2449        my $sat = 1 - 10 * $cov / 9;
2450        my $br  = 1;
2451        if ($rgb){
2452            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2453        }
2454        else{
2455            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2456        }
2457    }
2458    
2459    sub hsb2rgb {
2460        my ( $h, $s, $br ) = @_;
2461        $h = 6 * ($h - floor($h));
2462        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2463        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2464        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2465                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2466                                          :               ( 0,      1,      $h - 2 )
2467                                          )
2468                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2469                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2470                                          :               ( 1,      0,      6 - $h )
2471                                          );
2472        ( ( $r * $s + 1 - $s ) * $br,
2473          ( $g * $s + 1 - $s ) * $br,
2474          ( $b * $s + 1 - $s ) * $br
2475        )
2476    }
2477    
2478    sub html2rgb {
2479        my ($hex) = @_;
2480        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2481        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2482                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2483    
2484        my @R = split(//, $r);
2485        my @G = split(//, $g);
2486        my @B = split(//, $b);
2487    
2488        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2489        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2490        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2491    
2492        my $rgb = [$red, $green, $blue];
2493        return $rgb;
2494    
2495    }
2496    
2497    sub rgb2html {
2498        my ( $r, $g, $b ) = @_;
2499        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2500        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2501        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2502        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2503    }
2504    
2505    sub floor {
2506        my $x = $_[0];
2507        defined( $x ) || return undef;
2508        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2509    }
2510    
2511    sub get_function_color_cell{
2512      my ($functions, $fig) = @_;
2513    
2514      # figure out the quantity of each function
2515      my %hash;
2516      foreach my $key (keys %$functions){
2517        my $func = $functions->{$key};
2518        $hash{$func}++;
2519      }
2520    
2521      my %func_colors;
2522      my $count = 1;
2523      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2524        $func_colors{$key}=$count;
2525        $count++;
2526      }
2527    
2528      return \%func_colors;
2529  }  }
2530    
2531  sub get_essentially_identical{  sub get_essentially_identical{
# Line 2032  Line 2558 
2558    
2559    
2560  sub get_evidence_column{  sub get_evidence_column{
2561      my ($ids, $attributes,$fig) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2562      #my $fig = new FIG;      my ($column, $code_attributes);
2563      my $cgi = new CGI;  
2564      my (%column, %code_attributes);      if (! defined $attributes) {
2565            my @attributes_array = $fig->get_attributes($ids);
2566            $attributes = \@attributes_array;
2567        }
2568    
2569      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2570      foreach my $key (@codes){      foreach my $key (@codes){
2571          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2572      }      }
2573    
2574      foreach my $id (@$ids){      foreach my $id (@$ids){
2575          # add evidence code with tool tip          # add evidence code with tool tip
2576          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
2577    
2578          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2579          my @ev_codes = ();          my @ev_codes = ();
2580          foreach my $code (@codes) {          foreach my $code (@codes) {
2581              my $pretty_code = $code->[2];              my $pretty_code = $code->[2];
# Line 2064  Line 2593 
2593                                  {                                  {
2594                                      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));
2595          }          }
2596          $column{$id}=$ev_codes;  
2597            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2598            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2599      }      }
2600      return (%column);      return $column;
2601  }  }
2602    
2603  sub get_pfam_column{  sub get_attrb_column{
2604      my ($ids, $attributes,$fig) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2605      #my $fig = new FIG;  
2606      my $cgi = new CGI;      my ($column, %code_attributes, %attribute_locations);
2607      my (%column, %code_attributes, %attribute_locations);      my $dbmaster = DBMaster->new(-database =>'Ontology',
2608      my $dbmaster = DBMaster->new(-database =>'Ontology');                                   -host     => $WebConfig::DBHOST,
2609                                     -user     => $WebConfig::DBUSER,
2610                                     -password => $WebConfig::DBPWD);
2611    
2612        if ($colName eq "pfam"){
2613            if (! defined $attributes) {
2614                my @attributes_array = $fig->get_attributes($ids);
2615                $attributes = \@attributes_array;
2616            }
2617    
2618      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2619      foreach my $key (@codes){      foreach my $key (@codes){
2620          my $name = $key->[1];          my $name = $key->[1];
2621          if ($name =~ /_/){          if ($name =~ /_/){
# Line 2087  Line 2626 
2626      }      }
2627    
2628      foreach my $id (@$ids){      foreach my $id (@$ids){
2629          # add evidence code              # add pfam code
2630          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2631          my @pfam_codes = "";          my @pfam_codes = "";
2632          my %description_codes;          my %description_codes;
# Line 2103  Line 2642 
2642    
2643              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2644                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2645                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2646    
2647                  # get the locations for the domain                  # get the locations for the domain
2648                  my @locs;                  my @locs;
# Line 2122  Line 2661 
2661                  }                  }
2662                  else {                  else {
2663                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2664                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2665                      push(@pfam_codes, "$pfam_link ($locations)");                      push(@pfam_codes, "$pfam_link ($locations)");
2666                  }                  }
2667              }              }
2668    
2669                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2670                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2671                }
2672            }
2673        }
2674        elsif ($colName eq 'cellular_location'){
2675            if (! defined $attributes) {
2676                my @attributes_array = $fig->get_attributes($ids);
2677                $attributes = \@attributes_array;
2678          }          }
2679    
2680          $column{$id}=join("<br><br>", @pfam_codes);          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2681            foreach my $key (@codes){
2682                my ($loc) = ($key->[1]) =~ /::(.*)/;
2683                my ($new_loc, @all);
2684                @all = split (//, $loc);
2685                my $count = 0;
2686                foreach my $i (@all){
2687                    if ( ($i eq uc($i)) && ($count > 0) ){
2688                        $new_loc .= " " . $i;
2689                    }
2690                    else{
2691                        $new_loc .= $i;
2692                    }
2693                    $count++;
2694                }
2695                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2696      }      }
     return (%column);  
2697    
2698            foreach my $id (@$ids){
2699                my (@values, $entry);
2700                #@values = (" ");
2701                if (defined @{$code_attributes{$id}}){
2702                    my @ncodes = @{$code_attributes{$id}};
2703                    foreach my $code (@ncodes){
2704                        push (@values, $code->[0] . ", " . $code->[1]);
2705                    }
2706                }
2707                else{
2708                    @values = ("Not available");
2709                }
2710    
2711                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2712                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2713            }
2714        }
2715        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2716                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2717            if (! defined $attributes) {
2718                my @attributes_array = $fig->get_attributes($ids);
2719                $attributes = \@attributes_array;
2720            }
2721    
2722            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2723            foreach my $key (@codes){
2724                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2725            }
2726    
2727            foreach my $id (@$ids){
2728                my (@values, $entry);
2729                #@values = (" ");
2730                if (defined @{$code_attributes{$id}}){
2731                    my @ncodes = @{$code_attributes{$id}};
2732                    foreach my $code (@ncodes){
2733                        push (@values, $code);
2734                    }
2735                }
2736                else{
2737                    @values = ("Not available");
2738                }
2739    
2740                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2741                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2742            }
2743        }
2744        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2745                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2746                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2747                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2748                ($colName eq 'gc_content') ) {
2749            if (! defined $attributes) {
2750                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2751                $attributes = \@attributes_array;
2752  }  }
2753    
2754  sub get_aliases {          my $genomes_with_phenotype;
2755      my ($ids,$fig) = @_;          foreach my $attribute (@$attributes){
2756                my $genome = $attribute->[0];
2757                $genomes_with_phenotype->{$genome} = $attribute->[2];
2758            }
2759    
2760            foreach my $id (@$ids){
2761                my $genome = $fig->genome_of($id);
2762                my @values = (' ');
2763                if (defined $genomes_with_phenotype->{$genome}){
2764                    push (@values, $genomes_with_phenotype->{$genome});
2765                }
2766                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2767                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2768            }
2769        }
2770    
2771        return $column;
2772    }
2773    
2774    
2775    sub get_db_aliases {
2776        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2777    
2778        my $db_array;
2779      my $all_aliases = $fig->feature_aliases_bulk($ids);      my $all_aliases = $fig->feature_aliases_bulk($ids);
2780      foreach my $id (@$ids){      foreach my $id (@$ids){
2781          foreach my $alias (@{$$all_aliases{$id}}){          foreach my $alias (@{$$all_aliases{$id}}){
2782              my $id_db = &Observation::get_database($alias);              my $id_db = &Observation::get_database($alias);
2783              next if ($aliases->{$id}->{$id_db});              next if ( ($id_db ne $db) && ($db ne 'all') );
2784                next if ($aliases->{$id}->{$db});
2785              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2786          }          }
2787            if (!defined( $aliases->{$id}->{$db})){
2788                $aliases->{$id}->{$db} = " ";
2789      }      }
2790      return ($aliases);          #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2791            push (@$db_array, $aliases->{$id}->{$db});
2792        }
2793    
2794        if ($returnType eq 'hash') { return $aliases; }
2795        elsif ($returnType eq 'array') { return $db_array; }
2796  }  }
2797    
2798    
2799    
2800  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; $_ }
2801    
2802  sub color {  sub color {
# Line 2185  Line 2834 
2834  sub display {  sub display {
2835      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2836    
2837        $taxes = $fig->taxonomy_list();
2838    
2839      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2840      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2841      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
# Line 2258  Line 2909 
2909                  #my $genome = $fig->genome_of($sim->[1]);                  #my $genome = $fig->genome_of($sim->[1]);
2910                  my $genome = $fig->genome_of($sim->acc);                  my $genome = $fig->genome_of($sim->acc);
2911                  #my ($genome1) = ($genome) =~ /(.*)\./;                  #my ($genome1) = ($genome) =~ /(.*)\./;
2912                  #my $lineage = $taxes->{$genome1};                  my $lineage = $taxes->{$genome};
2913                  my $lineage = $fig->taxonomy_of($fig->genome_of($genome));                  #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2914                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2915                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2916                          #push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
# Line 2341  Line 2992 
2992          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2993          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2994          #my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2995          #my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
2996          my $lineage = $fig->taxonomy_of($region_genome);          #my $lineage = $fig->taxonomy_of($region_genome);
2997          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2998          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2999                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2432  Line 3083 
3083                  $prev_stop = $stop;                  $prev_stop = $stop;
3084                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3085    
3086                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3087                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3088                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3089                  }                  }
# Line 2584  Line 3235 
3235      my $cgi = new CGI;      my $cgi = new CGI;
3236      my $count = 0;      my $count = 0;
3237      my $peg_array = [];      my $peg_array = [];
3238      my (%evidence_column, %subsystems_column,  %e_identical);      my ($evidence_column, $subsystems_column,  %e_identical);
3239    
3240      if (@$dataset != 1){      if (@$dataset != 1){
3241          foreach my $thing (@$dataset){          foreach my $thing (@$dataset){
# Line 2593  Line 3244 
3244              }              }
3245          }          }
3246          # get the column for the evidence codes          # get the column for the evidence codes
3247          %evidence_column = &Observation::Sims::get_evidence_column($peg_array);          $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3248    
3249          # get the column for the subsystems          # get the column for the subsystems
3250          %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);          $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3251    
3252          # get essentially identical seqs          # get essentially identical seqs
3253          %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);          %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
# Line 2613  Line 3264 
3264          $org = $fig->org_of($id);          $org = $fig->org_of($id);
3265          $function = $fig->function_of($id);          $function = $fig->function_of($id);
3266          if ($mypeg ne $id){          if ($mypeg ne $id){
3267              $function_cell = "<input type=\"radio\" name=\"function\" id=\"$id\" value=\"$function\" onClick=\"clearText('newAnnotation');\">&nbsp;&nbsp;$function";              $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3268              $id_cell .= &HTML::set_prot_links($cgi,$id);              $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3269              if (defined($e_identical{$id})) { $id_cell .= "*";}              if (defined($e_identical{$id})) { $id_cell .= "*";}
3270          }          }
3271          else{          else{
3272              $function_cell = "&nbsp;&nbsp;$function";              $function_cell = "&nbsp;&nbsp;$function";
3273              $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";              $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3274              $id_cell .= &HTML::set_prot_links($cgi,$id);              $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3275          }          }
3276    
3277          push(@$row_data,$id_cell);          push(@$row_data,$id_cell);
3278          push(@$row_data,$org);          push(@$row_data,$org);
3279          push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);          push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3280          push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);          push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3281          push(@$row_data, $fig->translation_length($id));          push(@$row_data, $fig->translation_length($id));
3282          push(@$row_data,$function_cell);          push(@$row_data,$function_cell);
3283          push(@$all_rows,$row_data);          push(@$all_rows,$row_data);
# Line 2672  Line 3323 
3323    
3324      return($content);      return($content);
3325  }  }
3326    

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.64

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3