[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.68, Sun Aug 24 15:00:17 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,$parameters,$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,$parameters);
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      $content .= qq(</table><p>\n);      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        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          foreach my $tax (split(/\; /, $taxonomy)){          push (@{$families{figs}{$parent_tax}}, $id);
481              push (@{$families{children}{$parent_tax}}, $tax);          my $level = 2;
482            foreach my $tax (split(/\; /, $taxonomy),$id){
483                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 ( (defined $parameters->{flag}) && ($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}));
722          next if ($hit !~ /^fig\|/);      }
723          my @aliases = $fig->feature_aliases($hit);      elsif ( (defined $parameters->{sims_db}) && ($parameters->{sims_db} eq 'all')){
724          foreach my $alias (@aliases){        $max_sims = 50;
725              $id_list{$alias} = 1;        $max_expand = 5;
726          $max_eval = 1e-5;
727          $db_filter = "all";
728          $sim_filters->{ sort_by } = 'id';
729          }          }
730        else{
731          $max_sims = 50;
732          $max_expand = 5;
733          $max_eval = 1e-5;
734          $db_filter = "figx";
735          $sim_filters->{ sort_by } = 'id';
736          #$sim_order = "id";
737      }      }
738    
739      my %already;      my($id, $genome, @genomes, %sims);
740      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
741      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
742          my $hit = $sim->[1];      my ($dataset);
743          my ($id) = ($hit) =~ /\|(.*)/;  
744          next if (defined($already{$id}));      if ($group_by_genome){
745          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
746          push (@new_sims, $sim);        foreach $sim ( @tmp ){
747          $already{$id} = 1;          $id = $sim->id2;
748            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
749            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
750            push @{ $sims{ $genome } }, $sim;
751          }
752          @tmp = map { @{ $sims{$_} } } @genomes;
753      }      }
754    
755      foreach my $sim (@new_sims){      my $seen_sims={};
756        foreach my $sim (@tmp){
757          my $hit = $sim->[1];          my $hit = $sim->[1];
758            next if ($seen_sims->{$hit});
759            $seen_sims->{$hit}++;
760          my $percent = $sim->[2];          my $percent = $sim->[2];
761          my $evalue = $sim->[10];          my $evalue = $sim->[10];
762          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 682  Line 767 
767          my $hlength = $sim->[13];          my $hlength = $sim->[13];
768          my $db = get_database($hit);          my $db = get_database($hit);
769          my $func = $fig->function_of($hit);          my $func = $fig->function_of($hit);
770          my $organism = $fig->org_of($hit);          my $organism;
771            if ($fig->org_of($hit)){
772                $organism = $fig->org_of($hit);
773            }
774            else{
775                $organism = "Data not available";
776            }
777    
778          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
779                        'query' => $sim->[0],
780                      'acc' => $hit,                      'acc' => $hit,
781                      'identity' => $percent,                      'identity' => $percent,
782                      'type' => 'seq',                      'type' => 'seq',
# Line 714  Line 806 
806      my ($id) = (@_);      my ($id) = (@_);
807    
808      my ($db);      my ($db);
809      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
810      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
811        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
812      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
813        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
814      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
815      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
816      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 725  Line 819 
819      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
820      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
821      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
822        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
823        elsif ($id =~ /^img\|/)           { $db = "IMG" }
824        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
825        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
826    
827      return ($db);      return ($db);
828    
# Line 739  Line 837 
837    
838  sub get_identical_proteins{  sub get_identical_proteins{
839    
840      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
841      my $fig = new FIG;      #my $fig = new FIG;
842      my $funcs_ref;      my $funcs_ref;
843    
 #    my %id_list;  
844      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;  
 #    }  
   
845      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
846          my ($tmp, $who);          my ($tmp, $who);
847          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}))) {  
848              $who = &get_database($id);              $who = &get_database($id);
849              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
850          }          }
851      }      }
852    
     my ($dataset);  
853      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
854                     'type' => 'seq',                     'type' => 'seq',
855                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 869 
869    
870  sub get_functional_coupling{  sub get_functional_coupling{
871    
872      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
873      my $fig = new FIG;      #my $fig = new FIG;
874      my @funcs = ();      my @funcs = ();
875    
876      # initialize some variables      # initialize some variables
# Line 797  Line 887 
887                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
888                    } @fc_data;                    } @fc_data;
889    
     my ($dataset);  
