[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.54, Mon Feb 18 20:40:19 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 FigFams;
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);  
     }  
391    
392      if ( @subsystems ) {      push (@$row, $org_name);
393          $content .= qq(<tr><td>Subsystems</td><td>);      push (@$row, $fid);
394          foreach my $subsystem ( @subsystems ) {      push (@$row, $length);
395              $content .= join(" -- ", @$subsystem) . "<br>\n";      push (@$row, $function);
396          }  
397      }      # initialize the table for commentary and annotations
398        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
399        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
400        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
401        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
402        #$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      my %groups;      push(@$content, $row);
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
         }  
   
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
   
   
         $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;  
675      foreach my $sim (@sims){      foreach my $sim (@sims){
676          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($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);  
     foreach my $sim (@sims){  
         my $hit = $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        foreach my $thing (@$array){
1690            if ($thing->class eq "SIM"){
1691    
1692      my $organism = $self->organism;              my $peg = $thing->acc;
1693                my $query = $thing->query;
1694    
1695                my $organism = $thing->organism;
1696      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1697      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1698      my $function = $self->function;              my $function = $thing->function;
1699      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1700      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1701      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1702      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1703      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1704    
1705      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;
1706    
# Line 1655  Line 1717 
1717      my $descriptions = [];      my $descriptions = [];
1718    
1719      # get subsystem information      # get subsystem information
1720      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1721      my $link;      my $link;
1722      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1723               "link" => $url_link};               "link" => $url_link};
1724      push(@$links_list,$link);      push(@$links_list,$link);
1725    
1726      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1727      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1728                my @subsystems;
1729    
1730                foreach my $array (@subs){
1731                    my $subsystem = $$array[0];
1732                    push(@subsystems,$subsystem);
1733          my $link;          my $link;
1734          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1735                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1736          push(@$links_list,$link);          push(@$links_list,$link);
1737      }      }
1738    
1739                $link = {"link_title" => "view blast alignment",
1740                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1741                push (@$links_list,$link);
1742    
1743      my $description_function;      my $description_function;
1744      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1745                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1760 
1760                          "value" => $hit_stop};                          "value" => $hit_stop};
1761      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1762    
1763      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1764      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1765      {      {
1766          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1791 
1791          };          };
1792      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1793      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1794            }
1795        }
1796      return ($gd);      return ($gd);
   
1797  }  }
1798    
1799  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1803 
1803  =cut  =cut
1804    
1805  sub display_domain_composition {  sub display_domain_composition {
1806      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1807    
1808      my $fig = new FIG;      #$fig = new FIG;
1809      my $peg = $self->acc;      my $peg = $self->acc;
1810    
1811      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1813 
1813      my $descriptions = [];      my $descriptions = [];
1814    
1815      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1816        #my @domain_query_results = ();
1817      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1818          my $key = @$dqr[1];          my $key = @$dqr[1];
1819          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1838 
1838              }              }
1839          }          }
1840    
1841          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1842                                    -host     => $WebConfig::DBHOST,
1843                                    -user     => $WebConfig::DBUSER,
1844                                    -password => $WebConfig::DBPWD);
1845          my ($name_value,$description_value);          my ($name_value,$description_value);
1846    
1847          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 1878 
1878          my $link;          my $link;
1879          my $link_url;          my $link_url;
1880          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"}
1881          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"}
1882          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
1883    
1884          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 1902 
1902      }      }
1903    
1904      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1905                            'hover_title' => 'Domain',
1906                          'short_title' => $peg,                          'short_title' => $peg,
1907                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1908    
# Line 1848  Line 1922 
1922  =cut  =cut
1923    
1924  sub display_table {  sub display_table {
1925      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1926    
1927      my $data = [];      my $data = [];
1928      my $count = 0;      my $count = 0;
1929      my $content;      my $content;
1930      my $fig = new FIG;      #my $fig = new FIG;
1931      my $cgi = new CGI;      my $cgi = new CGI;
1932      my @ids;      my @ids;
1933        $lineages = $fig->taxonomy_list();
1934    
1935      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1936          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1937          push (@ids, $thing->acc);          push (@ids, $thing->acc);
1938      }      }
1939    
1940      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1941        my @attributes = $fig->get_attributes(\@ids);
1942    
1943      # get the column for the subsystems      # get the column for the subsystems
1944      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1945    
1946      # get the column for the evidence codes      # get the column for the evidence codes
1947      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1948    
1949      # get the column for pfam_domain      # get the column for pfam_domain
1950      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1951    
1952      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1953      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1954        #my $alias_col = {};
1955    
1956        my $figfam_data = "$FIG_Config::FigfamsData";
1957        my $figfams = new FigFams($fig,$figfam_data);
1958        my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1959    
1960      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1961          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1963 
1963          $count++;          $count++;
1964    
1965          my $id = $thing->acc;          my $id = $thing->acc;
1966            my $taxid   = $fig->genome_of($id);
1967          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1968          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1969          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1980 
1980          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1981          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1982          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');">);
1983            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1984    
1985          # get the linked fig id          # get the linked fig id
1986          my $fig_col;          my $fig_col;
1987          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1988              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1989          }          }
1990          else{          else{
1991              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1992          }          }
1993    
1994          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1995          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1996          push(@$single_domain,$thing->evalue);                  # permanent column  
         push(@$single_domain,"$iden\%");                       # permanent column  
         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  
