[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.38, Mon Sep 10 15:10:04 2007 UTC revision 1.66, Mon Aug 18 20:25:42 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;
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 86  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 305  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 360  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head
378  This method returns the housekeeping data for a given peg in a table format      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  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
392    
393      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
394      my $org_id   = $fig->orgid_of_orgname($org_name);      my ($self,$fid,$fig,$parameters) = @_;
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
     my $function = $fig->function_of($fid);  
     my @aliases  = $fig->feature_aliases($fid);  
     my $taxonomy = $fig->taxonomy_of($org_id);  
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
395    
396      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
397      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
398    
399      if ( @subsystems ) {      # call function that fetches attribute based observations
400          $content .= qq(<tr><td>Subsystems</td><td>);      # returns an array of arrays of hashes
401          foreach my $subsystem ( @subsystems ) {      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
402              $content .= join(" -- ", @$subsystem) . "<br>\n";  
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;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
411          }          }
412    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
413    
414    =head3 display_housekeeping
415    This method returns the housekeeping data for a given peg in a table format
416    
417          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
418          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
419              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
420          }      my $content = [];
421          $content .= qq(</td></tr></table>\n);      my $row = [];
422    
423        my $org_name = "Data not available";
424        if ( $fig->org_of($fid)){
425            $org_name = $fig->org_of($fid);
426      }      }
427        my $org_id = $fig->genome_of($fid);
428        my $function = $fig->function_of($fid);
429        #my $taxonomy = $fig->taxonomy_of($org_id);
430        my $length = $fig->translation_length($fid);
431    
432        push (@$row, $org_name);
433        push (@$row, $fid);
434        push (@$row, $length);
435        push (@$row, $function);
436    
437        # initialize the table for commentary and annotations
438        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
439        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
440        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
441        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
442        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
443        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
444        #$content .= qq(</table><p>\n);
445    
446      $content .= qq(</table><p>\n);      push(@$content, $row);
447    
448      return ($content);      return ($content);
449  }  }
# Line 435  Line 454 
454  =cut  =cut
455    
456  sub get_sims_summary {  sub get_sims_summary {
457      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
458      my %families;      my %families;
459      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
460    
461        foreach my $thing (@$dataset) {
462            my ($id, $evalue);
463            if ($thing =~ /fig\|/){
464                $id = $thing;
465                $evalue = -1;
466            }
467            else{
468                next if ($thing->class ne "SIM");
469                $id      = $thing->acc;
470                $evalue  = $thing->evalue;
471            }
472            next if ($id !~ /fig\|/);
473            next if ($fig->is_deleted_fid($id));
474    
475      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
476          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
477          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
478          my $parent_tax = "Root";          my $parent_tax = "Root";
479          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
480            push (@{$families{figs}{$parent_tax}}, $id);
481            my $level = 2;
482          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
483              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
484                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
485                $families{level}{$tax} = $level;
486              push (@currLineage, $tax);              push (@currLineage, $tax);
487              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
488              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
489                if (defined ($families{evalue}{$tax})){
490                    if ($evalue < $families{evalue}{$tax}){
491                        $families{evalue}{$tax} = $evalue;
492                        $families{color}{$tax} = &get_taxcolor($evalue);
493                    }
494                }
495                else{
496                    $families{evalue}{$tax} = $evalue;
497                    $families{color}{$tax} = &get_taxcolor($evalue);
498                }
499    
500              $parent_tax = $tax;              $parent_tax = $tax;
501                $level++;
502          }          }
503      }      }
504    
# Line 462  Line 509 
509          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
510          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
511      }      }
512      return (\%families);  
513        return \%families;
514  }  }
515    
516  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 521 
521    
522  =cut  =cut
523    
524  sub get_attribute_based_domain_observations{  sub get_taxcolor{
525        my ($evalue) = @_;
526        my $color;
527        if ($evalue == -1){            $color = "black";      }
528        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
529        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
530        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
531        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
532        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
533        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
534        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
535        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
536        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
537        else{        $color = "#6666FF";    }
538        return ($color);
539    }
540    
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);  
541    
542      my $fig = new FIG;  sub get_attribute_based_domain_observations{
543    
544        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
545        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
546        my $seen = {};
547      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
548          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
549          my @parts = split("::",$key);          my @parts = split("::",$key);
550          my $class = $parts[0];          my $class = $parts[0];
551            my $name = $parts[1];
552            next if ($seen->{$name});
553            $seen->{$name}++;
554            #next if (($class eq "PFAM") && ($name !~ /interpro/));
555    
556          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
557              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 560 
560                  my $from = $2;                  my $from = $2;
561                  my $to = $3;                  my $to = $3;
562                  my $evalue;                  my $evalue;
563                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
564                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
565                      my $part1 = $2/100;                      my $part1 = $2/100;
566                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
567                  }                  }
568                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
569                        $evalue=$raw_evalue;
570                    }
571                  else{                  else{
572                      $evalue = "0.0";                      $evalue = "0.0";
573                  }                  }
# Line 520  Line 590 
590    
591  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
592    
593      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
594      my $fig = new FIG;      #my $fig = new FIG;
595    
596      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
597    
# Line 531  Line 601 
601                     };                     };
602    
603      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
604          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
605          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
606          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 612 
612                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
613                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
614                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
615              }              }
616              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
617                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 650 
650  =cut  =cut
651    
652  sub get_pdb_observations{  sub get_pdb_observations{
653      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
654    
655      my $fig = new FIG;      #my $fig = new FIG;
656    
657      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
658          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
659          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
660          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 642  Line 708 
708  =cut  =cut
709    
710  sub get_sims_observations{  sub get_sims_observations{
711        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
712    
713      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter, $sim_filters);
714      my $fig = new FIG;      if ($parameters->{flag}){
715      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
716      my ($dataset);        $max_expand = $parameters->{max_expand};
717          $max_eval = $parameters->{max_eval};
718      my %id_list;        $db_filter = $parameters->{db_filter};
719      foreach my $sim (@sims){        $sim_filters->{ sort_by } = $parameters->{sim_order};
720          my $hit = $sim->[1];        #$sim_order = $parameters->{sim_order};
721          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
722          }          }
723        else{
724          $max_sims = 50;
725          $max_expand = 5;
726          $max_eval = 1e-5;
727          $db_filter = "figx";
728          $sim_filters->{ sort_by } = 'id';
729          #$sim_order = "id";
730      }      }
731    
732      my %already;      my($id, $genome, @genomes, %sims);
733      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
734      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
735          my $hit = $sim->[1];      my ($dataset);
736          my ($id) = ($hit) =~ /\|(.*)/;  
737          next if (defined($already{$id}));      if ($group_by_genome){
738          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
739          push (@new_sims, $sim);        foreach $sim ( @tmp ){
740          $already{$id} = 1;          $id = $sim->id2;
741            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
742            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
743            push @{ $sims{ $genome } }, $sim;
744          }
745          @tmp = map { @{ $sims{$_} } } @genomes;
746      }      }
747    
748      foreach my $sim (@new_sims){      my $seen_sims={};
749        foreach my $sim (@tmp){
750          my $hit = $sim->[1];          my $hit = $sim->[1];
751            next if ($seen_sims->{$hit});
752            $seen_sims->{$hit}++;
753          my $percent = $sim->[2];          my $percent = $sim->[2];
754          my $evalue = $sim->[10];          my $evalue = $sim->[10];
755          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 682  Line 760 
760          my $hlength = $sim->[13];          my $hlength = $sim->[13];
761          my $db = get_database($hit);          my $db = get_database($hit);
762          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
763          my $organism = $fig->org_of($hit);          my $organism;
764            if ($fig->org_of($hit)){
765                $organism = $fig->org_of($hit);
766            }
767            else{
768                $organism = "Data not available";
769            }
770    
771          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
772                        'query' => $sim->[0],
773                      'acc' => $hit,                      'acc' => $hit,
774                      'identity' => $percent,                      'identity' => $percent,
775                      'type' => 'seq',                      'type' => 'seq',
# Line 714  Line 799 
799      my ($id) = (@_);      my ($id) = (@_);
800    
801      my ($db);      my ($db);
802      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
803      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
804        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
805      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
806        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
807      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
808      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
809      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 725  Line 812 
812      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
813      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
814      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
815        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
816        elsif ($id =~ /^img\|/)           { $db = "IMG" }
817        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
818        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
819    
820      return ($db);      return ($db);
821    
# Line 739  Line 830 
830    
831  sub get_identical_proteins{  sub get_identical_proteins{
832    
833      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
834      my $fig = new FIG;      #my $fig = new FIG;
835      my $funcs_ref;      my $funcs_ref;
836    
 #    my %id_list;  
837      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);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
838      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
839          my ($tmp, $who);          my ($tmp, $who);
840          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
841              $who = &get_database($id);              $who = &get_database($id);
842              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
843          }          }
844      }      }
845    
     my ($dataset);  