890      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
891                     'type' => 'fc',                     'type' => 'fc',
892                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 997 
997      return $self->{database};      return $self->{database};
998  }  }
999    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
1000  ############################################################  ############################################################
1001  ############################################################  ############################################################
1002  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 1022 
1022  =cut  =cut
1023    
1024  sub display{  sub display{
1025      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1026    
1027      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1028      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1029                                    -host     => $WebConfig::DBHOST,
1030                                    -user     => $WebConfig::DBUSER,
1031                                    -password => $WebConfig::DBPWD);
1032    
1033      my $acc = $self->acc;      my $acc = $self->acc;
1034    
# Line 963  Line 1049 
1049      my $lines = [];      my $lines = [];
1050      my $line_data = [];      my $line_data = [];
1051      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1052                            'hover_title' => 'PDB',
1053                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1054                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1055    
1056      my $fig = new FIG;      #my $fig = new FIG;
1057      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1058      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1059    
# Line 1067  Line 1154 
1154    
1155    
1156  sub display_table{  sub display_table{
1157      my ($self) = @_;      my ($self,$fig) = @_;
1158    
1159      my $fig = new FIG;      #my $fig = new FIG;
1160      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1161      my $rows = $self->rows;      my $rows = $self->rows;
1162      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1080  Line 1167 
1167          my $id = $row->[0];          my $id = $row->[0];
1168          my $who = $row->[1];          my $who = $row->[1];
1169          my $assignment = $row->[2];          my $assignment = $row->[2];
1170          my $organism = $fig->org_of($id);          my $organism = "Data not available";
1171            if ($fig->org_of($id)){
1172                $organism = $fig->org_of($id);
1173            }
1174          my $single_domain = [];          my $single_domain = [];
1175          push(@$single_domain,$who);          push(@$single_domain,$who);
1176          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,"<a href='?page=Annotation&feature=$id'>$id</a>");
1177          push(@$single_domain,$organism);          push(@$single_domain,$organism);
1178          push(@$single_domain,$assignment);          push(@$single_domain,$assignment);
1179          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
# Line 1131  Line 1221 
1221    
1222  sub display_table {  sub display_table {
1223    
1224      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1225      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1226      my $rows = $self->rows;      my $rows = $self->rows;
1227      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1236 
1236          # construct the score link          # construct the score link
1237          my $score = $row->[0];          my $score = $row->[0];
1238          my $toid = $row->[1];          my $toid = $row->[1];
1239          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";
1240          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1241    
1242          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1243          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1290 
1290      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1291      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1292    
1293      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1294                                    -host     => $WebConfig::DBHOST,
1295                                    -user     => $WebConfig::DBUSER,
1296                                    -password => $WebConfig::DBPWD);
1297    
1298      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1299      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1312 
1312              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1313          }          }
1314      }      }
1315        elsif($db =~ /PFAM/){
1316            my ($new_id) = ($id) =~ /(.*?)_/;
1317            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1318            if(!scalar(@$pfam_objs)){
1319                $name_title = "name";
1320                $name_value = "not available";
1321                $description_title = "description";
1322                $description_value = "not available";
1323            }
1324            else{
1325                my $pfam_obj = $pfam_objs->[0];
1326                $name_title = "name";
1327                $name_value = $pfam_obj->term;
1328                #$description_title = "description";
1329                #$description_value = $pfam_obj->description;
1330            }
1331        }
1332    
1333      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1334                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1335        my $new_short_title=$short_title;
1336        if ($short_title =~ /interpro/){
1337            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1338        }
1339        my $line_config = { 'title' => $name_value,
1340                            'hover_title', => 'Domain',
1341                            'short_title' => $new_short_title,
1342                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1343    
1344      my $name;      my $name;
1345      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1346               "value" => $name_value};      $name = {"title" => $db,
1347                 "value" => $new_id};
1348      push(@$descriptions,$name);      push(@$descriptions,$name);
1349    
1350      my $description;  #    my $description;
1351      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1352                               "value" => $description_value};  #                   "value" => $description_value};
1353      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1354    
1355      my $score;      my $score;
1356      $score = {"title" => "score",      $score = {"title" => "score",
1357                "value" => $thing->evalue};                "value" => $thing->evalue};
1358      push(@$descriptions,$score);      push(@$descriptions,$score);
1359    
1360        my $location;
1361        $location = {"title" => "location",
1362                     "value" => $thing->start . " - " . $thing->stop};
1363        push(@$descriptions,$location);
1364    
1365      my $link_id;      my $link_id;
1366      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1367          $link_id = $1;          $link_id = $1;
1368      }      }
1369    
1370      my $link;      my $link;
1371      my $link_url;      my $link_url;
1372      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"}
1373      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"}
1374      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1375    
1376      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1378 
1378      push(@$links_list,$link);      push(@$links_list,$link);
1379    
1380      my $element_hash = {      my $element_hash = {
1381          "title" => $thing->type,          "title" => $name_value,
1382          "start" => $thing->start,          "start" => $thing->start,
1383          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1384          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1408 
1408          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1409          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1410    
1411          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1412                                    -host     => $WebConfig::DBHOST,
1413                                    -user     => $WebConfig::DBUSER,
1414                                    -password => $WebConfig::DBPWD);
1415    
1416          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1417          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1430 
1430                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1431              }              }
1432          }          }
1433            elsif($db =~ /PFAM/){
1434                my ($new_id) = ($id) =~ /(.*?)_/;
1435                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1436                if(!scalar(@$pfam_objs)){
1437                    $name_title = "name";
1438                    $name_value = "not available";
1439                    $description_title = "description";
1440                    $description_value = "not available";
1441                }
1442                else{
1443                    my $pfam_obj = $pfam_objs->[0];
1444                    $name_title = "name";
1445                    $name_value = $pfam_obj->term;
1446                    #$description_title = "description";
1447                    #$description_value = $pfam_obj->description;
1448                }
1449            }
1450    
1451          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1452    
# Line 1356  Line 1499 
1499      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1500      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1501      if($cello_location){      if($cello_location){
1502          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1503          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1504      }      }
1505      return ($html);      return ($html);
1506  }  }
1507    
1508  sub display {  sub display {
1509      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1510    
1511      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1512      my $fig= new FIG;      #my $fig= new FIG;
1513      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1514    
1515      my $cleavage_prob;      my $cleavage_prob;
# Line 1386  Line 1529 
1529      #color is      #color is
1530      my $color = "6";      my $color = "6";
1531    
1532  =pod=  =head3
1533    
1534      if($cello_location){      if($cello_location){
1535          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1394  Line 1537 
1537    
1538          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1539                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1540                                'hover_title' => 'Localization',
1541                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1542    
1543          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1562 
1562          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1563      }      }
1564    
 =cut  
   
1565      $color = "2";      $color = "2";
1566      if($tmpred_score){      if($tmpred_score){
1567          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1591 
1591          }          }
1592          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1593      }      }
1594    =cut
1595    
1596      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1597          my $line_data =[];          my $line_data =[];
1598          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1599                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1600                                'hover_title' => 'Localization',
1601                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1602    
1603          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1604              my $descriptions = [];              my $descriptions = [];
1605              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1606                               "value" => $tm_loc};                               "value" => $tm_loc};
1607              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1608    
1609              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1610    
1611              my $element_hash = {              my $element_hash = {
1612              "title" => "phobius transmembrane location",              "title" => "Phobius",
1613              "start" => $begin + 1,              "start" => $begin + 1,
1614              "end" =>  $end + 1,              "end" =>  $end + 1,
1615              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1643 
1643          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1644      }      }
1645    
1646    =head3
1647      $color = "1";      $color = "1";
1648      if($signal_peptide_score){      if($signal_peptide_score){
1649          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1651 
1651    
1652          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1653                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1654                                'hover_title' => 'Localization',
1655                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1656    
1657          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1676 
1676          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1677          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1678      }      }
1679    =cut
1680    
1681      return ($gd);      return ($gd);
1682    
# Line 1602  Line 1748 
1748      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1749      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1750      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1751        $self->{query} = $dataset->{'query'};
1752      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1753      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1754      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1772 
1772  =cut  =cut
1773    
1774  sub display {  sub display {
1775      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $fig = new FIG;  
     my $peg = $self->acc;  
1776    
1777      my $organism = $self->organism;      # declare variables
1778        my $window_size = $gd->window_size;
1779        my $peg = $thing->acc;
1780        my $query_id = $thing->query;
1781        my $organism = $thing->organism;
1782        my $abbrev_name = $fig->abbrev($organism);
1783        if (!$organism){
1784          $organism = $peg;
1785          $abbrev_name = $peg;
1786        }
1787      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1788      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1789      my $function = $self->function;      my $function = $thing->function;
1790      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1791      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1792      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1793      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1794      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1795        my $ln_hit = $thing->hlength;
1796    #    my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1797    #    my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1798        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1799        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1800    
1801      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;
1802    
1803        # hit sequence title
1804      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1805                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1806                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1807                          'basepair_offset' => '0'                          'basepair_offset' => '0',
1808                            'no_middle_line' => '1'
1809                          };                          };
1810    
1811        # query sequence title
1812        my $replace_id = $peg;
1813        $replace_id =~ s/\|/_/ig;
1814        my $anchor_name = "anchor_". $replace_id;
1815        my $query_config = { 'title' => "Query",
1816                             'short_title' => "Query",
1817                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1818                             'basepair_offset' => '0',
1819                             'no_middle_line' => '1'
1820                             };
1821      my $line_data = [];      my $line_data = [];
1822        my $query_data = [];
1823    
1824      my $element_hash;      my $element_hash;
1825      my $links_list = [];      my $hit_links_list = [];
1826      my $descriptions = [];      my $hit_descriptions = [];
1827        my $query_descriptions = [];
1828      # get subsystem information  
1829      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1830        # evidence link
1831      my $link;      my $evidence_link;
1832      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1833               "link" => $url_link};        $evidence_link = "?page=Annotation&feature=".$peg;
1834      push(@$links_list,$link);      }
1835        else{
1836          my $db = &Observation::get_database($peg);
1837          my ($link_id) = ($peg) =~ /\|(.*)/;
1838          $evidence_link = &HTML::alias_url($link_id, $db);
1839          #print STDERR "LINK: $db    $evidence_link";
1840        }
1841        my $link = {"link_title" => $peg,
1842                    "link" => $evidence_link};
1843        push(@$hit_links_list,$link) if ($evidence_link);
1844    
1845      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1846      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1847          my $link;      my @subsystems;
1848          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1849            my $subsystem = $$array[0];
1850            push(@subsystems,$subsystem);
1851            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1852                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1853          push(@$links_list,$link);          push(@$hit_links_list,$link);
1854      }      }
1855    
1856        # blast alignment
1857        $link = {"link_title" => "view blast alignment",
1858                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1859        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1860    
1861        # description data
1862      my $description_function;      my $description_function;
1863      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1864                               "value" => $function};                               "value" => $function};
1865      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1866    
1867      my ($description_ss, $ss_string);      # subsystem description
1868      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1869      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1870        my $description_ss = {"title" => "subsystems",
1871                         "value" => $ss_string};                         "value" => $ss_string};
1872      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1873    
1874        # location description
1875        # hit
1876      my $description_loc;      my $description_loc;
1877      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1878                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1879      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1880    
1881      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1882                          "value" => $hit_stop};                          "value" => $ln_hit};
1883      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1884    
1885        # query
1886        $description_loc = {"title" => "Hit Location",
1887                            "value" => $query_start . " - " . $query_stop};
1888        push(@$query_descriptions, $description_loc);
1889    
1890      my $evalue = $self->evalue;      $description_loc = {"title" => "Sequence Length",
1891                            "value" => $ln_query};
1892        push(@$query_descriptions, $description_loc);
1893    
1894    
1895    
1896        # evalue score description
1897        my $evalue = $thing->evalue;
1898      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1899      {      {
1900          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1699  Line 1903 
1903      }      }
1904    
1905      my $color = &color($evalue);      my $color = &color($evalue);
   
