[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.57, Thu Apr 17 20:45:23 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);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 86  Line 88 
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91    =head3 query()
92    
93    The query id
94    
95    =cut
96    
97    sub query {
98        my ($self) = @_;
99        return $self->{query};
100    }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 305  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 365  Line 379 
379    
380  =cut  =cut
381  sub display_housekeeping {  sub display_housekeeping {
382      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
383      my $fig = new FIG;      my $content = [];
384      my $content;      my $row = [];
385    
386      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
387      my $org_id   = $fig->orgid_of_orgname($org_name);      my $org_id = $fig->genome_of($fid);
     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);  
388      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
389      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
390      my $taxonomy = $fig->taxonomy_of($org_id);      my $length = $fig->translation_length($fid);
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
   
     $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);  
     $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);  
     $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);  
     }  
   
     if ( @subsystems ) {  
         $content .= qq(<tr><td>Subsystems</td><td>);  
         foreach my $subsystem ( @subsystems ) {  
             $content .= join(" -- ", @$subsystem) . "<br>\n";  
         }  
     }  
391    
392      my %groups;      push (@$row, $org_name);
393      if ( @aliases ) {      push (@$row, $fid);
394          # get the db for each alias      push (@$row, $length);
395          foreach my $alias (@aliases){      push (@$row, $function);
396              $groups{$alias} = &get_database($alias);  
397          }      # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399          # group ids by aliases      #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400          my %db_aliases;      #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401          foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){      #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402              push (@{$db_aliases{$groups{$key}}}, $key);      #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
403          }      #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
404        #$content .= qq(</table><p>\n);
405    
406        push(@$content, $row);
         $content .= qq(<tr><td>Aliases</td><td><table border="0">);  
         foreach my $key (sort keys %db_aliases){  
             $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);  
         }  
         $content .= qq(</td></tr></table>\n);  
     }  
   
     $content .= qq(</table><p>\n);  