846      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
847                     'type' => 'seq',                     'type' => 'seq',
848                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 862 
862    
863  sub get_functional_coupling{  sub get_functional_coupling{
864    
865      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
866      my $fig = new FIG;      #my $fig = new FIG;
867      my @funcs = ();      my @funcs = ();
868    
869      # initialize some variables      # initialize some variables
# Line 797  Line 880 
880                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
881                    } @fc_data;                    } @fc_data;
882    
     my ($dataset);  
883      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
884                     'type' => 'fc',                     'type' => 'fc',
885                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 990 
990      return $self->{database};      return $self->{database};
991  }  }
992    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
993  ############################################################  ############################################################
994  ############################################################  ############################################################
995  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 1015 
1015  =cut  =cut
1016    
1017  sub display{  sub display{
1018      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1019    
1020      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1021      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1022                                    -host     => $WebConfig::DBHOST,
1023                                    -user     => $WebConfig::DBUSER,
1024                                    -password => $WebConfig::DBPWD);
1025    
1026      my $acc = $self->acc;      my $acc = $self->acc;
1027    
# Line 963  Line 1042 
1042      my $lines = [];      my $lines = [];
1043      my $line_data = [];      my $line_data = [];
1044      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1045                            'hover_title' => 'PDB',
1046                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1047                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1048    
1049      my $fig = new FIG;      #my $fig = new FIG;
1050      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1051      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1052    
# Line 1067  Line 1147 
1147    
1148    
1149  sub display_table{  sub display_table{
1150      my ($self) = @_;      my ($self,$fig) = @_;
1151    
1152      my $fig = new FIG;      #my $fig = new FIG;
1153      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1154      my $rows = $self->rows;      my $rows = $self->rows;
1155      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1080  Line 1160 
1160          my $id = $row->[0];          my $id = $row->[0];
1161          my $who = $row->[1];          my $who = $row->[1];
1162          my $assignment = $row->[2];          my $assignment = $row->[2];
1163          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1164            if ($fig->org_of($id)){
1165                $organism = $fig->org_of($id);
1166            }
1167          my $single_domain = [];          my $single_domain = [];
1168          push(@$single_domain,$who);          push(@$single_domain,$who);
1169          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1170          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1171          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1172          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1131  Line 1214 
1214    
1215  sub display_table {  sub display_table {
1216    
1217      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1218      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1219      my $rows = $self->rows;      my $rows = $self->rows;
1220      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1229 
1229          # construct the score link          # construct the score link
1230          my $score = $row->[0];          my $score = $row->[0];
1231          my $toid = $row->[1];          my $toid = $row->[1];
1232          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1233          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1234    
1235          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1236          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1283 
1283      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1284      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1285    
1286      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1287                                    -host     => $WebConfig::DBHOST,
1288                                    -user     => $WebConfig::DBUSER,
1289                                    -password => $WebConfig::DBPWD);
1290    
1291      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1292      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1305 
1305              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1306          }          }
1307      }      }
1308        elsif($db =~ /PFAM/){
1309            my ($new_id) = ($id) =~ /(.*?)_/;
1310            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1311            if(!scalar(@$pfam_objs)){
1312                $name_title = "name";
1313                $name_value = "not available";
1314                $description_title = "description";
1315                $description_value = "not available";
1316            }
1317            else{
1318                my $pfam_obj = $pfam_objs->[0];
1319                $name_title = "name";
1320                $name_value = $pfam_obj->term;
1321                #$description_title = "description";
1322                #$description_value = $pfam_obj->description;
1323            }
1324        }
1325    
1326      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1327                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1328        my $new_short_title=$short_title;
1329        if ($short_title =~ /interpro/){
1330            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1331        }
1332        my $line_config = { 'title' => $name_value,
1333                            'hover_title', => 'Domain',
1334                            'short_title' => $new_short_title,
1335                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1336    
1337      my $name;      my $name;
1338      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1339               "value" => $name_value};      $name = {"title" => $db,
1340                 "value" => $new_id};
1341      push(@$descriptions,$name);      push(@$descriptions,$name);
1342    
1343      my $description;  #    my $description;
1344      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1345                               "value" => $description_value};  #                   "value" => $description_value};
1346      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1347    
1348      my $score;      my $score;
1349      $score = {"title" => "score",      $score = {"title" => "score",
1350                "value" => $thing->evalue};                "value" => $thing->evalue};
1351      push(@$descriptions,$score);      push(@$descriptions,$score);
1352    
1353        my $location;
1354        $location = {"title" => "location",
1355                     "value" => $thing->start . " - " . $thing->stop};
1356        push(@$descriptions,$location);
1357    
1358      my $link_id;      my $link_id;
1359      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1360          $link_id = $1;          $link_id = $1;
1361      }      }
1362    
1363      my $link;      my $link;
1364      my $link_url;      my $link_url;
1365      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"}
1366      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"}
1367      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1368    
1369      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1371 
1371      push(@$links_list,$link);      push(@$links_list,$link);
1372    
1373      my $element_hash = {      my $element_hash = {
1374          "title" => $thing->type,          "title" => $name_value,
1375          "start" => $thing->start,          "start" => $thing->start,
1376          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1377          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1401 
1401          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1402          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1403    
1404          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1405                                    -host     => $WebConfig::DBHOST,
1406                                    -user     => $WebConfig::DBUSER,
1407                                    -password => $WebConfig::DBPWD);
1408    
1409          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1410          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1423 
1423                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1424              }              }
1425          }          }
1426            elsif($db =~ /PFAM/){
1427                my ($new_id) = ($id) =~ /(.*?)_/;
1428                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1429                if(!scalar(@$pfam_objs)){
1430                    $name_title = "name";
1431                    $name_value = "not available";
1432                    $description_title = "description";
1433                    $description_value = "not available";
1434                }
1435                else{
1436                    my $pfam_obj = $pfam_objs->[0];
1437                    $name_title = "name";
1438                    $name_value = $pfam_obj->term;
1439                    #$description_title = "description";
1440                    #$description_value = $pfam_obj->description;
1441                }
1442            }
1443    
1444          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1445    
# Line 1356  Line 1492 
1492      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1493      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1494      if($cello_location){      if($cello_location){
1495          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1496          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1497      }      }
1498      return ($html);      return ($html);
1499  }  }
1500    
1501  sub display {  sub display {
1502      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1503    
1504      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1505      my $fig= new FIG;      #my $fig= new FIG;
1506      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1507    
1508      my $cleavage_prob;      my $cleavage_prob;
# Line 1386  Line 1522 
1522      #color is      #color is
1523      my $color = "6";      my $color = "6";
1524    
1525  =pod=  =head3
1526    
1527      if($cello_location){      if($cello_location){
1528          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1394  Line 1530 
1530    
1531          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1532                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1533                                'hover_title' => 'Localization',
1534                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1535    
1536          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1555 
1555          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1556      }      }
1557    
 =cut  
   
1558      $color = "2";      $color = "2";
1559      if($tmpred_score){      if($tmpred_score){
1560          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1584 
1584          }          }
1585          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1586      }      }
1587    =cut
1588    
1589      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1590          my $line_data =[];          my $line_data =[];
1591          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1592                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1593                                'hover_title' => 'Localization',
1594                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1595    
1596          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1597              my $descriptions = [];              my $descriptions = [];
1598              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1599                               "value" => $tm_loc};                               "value" => $tm_loc};
1600              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1601    
1602              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1603    
1604              my $element_hash = {              my $element_hash = {
1605              "title" => "phobius transmembrane location",              "title" => "Phobius",
1606              "start" => $begin + 1,              "start" => $begin + 1,
1607              "end" =>  $end + 1,              "end" =>  $end + 1,
1608              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1636 
1636          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1637      }      }
1638    
1639    =head3
1640      $color = "1";      $color = "1";
1641      if($signal_peptide_score){      if($signal_peptide_score){
1642          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1644 
1644    
1645          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1646                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1647                                'hover_title' => 'Localization',
1648                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1649    
1650          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1669 
1669          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1670          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1671      }      }
1672    =cut
1673    
1674      return ($gd);      return ($gd);
1675    
# Line 1602  Line 1741 
1741      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1742      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1743      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1744        $self->{query} = $dataset->{'query'};
1745      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1746      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1747      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1765 
1765  =cut  =cut
1766    
1767  sub display {  sub display {
1768      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1769    
1770      my $fig = new FIG;      # declare variables
1771      my $peg = $self->acc;      my $window_size = $gd->window_size;
1772        my $peg = $thing->acc;
1773      my $organism = $self->organism;      my $query_id = $thing->query;
1774        my $organism = $thing->organism;
1775        my $abbrev_name = $fig->abbrev($organism);
1776        if (!$organism){
1777          $organism = $peg;
1778          $abbrev_name = $peg;
1779        }
1780      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1781      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1782      my $function = $self->function;      my $function = $thing->function;
1783      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1784      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1785      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1786      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1787      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1788        my $ln_hit = $thing->hlength;
1789    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1790    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1791        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1792        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1793    
1794      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;
1795    
1796        # hit sequence title
1797      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1798                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1799                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1800                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1801                            'no_middle_line' => '1'
1802                          };                          };
1803    
1804        # query sequence title
1805        my $replace_id = $peg;
1806        $replace_id =~ s/\|/_/ig;
1807        my $anchor_name = "anchor_". $replace_id;
1808        my $query_config = { 'title' => "Query",
1809                             'short_title' => "Query",
1810                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1811                             'basepair_offset' => '0',
1812                             'no_middle_line' => '1'
1813                             };
1814      my $line_data = [];      my $line_data = [];
1815        my $query_data = [];
1816    
1817      my $element_hash;      my $element_hash;
1818      my $links_list = [];      my $hit_links_list = [];
1819      my $descriptions = [];      my $hit_descriptions = [];
1820        my $query_descriptions = [];
1821      # get subsystem information  
1822      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1823        # evidence link
1824      my $link;      my $evidence_link;
1825      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1826               "link" => $url_link};        $evidence_link = "?page=Annotation&feature=".$peg;
1827      push(@$links_list,$link);      }
1828        else{
1829          my $db = &Observation::get_database($peg);
1830          my ($link_id) = ($peg) =~ /\|(.*)/;
1831          $evidence_link = &HTML::alias_url($link_id, $db);
1832          #print STDERR "LINK: $db    $evidence_link";
1833        }
1834        my $link = {"link_title" => $peg,
1835                    "link" => $evidence_link};
1836        push(@$hit_links_list,$link) if ($evidence_link);
1837    
1838      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1839      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1840          my $link;      my @subsystems;
1841          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1842            my $subsystem = $$array[0];
1843            push(@subsystems,$subsystem);
1844            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1845                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1846          push(@$links_list,$link);          push(@$hit_links_list,$link);
1847      }      }
1848    
1849        # blast alignment
1850        $link = {"link_title" => "view blast alignment",
1851                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1852        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1853    
1854        # description data
1855      my $description_function;      my $description_function;
1856      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1857                               "value" => $function};                               "value" => $function};
1858      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1859    
1860      my ($description_ss, $ss_string);      # subsystem description
1861      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1862      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1863        my $description_ss = {"title" => "subsystems",
1864                         "value" => $ss_string};                         "value" => $ss_string};
1865      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1866    
1867        # location description
1868        # hit
1869      my $description_loc;      my $description_loc;
1870      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1871                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1872      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1873    
1874      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1875                          "value" => $hit_stop};                          "value" => $ln_hit};
1876      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1877    
1878        # query
1879        $description_loc = {"title" => "Hit Location",
1880                            "value" => $query_start . " - " . $query_stop};
1881        push(@$query_descriptions, $description_loc);
1882    
1883        $description_loc = {"title" => "Sequence Length",
1884                            "value" => $ln_query};
1885        push(@$query_descriptions, $description_loc);
1886    
1887    
1888    
1889      my $evalue = $self->evalue;      # evalue score description
1890        my $evalue = $thing->evalue;
1891      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1892      {      {
1893          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1699  Line 1896 
1896      }      }
1897    
1898      my $color = &color($evalue);      my $color = &color($evalue);
   