1906      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1907                              "value" => $evalue};                              "value" => $evalue};
1908      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1909        push(@$query_descriptions, $description_eval);
1910    
1911      my $identity = $self->identity;      my $identity = $self->identity;
1912      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1913                                  "value" => $identity};                                  "value" => $identity};
1914      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1915        push(@$query_descriptions, $description_identity);
1916    
1917    
1918        my $number = $base_start + ($query_start-$hit_start);
1919        #print STDERR "START: $number";
1920        $element_hash = {
1921            "title" => $query_id,
1922            "start" => $base_start,
1923            "end" => $base_start+$ln_query,
1924            "type"=> 'box',
1925            "color"=> $color,
1926            "zlayer" => "2",
1927            "links_list" => $query_links_list,
1928            "description" => $query_descriptions
1929            };
1930        push(@$query_data,$element_hash);
1931    
1932        $element_hash = {
1933            "title" => $query_id . ': HIT AREA',
1934            "start" => $base_start + $query_start,
1935            "end" =>  $base_start + $query_stop,
1936            "type"=> 'smallbox',
1937            "color"=> $query_color,
1938            "zlayer" => "3",
1939            "links_list" => $query_links_list,
1940            "description" => $query_descriptions
1941            };
1942        push(@$query_data,$element_hash);
1943    
1944        $gd->add_line($query_data, $query_config);
1945    
1946    
1947      $element_hash = {      $element_hash = {
1948          "title" => $peg,          "title" => $peg,
1949          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1950          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1951          "type"=> 'box',          "type"=> 'box',
1952          "color"=> $color,          "color"=> $color,
1953          "zlayer" => "2",          "zlayer" => "2",
1954          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1955          "description" => $descriptions                  "description" => $hit_descriptions
1956          };          };
1957      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1958    
1959        $element_hash = {
1960            "title" => $peg . ': HIT AREA',
1961            "start" => $base_start + $query_start,
1962            "end" =>  $base_start + $query_stop,
1963            "type"=> 'smallbox',
1964            "color"=> $hit_color,
1965            "zlayer" => "3",
1966            "links_list" => $hit_links_list,
1967            "description" => $hit_descriptions
1968            };
1969        push(@$line_data,$element_hash);
1970    
1971      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1972    
1973      return ($gd);      my $breaker = [];
1974        my $breaker_hash = {};
1975        my $breaker_config = { 'no_middle_line' => "1" };
1976    
1977        push (@$breaker, $breaker_hash);
1978        $gd->add_line($breaker, $breaker_config);
1979    
1980        return ($gd);
1981  }  }
1982    
1983  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1987 
1987  =cut  =cut
1988    
1989  sub display_domain_composition {  sub display_domain_composition {
1990      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1991    
1992      my $fig = new FIG;      #$fig = new FIG;
1993      my $peg = $self->acc;      my $peg = $self->acc;
1994    
1995      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1997 
1997      my $descriptions = [];      my $descriptions = [];
1998    
1999      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
2000        #my @domain_query_results = ();
2001      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
2002          my $key = @$dqr[1];          my $key = @$dqr[1];
2003          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 2022 
2022              }              }
2023          }          }
2024    
2025          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
2026                                    -host     => $WebConfig::DBHOST,
2027                                    -user     => $WebConfig::DBUSER,
2028                                    -password => $WebConfig::DBPWD);
2029          my ($name_value,$description_value);          my ($name_value,$description_value);
2030    
2031          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 2062 
2062          my $link;          my $link;
2063          my $link_url;          my $link_url;
2064          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"}
2065          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"}
2066          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2067    
2068          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 2086 
2086      }      }
2087    
2088      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2089                            'hover_title' => 'Domain',
2090                          'short_title' => $peg,                          'short_title' => $peg,
2091                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2092    
# Line 1848  Line 2106 
2106  =cut  =cut
2107    
2108  sub display_table {  sub display_table {
2109      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2110        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2111    
2112      my $data = [];      my $scroll_list;
2113      my $count = 0;      foreach my $col (@$show_columns){
2114      my $content;          push (@$scroll_list, $col->{key});
2115      my $fig = new FIG;      }
2116      my $cgi = new CGI;  
2117      my @ids;      push (@ids, $query_fid);
2118      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2119          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2120          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2121      }      }
2122    
2123      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2124        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2125    
2126      # get the column for the subsystems      # get the column for the subsystems
2127      %subsystems_column = &get_subsystems_column(\@ids);      $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2128    
2129      # get the column for the evidence codes      # get the column for the evidence codes
2130      %evidence_column = &get_evidence_column(\@ids);      $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2131    
2132      # get the column for pfam_domain      # get the column for pfam_domain
2133      %pfam_column = &get_pfam_column(\@ids);      $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2134    
2135      my %e_identical = &get_essentially_identical($query_fid);      # get the column for molecular weight
2136      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);
2137    
2138      foreach my $thing (@$dataset) {      # get the column for organism's habitat
2139        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2140    
2141        # get the column for organism's temperature optimum
2142        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2143    
2144        # get the column for organism's temperature range
2145        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2146    
2147        # get the column for organism's oxygen requirement
2148        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2149    
2150        # get the column for organism's pathogenicity
2151        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2152    
2153        # get the column for organism's pathogenicity host
2154        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2155    
2156        # get the column for organism's salinity
2157        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2158    
2159        # get the column for organism's motility
2160        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2161    
2162        # get the column for organism's gram stain
2163        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2164    
2165        # get the column for organism's endospores
2166        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2167    
2168        # get the column for organism's shape
2169        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2170    
2171        # get the column for organism's disease
2172        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2173    
2174        # get the column for organism's disease
2175        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2176    
2177        # get the column for transmembrane domains
2178        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2179    
2180        # get the column for similar to human
2181        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);
2182    
2183        # get the column for signal peptide
2184        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2185    
2186        # get the column for transmembrane domains
2187        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2188    
2189        # get the column for conserved neighborhood
2190        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2191    
2192        # get the column for cellular location
2193        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2194    
2195        # get the aliases
2196        my $alias_col;
2197        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2198             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2199             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2200             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2201             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2202            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2203        }
2204    
2205        # get the colors for the function cell
2206        my $functions = $fig->function_of_bulk(\@ids,1);
2207        $functional_color = &get_function_color_cell($functions, $fig);
2208        my $query_function = $fig->function_of($query_fid);
2209    
2210        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2211    
2212        my $figfam_data = &FIG::get_figfams_data();
2213        my $figfams = new FFs($figfam_data);
2214        my $same_genome_flag = 0;
2215    
2216        my $func_color_offset=0;
2217        unshift(@$dataset, $query_fid);
2218        for (my $thing_count=0;$thing_count<scalar @$dataset;$thing_count++){
2219    #    foreach my $thing ( @$dataset){
2220            my $thing = $dataset->[$thing_count];
2221            my $next_thing = $dataset->[$thing_count+1] if (defined $dataset->[$thing_count+1]);
2222            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2, $next_org);
2223            if ($thing eq $query_fid){
2224                $id = $thing;
2225                $taxid   = $fig->genome_of($id);
2226                $organism = $fig->genus_species($taxid);
2227                $current_function = $fig->function_of($id);
2228            }
2229            else{
2230          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2231    
2232                $id      = $thing->acc;
2233                $evalue  = $thing->evalue;
2234                $taxid   = $fig->genome_of($id);
2235                $iden    = $thing->identity;
2236                $organism= $thing->organism;
2237                $ln1     = $thing->qlength;
2238                $ln2     = $thing->hlength;
2239                $b1      = $thing->qstart;
2240                $e1      = $thing->qstop;
2241                $b2      = $thing->hstart;
2242                $e2      = $thing->hstop;
2243                $d1      = abs($e1 - $b1) + 1;
2244                $d2      = abs($e2 - $b2) + 1;
2245                $color1  = match_color( $b1, $e1, $ln1 );
2246                $color2  = match_color( $b2, $e2, $ln2 );
2247                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2248                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2249                $current_function = $thing->function;
2250                $next_org = $next_thing->organism if (defined $next_thing);
2251            }
2252    
2253          my $single_domain = [];          my $single_domain = [];
2254          $count++;          $count++;
2255    
2256          my $id = $thing->acc;          # organisms cell
2257            my ($org, $org_color) = $fig->org_and_color_of($id);
2258    
2259          my $iden    = $thing->identity;          my $org_cell;
2260          my $ln1     = $thing->qlength;          if ( ($next_org ne $organism) && ($same_genome_flag == 0) ){
2261          my $ln2     = $thing->hlength;              $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2262          my $b1      = $thing->qstart;          }
2263          my $e1      = $thing->qstop;          elsif ($next_org eq $organism){
2264          my $b2      = $thing->hstart;              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2265          my $e2      = $thing->hstop;              $same_genome_flag = 1;
2266          my $d1      = abs($e1 - $b1) + 1;          }
2267          my $d2      = abs($e2 - $b2) + 1;          elsif ($same_genome_flag == 1){
2268          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";              $org_cell = { 'data' =>  "<b>" . $organism . "</b>", 'highlight' => $org_color};
2269          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";              $same_genome_flag = 0;
2270            }
2271    
2272          # checkbox column          # checkbox cell
2273            my ($box_cell,$tax, $radio_cell);
2274          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2275          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2276          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;
2277            my $replace_id = $id;
2278            $replace_id =~ s/\|/_/ig;
2279            my $white = '#ffffff';
2280            $white = '#999966' if ($id eq $query_fid);
2281            $org_color = '#999966' if ($id eq $query_fid);
2282            my $anchor_name = "anchor_". $replace_id;
2283            my $checked = "";
2284            #$checked = "checked" if ($id eq $query_fid);
2285            if ($id =~ /^fig\|/){
2286              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>~;
2287              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2288              $tax = $fig->genome_of($id);
2289            }
2290            else{
2291              my $box = qq(<a name="$anchor_name"></a>);
2292              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2293            }
2294    
2295            # create the radio cell for any sequence, not just fig ids
2296            my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" onClick="clearText('new_text_function')">);
2297            $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2298    
2299          # get the linked fig id          # get the linked fig id
2300          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2301          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2302              $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>);
2303          }          my $fig_col = {'data'=> $fig_data,
2304          else{                         'highlight'=>$white};
2305              $fig_col = &HTML::set_prot_links($cgi,$id);  
2306          }          $replace_id = $peg;
2307            $replace_id =~ s/\|/_/ig;
2308          push(@$single_domain,$box_col);                        # permanent column          $anchor_name = "anchor_". $replace_id;
2309          push(@$single_domain,$fig_col);                        # permanent column          my $query_config = { 'title' => "Query",
2310          push(@$single_domain,$thing->evalue);                  # permanent column                               'short_title' => "Query",
2311          push(@$single_domain,"$iden\%");                       # permanent column                               'title_link' => "changeSimsLocation('$replace_id')",
2312          push(@$single_domain,$reg1);                           # permanent column                               'basepair_offset' => '0'
2313          push(@$single_domain,$reg2);                           # permanent column                               };
2314          push(@$single_domain,$thing->organism);                # permanent column  
2315          push(@$single_domain,$thing->function);                # permanent column          # function cell
2316          foreach my $col (sort keys %$scroll_list){          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2317              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}                                      3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2318              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}                                      6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2319              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}  
2320              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}          my $function_color;
2321              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) ){
2322              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};
2323              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}          }
2324              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}          else{
2325              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2326              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}          }
2327              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}          my $function_cell;
2328              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}          if ($current_function){
2329              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}            if ($current_function eq $query_function){
2330                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2331                $func_color_offset=1;
2332              }
2333              else{
2334                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2335          }          }
2336          push(@$data,$single_domain);          }
2337            else{
2338              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2339      }      }
2340    
2341            if ($id eq $query_fid){
2342                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2343                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2344                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2345            }
2346            else{
2347                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2348                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2349            }
2350    
2351            if ( ( $application->session->user) ){
2352                my $user = $application->session->user;
2353                if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {
2354                    push (@$single_domain,$radio_cell);
2355                }
2356            }
2357    
2358            my ($ff) = $figfams->families_containing_peg($id);
2359    
2360            foreach my $col (@$scroll_list){
2361                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2362                else { $highlight_color = "#ffffff"; }
2363    
2364                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2365                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2366                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2367                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2368                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2369                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2370                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2371                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2372                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2373                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2374                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2375                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2376                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2377                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2378                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2379                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2380                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2381                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2382                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2383                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2384                elsif ($col =~ /conerved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2385                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2386                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2387                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2388                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2389                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2390                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2391                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2392                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2393                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2394                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2395                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2396                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2397                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2398            }
2399            push(@$data,$single_domain);
2400        }
2401      if ($count >0 ){      if ($count >0 ){
2402          $content = $data;          $content = $data;
2403      }      }
2404      else{      else{
2405          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2406      }      }
2407        shift(@$dataset);
2408      return ($content);      return ($content);
2409  }  }
2410    
# Line 1949  Line 2414 
2414      foreach my $id (@$ids){      foreach my $id (@$ids){
2415          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2416          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2417          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2418            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2419      }      }
2420      return (%column);      return (%column);
2421  }  }
2422    
2423    sub get_figfam_column{
2424        my ($ids, $fig, $cgi) = @_;
2425        my $column;
2426    
2427        my $figfam_data = &FIG::get_figfams_data();
2428        my $figfams = new FFs($figfam_data);
2429    
2430        foreach my $id (@$ids){
2431            my ($ff) =  $figfams->families_containing_peg($id);
2432            if ($ff){
2433                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2434            }
2435            else{
2436                push (@$column, " ");
2437            }
2438        }
2439    
2440        return $column;
2441    }
2442    
2443  sub get_subsystems_column{  sub get_subsystems_column{
2444      my ($ids) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2445    
     my $fig = new FIG;  
     my $cgi = new CGI;  
2446      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2447      my %column;      my ($column, $ss);
2448      foreach my $id (@$ids){      foreach my $id (@$ids){
2449          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2450          my @subsystems;          my @subsystems;
2451    
2452          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2453              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2454                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $array->[0];
2455                  $count++;                  $ss =~ s/_/ /ig;
2456                    push (@subsystems, "-" . $ss);
2457              }              }
2458              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2459              $column{$id} = $in_sub_line;              $ss->{$id} = $in_sub_line;
2460          } else {          } else {
2461              $column{$id} = "&nbsp;";              $ss->{$id} = "None added";
2462          }          }
2463            push (@$column, $ss->{$id});
2464        }
2465    
2466        if ($returnType eq 'hash') { return $ss; }
2467        elsif ($returnType eq 'array') { return $column; }
2468    }
2469    
2470    sub get_lineage_column{
2471        my ($ids, $fig, $cgi) = @_;
2472    
2473        my $lineages = $fig->taxonomy_list();
2474    
2475        foreach my $id (@$ids){
2476            my $genome = $fig->genome_of($id);
2477            if ($lineages->{$genome}){
2478    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2479                push (@$column, $lineages->{$genome});
2480            }
2481            else{
2482                push (@$column, " ");
2483      }      }
2484      return (%column);      }
2485        return $column;
2486    }
2487    
2488    sub match_color {
2489        my ( $b, $e, $n , $rgb) = @_;
2490        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2491        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2492        my $cov = ( $r - $l + 1 ) / $n;
2493        my $sat = 1 - 10 * $cov / 9;
2494        my $br  = 1;
2495        if ($rgb){
2496            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2497        }
2498        else{
2499            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2500        }
2501    }
2502    
2503    sub hsb2rgb {
2504        my ( $h, $s, $br ) = @_;
2505        $h = 6 * ($h - floor($h));
2506        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2507        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2508        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2509                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2510                                          :               ( 0,      1,      $h - 2 )
2511                                          )
2512                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2513                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2514                                          :               ( 1,      0,      6 - $h )
2515                                          );
2516        ( ( $r * $s + 1 - $s ) * $br,
2517          ( $g * $s + 1 - $s ) * $br,
2518          ( $b * $s + 1 - $s ) * $br
2519        )
2520    }
2521    
2522    sub html2rgb {
2523        my ($hex) = @_;
2524        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2525        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2526                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2527    
2528        my @R = split(//, $r);
2529        my @G = split(//, $g);
2530        my @B = split(//, $b);
2531    
2532        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2533        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2534        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2535    
2536        my $rgb = [$red, $green, $blue];
2537        return $rgb;
2538    
2539    }
2540    
2541    sub rgb2html {
2542        my ( $r, $g, $b ) = @_;
2543        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2544        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2545        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2546        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2547    }
2548    
2549    sub floor {
2550        my $x = $_[0];
2551        defined( $x ) || return undef;
2552        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2553    }
2554    
2555    sub get_function_color_cell{
2556      my ($functions, $fig) = @_;
2557    
2558      # figure out the quantity of each function
2559      my %hash;
2560      foreach my $key (keys %$functions){
2561        my $func = $functions->{$key};
2562        $hash{$func}++;
2563      }
2564    
2565      my %func_colors;
2566      my $count = 1;
2567      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2568        $func_colors{$key}=$count;
2569        $count++;
2570      }
2571    
2572      return \%func_colors;
2573  }  }
2574    
2575  sub get_essentially_identical{  sub get_essentially_identical{
2576      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2577      my $fig = new FIG;      #my $fig = new FIG;
2578    
2579      my %id_list;      my %id_list;
2580      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);
2581    
2582      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2583            if($thing->class eq "IDENTICAL"){
2584                my $rows = $thing->rows;
2585                my $count_identical = 0;
2586                foreach my $row (@$rows) {
2587                    my $id = $row->[0];
2588          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2589              $id_list{$id} = 1;              $id_list{$id} = 1;
2590          }          }
2591      }      }
2592            }
2593        }
2594    
2595    #    foreach my $id (@maps_to) {
2596    #        if (($id ne $fid) && ($fig->function_of($id))) {
2597    #           $id_list{$id} = 1;
2598    #        }
2599    #    }
2600      return(%id_list);      return(%id_list);
2601  }  }
2602    
2603    
2604  sub get_evidence_column{  sub get_evidence_column{
2605      my ($ids) = @_;      my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2606      my $fig = new FIG;      my ($column, $code_attributes);
2607      my $cgi = new CGI;  
2608      my (%column, %code_attributes);      if (! defined $attributes) {
2609            my @attributes_array = $fig->get_attributes($ids);
2610            $attributes = \@attributes_array;
2611        }
2612    
2613      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2614      foreach my $key (@codes){      foreach my $key (@codes){
2615          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes->{$key->[0]}}, $key);
2616      }      }
2617    
2618      foreach my $id (@$ids){      foreach my $id (@$ids){
2619          # add evidence code with tool tip          # add evidence code with tool tip
2620          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2621    
2622          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2623              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2624              foreach my $code (@codes) {              foreach my $code (@codes) {
2625                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2626                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
2627                      my ($cd, $ss) = split(";", $code->[2]);                      my ($cd, $ss) = split(";", $code->[2]);
2628                    print STDERR "$id: $cd, $ss\n";
2629                    if ($cd =~ /ilit|dlit/){
2630                        my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2631                        my $publink = &HTML::alias_url($pubmed_id,'PMID');
2632                        $cd = $type . "(<a href='" . $publink . "'>" . $pubmed_id . "</a>)";
2633                    }
2634                      $ss =~ s/_/ /g;                      $ss =~ s/_/ /g;
2635                      $pretty_code = $cd;# . " in " . $ss;                      $pretty_code = $cd;# . " in " . $ss;
2636                  }                  }
2637                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2638              }              }
         }  