407    
408      return ($content);      return ($content);
409  }  }
# Line 435  Line 414 
414  =cut  =cut
415    
416  sub get_sims_summary {  sub get_sims_summary {
417      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
418      my %families;      my %families;
419      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
420    
421      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
422          next if ($sim->[1] !~ /fig\|/);          my ($id, $evalue);
423          my $genome = $fig->genome_of($sim->[1]);          if ($thing =~ /fig\|/){
424          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));              $id = $thing;
425                $evalue = -1;
426            }
427            else{
428                next if ($thing->class ne "SIM");
429                $id      = $thing->acc;
430                $evalue  = $thing->evalue;
431            }
432            next if ($id !~ /fig\|/);
433            next if ($fig->is_deleted_fid($id));
434    
435            my $genome = $fig->genome_of($id);
436            #my ($genome1) = ($genome) =~ /(.*)\./;
437            my $taxonomy = $taxes->{$genome};
438          my $parent_tax = "Root";          my $parent_tax = "Root";
439          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
440            push (@{$families{figs}{$parent_tax}}, $id);
441            my $level = 2;
442          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
443              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
444                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
445                $families{level}{$tax} = $level;
446              push (@currLineage, $tax);              push (@currLineage, $tax);
447              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
448              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
449                if (defined ($families{evalue}{$tax})){
450                    if ($evalue < $families{evalue}{$tax}){
451                        $families{evalue}{$tax} = $evalue;
452                        $families{color}{$tax} = &get_taxcolor($evalue);
453                    }
454                }
455                else{
456                    $families{evalue}{$tax} = $evalue;
457                    $families{color}{$tax} = &get_taxcolor($evalue);
458                }
459    
460              $parent_tax = $tax;              $parent_tax = $tax;
461                $level++;
462          }          }
463      }      }
464    
# Line 462  Line 469 
469          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
470          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
471      }      }
472      return (\%families);  
473        return \%families;
474  }  }
475    
476  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 481 
481    
482  =cut  =cut
483    
484    sub get_taxcolor{
485        my ($evalue) = @_;
486        my $color;
487        if ($evalue == -1){            $color = "black";      }
488        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
489        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
490        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
491        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
492        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
493        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
494        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
495        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
496        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
497        else{        $color = "#6666FF";    }
498        return ($color);
499    }
500    
501    
502  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
503    
504      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
505      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
506    
507      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
508          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
509          my @parts = split("::",$key);          my @parts = split("::",$key);
510          my $class = $parts[0];          my $class = $parts[0];
511            my $name = $parts[1];
512            #next if (($class eq "PFAM") && ($name !~ /interpro/));
513    
514          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
515              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 518 
518                  my $from = $2;                  my $from = $2;
519                  my $to = $3;                  my $to = $3;
520                  my $evalue;                  my $evalue;
521                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
522                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
523                      my $part1 = $2/100;                      my $part1 = $2/100;
524                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
525                  }                  }
526                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
527                        $evalue=$raw_evalue;
528                    }
529                  else{                  else{
530                      $evalue = "0.0";                      $evalue = "0.0";
531                  }                  }
# Line 520  Line 548 
548    
549  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
550    
551      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
552      my $fig = new FIG;      #my $fig = new FIG;
553    
554      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
555    
# Line 531  Line 559 
559                     };                     };
560    
561      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
562          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
563          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
564          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 570 
570                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
571                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
572                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
573              }              }
574              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
575                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 608 
608  =cut  =cut
609    
610  sub get_pdb_observations{  sub get_pdb_observations{
611      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
612    
613      my $fig = new FIG;      #my $fig = new FIG;
614    
615      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
616          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
617          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
618          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 667 
667    
668  sub get_sims_observations{  sub get_sims_observations{
669    
670      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
671      my $fig = new FIG;      #my $fig = new FIG;
672      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
673      my ($dataset);      my ($dataset);
674    
     my %id_list;  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
675      foreach my $sim (@sims){      foreach my $sim (@sims){
676          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($sim->[1]));
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
   
     foreach my $sim (@new_sims){  
677          my $hit = $sim->[1];          my $hit = $sim->[1];
678          my $percent = $sim->[2];          my $percent = $sim->[2];
679          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 688 
688          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
689    
690          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
691                        'query' => $sim->[0],
692                      'acc' => $hit,                      'acc' => $hit,
693                      'identity' => $percent,                      'identity' => $percent,
694                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 743 
743    
744  sub get_identical_proteins{  sub get_identical_proteins{
745    
746      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
747      my $fig = new FIG;      #my $fig = new FIG;
748      my $funcs_ref;      my $funcs_ref;
749    
 #    my %id_list;  
750      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;  
 #    }  
   
751      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
752          my ($tmp, $who);          my ($tmp, $who);
753          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}))) {  
754              $who = &get_database($id);              $who = &get_database($id);
755              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
756          }          }
757      }      }
758    
     my ($dataset);  
759      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
760                     'type' => 'seq',                     'type' => 'seq',
761                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 775 
775    
776  sub get_functional_coupling{  sub get_functional_coupling{
777    
778      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
779      my $fig = new FIG;      #my $fig = new FIG;
780      my @funcs = ();      my @funcs = ();
781    
782      # initialize some variables      # initialize some variables
# Line 797  Line 793 
793                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
794                    } @fc_data;                    } @fc_data;
795    
     my ($dataset);  
796      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
797                     'type' => 'fc',                     'type' => 'fc',
798                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 903 
903      return $self->{database};      return $self->{database};
904  }  }
905    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
906  ############################################################  ############################################################
907  ############################################################  ############################################################
908  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 928 
928  =cut  =cut
929    
930  sub display{  sub display{
931      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
932    
933      my $fid = $self->fig_id;      my $fid = $self->fig_id;
934      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
935                                    -host     => $WebConfig::DBHOST,
936                                    -user     => $WebConfig::DBUSER,
937                                    -password => $WebConfig::DBPWD);
938    
939      my $acc = $self->acc;      my $acc = $self->acc;
940    
# Line 963  Line 955 
955      my $lines = [];      my $lines = [];
956      my $line_data = [];      my $line_data = [];
957      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
958                            'hover_title' => 'PDB',
959                          'short_title' => "best PDB",                          'short_title' => "best PDB",
960                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
961    
962      my $fig = new FIG;      #my $fig = new FIG;
963      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
964      my $fid_stop = length($seq);      my $fid_stop = length($seq);
965    
# Line 1067  Line 1060 
1060    
1061    
1062  sub display_table{  sub display_table{
1063      my ($self) = @_;      my ($self,$fig) = @_;
1064    
1065      my $fig = new FIG;      #my $fig = new FIG;
1066      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1067      my $rows = $self->rows;      my $rows = $self->rows;
1068      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1124 
1124    
1125  sub display_table {  sub display_table {
1126    
1127      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1128      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1129      my $rows = $self->rows;      my $rows = $self->rows;
1130      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1139 
1139          # construct the score link          # construct the score link
1140          my $score = $row->[0];          my $score = $row->[0];
1141          my $toid = $row->[1];          my $toid = $row->[1];
1142          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";
1143          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1144    
1145          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1146          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1193 
1193      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1194      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1195    
1196      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1197                                    -host     => $WebConfig::DBHOST,
1198                                    -user     => $WebConfig::DBUSER,
1199                                    -password => $WebConfig::DBPWD);
1200    
1201      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1202      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1215 
1215              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1216          }          }
1217      }      }
1218        elsif($db =~ /PFAM/){
1219            my ($new_id) = ($id) =~ /(.*?)_/;
1220            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1221            if(!scalar(@$pfam_objs)){
1222                $name_title = "name";
1223                $name_value = "not available";
1224                $description_title = "description";
1225                $description_value = "not available";
1226            }
1227            else{
1228                my $pfam_obj = $pfam_objs->[0];
1229                $name_title = "name";
1230                $name_value = $pfam_obj->term;
1231                #$description_title = "description";
1232                #$description_value = $pfam_obj->description;
1233            }
1234        }
1235    
1236      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1237                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1238        my $new_short_title=$short_title;
1239        if ($short_title =~ /interpro/){
1240            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1241        }
1242        my $line_config = { 'title' => $name_value,
1243                            'hover_title', => 'Domain',
1244                            'short_title' => $new_short_title,
1245                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1246    
1247      my $name;      my $name;
1248      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1249               "value" => $name_value};      $name = {"title" => $db,
1250                 "value" => $new_id};
1251      push(@$descriptions,$name);      push(@$descriptions,$name);
1252    
1253      my $description;  #    my $description;
1254      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1255                               "value" => $description_value};  #                   "value" => $description_value};
1256      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1257    
1258      my $score;      my $score;
1259      $score = {"title" => "score",      $score = {"title" => "score",
1260                "value" => $thing->evalue};                "value" => $thing->evalue};
1261      push(@$descriptions,$score);      push(@$descriptions,$score);
1262    
1263        my $location;
1264        $location = {"title" => "location",
1265                     "value" => $thing->start . " - " . $thing->stop};
1266        push(@$descriptions,$location);
1267    
1268      my $link_id;      my $link_id;
1269      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1270          $link_id = $1;          $link_id = $1;
1271      }      }
1272    
1273      my $link;      my $link;
1274      my $link_url;      my $link_url;
1275      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"}
1276      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"}
1277      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1278    
1279      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1281 
1281      push(@$links_list,$link);      push(@$links_list,$link);
1282    
1283      my $element_hash = {      my $element_hash = {
1284          "title" => $thing->type,          "title" => $name_value,
1285          "start" => $thing->start,          "start" => $thing->start,
1286          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1287          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1311 
1311          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1312          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1313    
1314          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1315                                    -host     => $WebConfig::DBHOST,
1316                                    -user     => $WebConfig::DBUSER,
1317                                    -password => $WebConfig::DBPWD);
1318    
1319          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1320          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1333 
1333                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1334              }              }
1335          }          }
1336            elsif($db =~ /PFAM/){
1337                my ($new_id) = ($id) =~ /(.*?)_/;
1338                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1339                if(!scalar(@$pfam_objs)){
1340                    $name_title = "name";
1341                    $name_value = "not available";
1342                    $description_title = "description";
1343                    $description_value = "not available";
1344                }
1345                else{
1346                    my $pfam_obj = $pfam_objs->[0];
1347                    $name_title = "name";
1348                    $name_value = $pfam_obj->term;
1349                    #$description_title = "description";
1350                    #$description_value = $pfam_obj->description;
1351                }
1352            }
1353    
1354          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1355    
# Line 1356  Line 1402 
1402      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1403      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1404      if($cello_location){      if($cello_location){
1405          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1406          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1407      }      }
1408      return ($html);      return ($html);
1409  }  }
1410    
1411  sub display {  sub display {
1412      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1413    
1414      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1415      my $fig= new FIG;      #my $fig= new FIG;
1416      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1417    
1418      my $cleavage_prob;      my $cleavage_prob;
# Line 1394  Line 1440 
1440    
1441          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1442                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1443                                'hover_title' => 'Localization',
1444                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1445    
1446          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1465 
1465          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1466      }      }
1467    
 =cut  
   