1997          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1998              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1999              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2000              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2001              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"});}
2002              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"});}
2003              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"});}
2004              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"});}
2005              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"});}
2006              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"});}
2007              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"});}
2008              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"});}
2009              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"});}
2010              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"});}
2011                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2012                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2013                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2014          }          }
2015          push(@$data,$single_domain);          push(@$data,$single_domain);
2016      }      }
   
2017      if ($count >0 ){      if ($count >0 ){
2018          $content = $data;          $content = $data;
2019      }      }
# Line 1955  Line 2035 
2035  }  }
2036    
2037  sub get_subsystems_column{  sub get_subsystems_column{
2038      my ($ids) = @_;      my ($ids,$fig) = @_;
2039    
2040      my $fig = new FIG;      #my $fig = new FIG;
2041      my $cgi = new CGI;      my $cgi = new CGI;
2042      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2043      my %column;      my %column;
# Line 1966  Line 2046 
2046          my @subsystems;          my @subsystems;
2047    
2048          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2049              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2050                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2051                  $count++;                  $ss =~ s/_/ /ig;
2052                    push (@subsystems, "-" . $ss);
2053              }              }
2054              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2055              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2061 
2061  }  }
2062    
2063  sub get_essentially_identical{  sub get_essentially_identical{
2064      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2065      my $fig = new FIG;      #my $fig = new FIG;
2066    
2067      my %id_list;      my %id_list;
2068      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);
2069    
2070      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2071            if($thing->class eq "IDENTICAL"){
2072                my $rows = $thing->rows;
2073                my $count_identical = 0;
2074                foreach my $row (@$rows) {
2075                    my $id = $row->[0];
2076          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2077              $id_list{$id} = 1;              $id_list{$id} = 1;
2078          }          }
2079      }      }
2080            }
2081        }
2082    
2083    #    foreach my $id (@maps_to) {
2084    #        if (($id ne $fid) && ($fig->function_of($id))) {
2085    #           $id_list{$id} = 1;
2086    #        }
2087    #    }
2088      return(%id_list);      return(%id_list);
2089  }  }
2090    
2091    
2092  sub get_evidence_column{  sub get_evidence_column{
2093      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2094      my $fig = new FIG;      #my $fig = new FIG;
2095      my $cgi = new CGI;      my $cgi = new CGI;
2096      my (%column, %code_attributes);      my (%column, %code_attributes);
2097    
2098      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2099      foreach my $key (@codes){      foreach my $key (@codes){
2100          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2101      }      }
# Line 2010  Line 2103 
2103      foreach my $id (@$ids){      foreach my $id (@$ids){
2104          # add evidence code with tool tip          # add evidence code with tool tip
2105          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2106    
2107          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2108              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2109              foreach my $code (@codes) {              foreach my $code (@codes) {
2110                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2111                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2115 
2115                  }                  }
2116                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2117              }              }
         }  
2118    
2119          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2120              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 2128 
2128  }  }
2129    
2130  sub get_pfam_column{  sub get_pfam_column{
2131      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2132      my $fig = new FIG;      #my $fig = new FIG;
2133      my $cgi = new CGI;      my $cgi = new CGI;
2134      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2135      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2136                                    -host     => $WebConfig::DBHOST,
2137                                    -user     => $WebConfig::DBUSER,
2138                                    -password => $WebConfig::DBPWD);
2139    
2140      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2141      foreach my $key (@codes){      foreach my $key (@codes){
2142          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2143            if ($name =~ /_/){
2144                ($name) = ($key->[1]) =~ /(.*?)_/;
2145            }
2146            push (@{$code_attributes{$key->[0]}}, $name);
2147            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2148      }      }
2149    
2150      foreach my $id (@$ids){      foreach my $id (@$ids){
2151          # add evidence code with tool tip          # add evidence code
2152          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2153          my @pfam_codes = "";          my @pfam_codes = "";
2154          my %description_codes;          my %description_codes;
2155    
2156          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2157              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2158              @pfam_codes = ();              @pfam_codes = ();
2159              foreach my $code (@codes) {  
2160                # get only unique values
2161                my %saw;
2162                foreach my $key (@ncodes) {$saw{$key}=1;}
2163                @ncodes = keys %saw;
2164    
2165                foreach my $code (@ncodes) {
2166                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2167                  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>";
2168    
2169                    # get the locations for the domain
2170                    my @locs;
2171                    foreach my $part (@{$attribute_location{$id}{$code}}){
2172                        my ($loc) = ($part) =~ /\;(.*)/;
2173                        push (@locs,$loc);
2174                    }
2175                    my %locsaw;
2176                    foreach my $key (@locs) {$locsaw{$key}=1;}
2177                    @locs = keys %locsaw;
2178    
2179                    my $locations = join (", ", @locs);
2180    
2181                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2182                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2183                  }                  }
2184                  else {                  else {
2185                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2186                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2187                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2188                  }                  }
2189              }              }
2190          }          }
# Line 2080  Line 2195 
2195    
2196  }  }
2197    
2198  sub get_prefer {  sub get_aliases {
2199      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2200    
2201      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2202        foreach my $id (@$ids){
2203            foreach my $alias (@{$$all_aliases{$id}}){
2204          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2205          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2206              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2207          }          }
2208      }      }
2209      return (" ");      return ($aliases);
2210  }  }
2211    
2212  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; $_ }
2213    
2214  sub color {  sub color {
2215      my ($evalue) = @_;      my ($evalue) = @_;
2216        my $palette = WebColors::get_palette('vitamins');
2217      my $color;      my $color;
2218      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2219          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2220      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2221      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2222          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2223      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2224      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2225          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2226      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2227      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;  
     }  
   
   
2228      return ($color);      return ($color);
2229  }  }
2230    
# Line 2152  Line 2244 
2244  }  }
2245    
2246  sub display {  sub display {
2247      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2248    
2249        $taxes = $fig->taxonomy_list();
2250    
2251      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2252      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2253      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2254      my $fig = new FIG;      my $range = $gd_window_size;
2255      my $all_regions = [];      my $all_regions = [];
2256      my $gene_associations={};      my $gene_associations={};
2257    
# Line 2182  Line 2276 
2276      my ($region_start, $region_end);      my ($region_start, $region_end);
2277      if ($beg < $end)      if ($beg < $end)
2278      {      {
2279          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2280          $region_end = $end+4000;          $region_end = $end+ ($range);
2281          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2282      }      }
2283      else      else
2284      {      {
2285          $region_start = $end-4000;          $region_start = $end-($range);
2286          $region_end = $beg+4000;          $region_end = $beg+($range);
2287          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2288          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2289          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2291 
2291    
2292      # call genes in region      # call genes in region
2293      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);
2294        #foreach my $feat (@$target_gene_features){
2295        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2296        #}
2297      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2298      my (@start_array_region);      my (@start_array_region);
2299      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2300    
2301      my %all_genes;      my %all_genes;
2302      my %all_genomes;      my %all_genomes;
2303      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2304            #if ($feature =~ /peg/){
2305      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2306      {          #}
         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;  
2307                  }                  }
2308    
2309                  push (@start_array_region, $offset);      my @selected_sims;
2310    
2311                  $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"){  
2312          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2313          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2314    
2315          # 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");  
   
2316          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2317              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2318                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2319                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2320                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2321                    #my $genome = $fig->genome_of($sim->[1]);
2322                    my $genome = $fig->genome_of($sim->acc);
2323                    #my ($genome1) = ($genome) =~ /(.*)\./;
2324                    my $lineage = $taxes->{$genome};
2325                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2326                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2327                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2328                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2329                            push (@selected_sims, $sim->acc);
2330                      }                      }
2331                  }                  }
2332                  my %saw;              }
2333                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2334            else{
2335                my $simcount = 0;
2336                foreach my $sim (@$sims_array){
2337                    next if ($sim->class ne "SIM");
2338                    next if ($sim->acc !~ /fig\|/);
2339    
2340                    push (@selected_sims, $sim->acc);
2341                    $simcount++;
2342                    last if ($simcount > 4);
2343              }              }
2344          }          }
2345    
2346            my %saw;
2347            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2348    
2349          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2350          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2351              #get the organism genome              #get the organism genome
# Line 2293  Line 2368 
2368              my ($region_start, $region_end);              my ($region_start, $region_end);
2369              if ($beg < $end)              if ($beg < $end)
2370              {              {
2371                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2372                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2373                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2374              }              }
2375              else              else
2376              {              {
2377                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2378                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2379                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2380                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2381                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2391 
2391    
2392      }      }
2393    
2394        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2395      # cluster the genes      # cluster the genes
2396      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2397      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2398        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2399        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2400    
2401      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2402          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2403          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2404          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2405          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2406            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2407            my $lineage = $taxes->{$region_genome};
2408            #my $lineage = $fig->taxonomy_of($region_genome);
2409            #$region_gs .= "Lineage:$lineage";
2410          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2411                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2412                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2414 
2414    
2415          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2416    
2417          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2418                                     'short_title' => "",                                     'short_title' => "",
2419                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2420                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2438 
2438    
2439              # get subsystem information              # get subsystem information
2440              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2441              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2442    
2443              my $link;              my $link;
2444              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2445                       "link" => $url_link};                       "link" => $url_link};
2446              push(@$links_list,$link);              push(@$links_list,$link);
2447    
2448              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2449              foreach my $subsystem (@subsystems){              my @subsystems;
2450                foreach my $array (@subs){
2451                    my $subsystem = $$array[0];
2452                    my $ss = $subsystem;
2453                    $ss =~ s/_/ /ig;
2454                    push (@subsystems, $ss);
2455                  my $link;                  my $link;
2456                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2457                           "link_title" => $subsystem};                           "link_title" => $ss};
2458                    push(@$links_list,$link);
2459                }
2460    
2461                if ($fid1 eq $fid){
2462                    my $link;
2463                    $link = {"link_title" => "Annotate this sequence",
2464                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2465                  push(@$links_list,$link);                  push(@$links_list,$link);
2466              }              }
2467    
# Line 2406  Line 2500 
2500                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2501                  }                  }
2502    
2503                    my $title = $fid1;
2504                    if ($fid1 eq $fid){
2505                        $title = "My query gene: $fid1";
2506                    }
2507    
2508                  $element_hash = {                  $element_hash = {
2509                      "title" => $fid1,                      "title" => $title,
2510                      "start" => $start,                      "start" => $start,
2511                      "end" =>  $stop,                      "end" =>  $stop,
2512                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2519 
2519                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2520                  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;}
2521                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2522    
2523                    if ($fid1 eq $fid){
2524                        $element_hash = {
2525                            "title" => 'Query',
2526                            "start" => $start,
2527                            "end" =>  $stop,
2528                            "type"=> 'bigbox',
2529                            "color"=> $color,
2530                            "zlayer" => "1"
2531                            };
2532    
2533                        # if there is an overlap, put into second line
2534                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2535                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2536                    }
2537              }              }
2538          }          }
2539          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2540          $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);
2541      }      }
2542      return $gd;      return ($gd, \@selected_sims);
2543  }  }
2544    
2545  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2609 
2609      }      }
2610    
2611      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2612          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2613              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2614                  foreach $y (@$x) {                  foreach $y (@$x) {
2615                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2627 
2627      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2628      return ($i < @$xL);      return ($i < @$xL);
2629  }  }
2630    
2631    #############################################
2632    #############################################
2633    package Observation::Commentary;
2634    
2635    use base qw(Observation);
2636    
2637    =head3 display_protein_commentary()
2638    
2639    =cut
2640    
2641    sub display_protein_commentary {
2642        my ($self,$dataset,$mypeg,$fig) = @_;
2643    
2644        my $all_rows = [];
2645        my $content;
2646        #my $fig = new FIG;
2647        my $cgi = new CGI;
2648        my $count = 0;
2649        my $peg_array = [];
2650        my (%evidence_column, %subsystems_column,  %e_identical);
2651    
2652        if (@$dataset != 1){
2653            foreach my $thing (@$dataset){
2654                if ($thing->class eq "SIM"){
2655                    push (@$peg_array, $thing->acc);
2656                }
2657            }
2658            # get the column for the evidence codes
2659            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2660    
2661            # get the column for the subsystems
2662            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2663    
2664            # get essentially identical seqs
2665            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2666        }
2667        else{
2668            push (@$peg_array, @$dataset);
2669        }
2670    
2671        my $selected_sims = [];
2672        foreach my $id (@$peg_array){
2673            last if ($count > 10);
2674            my $row_data = [];
2675            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2676            $org = $fig->org_of($id);
2677            $function = $fig->function_of($id);
2678            if ($mypeg ne $id){
2679                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2680                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2681                if (defined($e_identical{$id})) { $id_cell .= "*";}
2682            }
2683            else{
2684                $function_cell = "&nbsp;&nbsp;$function";
2685                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2686                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2687            }
2688    
2689            push(@$row_data,$id_cell);
2690            push(@$row_data,$org);
2691            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2692            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2693            push(@$row_data, $fig->translation_length($id));
2694            push(@$row_data,$function_cell);
2695            push(@$all_rows,$row_data);
2696            push (@$selected_sims, $id);
2697            $count++;
2698        }
2699    
2700        if ($count >0){
2701            $content = $all_rows;
2702        }
2703        else{
2704            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2705        }
2706        return ($content,$selected_sims);
2707    }
2708    
2709    sub display_protein_history {
2710        my ($self, $id,$fig) = @_;
2711        my $all_rows = [];
2712        my $content;
2713    
2714        my $cgi = new CGI;
2715        my $count = 0;
2716        foreach my $feat ($fig->feature_annotations($id)){
2717            my $row = [];
2718            my $col1 = $feat->[2];
2719            my $col2 = $feat->[1];
2720            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2721            my $text = $feat->[3];
2722    
2723            push (@$row, $col1);
2724            push (@$row, $col2);
2725            push (@$row, $text);
2726            push (@$all_rows, $row);
2727            $count++;
2728        }
2729        if ($count > 0){
2730            $content = $all_rows;
2731        }
2732        else {
2733            $content = "There is no history for this PEG";
2734        }
2735    
2736        return($content);
2737    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3