2639    
2640          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2641              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 2643 
2643                                  {                                  {
2644                                      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));
2645          }          }
2646          $column{$id}=$ev_codes;  
2647            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2648            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2649      }      }
2650      return (%column);      return $column;
2651  }  }
2652    
2653  sub get_pfam_column{  sub get_attrb_column{
2654      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');  
2655    
2656      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my ($column, %code_attributes, %attribute_locations);
2657        my $dbmaster = DBMaster->new(-database =>'Ontology',
2658                                     -host     => $WebConfig::DBHOST,
2659                                     -user     => $WebConfig::DBUSER,
2660                                     -password => $WebConfig::DBPWD);
2661    
2662        if ($colName eq "pfam"){
2663            if (! defined $attributes) {
2664                my @attributes_array = $fig->get_attributes($ids);
2665                $attributes = \@attributes_array;
2666            }
2667    
2668            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2669      foreach my $key (@codes){      foreach my $key (@codes){
2670          push (@{$code_attributes{$$key[0]}}, $$key[1]);              my $name = $key->[1];
2671                if ($name =~ /_/){
2672                    ($name) = ($key->[1]) =~ /(.*?)_/;
2673                }
2674                push (@{$code_attributes{$key->[0]}}, $name);
2675                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2676      }      }
2677    
2678      foreach my $id (@$ids){      foreach my $id (@$ids){
2679          # add evidence code with tool tip              # add pfam code
2680          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2681          my @pfam_codes = "";          my @pfam_codes = "";
2682          my %description_codes;          my %description_codes;
2683    
2684          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2685              my @codes;                  my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2686              @pfam_codes = ();              @pfam_codes = ();
2687              foreach my $code (@codes) {  
2688                    # get only unique values
2689                    my %saw;
2690                    foreach my $key (@ncodes) {$saw{$key}=1;}
2691                    @ncodes = keys %saw;
2692    
2693                    foreach my $code (@ncodes) {
2694                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2695                  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>";
2696    
2697                        # get the locations for the domain
2698                        my @locs;
2699                        foreach my $part (@{$attribute_location{$id}{$code}}){
2700                            my ($loc) = ($part) =~ /\;(.*)/;
2701                            push (@locs,$loc);
2702                        }
2703                        my %locsaw;
2704                        foreach my $key (@locs) {$locsaw{$key}=1;}
2705                        @locs = keys %locsaw;
2706    
2707                        my $locations = join (", ", @locs);
2708    
2709                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2710                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                          push(@pfam_codes, "$parts[1] ($locations)");
2711                  }                  }
2712                  else {                  else {
2713                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2714                      $description_codes{$parts[1]} = ${$$description[0]}{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2715                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                          push(@pfam_codes, "$pfam_link ($locations)");
                 }  
2716              }              }
2717          }          }
2718    
2719          $column{$id}=join("<br><br>", @pfam_codes);                  if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2720                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2721                }
2722            }
2723        }
2724        elsif ($colName eq 'cellular_location'){
2725            if (! defined $attributes) {
2726                my @attributes_array = $fig->get_attributes($ids);
2727                $attributes = \@attributes_array;
2728      }      }
     return (%column);  