1468      $color = "2";      $color = "2";
1469      if($tmpred_score){      if($tmpred_score){
1470          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1494 
1494          }          }
1495          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1496      }      }
1497    =cut
1498    
1499      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1500          my $line_data =[];          my $line_data =[];
1501          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1502                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1503                                'hover_title' => 'Localization',
1504                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1505    
1506          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1507              my $descriptions = [];              my $descriptions = [];
1508              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1509                               "value" => $tm_loc};                               "value" => $tm_loc};
1510              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1511    
1512              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1513    
1514              my $element_hash = {              my $element_hash = {
1515              "title" => "phobius transmembrane location",              "title" => "Phobius",
1516              "start" => $begin + 1,              "start" => $begin + 1,
1517              "end" =>  $end + 1,              "end" =>  $end + 1,
1518              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1546 
1546          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1547      }      }
1548    
1549    =head3
1550      $color = "1";      $color = "1";
1551      if($signal_peptide_score){      if($signal_peptide_score){
1552          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1554 
1554    
1555          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1556                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1557                                'hover_title' => 'Localization',
1558                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1559    
1560          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1579 
1579          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1580          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1581      }      }
1582    =cut
1583    
1584      return ($gd);      return ($gd);
1585    
# Line 1602  Line 1651 
1651      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1652      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1653      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1654        $self->{query} = $dataset->{'query'};
1655      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1656      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1657      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1675 
1675  =cut  =cut
1676    
1677  sub display {  sub display {
1678      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1679        #my $fig = new FIG;
1680    
1681      my $fig = new FIG;      my @ids;
1682      my $peg = $self->acc;      foreach my $thing(@$array){
1683            next if ($thing->class ne "SIM");
1684            push (@ids, $thing->acc);
1685        }
1686    
1687        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1688    
1689        my %sims_objects_evalue;
1690        my $count = 0;
1691        foreach my $thing (@$array){
1692            if ($thing->class eq "SIM"){
1693                $sims_objects_evalue{$count} = $thing->evalue;
1694            }
1695            $count++;
1696        }
1697    
1698      my $organism = $self->organism;      foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1699    #    foreach my $thing ( @$array){
1700            my $thing = $array->[$index];
1701            if ($thing->class eq "SIM"){
1702                my $peg = $thing->acc;
1703                my $query = $thing->query;
1704    
1705                my $organism = $thing->organism;
1706      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1707      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1708      my $function = $self->function;              my $function = $thing->function;
1709      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1710      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1711      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1712      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1713      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1714    
1715      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;
1716    
# Line 1655  Line 1727 
1727      my $descriptions = [];      my $descriptions = [];
1728    
1729      # get subsystem information      # get subsystem information
1730      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1731      my $link;      my $link;
1732      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1733               "link" => $url_link};               "link" => $url_link};
1734      push(@$links_list,$link);      push(@$links_list,$link);
1735    
1736      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1737      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1738                my @subsystems;
1739    
1740                foreach my $array (@subs){
1741                    my $subsystem = $$array[0];
1742                    push(@subsystems,$subsystem);
1743          my $link;          my $link;
1744          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1745                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1746          push(@$links_list,$link);          push(@$links_list,$link);
1747      }      }
1748    
1749                $link = {"link_title" => "view blast alignment",
1750                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1751                push (@$links_list,$link);
1752    
1753      my $description_function;      my $description_function;
1754      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1755                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1770 
1770                          "value" => $hit_stop};                          "value" => $hit_stop};
1771      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1772    
1773      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1774      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1775      {      {
1776          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1801 
1801          };          };
1802      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1803      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1804            }
1805        }
1806      return ($gd);      return ($gd);
   