1899      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1900                              "value" => $evalue};                              "value" => $evalue};
1901      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1902        push(@$query_descriptions, $description_eval);
1903    
1904      my $identity = $self->identity;      my $identity = $self->identity;
1905      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1906                                  "value" => $identity};                                  "value" => $identity};
1907      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1908        push(@$query_descriptions, $description_identity);
1909    
1910    
1911        my $number = $base_start + ($query_start-$hit_start);
1912        #print STDERR "START: $number";
1913        $element_hash = {
1914            "title" => $query_id,
1915            "start" => $base_start,
1916            "end" => $base_start+$ln_query,
1917            "type"=> 'box',
1918            "color"=> $color,
1919            "zlayer" => "2",
1920            "links_list" => $query_links_list,
1921            "description" => $query_descriptions
1922            };
1923        push(@$query_data,$element_hash);
1924    
1925        $element_hash = {
1926            "title" => $query_id . ': HIT AREA',
1927            "start" => $base_start + $query_start,
1928            "end" =>  $base_start + $query_stop,
1929            "type"=> 'smallbox',
1930            "color"=> $query_color,
1931            "zlayer" => "3",
1932            "links_list" => $query_links_list,
1933            "description" => $query_descriptions
1934            };
1935        push(@$query_data,$element_hash);
1936    
1937        $gd->add_line($query_data, $query_config);
1938    
1939    
1940      $element_hash = {      $element_hash = {
1941          "title" => $peg,          "title" => $peg,
1942          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1943          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1944          "type"=> 'box',          "type"=> 'box',
1945          "color"=> $color,          "color"=> $color,
1946          "zlayer" => "2",          "zlayer" => "2",
1947          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1948          "description" => $descriptions                  "description" => $hit_descriptions
1949          };          };
1950      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1951    
1952        $element_hash = {
1953            "title" => $peg . ': HIT AREA',
1954            "start" => $base_start + $query_start,
1955            "end" =>  $base_start + $query_stop,
1956            "type"=> 'smallbox',
1957            "color"=> $hit_color,
1958            "zlayer" => "3",
1959            "links_list" => $hit_links_list,
1960            "description" => $hit_descriptions
1961            };
1962        push(@$line_data,$element_hash);
1963    
1964      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1965    
1966      return ($gd);      my $breaker = [];
1967        my $breaker_hash = {};
1968        my $breaker_config = { 'no_middle_line' => "1" };
1969    
1970        push (@$breaker, $breaker_hash);
1971        $gd->add_line($breaker, $breaker_config);
1972    
1973        return ($gd);
1974  }  }
1975    
1976  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1980 
1980  =cut  =cut
1981    
1982  sub display_domain_composition {  sub display_domain_composition {
1983      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1984    
1985      my $fig = new FIG;      #$fig = new FIG;
1986      my $peg = $self->acc;      my $peg = $self->acc;
1987    
1988      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1990 
1990      my $descriptions = [];      my $descriptions = [];
1991    
1992      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1993        #my @domain_query_results = ();
1994      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1995          my $key = @$dqr[1];          my $key = @$dqr[1];
1996          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 2015 
2015              }              }
2016          }          }
2017    
2018          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2019                                    -host     => $WebConfig::DBHOST,
2020                                    -user     => $WebConfig::DBUSER,
2021                                    -password => $WebConfig::DBPWD);
2022          my ($name_value,$description_value);          my ($name_value,$description_value);
2023    
2024          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 2055 
2055          my $link;          my $link;
2056          my $link_url;          my $link_url;
2057          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"}
2058          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"}
2059          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2060    
2061          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 2079 
2079      }      }
2080    
2081      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2082                            'hover_title' => 'Domain',
2083                          'short_title' => $peg,                          'short_title' => $peg,
2084                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2085    
# Line 1848  Line 2099 
2099  =cut  =cut
2100    
2101  sub display_table {  sub display_table {
2102      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2103        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2104    
2105      my $data = [];      my $scroll_list;
2106      my $count = 0;      foreach my $col (@$show_columns){
2107      my $content;          push (@$scroll_list, $col->{key});
2108      my $fig = new FIG;      }
2109      my $cgi = new CGI;  
2110      my @ids;      push (@ids, $query_fid);
2111      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2112          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2113          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2114      }      }
2115    
2116      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2117        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2118    
2119      # get the column for the subsystems      # get the column for the subsystems
2120      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2121    
2122      # get the column for the evidence codes      # get the column for the evidence codes
2123      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2124    
2125      # get the column for pfam_domain      # get the column for pfam_domain
2126      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2127    
2128      my %e_identical = &get_essentially_identical($query_fid);      # get the column for molecular weight
2129      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2130    
2131      foreach my $thing (@$dataset) {      # get the column for organism's habitat
2132        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2133    
2134        # get the column for organism's temperature optimum
2135        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2136    
2137        # get the column for organism's temperature range
2138        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2139    
2140        # get the column for organism's oxygen requirement
2141        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2142    
2143        # get the column for organism's pathogenicity
2144        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2145    
2146        # get the column for organism's pathogenicity host
2147        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2148    
2149        # get the column for organism's salinity
2150        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2151    
2152        # get the column for organism's motility
2153        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2154    
2155        # get the column for organism's gram stain
2156        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2157    
2158        # get the column for organism's endospores
2159        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2160    
2161        # get the column for organism's shape
2162        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2163    
2164        # get the column for organism's disease
2165        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2166    
2167        # get the column for organism's disease
2168        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2169    
2170        # get the column for transmembrane domains
2171        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2172    
2173        # get the column for similar to human
2174        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);
2175    
2176        # get the column for signal peptide
2177        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2178    
2179        # get the column for transmembrane domains
2180        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2181    
2182        # get the column for conserved neighborhood
2183        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2184    
2185        # get the column for cellular location
2186        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2187    
2188        # get the aliases
2189        my $alias_col;
2190        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2191             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2192             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2193             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2194             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2195            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2196        }
2197    
2198        # get the colors for the function cell
2199        my $functions = $fig->function_of_bulk(\@ids,1);
2200        $functional_color = &get_function_color_cell($functions, $fig);
2201        my $query_function = $fig->function_of($query_fid);
2202    
2203        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2204    
2205        my $figfam_data = &FIG::get_figfams_data();
2206        my $figfams = new FFs($figfam_data);
2207        my $same_genome_flag = 0;
2208    
2209        my $func_color_offset=0;
2210        unshift(@$dataset, $query_fid);
2211        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2212    #    foreach my $thing ( @$dataset){
2213            my $thing = $dataset->[$thing_count];
2214            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2215            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2216            if ($thing eq $query_fid){
2217                $id = $thing;
2218                $taxid   = $fig->genome_of($id);
2219                $organism = $fig->genus_species($taxid);
2220                $current_function = $fig->function_of($id);
2221            }
2222            else{
2223          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2224    
2225                $id      = $thing->acc;
2226                $evalue  = $thing->evalue;
2227                $taxid   = $fig->genome_of($id);
2228                $iden    = $thing->identity;
2229                $organism= $thing->organism;
2230                $ln1     = $thing->qlength;
2231                $ln2     = $thing->hlength;
2232                $b1      = $thing->qstart;
2233                $e1      = $thing->qstop;
2234                $b2      = $thing->hstart;
2235                $e2      = $thing->hstop;
2236                $d1      = abs($e1 - $b1) + 1;
2237                $d2      = abs($e2 - $b2) + 1;
2238                $color1  = match_color( $b1, $e1, $ln1 );
2239                $color2  = match_color( $b2, $e2, $ln2 );
2240                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2241                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2242                $current_function = $thing->function;
2243                $next_org = $next_thing->organism if (defined $next_thing);
2244            }
2245    
2246          my $single_domain = [];          my $single_domain = [];
2247          $count++;          $count++;
2248    
2249          my $id = $thing->acc;          # organisms cell
2250            my ($org, $org_color) = $fig->org_and_color_of($id);
2251    
2252          my $iden    = $thing->identity;          my $org_cell;
2253          my $ln1     = $thing->qlength;          if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2254          my $ln2     = $thing->hlength;              $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2255          my $b1      = $thing->qstart;          }
2256          my $e1      = $thing->qstop;          elsif ($next_org eq $organism){
2257          my $b2      = $thing->hstart;              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2258          my $e2      = $thing->hstop;              $same_genome_flag = 1;
2259          my $d1      = abs($e1 - $b1) + 1;          }
2260          my $d2      = abs($e2 - $b2) + 1;          elsif ($same_genome_flag == 1){
2261          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2262          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";              $same_genome_flag = 0;
2263            }
2264    
2265          # checkbox column          # checkbox cell
2266            my ($box_cell,$tax, $radio_cell);
2267          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2268          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2269          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;
2270            my $replace_id = $id;
2271            $replace_id =~ s/\|/_/ig;
2272            my $white = '#ffffff';
2273            $white = '#999966' if ($id eq $query_fid);
2274            $org_color = '#999966' if ($id eq $query_fid);
2275            my $anchor_name = "anchor_". $replace_id;
2276            my $checked = "";
2277            #$checked = "checked" if ($id eq $query_fid);
2278            if ($id =~ /^fig\|/){
2279              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>~;
2280              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" onClick="clearText('new_text_function')">);
2281              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2282              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2283              $tax = $fig->genome_of($id);
2284            }
2285            else{
2286              my $box = qq(<a name="$anchor_name"></a>);
2287              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2288            }
2289    
2290          # get the linked fig id          # get the linked fig id
2291          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2292          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2293              $fig_col = &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>);
2294          }          my $fig_col = {'data'=> $fig_data,
2295          else{                         'highlight'=>$white};
2296              $fig_col = &HTML::set_prot_links($cgi,$id);  
2297          }          $replace_id = $peg;
2298            $replace_id =~ s/\|/_/ig;
2299          push(@$single_domain,$box_col);                        # permanent column          $anchor_name = "anchor_". $replace_id;
2300          push(@$single_domain,$fig_col);                        # permanent column          my $query_config = { 'title' => "Query",
2301          push(@$single_domain,$thing->evalue);                  # permanent column                               'short_title' => "Query",
2302          push(@$single_domain,"$iden\%");                       # permanent column                               'title_link' => "changeSimsLocation('$replace_id')",
2303          push(@$single_domain,$reg1);                           # permanent column                               'basepair_offset' => '0'
2304          push(@$single_domain,$reg2);                           # permanent column                               };
2305          push(@$single_domain,$thing->organism);                # permanent column  
2306          push(@$single_domain,$thing->function);                # permanent column          # function cell
2307          foreach my $col (sort keys %$scroll_list){          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2308              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2309              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2310              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2311              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}          my $function_color;
2312              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}          if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2313              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2314              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2315              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2316              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2317              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2318              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2319              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2320              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            if ($current_function eq $query_function){
2321                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2322                $func_color_offset=1;
2323              }
2324              else{
2325                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2326              }
2327            }
2328            else{
2329              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2330            }
2331    
2332            if ($id eq $query_fid){
2333                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2334                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2335                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2336            }
2337            else{
2338                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2339                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2340            }
2341    
2342            if ( ( $application->session->user) ){
2343                my $user = $application->session->user;
2344                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2345                    push (@$single_domain,$radio_cell);
2346          }          }
         push(@$data,$single_domain);  