2729    
2730            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2731            foreach my $key (@codes){
2732                my ($loc) = ($key->[1]) =~ /::(.*)/;
2733                my ($new_loc, @all);
2734                @all = split (//, $loc);
2735                my $count = 0;
2736                foreach my $i (@all){
2737                    if ( ($i eq uc($i)) && ($count > 0) ){
2738                        $new_loc .= " " . $i;
2739                    }
2740                    else{
2741                        $new_loc .= $i;
2742                    }
2743                    $count++;
2744                }
2745                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2746  }  }
2747    
2748  sub get_prefer {          foreach my $id (@$ids){
2749      my ($fid, $db, $all_aliases) = @_;              my (@values, $entry);
2750      my $fig = new FIG;              #@values = (" ");
2751      my $cgi = new CGI;              if (defined @{$code_attributes{$id}}){
2752                    my @ncodes = @{$code_attributes{$id}};
2753                    foreach my $code (@ncodes){
2754                        push (@values, $code->[0] . ", " . $code->[1]);
2755                    }
2756                }
2757                else{
2758                    @values = ("Not available");
2759                }
2760    
2761      foreach my $alias (@{$$all_aliases{$fid}}){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2762          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);  
2763          }          }
2764      }      }
2765      return (" ");      elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2766                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2767            if (! defined $attributes) {
2768                my @attributes_array = $fig->get_attributes($ids);
2769                $attributes = \@attributes_array;
2770  }  }
2771    
2772  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }          my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2773            foreach my $key (@codes){
2774                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2775            }
2776    
2777  sub color {          foreach my $id (@$ids){
2778      my ($evalue) = @_;              my (@values, $entry);
2779                #@values = (" ");
2780                if (defined @{$code_attributes{$id}}){
2781                    my @ncodes = @{$code_attributes{$id}};
2782                    foreach my $code (@ncodes){
2783                        push (@values, $code);
2784                    }
2785                }
2786                else{
2787                    @values = ("Not available");
2788                }
2789    
2790      my $color;              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2791      if ($evalue <= 1e-170){              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
         $color = 51;  
2792      }      }
     elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){  
         $color = 52;  
2793      }      }
2794      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2795          $color = 53;              ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2796                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2797                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2798                ($colName eq 'gc_content') ) {
2799            if (! defined $attributes) {
2800                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2801                $attributes = \@attributes_array;
2802      }      }
2803      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){  
2804          $color = 54;          my $genomes_with_phenotype;
2805            foreach my $attribute (@$attributes){
2806                my $genome = $attribute->[0];
2807                $genomes_with_phenotype->{$genome} = $attribute->[2];
2808      }      }
2809      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
2810          $color = 55;          foreach my $id (@$ids){
2811                my $genome = $fig->genome_of($id);
2812                my @values = (' ');
2813                if (defined $genomes_with_phenotype->{$genome}){
2814                    push (@values, $genomes_with_phenotype->{$genome});
2815      }      }
2816      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){              if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2817          $color = 56;              elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2818      }      }
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
2819      }      }
2820      elsif (($evalue <= 1) && ($evalue > 1e-5)){  
2821          $color = 58;      return $column;
2822      }      }
2823      elsif (($evalue <= 10) && ($evalue > 1)){  
2824          $color = 59;  
2825    sub get_db_aliases {
2826        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2827    
2828        my $db_array;
2829        my $all_aliases = $fig->feature_aliases_bulk($ids);
2830        foreach my $id (@$ids){
2831            foreach my $alias (@{$$all_aliases{$id}}){
2832                my $id_db = &Observation::get_database($alias);
2833                next if ( ($id_db ne $db) && ($db ne 'all') );
2834                next if ($aliases->{$id}->{$db});
2835                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2836      }      }
2837      else{          if (!defined( $aliases->{$id}->{$db})){
2838          $color = 60;              $aliases->{$id}->{$db} = " ";
2839            }
2840            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2841            push (@$db_array, $aliases->{$id}->{$db});
2842      }      }
2843    
2844        if ($returnType eq 'hash') { return $aliases; }
2845        elsif ($returnType eq 'array') { return $db_array; }
2846    }
2847    
2848    
2849    
2850    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2851    
2852    sub color {
2853        my ($evalue) = @_;
2854        my $palette = WebColors::get_palette('vitamins');
2855        my $color;
2856        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2857        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2858        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2859        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2860        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2861        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2862        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2863        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2864        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2865        else{        $color = $palette->[9];    }
2866      return ($color);      return ($color);
2867  }  }
2868    
# Line 2152  Line 2882 
2882  }  }
2883    
2884  sub display {  sub display {
2885      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2886    
2887        $taxes = $fig->taxonomy_list();
2888    
2889      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2890      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2891      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2892      my $fig = new FIG;      my $range = $gd_window_size;
2893      my $all_regions = [];      my $all_regions = [];
2894      my $gene_associations={};      my $gene_associations={};
2895    
# Line 2182  Line 2914 
2914      my ($region_start, $region_end);      my ($region_start, $region_end);
2915      if ($beg < $end)      if ($beg < $end)
2916      {      {
2917          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2918          $region_end = $end+4000;          $region_end = $end+ ($range);
2919          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2920      }      }
2921      else      else
2922      {      {
2923          $region_start = $end-4000;          $region_start = $end-($range);
2924          $region_end = $beg+4000;          $region_end = $beg+($range);
2925          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2926          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2927          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2929 
2929    
2930      # call genes in region      # call genes in region
2931      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);
2932        #foreach my $feat (@$target_gene_features){
2933        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2934        #}
2935      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2936      my (@start_array_region);      my (@start_array_region);
2937      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2938    
2939      my %all_genes;      my %all_genes;
2940      my %all_genomes;      my %all_genomes;
2941      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2942            #if ($feature =~ /peg/){
2943      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2944      {          #}
         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;  
2945                  }                  }
2946    
2947                  push (@start_array_region, $offset);      my @selected_sims;
2948    
2949                  $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"){  
2950          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2951          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2952    
2953          # 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");  
   
2954          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2955              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2956                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2957                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2958                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2959                    #my $genome = $fig->genome_of($sim->[1]);
2960                    my $genome = $fig->genome_of($sim->acc);
2961                    #my ($genome1) = ($genome) =~ /(.*)\./;
2962                    my $lineage = $taxes->{$genome};
2963                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2964                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2965                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2966                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2967                            push (@selected_sims, $sim->acc);
2968                      }                      }
2969                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2970              }              }
2971          }          }
2972            else{
2973                my $simcount = 0;
2974                foreach my $sim (@$sims_array){
2975                    next if ($sim->class ne "SIM");
2976                    next if ($sim->acc !~ /fig\|/);
2977    
2978                    push (@selected_sims, $sim->acc);
2979                    $simcount++;
2980                    last if ($simcount > 4);
2981                }
2982            }
2983    
2984            my %saw;
2985            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2986    
2987          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2988          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 3006 
3006              my ($region_start, $region_end);              my ($region_start, $region_end);
3007              if ($beg < $end)              if ($beg < $end)
3008              {              {
3009                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
3010                  $region_end = $end+4000;                  $region_end = $end+($range/2);
3011                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
3012              }              }
3013              else              else
3014              {              {
3015                  $region_start = $end-4000;                  $region_start = $end-($range/2);
3016                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
3017                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
3018                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
3019                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 3029 
3029    
3030      }      }
3031    
3032        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
3033      # cluster the genes      # cluster the genes
3034      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3035      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3036        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3037        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
3038    
3039      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3040          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
3041          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
3042          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
3043          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
3044            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
3045            my $lineage = $taxes->{$region_genome};
3046            #my $lineage = $fig->taxonomy_of($region_genome);
3047            #$region_gs .= "Lineage:$lineage";
3048          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
3049                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
3050                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 3052 
3052    
3053          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
3054    
3055          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
3056                                     'short_title' => "",                                     'short_title' => "",
3057                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
3058                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 3076 
3076    
3077              # get subsystem information              # get subsystem information
3078              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
3079              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
3080    
3081              my $link;              my $link;
3082              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
3083                       "link" => $url_link};                       "link" => $url_link};
3084              push(@$links_list,$link);              push(@$links_list,$link);
3085    
3086              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3087              foreach my $subsystem (@subsystems){              my @subsystems;
3088                foreach my $array (@subs){
3089                    my $subsystem = $$array[0];
3090                    my $ss = $subsystem;
3091                    $ss =~ s/_/ /ig;
3092                    push (@subsystems, $ss);
3093                  my $link;                  my $link;
3094                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3095                           "link_title" => $subsystem};                           "link_title" => $ss};
3096                    push(@$links_list,$link);
3097                }
3098    
3099                if ($fid1 eq $fid){
3100                    my $link;
3101                    $link = {"link_title" => "Annotate this sequence",
3102                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3103                  push(@$links_list,$link);                  push(@$links_list,$link);
3104              }              }
3105    
# Line 2401  Line 3133 
3133                  $prev_stop = $stop;                  $prev_stop = $stop;
3134                  $prev_fig = $fid1;                  $prev_fig = $fid1;
3135    
3136                  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})){
3137                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
3138                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
3139                  }                  }
3140    
3141                    my $title = $fid1;
3142                    if ($fid1 eq $fid){
3143                        $title = "My query gene: $fid1";
3144                    }
3145    
3146                  $element_hash = {                  $element_hash = {
3147                      "title" => $fid1,                      "title" => $title,
3148                      "start" => $start,                      "start" => $start,
3149                      "end" =>  $stop,                      "end" =>  $stop,
3150                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 3157 
3157                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
3158                  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;}
3159                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3160    
3161                    if ($fid1 eq $fid){
3162                        $element_hash = {
3163                            "title" => 'Query',
3164                            "start" => $start,
3165                            "end" =>  $stop,
3166                            "type"=> 'bigbox',
3167                            "color"=> $color,
3168                            "zlayer" => "1"
3169                            };
3170    
3171                        # if there is an overlap, put into second line
3172                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3173                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3174                    }
3175              }              }
3176          }          }
3177          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3178          $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);
3179      }      }
3180      return $gd;      return ($gd, \@selected_sims);
3181  }  }
3182    
3183  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 3247 
3247      }      }
3248    
3249      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
3250          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3251              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
3252                  foreach $y (@$x) {                  foreach $y (@$x) {
3253                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 3265 
3265      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3266      return ($i < @$xL);      return ($i < @$xL);
3267  }  }
3268    
3269    #############################################
3270    #############################################
3271    package Observation::Commentary;
3272    
3273    use base qw(Observation);
3274    
3275    =head3 display_protein_commentary()
3276    
3277    =cut
3278    
3279    sub display_protein_commentary {
3280        my ($self,$dataset,$mypeg,$fig) = @_;
3281    
3282        my $all_rows = [];
3283        my $content;
3284        #my $fig = new FIG;
3285        my $cgi = new CGI;
3286        my $count = 0;
3287        my $peg_array = [];
3288        my ($evidence_column, $subsystems_column,  %e_identical);
3289    
3290        if (@$dataset != 1){
3291            foreach my $thing (@$dataset){
3292                if ($thing->class eq "SIM"){
3293                    push (@$peg_array, $thing->acc);
3294                }
3295            }
3296            # get the column for the evidence codes
3297            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3298    
3299            # get the column for the subsystems
3300            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3301    
3302            # get essentially identical seqs
3303            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3304        }
3305        else{
3306            push (@$peg_array, @$dataset);
3307        }
3308    
3309        my $selected_sims = [];
3310        foreach my $id (@$peg_array){
3311            last if ($count > 10);
3312            my $row_data = [];
3313            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3314            if ($fig->org_of($id)){
3315                $org = $fig->org_of($id);
3316            }
3317            else{
3318                $org = "Data not available";
3319            }
3320            $function = $fig->function_of($id);
3321            if ($mypeg ne $id){
3322                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3323                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3324                if (defined($e_identical{$id})) { $id_cell .= "*";}
3325            }
3326            else{
3327                $function_cell = "&nbsp;&nbsp;$function";
3328                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3329                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3330            }
3331    
3332            push(@$row_data,$id_cell);
3333            push(@$row_data,$org);
3334            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3335            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3336            push(@$row_data, $fig->translation_length($id));
3337            push(@$row_data,$function_cell);
3338            push(@$all_rows,$row_data);
3339            push (@$selected_sims, $id);
3340            $count++;
3341        }
3342    
3343        if ($count >0){
3344            $content = $all_rows;
3345        }
3346        else{
3347            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3348        }
3349        return ($content,$selected_sims);
3350    }
3351    
3352    sub display_protein_history {
3353        my ($self, $id,$fig) = @_;
3354        my $all_rows = [];
3355        my $content;
3356    
3357        my $cgi = new CGI;
3358        my $count = 0;
3359        foreach my $feat ($fig->feature_annotations($id)){
3360            my $row = [];
3361            my $col1 = $feat->[2];
3362            my $col2 = $feat->[1];
3363            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3364            my $text = $feat->[3];
3365    
3366            push (@$row, $col1);
3367            push (@$row, $col2);
3368            push (@$row, $text);
3369            push (@$all_rows, $row);
3370            $count++;
3371        }
3372        if ($count > 0){
3373            $content = $all_rows;
3374        }
3375        else {
3376            $content = "There is no history for this PEG";
3377        }
3378    
3379        return($content);
3380    }
3381    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3