1807  }  }
1808    
1809  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1813 
1813  =cut  =cut
1814    
1815  sub display_domain_composition {  sub display_domain_composition {
1816      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1817    
1818      my $fig = new FIG;      #$fig = new FIG;
1819      my $peg = $self->acc;      my $peg = $self->acc;
1820    
1821      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1823 
1823      my $descriptions = [];      my $descriptions = [];
1824    
1825      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1826        #my @domain_query_results = ();
1827      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1828          my $key = @$dqr[1];          my $key = @$dqr[1];
1829          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1848 
1848              }              }
1849          }          }
1850    
1851          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1852                                    -host     => $WebConfig::DBHOST,
1853                                    -user     => $WebConfig::DBUSER,
1854                                    -password => $WebConfig::DBPWD);
1855          my ($name_value,$description_value);          my ($name_value,$description_value);
1856    
1857          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 1888 
1888          my $link;          my $link;
1889          my $link_url;          my $link_url;
1890          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"}
1891          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"}
1892          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
1893    
1894          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 1912 
1912      }      }
1913    
1914      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1915                            'hover_title' => 'Domain',
1916                          'short_title' => $peg,                          'short_title' => $peg,
1917                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1918    
# Line 1848  Line 1932 
1932  =cut  =cut
1933    
1934  sub display_table {  sub display_table {
1935      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1936    
1937      my $data = [];      my $data = [];
1938      my $count = 0;      my $count = 0;
1939      my $content;      my $content;
1940      my $fig = new FIG;      #my $fig = new FIG;
1941      my $cgi = new CGI;      my $cgi = new CGI;
1942      my @ids;      my @ids;
1943        $lineages = $fig->taxonomy_list();
1944    
1945      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1946          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1947          push (@ids, $thing->acc);          push (@ids, $thing->acc);
1948      }      }
1949    
1950      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1951        my @attributes = $fig->get_attributes(\@ids);
1952    
1953      # get the column for the subsystems      # get the column for the subsystems
1954      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1955    
1956      # get the column for the evidence codes      # get the column for the evidence codes
1957      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1958    
1959      # get the column for pfam_domain      # get the column for pfam_domain
1960      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1961    
1962      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1963      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1964        #my $alias_col = {};
1965    
1966        my $figfam_data = &FIG::get_figfams_data();
1967        my $figfams = new FFs($figfam_data);
1968    #    my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1969    
1970        my %sims_objects_evalue;
1971        my $simcount = 0;
1972      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1973            if ($thing->class eq "SIM"){
1974                $sims_objects_evalue{$simcount} = $thing->evalue;
1975            }
1976            $simcount++;
1977        }
1978    
1979        foreach my $index (sort {$sims_objects_evalue{$a}<=>$sims_objects_evalue{$b}} keys %sims_objects_evalue){
1980    #    foreach my $thing ( @$dataset){
1981            my $thing = $dataset->[$index];
1982    
1983          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1984          my $single_domain = [];          my $single_domain = [];
1985          $count++;          $count++;
1986    
1987          my $id = $thing->acc;          my $id = $thing->acc;
1988            my $taxid   = $fig->genome_of($id);
1989          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1990          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1991          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 2002 
2002          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2003          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2004          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
2005            my ($tax) = ($id) =~ /fig\|(.*?)\./;
2006    
2007          # get the linked fig id          # get the linked fig id
2008          my $fig_col;          my $fig_col;
2009          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
2010              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
2011          }          }
2012          else{          else{
2013              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
2014          }          }
2015    
2016          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
2017          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
2018          push(@$single_domain,$thing->evalue);                  # permanent column  
2019          push(@$single_domain,"$iden\%");                       # permanent column          my ($ff) = $figfams->families_containing_peg($id);
2020          push(@$single_domain,$reg1);                           # permanent column  
         push(@$single_domain,$reg2);                           # permanent column  
         push(@$single_domain,$thing->organism);                # permanent column  
         push(@$single_domain,$thing->function);                # permanent column  