2347      }      }
2348    
2349            my ($ff) = $figfams->families_containing_peg($id);
2350    
2351            foreach my $col (@$scroll_list){
2352                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2353                else { $highlight_color = "#ffffff"; }
2354    
2355                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2356                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2357                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2358                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2359                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2360                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2361                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2362                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2363                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2364                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2389            }
2390            push(@$data,$single_domain);
2391        }
2392      if ($count >0 ){      if ($count >0 ){
2393          $content = $data;          $content = $data;
2394      }      }
2395      else{      else{
2396          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2397      }      }
2398        shift(@$dataset);
2399      return ($content);      return ($content);
2400  }  }
2401    
# Line 1949  Line 2405 
2405      foreach my $id (@$ids){      foreach my $id (@$ids){
2406          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2407          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2408          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2409            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2410      }      }
2411      return (%column);      return (%column);
2412  }  }
2413    
2414    sub get_figfam_column{
2415        my ($ids, $fig, $cgi) = @_;
2416        my $column;
2417    
2418        my $figfam_data = &FIG::get_figfams_data();
2419        my $figfams = new FFs($figfam_data);
2420    
2421        foreach my $id (@$ids){
2422            my ($ff) =  $figfams->families_containing_peg($id);
2423            if ($ff){
2424                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2425            }
2426            else{
2427                push (@$column, " ");
2428            }
2429        }
2430    
2431        return $column;
2432    }
2433    
2434  sub get_subsystems_column{  sub get_subsystems_column{
2435      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2436    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2437      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2438      my %column;      my ($column, $ss);
2439      foreach my $id (@$ids){      foreach my $id (@$ids){
2440          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2441          my @subsystems;          my @subsystems;
2442    
2443          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2444              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2445                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2446                  $count++;                  $ss =~ s/_/ /ig;
2447                    push (@subsystems, "-" . $ss);
2448              }              }
2449              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2450              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2451          } else {          } else {
2452              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2453          }          }
2454            push (@$column, $ss->{$id});
2455        }
2456    
2457        if ($returnType eq 'hash') { return $ss; }
2458        elsif ($returnType eq 'array') { return $column; }
2459    }
2460    
2461    sub get_lineage_column{
2462        my ($ids, $fig, $cgi) = @_;
2463    
2464        my $lineages = $fig->taxonomy_list();
2465    
2466        foreach my $id (@$ids){
2467            my $genome = $fig->genome_of($id);
2468            if ($lineages->{$genome}){
2469    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2470                push (@$column, $lineages->{$genome});
2471            }
2472            else{
2473                push (@$column, " ");
2474      }      }
2475      return (%column);      }
2476        return $column;
2477    }
2478    
2479    sub match_color {
2480        my ( $b, $e, $n , $rgb) = @_;
2481        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2482        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2483        my $cov = ( $r - $l + 1 ) / $n;
2484        my $sat = 1 - 10 * $cov / 9;
2485        my $br  = 1;
2486        if ($rgb){
2487            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2488        }
2489        else{
2490            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2491        }
2492    }
2493    
2494    sub hsb2rgb {
2495        my ( $h, $s, $br ) = @_;
2496        $h = 6 * ($h - floor($h));
2497        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2498        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2499        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2500                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2501                                          :               ( 0,      1,      $h - 2 )
2502                                          )
2503                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2504                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2505                                          :               ( 1,      0,      6 - $h )
2506                                          );
2507        ( ( $r * $s + 1 - $s ) * $br,
2508          ( $g * $s + 1 - $s ) * $br,
2509          ( $b * $s + 1 - $s ) * $br
2510        )
2511    }
2512    
2513    sub html2rgb {
2514        my ($hex) = @_;
2515        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2516        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2517                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2518    
2519        my @R = split(//, $r);
2520        my @G = split(//, $g);
2521        my @B = split(//, $b);
2522    
2523        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2524        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2525        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2526    
2527        my $rgb = [$red, $green, $blue];
2528        return $rgb;
2529    
2530    }
2531    
2532    sub rgb2html {
2533        my ( $r, $g, $b ) = @_;
2534        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2535        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2536        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2537        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2538    }
2539    
2540    sub floor {
2541        my $x = $_[0];
2542        defined( $x ) || return undef;
2543        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2544    }
2545    
2546    sub get_function_color_cell{
2547      my ($functions, $fig) = @_;
2548    
2549      # figure out the quantity of each function
2550      my %hash;
2551      foreach my $key (keys %$functions){
2552        my $func = $functions->{$key};
2553        $hash{$func}++;
2554      }
2555    
2556      my %func_colors;
2557      my $count = 1;
2558      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2559        $func_colors{$key}=$count;
2560        $count++;
2561      }
2562    
2563      return \%func_colors;
2564  }  }
2565    
2566  sub get_essentially_identical{  sub get_essentially_identical{
2567      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2568      my $fig = new FIG;      #my $fig = new FIG;
2569    
2570      my %id_list;      my %id_list;
2571      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);
2572    
2573      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2574            if($thing->class eq "IDENTICAL"){
2575                my $rows = $thing->rows;
2576                my $count_identical = 0;
2577                foreach my $row (@$rows) {
2578                    my $id = $row->[0];
2579          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2580              $id_list{$id} = 1;              $id_list{$id} = 1;
2581          }          }
2582      }      }
2583            }
2584        }
2585    
2586    #    foreach my $id (@maps_to) {
2587    #        if (($id ne $fid) && ($fig->function_of($id))) {
2588    #           $id_list{$id} = 1;
2589    #        }
2590    #    }
2591      return(%id_list);      return(%id_list);
2592  }  }
2593    
2594    
2595  sub get_evidence_column{  sub get_evidence_column{
2596      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2597      my $fig = new FIG;      my ($column, $code_attributes);
2598      my $cgi = new CGI;  
2599      my (%column, %code_attributes);      if (! defined $attributes) {
2600            my @attributes_array = $fig->get_attributes($ids);
2601            $attributes = \@attributes_array;
2602        }
2603    
2604      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2605      foreach my $key (@codes){      foreach my $key (@codes){
2606          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2607      }      }
2608    
2609      foreach my $id (@$ids){      foreach my $id (@$ids){
2610          # add evidence code with tool tip          # add evidence code with tool tip
2611          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2612    
2613          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2614              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2615              foreach my $code (@codes) {              foreach my $code (@codes) {
2616                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2617                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
2618                      my ($cd, $ss) = split(";", $code->[2]);                      my ($cd, $ss) = split(";", $code->[2]);
2619                    print STDERR "$id: $cd, $ss\n";
2620                    if ($cd =~ /ilit|dlit/){
2621                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2622                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2623                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2624                    }
2625                      $ss =~ s/_/ /g;                      $ss =~ s/_/ /g;
2626                      $pretty_code = $cd;# . " in " . $ss;                      $pretty_code = $cd;# . " in " . $ss;
2627                  }                  }
2628                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2629              }              }
         }  
2630    
2631          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2632              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2033  Line 2634 
2634                                  {                                  {
2635                                      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));
2636          }          }
2637          $column{$id}=$ev_codes;  
2638            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2639            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2640      }      }
2641      return (%column);      return $column;
2642  }  }
2643    
2644  sub get_pfam_column{  sub get_attrb_column{
2645      my ($ids) = @_;      my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
     my (%column, %code_attributes);  
     my $dbmaster = DBMaster->new(-database =>'Ontology');  
2646    
2647      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2648        my $dbmaster = DBMaster->new(-database =>'Ontology',
2649                                     -host     => $WebConfig::DBHOST,
2650                                     -user     => $WebConfig::DBUSER,
2651                                     -password => $WebConfig::DBPWD);
2652    
2653        if ($colName eq "pfam"){
2654            if (! defined $attributes) {
2655                my @attributes_array = $fig->get_attributes($ids);
2656                $attributes = \@attributes_array;
2657            }
2658    
2659            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2660      foreach my $key (@codes){      foreach my $key (@codes){
2661          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2662                if ($name =~ /_/){
2663                    ($name) = ($key->[1]) =~ /(.*?)_/;
2664                }
2665                push (@{$code_attributes{$key->[0]}}, $name);
2666                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2667      }      }
2668    
2669      foreach my $id (@$ids){      foreach my $id (@$ids){
2670          # add evidence code with tool tip              # add pfam code
2671          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2672          my @pfam_codes = "";          my @pfam_codes = "";
2673          my %description_codes;          my %description_codes;
2674    
2675          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2676              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2677              @pfam_codes = ();              @pfam_codes = ();
2678              foreach my $code (@codes) {  
2679                    # get only unique values
2680                    my %saw;
2681                    foreach my $key (@ncodes) {$saw{$key}=1;}
2682                    @ncodes = keys %saw;
2683    
2684                    foreach my $code (@ncodes) {
2685                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2686                  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>";
2687    
2688                        # get the locations for the domain
2689                        my @locs;
2690                        foreach my $part (@{$attribute_location{$id}{$code}}){
2691                            my ($loc) = ($part) =~ /\;(.*)/;
2692                            push (@locs,$loc);
2693                        }
2694                        my %locsaw;
2695                        foreach my $key (@locs) {$locsaw{$key}=1;}
2696                        @locs = keys %locsaw;
2697    
2698                        my $locations = join (", ", @locs);
2699    
2700                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2701                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2702                  }                  }
2703                  else {                  else {
2704                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2705                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2706                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2707              }              }
2708          }          }
2709    
2710          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2711                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2712                }
2713            }
2714        }
2715        elsif ($colName eq 'cellular_location'){
2716            if (! defined $attributes) {
2717                my @attributes_array = $fig->get_attributes($ids);
2718                $attributes = \@attributes_array;
2719      }      }
     return (%column);  