2021          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
2022              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
2023              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2024              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2025              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
2026              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
2027              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
2028              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
2029              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
2030              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
2031              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
2032              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
2033              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
2034              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
2035                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2036                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2037                #elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2038                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");}
2039          }          }
2040          push(@$data,$single_domain);          push(@$data,$single_domain);
2041      }      }
   
2042      if ($count >0 ){      if ($count >0 ){
2043          $content = $data;          $content = $data;
2044      }      }
# Line 1955  Line 2060 
2060  }  }
2061    
2062  sub get_subsystems_column{  sub get_subsystems_column{
2063      my ($ids) = @_;      my ($ids,$fig) = @_;
2064    
2065      my $fig = new FIG;      #my $fig = new FIG;
2066      my $cgi = new CGI;      my $cgi = new CGI;
2067      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2068      my %column;      my %column;
# Line 1966  Line 2071 
2071          my @subsystems;          my @subsystems;
2072    
2073          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2074              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2075                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2076                  $count++;                  $ss =~ s/_/ /ig;
2077                    push (@subsystems, "-" . $ss);
2078              }              }
2079              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2080              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2086 
2086  }  }
2087    
2088  sub get_essentially_identical{  sub get_essentially_identical{
2089      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2090      my $fig = new FIG;      #my $fig = new FIG;
2091    
2092      my %id_list;      my %id_list;
2093      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);
2094    
2095      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2096            if($thing->class eq "IDENTICAL"){
2097                my $rows = $thing->rows;
2098                my $count_identical = 0;
2099                foreach my $row (@$rows) {
2100                    my $id = $row->[0];
2101          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2102              $id_list{$id} = 1;              $id_list{$id} = 1;
2103          }          }
2104      }      }
2105            }
2106        }
2107    
2108    #    foreach my $id (@maps_to) {
2109    #        if (($id ne $fid) && ($fig->function_of($id))) {
2110    #           $id_list{$id} = 1;
2111    #        }
2112    #    }
2113      return(%id_list);      return(%id_list);
2114  }  }
2115    
2116    
2117  sub get_evidence_column{  sub get_evidence_column{
2118      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2119      my $fig = new FIG;      #my $fig = new FIG;
2120      my $cgi = new CGI;      my $cgi = new CGI;
2121      my (%column, %code_attributes);      my (%column, %code_attributes);
2122    
2123      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2124      foreach my $key (@codes){      foreach my $key (@codes){
2125          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2126      }      }
# Line 2010  Line 2128 
2128      foreach my $id (@$ids){      foreach my $id (@$ids){
2129          # add evidence code with tool tip          # add evidence code with tool tip
2130          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2131    
2132          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2133              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2134              foreach my $code (@codes) {              foreach my $code (@codes) {
2135                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2136                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2140 
2140                  }                  }
2141                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2142              }              }
         }  
2143    
2144          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2145              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 2039  Line 2153 
2153  }  }
2154    
2155  sub get_pfam_column{  sub get_pfam_column{
2156      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2157      my $fig = new FIG;      #my $fig = new FIG;
2158      my $cgi = new CGI;      my $cgi = new CGI;
2159      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2160      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2161                                    -host     => $WebConfig::DBHOST,
2162                                    -user     => $WebConfig::DBUSER,
2163                                    -password => $WebConfig::DBPWD);
2164    
2165      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2166      foreach my $key (@codes){      foreach my $key (@codes){
2167          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2168            if ($name =~ /_/){
2169                ($name) = ($key->[1]) =~ /(.*?)_/;
2170            }
2171            push (@{$code_attributes{$key->[0]}}, $name);
2172            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2173      }      }
2174    
2175      foreach my $id (@$ids){      foreach my $id (@$ids){
2176          # add evidence code with tool tip          # add evidence code
2177          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2178          my @pfam_codes = "";          my @pfam_codes = "";
2179          my %description_codes;          my %description_codes;
2180    
2181          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2182              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2183              @pfam_codes = ();              @pfam_codes = ();
2184              foreach my $code (@codes) {  
2185                # get only unique values
2186                my %saw;
2187                foreach my $key (@ncodes) {$saw{$key}=1;}
2188                @ncodes = keys %saw;
2189    
2190                foreach my $code (@ncodes) {
2191                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2192                  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>";
2193    
2194                    # get the locations for the domain
2195                    my @locs;
2196                    foreach my $part (@{$attribute_location{$id}{$code}}){
2197                        my ($loc) = ($part) =~ /\;(.*)/;
2198                        push (@locs,$loc);
2199                    }
2200                    my %locsaw;
2201                    foreach my $key (@locs) {$locsaw{$key}=1;}
2202                    @locs = keys %locsaw;
2203    
2204                    my $locations = join (", ", @locs);
2205    
2206                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2207                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2208                  }                  }
2209                  else {                  else {
2210                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2211                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2212                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2213                  }                  }
2214              }              }
2215          }          }
# Line 2080  Line 2220 
2220    
2221  }  }
2222    
2223  sub get_prefer {  sub get_aliases {
2224      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2225    
2226      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2227        foreach my $id (@$ids){
2228            foreach my $alias (@{$$all_aliases{$id}}){
2229          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2230          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2231              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2232          }          }
2233      }      }
2234      return (" ");      return ($aliases);
2235  }  }
2236    
2237  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2238    
2239  sub color {  sub color {
2240      my ($evalue) = @_;      my ($evalue) = @_;
2241        my $palette = WebColors::get_palette('vitamins');
2242      my $color;      my $color;
2243      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2244          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2245      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2246      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2247          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2248      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2249      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2250          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2251      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2252      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){      else{        $color = $palette->[9];    }
         $color = 54;  
     }  
     elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){  
         $color = 55;  
     }  
     elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){  
         $color = 56;  
     }  
     elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){  
         $color = 57;  
     }  
     elsif (($evalue <= 1) && ($evalue > 1e-5)){  
         $color = 58;  
     }  
     elsif (($evalue <= 10) && ($evalue > 1)){  
         $color = 59;  
     }  
     else{  
         $color = 60;  
     }  
   
   
2253      return ($color);      return ($color);
2254  }  }
2255    
# Line 2152  Line 2269 
2269  }  }
2270    
2271  sub display {  sub display {
2272      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2273    
2274        $taxes = $fig->taxonomy_list();
2275    
2276      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2277      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2278      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2279      my $fig = new FIG;      my $range = $gd_window_size;
2280      my $all_regions = [];      my $all_regions = [];
2281      my $gene_associations={};      my $gene_associations={};
2282    
# Line 2182  Line 2301 
2301      my ($region_start, $region_end);      my ($region_start, $region_end);
2302      if ($beg < $end)      if ($beg < $end)
2303      {      {
2304          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2305          $region_end = $end+4000;          $region_end = $end+ ($range);
2306          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2307      }      }
2308      else      else
2309      {      {
2310          $region_start = $end-4000;          $region_start = $end-($range);
2311          $region_end = $beg+4000;          $region_end = $beg+($range);
2312          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2313          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2314          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2316 
2316    
2317      # call genes in region      # call genes in region
2318      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);
2319        #foreach my $feat (@$target_gene_features){
2320        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2321        #}
2322      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2323      my (@start_array_region);      my (@start_array_region);
2324      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2325    
2326      my %all_genes;      my %all_genes;
2327      my %all_genomes;      my %all_genomes;
2328      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2329            #if ($feature =~ /peg/){
2330      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2331      {          #}
         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;  
2332                  }                  }
2333    
2334                  push (@start_array_region, $offset);      my @selected_sims;
2335    
2336                  $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"){  
2337          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2338          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2339    
2340          # 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");  
   
2341          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2342              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2343                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2344                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2345                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2346                    #my $genome = $fig->genome_of($sim->[1]);
2347                    my $genome = $fig->genome_of($sim->acc);
2348                    #my ($genome1) = ($genome) =~ /(.*)\./;
2349                    my $lineage = $taxes->{$genome};
2350                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2351                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2352                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2353                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2354                            push (@selected_sims, $sim->acc);
2355                      }                      }
2356                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2357              }              }
2358          }          }
2359            else{
2360                my $simcount = 0;
2361                foreach my $sim (@$sims_array){
2362                    next if ($sim->class ne "SIM");
2363                    next if ($sim->acc !~ /fig\|/);
2364    
2365                    push (@selected_sims, $sim->acc);
2366                    $simcount++;
2367                    last if ($simcount > 4);
2368                }
2369            }
2370    
2371            my %saw;
2372            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2373    
2374          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2375          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2393 
2393              my ($region_start, $region_end);              my ($region_start, $region_end);
2394              if ($beg < $end)              if ($beg < $end)
2395              {              {
2396                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2397                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2398                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2399              }              }
2400              else              else
2401              {              {
2402                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2403                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2404                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2405                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2406                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2416 
2416    
2417      }      }
2418    
2419        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2420      # cluster the genes      # cluster the genes
2421      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2422      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2423        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2424        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2425    
2426      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2427          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2428          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2429          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2430          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2431            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2432            my $lineage = $taxes->{$region_genome};
2433            #my $lineage = $fig->taxonomy_of($region_genome);
2434            #$region_gs .= "Lineage:$lineage";
2435          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2436                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2437                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2439 
2439    
2440          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2441    
2442          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2443                                     'short_title' => "",                                     'short_title' => "",
2444                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2445                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2463 
2463    
2464              # get subsystem information              # get subsystem information
2465              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2466              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2467    
2468              my $link;              my $link;
2469              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2470                       "link" => $url_link};                       "link" => $url_link};
2471              push(@$links_list,$link);              push(@$links_list,$link);
2472    
2473              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2474              foreach my $subsystem (@subsystems){              my @subsystems;
2475                foreach my $array (@subs){
2476                    my $subsystem = $$array[0];
2477                    my $ss = $subsystem;
2478                    $ss =~ s/_/ /ig;
2479                    push (@subsystems, $ss);
2480                  my $link;                  my $link;
2481                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2482                           "link_title" => $subsystem};                           "link_title" => $ss};
2483                    push(@$links_list,$link);
2484                }
2485    
2486                if ($fid1 eq $fid){
2487                    my $link;
2488                    $link = {"link_title" => "Annotate this sequence",
2489                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2490                  push(@$links_list,$link);                  push(@$links_list,$link);
2491              }              }
2492    
# Line 2406  Line 2525 
2525                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2526                  }                  }
2527    
2528                    my $title = $fid1;
2529                    if ($fid1 eq $fid){
2530                        $title = "My query gene: $fid1";
2531                    }
2532    
2533                  $element_hash = {                  $element_hash = {
2534                      "title" => $fid1,                      "title" => $title,
2535                      "start" => $start,                      "start" => $start,
2536                      "end" =>  $stop,                      "end" =>  $stop,
2537                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2544 
2544                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2545                  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;}
2546                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2547    
2548                    if ($fid1 eq $fid){
2549                        $element_hash = {
2550                            "title" => 'Query',
2551                            "start" => $start,
2552                            "end" =>  $stop,
2553                            "type"=> 'bigbox',
2554                            "color"=> $color,
2555                            "zlayer" => "1"
2556                            };
2557    
2558                        # if there is an overlap, put into second line
2559                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2560                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2561                    }
2562              }              }
2563          }          }
2564          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2565          $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);
2566      }      }
2567      return $gd;      return ($gd, \@selected_sims);
2568  }  }
2569    
2570  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2634 
2634      }      }
2635    
2636      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2637          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2638              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2639                  foreach $y (@$x) {                  foreach $y (@$x) {
2640                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2652 
2652      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2653      return ($i < @$xL);      return ($i < @$xL);
2654  }  }
2655    
2656    #############################################
2657    #############################################
2658    package Observation::Commentary;
2659    
2660    use base qw(Observation);
2661    
2662    =head3 display_protein_commentary()
2663    
2664    =cut
2665    
2666    sub display_protein_commentary {
2667        my ($self,$dataset,$mypeg,$fig) = @_;
2668    
2669        my $all_rows = [];
2670        my $content;
2671        #my $fig = new FIG;
2672        my $cgi = new CGI;
2673        my $count = 0;
2674        my $peg_array = [];
2675        my (%evidence_column, %subsystems_column,  %e_identical);
2676    
2677        if (@$dataset != 1){
2678            foreach my $thing (@$dataset){
2679                if ($thing->class eq "SIM"){
2680                    push (@$peg_array, $thing->acc);
2681                }
2682            }
2683            # get the column for the evidence codes
2684            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2685    
2686            # get the column for the subsystems
2687            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2688    
2689            # get essentially identical seqs
2690            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2691        }
2692        else{
2693            push (@$peg_array, @$dataset);
2694        }
2695    
2696        my $selected_sims = [];
2697        foreach my $id (@$peg_array){
2698            last if ($count > 10);
2699            my $row_data = [];
2700            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2701            $org = $fig->org_of($id);
2702            $function = $fig->function_of($id);
2703            if ($mypeg ne $id){
2704                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2705                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2706                if (defined($e_identical{$id})) { $id_cell .= "*";}
2707            }
2708            else{
2709                $function_cell = "&nbsp;&nbsp;$function";
2710                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2711                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2712            }
2713    
2714            push(@$row_data,$id_cell);
2715            push(@$row_data,$org);
2716            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2717            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2718            push(@$row_data, $fig->translation_length($id));
2719            push(@$row_data,$function_cell);
2720            push(@$all_rows,$row_data);
2721            push (@$selected_sims, $id);
2722            $count++;
2723        }
2724    
2725        if ($count >0){
2726            $content = $all_rows;
2727        }
2728        else{
2729            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2730        }
2731        return ($content,$selected_sims);
2732    }
2733    
2734    sub display_protein_history {
2735        my ($self, $id,$fig) = @_;
2736        my $all_rows = [];
2737        my $content;
2738    
2739        my $cgi = new CGI;
2740        my $count = 0;
2741        foreach my $feat ($fig->feature_annotations($id)){
2742            my $row = [];
2743            my $col1 = $feat->[2];
2744            my $col2 = $feat->[1];
2745            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2746            my $text = $feat->[3];
2747    
2748            push (@$row, $col1);
2749            push (@$row, $col2);
2750            push (@$row, $text);
2751            push (@$all_rows, $row);
2752            $count++;
2753        }
2754        if ($count > 0){
2755            $content = $all_rows;
2756        }
2757        else {
2758            $content = "There is no history for this PEG";
2759        }
2760    
2761        return($content);
2762    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3