2720    
2721            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2722            foreach my $key (@codes){
2723                my ($loc) = ($key->[1]) =~ /::(.*)/;
2724                my ($new_loc, @all);
2725                @all = split (//, $loc);
2726                my $count = 0;
2727                foreach my $i (@all){
2728                    if ( ($i eq uc($i)) && ($count > 0) ){
2729                        $new_loc .= " " . $i;
2730                    }
2731                    else{
2732                        $new_loc .= $i;
2733                    }
2734                    $count++;
2735                }
2736                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2737  }  }
2738    
2739  sub get_prefer {          foreach my $id (@$ids){
2740      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2741      my $fig = new FIG;              #@values = (" ");
2742      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2743                    my @ncodes = @{$code_attributes{$id}};
2744                    foreach my $code (@ncodes){
2745                        push (@values, $code->[0] . ", " . $code->[1]);
2746                    }
2747                }
2748                else{
2749                    @values = ("Not available");
2750                }
2751    
2752      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2753          my $id_db = &Observation::get_database($alias);              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         if ($id_db eq $db){  
             my $acc_col .= &HTML::set_prot_links($cgi,$alias);  
             return ($acc_col);  
2754          }          }
2755      }      }
2756      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2757                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2758            if (! defined $attributes) {
2759                my @attributes_array = $fig->get_attributes($ids);
2760                $attributes = \@attributes_array;
2761  }  }
2762    
2763  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2764            foreach my $key (@codes){
2765                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2766            }
2767    
2768  sub color {          foreach my $id (@$ids){
2769      my ($evalue) = @_;              my (@values, $entry);
2770                #@values = (" ");
2771                if (defined @{$code_attributes{$id}}){
2772                    my @ncodes = @{$code_attributes{$id}};
2773                    foreach my $code (@ncodes){
2774                        push (@values, $code);
2775                    }
2776                }
2777                else{
2778                    @values = ("Not available");
2779                }
2780    
2781      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2782      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2783      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2784      }      }
2785      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2786          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2787                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2788                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2789                ($colName eq 'gc_content') ) {
2790            if (! defined $attributes) {
2791                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2792                $attributes = \@attributes_array;
2793      }      }
2794      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2795          $color = 54;          my $genomes_with_phenotype;
2796            foreach my $attribute (@$attributes){
2797                my $genome = $attribute->[0];
2798                $genomes_with_phenotype->{$genome} = $attribute->[2];
2799      }      }
2800      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2801          $color = 55;          foreach my $id (@$ids){
2802                my $genome = $fig->genome_of($id);
2803                my @values = (' ');
2804                if (defined $genomes_with_phenotype->{$genome}){
2805                    push (@values, $genomes_with_phenotype->{$genome});
2806      }      }
2807      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2808          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2809      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2810      }      }
2811      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2812          $color = 58;      return $column;
2813      }      }
2814      elsif (($evalue <= 10) && ($evalue > 1)){  
2815          $color = 59;  
2816    sub get_db_aliases {
2817        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2818    
2819        my $db_array;
2820        my $all_aliases = $fig->feature_aliases_bulk($ids);
2821        foreach my $id (@$ids){
2822            foreach my $alias (@{$$all_aliases{$id}}){
2823                my $id_db = &Observation::get_database($alias);
2824                next if ( ($id_db ne $db) && ($db ne 'all') );
2825                next if ($aliases->{$id}->{$db});
2826                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2827      }      }
2828      else{          if (!defined( $aliases->{$id}->{$db})){
2829          $color = 60;              $aliases->{$id}->{$db} = " ";
2830            }
2831            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2832            push (@$db_array, $aliases->{$id}->{$db});
2833      }      }
2834    
2835        if ($returnType eq 'hash') { return $aliases; }
2836        elsif ($returnType eq 'array') { return $db_array; }
2837    }
2838    
2839    
2840    
2841    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2842    
2843    sub color {
2844        my ($evalue) = @_;
2845        my $palette = WebColors::get_palette('vitamins');
2846        my $color;
2847        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2848        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2849        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2850        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2851        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2852        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2853        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2854        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2855        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2856        else{        $color = $palette->[9];    }
2857      return ($color);      return ($color);
2858  }  }
2859    
# Line 2152  Line 2873 
2873  }  }
2874    
2875  sub display {  sub display {
2876      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2877    
2878        $taxes = $fig->taxonomy_list();
2879    
2880      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2881      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2882      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2883      my $fig = new FIG;      my $range = $gd_window_size;
2884      my $all_regions = [];      my $all_regions = [];
2885      my $gene_associations={};      my $gene_associations={};
2886    
# Line 2182  Line 2905 
2905      my ($region_start, $region_end);      my ($region_start, $region_end);
2906      if ($beg < $end)      if ($beg < $end)
2907      {      {
2908          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2909          $region_end = $end+4000;          $region_end = $end+ ($range);
2910          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2911      }      }
2912      else      else
2913      {      {
2914          $region_start = $end-4000;          $region_start = $end-($range);
2915          $region_end = $beg+4000;          $region_end = $beg+($range);
2916          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2917          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2918          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2920 
2920    
2921      # call genes in region      # call genes in region
2922      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2923        #foreach my $feat (@$target_gene_features){
2924        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2925        #}
2926      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2927      my (@start_array_region);      my (@start_array_region);
2928      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2929    
2930      my %all_genes;      my %all_genes;
2931      my %all_genomes;      my %all_genomes;
2932      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2933            #if ($feature =~ /peg/){
2934      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2935      {          #}
         my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);  
   
         my $coup_count = 0;  
   
         foreach my $pair (@{$coup[0]->[2]}) {  
             #   last if ($coup_count > 10);  
             my ($peg1,$peg2) = @$pair;  
   
             my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);  
             $pair_genome = $fig->genome_of($peg1);  
   
             my $location = $fig->feature_location($peg1);  
             if($location =~/(.*)_(\d+)_(\d+)$/){  
                 $pair_contig = $1;  
                 $pair_beg = $2;  
                 $pair_end = $3;  
                 if ($pair_beg < $pair_end)  
                 {  
                     $pair_region_start = $pair_beg - 4000;  
                     $pair_region_stop = $pair_end+4000;  
                     $offset = ($pair_beg+(($pair_end-$pair_beg)/2))-($gd_window_size/2);  
                 }  
                 else  
                 {  
                     $pair_region_start = $pair_end-4000;  
                     $pair_region_stop = $pair_beg+4000;  
                     $offset = ($pair_end+(($pair_beg-$pair_end)/2))-($gd_window_size/2);  
                     $reverse_flag{$pair_genome} = $peg1;  
2936                  }                  }
2937    
2938                  push (@start_array_region, $offset);      my @selected_sims;
2939    
2940                  $all_genomes{$pair_genome} = 1;      if ($compare_or_coupling eq "sims"){
                 my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
                 push(@$all_regions,$pair_features);  
                 foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;}  
             }  
             $coup_count++;  
         }  
     }  
     elsif ($compare_or_coupling eq "sims"){  
2941          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2942          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2943    
2944          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
2945          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2946              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2947                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2948                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2949                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2950                    #my $genome = $fig->genome_of($sim->[1]);
2951                    my $genome = $fig->genome_of($sim->acc);
2952                    #my ($genome1) = ($genome) =~ /(.*)\./;
2953                    my $lineage = $taxes->{$genome};
2954                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2955                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2956                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2957                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2958                            push (@selected_sims, $sim->acc);
2959                      }                      }
2960                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2961              }              }
2962          }          }
2963            else{
2964                my $simcount = 0;
2965                foreach my $sim (@$sims_array){
2966                    next if ($sim->class ne "SIM");
2967                    next if ($sim->acc !~ /fig\|/);
2968    
2969                    push (@selected_sims, $sim->acc);
2970                    $simcount++;
2971                    last if ($simcount > 4);
2972                }
2973            }
2974    
2975            my %saw;
2976            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2977    
2978          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2979          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2997 
2997              my ($region_start, $region_end);              my ($region_start, $region_end);
2998              if ($beg < $end)              if ($beg < $end)
2999              {              {
3000                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
3001                  $region_end = $end+4000;                  $region_end = $end+($range/2);
3002                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3003              }              }
3004              else              else
3005              {              {
3006                  $region_start = $end-4000;                  $region_start = $end-($range/2);
3007                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
3008                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3009                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
3010                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 3020 
3020    
3021      }      }
3022    
3023        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3024      # cluster the genes      # cluster the genes
3025      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3026      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3027        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3028        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
3029    
3030      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3031          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3032          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3033          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3034          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3035            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3036            my $lineage = $taxes->{$region_genome};
3037            #my $lineage = $fig->taxonomy_of($region_genome);
3038            #$region_gs .= "Lineage:$lineage";
3039          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3040                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3041                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 3043 
3043    
3044          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3045    
3046          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3047                                     'short_title' => "",                                     'short_title' => "",
3048                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3049                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3067 
3067    
3068              # get subsystem information              # get subsystem information
3069              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3070              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3071    
3072              my $link;              my $link;
3073              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3074                       "link" => $url_link};                       "link" => $url_link};
3075              push(@$links_list,$link);              push(@$links_list,$link);
3076    
3077              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3078              foreach my $subsystem (@subsystems){              my @subsystems;
3079                foreach my $array (@subs){
3080                    my $subsystem = $$array[0];
3081                    my $ss = $subsystem;
3082                    $ss =~ s/_/ /ig;
3083                    push (@subsystems, $ss);
3084                  my $link;                  my $link;
3085                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3086                           "link_title" => $subsystem};                           "link_title" => $ss};
3087                    push(@$links_list,$link);
3088                }
3089    
3090                if ($fid1 eq $fid){
3091                    my $link;
3092                    $link = {"link_title" => "Annotate this sequence",
3093                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3094                  push(@$links_list,$link);                  push(@$links_list,$link);
3095              }              }
3096    
# Line 2401  Line 3124 
3124                  $prev_stop = $stop;                  $prev_stop = $stop;
3125                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3126    
3127                  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})){
3128                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3129                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3130                  }                  }
3131    
3132                    my $title = $fid1;
3133                    if ($fid1 eq $fid){
3134                        $title = "My query gene: $fid1";
3135                    }
3136    
3137                  $element_hash = {                  $element_hash = {
3138                      "title" => $fid1,                      "title" => $title,
3139                      "start" => $start,                      "start" => $start,
3140                      "end" =>  $stop,                      "end" =>  $stop,
3141                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3148 
3148                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3149                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3150                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3151    
3152                    if ($fid1 eq $fid){
3153                        $element_hash = {
3154                            "title" => 'Query',
3155                            "start" => $start,
3156                            "end" =>  $stop,
3157                            "type"=> 'bigbox',
3158                            "color"=> $color,
3159                            "zlayer" => "1"
3160                            };
3161    
3162                        # if there is an overlap, put into second line
3163                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3164                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3165                    }
3166              }              }
3167          }          }
3168          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3169          $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3170      }      }
3171      return $gd;      return ($gd, \@selected_sims);
3172  }  }
3173    
3174  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3238 
3238      }      }
3239    
3240      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3241          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3242              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3243                  foreach $y (@$x) {                  foreach $y (@$x) {
3244                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3256 
3256      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3257      return ($i < @$xL);      return ($i < @$xL);
3258  }  }
3259    
3260    #############################################
3261    #############################################
3262    package Observation::Commentary;
3263    
3264    use base qw(Observation);
3265    
3266    =head3 display_protein_commentary()
3267    
3268    =cut
3269    
3270    sub display_protein_commentary {
3271        my ($self,$dataset,$mypeg,$fig) = @_;
3272    
3273        my $all_rows = [];
3274        my $content;
3275        #my $fig = new FIG;
3276        my $cgi = new CGI;
3277        my $count = 0;
3278        my $peg_array = [];
3279        my ($evidence_column, $subsystems_column,  %e_identical);
3280    
3281        if (@$dataset != 1){
3282            foreach my $thing (@$dataset){
3283                if ($thing->class eq "SIM"){
3284                    push (@$peg_array, $thing->acc);
3285                }
3286            }
3287            # get the column for the evidence codes
3288            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3289    
3290            # get the column for the subsystems
3291            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3292    
3293            # get essentially identical seqs
3294            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3295        }
3296        else{
3297            push (@$peg_array, @$dataset);
3298        }
3299    
3300        my $selected_sims = [];
3301        foreach my $id (@$peg_array){
3302            last if ($count > 10);
3303            my $row_data = [];
3304            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3305            if ($fig->org_of($id)){
3306                $org = $fig->org_of($id);
3307            }
3308            else{
3309                $org = "Data not available";
3310            }
3311            $function = $fig->function_of($id);
3312            if ($mypeg ne $id){
3313                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3314                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3315                if (defined($e_identical{$id})) { $id_cell .= "*";}
3316            }
3317            else{
3318                $function_cell = "&nbsp;&nbsp;$function";
3319                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3320                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3321            }
3322    
3323            push(@$row_data,$id_cell);
3324            push(@$row_data,$org);
3325            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3326            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3327            push(@$row_data, $fig->translation_length($id));
3328            push(@$row_data,$function_cell);
3329            push(@$all_rows,$row_data);
3330            push (@$selected_sims, $id);
3331            $count++;
3332        }
3333    
3334        if ($count >0){
3335            $content = $all_rows;
3336        }
3337        else{
3338            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3339        }
3340        return ($content,$selected_sims);
3341    }
3342    
3343    sub display_protein_history {
3344        my ($self, $id,$fig) = @_;
3345        my $all_rows = [];
3346        my $content;
3347    
3348        my $cgi = new CGI;
3349        my $count = 0;
3350        foreach my $feat ($fig->feature_annotations($id)){
3351            my $row = [];
3352            my $col1 = $feat->[2];
3353            my $col2 = $feat->[1];
3354            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3355            my $text = $feat->[3];
3356    
3357            push (@$row, $col1);
3358            push (@$row, $col2);
3359            push (@$row, $text);
3360            push (@$all_rows, $row);
3361            $count++;
3362        }
3363        if ($count > 0){
3364            $content = $all_rows;
3365        }
3366        else {
3367            $content = "There is no history for this PEG";
3368        }
3369    
3370        return($content);
3371    }
3372    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3