[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.53, Mon Feb 18 20:29:09 2008 UTC
# Line 7  Line 7 
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    
# Line 86  Line 90 
90    return $self->{acc};    return $self->{acc};
91  }  }
92    
93    =head3 query()
94    
95    The query id
96    
97    =cut
98    
99    sub query {
100        my ($self) = @_;
101        return $self->{query};
102    }
103    
104    
105  =head3 class()  =head3 class()
106    
107  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 321 
321  =cut  =cut
322    
323  sub get_objects {  sub get_objects {
324      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
325    
326      my $objects = [];      my $objects = [];
327      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
328    
329      # call function that fetches attribute based observations      # call function that fetches attribute based observations
330      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 336 
336          my %domain_classes;          my %domain_classes;
337          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
338          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
339          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
340          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
341          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
342          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
343          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
344          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
345            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
346      }      }
347    
348      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 350 
350          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
351              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
352          }          }
353          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
354              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
355          }          }
356          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
357              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
358          }          }
359          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
360              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
361          }          }
362          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
363              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
364          }          }
365          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
366              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
367          }          }
368          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
369              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
370          }          }
371    
# Line 365  Line 381 
381    
382  =cut  =cut
383  sub display_housekeeping {  sub display_housekeeping {
384      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
385      my $fig = new FIG;      my $content = [];
386      my $content;      my $row = [];
387    
388      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
389      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);  
390      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
391      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
392      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);  
     }  
393    
394      if ( @subsystems ) {      push (@$row, $org_name);
395          $content .= qq(<tr><td>Subsystems</td><td>);      push (@$row, $fid);
396          foreach my $subsystem ( @subsystems ) {      push (@$row, $length);
397              $content .= join(" -- ", @$subsystem) . "<br>\n";      push (@$row, $function);
398          }  
399      }      # initialize the table for commentary and annotations
400        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
401        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
402        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
403        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
404        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
405        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
406        #$content .= qq(</table><p>\n);
407    
408      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);  
409    
410      return ($content);      return ($content);
411  }  }
# Line 435  Line 416 
416  =cut  =cut
417    
418  sub get_sims_summary {  sub get_sims_summary {
419      my ($observation, $fid) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
420      my %families;      my %families;
421      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
422    
423      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
424          next if ($sim->[1] !~ /fig\|/);          my ($id, $evalue);
425          my $genome = $fig->genome_of($sim->[1]);          if ($thing =~ /fig\|/){
426          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));              $id = $thing;
427                $evalue = -1;
428            }
429            else{
430                next if ($thing->class ne "SIM");
431                $id      = $thing->acc;
432                $evalue  = $thing->evalue;
433            }
434            next if ($id !~ /fig\|/);
435            next if ($fig->is_deleted_fid($id));
436    
437            my $genome = $fig->genome_of($id);
438            #my ($genome1) = ($genome) =~ /(.*)\./;
439            my $taxonomy = $taxes->{$genome};
440          my $parent_tax = "Root";          my $parent_tax = "Root";
441          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
442            push (@{$families{figs}{$parent_tax}}, $id);
443            my $level = 2;
444          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
445              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
446                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
447                $families{level}{$tax} = $level;
448              push (@currLineage, $tax);              push (@currLineage, $tax);
449              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
450              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
451                if (defined ($families{evalue}{$tax})){
452                    if ($evalue < $families{evalue}{$tax}){
453                        $families{evalue}{$tax} = $evalue;
454                        $families{color}{$tax} = &get_taxcolor($evalue);
455                    }
456                }
457                else{
458                    $families{evalue}{$tax} = $evalue;
459                    $families{color}{$tax} = &get_taxcolor($evalue);
460                }
461    
462              $parent_tax = $tax;              $parent_tax = $tax;
463                $level++;
464          }          }
465      }      }
466    
# Line 462  Line 471 
471          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
472          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
473      }      }
474      return (\%families);  
475        return \%families;
476  }  }
477    
478  =head1 Internal Methods  =head1 Internal Methods
# Line 473  Line 483 
483    
484  =cut  =cut
485    
486    sub get_taxcolor{
487        my ($evalue) = @_;
488        my $color;
489        if ($evalue == -1){            $color = "black";      }
490        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
491        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
492        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
493        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
494        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
495        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
496        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
497        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
498        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
499        else{        $color = "#6666FF";    }
500        return ($color);
501    }
502    
503    
504  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
505    
506      # 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)
507      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
508    
509      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
510          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
511          my @parts = split("::",$key);          my @parts = split("::",$key);
512          my $class = $parts[0];          my $class = $parts[0];
513            my $name = $parts[1];
514            next if (($class eq "PFAM") && ($name !~ /interpro/));
515    
516          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
517              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 520 
520                  my $from = $2;                  my $from = $2;
521                  my $to = $3;                  my $to = $3;
522                  my $evalue;                  my $evalue;
523                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
524                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
525                      my $part1 = $2/100;                      my $part1 = $2/100;
526                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
527                  }                  }
528                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
529                        $evalue=$raw_evalue;
530                    }
531                  else{                  else{
532                      $evalue = "0.0";                      $evalue = "0.0";
533                  }                  }
# Line 520  Line 550 
550    
551  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
552    
553      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
554      my $fig = new FIG;      #my $fig = new FIG;
555    
556      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
557    
# Line 531  Line 561 
561                     };                     };
562    
563      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
564          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
565          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
566          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 572 
572                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
573                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
574                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
575              }              }
576              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
577                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 610 
610  =cut  =cut
611    
612  sub get_pdb_observations{  sub get_pdb_observations{
613      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
614    
615      my $fig = new FIG;      #my $fig = new FIG;
616    
617      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
618          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
619          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
620          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 669 
669    
670  sub get_sims_observations{  sub get_sims_observations{
671    
672      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
673      my $fig = new FIG;      #my $fig = new FIG;
674      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
675      my ($dataset);      my ($dataset);
676    
     my %id_list;  
677      foreach my $sim (@sims){      foreach my $sim (@sims){
678          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){  
679          my $hit = $sim->[1];          my $hit = $sim->[1];
680          my $percent = $sim->[2];          my $percent = $sim->[2];
681          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 690 
690          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
691    
692          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
693                        'query' => $sim->[0],
694                      'acc' => $hit,                      'acc' => $hit,
695                      'identity' => $percent,                      'identity' => $percent,
696                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 745 
745    
746  sub get_identical_proteins{  sub get_identical_proteins{
747    
748      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
749      my $fig = new FIG;      #my $fig = new FIG;
750      my $funcs_ref;      my $funcs_ref;
751    
 #    my %id_list;  
752      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;  
 #    }  
   
753      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
754          my ($tmp, $who);          my ($tmp, $who);
755          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}))) {  
756              $who = &get_database($id);              $who = &get_database($id);
757              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
758          }          }
759      }      }
760    
     my ($dataset);  
761      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
762                     'type' => 'seq',                     'type' => 'seq',
763                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 777 
777    
778  sub get_functional_coupling{  sub get_functional_coupling{
779    
780      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
781      my $fig = new FIG;      #my $fig = new FIG;
782      my @funcs = ();      my @funcs = ();
783    
784      # initialize some variables      # initialize some variables
# Line 797  Line 795 
795                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
796                    } @fc_data;                    } @fc_data;
797    
     my ($dataset);  
798      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
799                     'type' => 'fc',                     'type' => 'fc',
800                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 905 
905      return $self->{database};      return $self->{database};
906  }  }
907    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
908  ############################################################  ############################################################
909  ############################################################  ############################################################
910  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 930 
930  =cut  =cut
931    
932  sub display{  sub display{
933      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
934    
935      my $fid = $self->fig_id;      my $fid = $self->fig_id;
936      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
937                                    -host     => $WebConfig::DBHOST,
938                                    -user     => $WebConfig::DBUSER,
939                                    -password => $WebConfig::DBPWD);
940    
941      my $acc = $self->acc;      my $acc = $self->acc;
942    
# Line 963  Line 957 
957      my $lines = [];      my $lines = [];
958      my $line_data = [];      my $line_data = [];
959      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
960                            'hover_title' => 'PDB',
961                          'short_title' => "best PDB",                          'short_title' => "best PDB",
962                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
963    
964      my $fig = new FIG;      #my $fig = new FIG;
965      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
966      my $fid_stop = length($seq);      my $fid_stop = length($seq);
967    
# Line 1067  Line 1062 
1062    
1063    
1064  sub display_table{  sub display_table{
1065      my ($self) = @_;      my ($self,$fig) = @_;
1066    
1067      my $fig = new FIG;      #my $fig = new FIG;
1068      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1069      my $rows = $self->rows;      my $rows = $self->rows;
1070      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1126 
1126    
1127  sub display_table {  sub display_table {
1128    
1129      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1130      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1131      my $rows = $self->rows;      my $rows = $self->rows;
1132      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1141 
1141          # construct the score link          # construct the score link
1142          my $score = $row->[0];          my $score = $row->[0];
1143          my $toid = $row->[1];          my $toid = $row->[1];
1144          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";
1145          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1146    
1147          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1148          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1195 
1195      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1196      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1197    
1198      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1199                                    -host     => $WebConfig::DBHOST,
1200                                    -user     => $WebConfig::DBUSER,
1201                                    -password => $WebConfig::DBPWD);
1202    
1203      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1204      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1217 
1217              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1218          }          }
1219      }      }
1220        elsif($db =~ /PFAM/){
1221            my ($new_id) = ($id) =~ /(.*?)_/;
1222            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1223            if(!scalar(@$pfam_objs)){
1224                $name_title = "name";
1225                $name_value = "not available";
1226                $description_title = "description";
1227                $description_value = "not available";
1228            }
1229            else{
1230                my $pfam_obj = $pfam_objs->[0];
1231                $name_title = "name";
1232                $name_value = $pfam_obj->term;
1233                #$description_title = "description";
1234                #$description_value = $pfam_obj->description;
1235            }
1236        }
1237    
1238      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1239                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1240        my $new_short_title=$short_title;
1241        if ($short_title =~ /interpro/){
1242            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1243        }
1244        my $line_config = { 'title' => $name_value,
1245                            'hover_title', => 'Domain',
1246                            'short_title' => $new_short_title,
1247                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1248    
1249      my $name;      my $name;
1250      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1251               "value" => $name_value};      $name = {"title" => $db,
1252                 "value" => $new_id};
1253      push(@$descriptions,$name);      push(@$descriptions,$name);
1254    
1255      my $description;  #    my $description;
1256      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1257                               "value" => $description_value};  #                   "value" => $description_value};
1258      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1259    
1260      my $score;      my $score;
1261      $score = {"title" => "score",      $score = {"title" => "score",
1262                "value" => $thing->evalue};                "value" => $thing->evalue};
1263      push(@$descriptions,$score);      push(@$descriptions,$score);
1264    
1265        my $location;
1266        $location = {"title" => "location",
1267                     "value" => $thing->start . " - " . $thing->stop};
1268        push(@$descriptions,$location);
1269    
1270      my $link_id;      my $link_id;
1271      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1272          $link_id = $1;          $link_id = $1;
1273      }      }
1274    
1275      my $link;      my $link;
1276      my $link_url;      my $link_url;
1277      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"}
1278      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"}
1279      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1280    
1281      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1255  Line 1283 
1283      push(@$links_list,$link);      push(@$links_list,$link);
1284    
1285      my $element_hash = {      my $element_hash = {
1286          "title" => $thing->type,          "title" => $name_value,
1287          "start" => $thing->start,          "start" => $thing->start,
1288          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1289          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1313 
1313          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1314          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1315    
1316          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1317                                    -host     => $WebConfig::DBHOST,
1318                                    -user     => $WebConfig::DBUSER,
1319                                    -password => $WebConfig::DBPWD);
1320    
1321          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1322          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1335 
1335                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1336              }              }
1337          }          }
1338            elsif($db =~ /PFAM/){
1339                my ($new_id) = ($id) =~ /(.*?)_/;
1340                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1341                if(!scalar(@$pfam_objs)){
1342                    $name_title = "name";
1343                    $name_value = "not available";
1344                    $description_title = "description";
1345                    $description_value = "not available";
1346                }
1347                else{
1348                    my $pfam_obj = $pfam_objs->[0];
1349                    $name_title = "name";
1350                    $name_value = $pfam_obj->term;
1351                    #$description_title = "description";
1352                    #$description_value = $pfam_obj->description;
1353                }
1354            }
1355    
1356          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1357    
# Line 1356  Line 1404 
1404      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1405      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1406      if($cello_location){      if($cello_location){
1407          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1408          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1409      }      }
1410      return ($html);      return ($html);
1411  }  }
1412    
1413  sub display {  sub display {
1414      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1415    
1416      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1417      my $fig= new FIG;      #my $fig= new FIG;
1418      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1419    
1420      my $cleavage_prob;      my $cleavage_prob;
# Line 1394  Line 1442 
1442    
1443          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1444                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1445                                'hover_title' => 'Localization',
1446                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1447    
1448          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1467 
1467          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1468      }      }
1469    
 =cut  
   
1470      $color = "2";      $color = "2";
1471      if($tmpred_score){      if($tmpred_score){
1472          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1496 
1496          }          }
1497          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1498      }      }
1499    =cut
1500    
1501      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1502          my $line_data =[];          my $line_data =[];
1503          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1504                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1505                                'hover_title' => 'Localization',
1506                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1507    
1508          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1509              my $descriptions = [];              my $descriptions = [];
1510              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1511                               "value" => $tm_loc};                               "value" => $tm_loc};
1512              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1513    
1514              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1515    
1516              my $element_hash = {              my $element_hash = {
1517              "title" => "phobius transmembrane location",              "title" => "Phobius",
1518              "start" => $begin + 1,              "start" => $begin + 1,
1519              "end" =>  $end + 1,              "end" =>  $end + 1,
1520              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1548 
1548          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1549      }      }
1550    
1551    =head3
1552      $color = "1";      $color = "1";
1553      if($signal_peptide_score){      if($signal_peptide_score){
1554          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1556 
1556    
1557          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1558                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1559                                'hover_title' => 'Localization',
1560                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1561    
1562          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1581 
1581          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1582          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1583      }      }
1584    =cut
1585    
1586      return ($gd);      return ($gd);
1587    
# Line 1602  Line 1653 
1653      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1654      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1655      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1656        $self->{query} = $dataset->{'query'};
1657      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1658      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1659      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1677 
1677  =cut  =cut
1678    
1679  sub display {  sub display {
1680      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1681        #my $fig = new FIG;
1682    
1683      my $fig = new FIG;      my @ids;
1684      my $peg = $self->acc;      foreach my $thing(@$array){
1685            next if ($thing->class ne "SIM");
1686            push (@ids, $thing->acc);
1687        }
1688    
1689        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1690    
1691        foreach my $thing (@$array){
1692            if ($thing->class eq "SIM"){
1693    
1694                my $peg = $thing->acc;
1695                my $query = $thing->query;
1696    
1697      my $organism = $self->organism;              my $organism = $thing->organism;
1698      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1699      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1700      my $function = $self->function;              my $function = $thing->function;
1701      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1702      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1703      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1704      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1705      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1706    
1707      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;
1708    
# Line 1655  Line 1719 
1719      my $descriptions = [];      my $descriptions = [];
1720    
1721      # get subsystem information      # get subsystem information
1722      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1723      my $link;      my $link;
1724      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1725               "link" => $url_link};               "link" => $url_link};
1726      push(@$links_list,$link);      push(@$links_list,$link);
1727    
1728      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1729      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1730                my @subsystems;
1731    
1732                foreach my $array (@subs){
1733                    my $subsystem = $$array[0];
1734                    push(@subsystems,$subsystem);
1735          my $link;          my $link;
1736          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1737                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1738          push(@$links_list,$link);          push(@$links_list,$link);
1739      }      }
1740    
1741                $link = {"link_title" => "view blast alignment",
1742                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1743                push (@$links_list,$link);
1744    
1745      my $description_function;      my $description_function;
1746      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1747                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1762 
1762                          "value" => $hit_stop};                          "value" => $hit_stop};
1763      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1764    
1765      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1766      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1767      {      {
1768          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1793 
1793          };          };
1794      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1795      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1796            }
1797        }
1798      return ($gd);      return ($gd);
   
1799  }  }
1800    
1801  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1805 
1805  =cut  =cut
1806    
1807  sub display_domain_composition {  sub display_domain_composition {
1808      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1809    
1810      my $fig = new FIG;      #$fig = new FIG;
1811      my $peg = $self->acc;      my $peg = $self->acc;
1812    
1813      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1815 
1815      my $descriptions = [];      my $descriptions = [];
1816    
1817      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1818        #my @domain_query_results = ();
1819      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1820          my $key = @$dqr[1];          my $key = @$dqr[1];
1821          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1840 
1840              }              }
1841          }          }
1842    
1843          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1844                                    -host     => $WebConfig::DBHOST,
1845                                    -user     => $WebConfig::DBUSER,
1846                                    -password => $WebConfig::DBPWD);
1847          my ($name_value,$description_value);          my ($name_value,$description_value);
1848    
1849          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1805  Line 1880 
1880          my $link;          my $link;
1881          my $link_url;          my $link_url;
1882          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"}
1883          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"}
1884          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
1885    
1886          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1829  Line 1904 
1904      }      }
1905    
1906      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1907                            'hover_title' => 'Domain',
1908                          'short_title' => $peg,                          'short_title' => $peg,
1909                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1910    
# Line 1848  Line 1924 
1924  =cut  =cut
1925    
1926  sub display_table {  sub display_table {
1927      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1928    
1929      my $data = [];      my $data = [];
1930      my $count = 0;      my $count = 0;
1931      my $content;      my $content;
1932      my $fig = new FIG;      #my $fig = new FIG;
1933      my $cgi = new CGI;      my $cgi = new CGI;
1934      my @ids;      my @ids;
1935        $lineages = $fig->taxonomy_list();
1936    
1937      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1938          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
1939          push (@ids, $thing->acc);          push (@ids, $thing->acc);
1940      }      }
1941    
1942      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1943        my @attributes = $fig->get_attributes(\@ids);
1944    
1945      # get the column for the subsystems      # get the column for the subsystems
1946      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1947    
1948      # get the column for the evidence codes      # get the column for the evidence codes
1949      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1950    
1951      # get the column for pfam_domain      # get the column for pfam_domain
1952      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1953    
1954      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1955      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1956        #my $alias_col = {};
1957    
1958        my $figfam_data = "$FIG_Config::FigfamsData";
1959        my $figfams = new FigFams($fig,$figfam_data);
1960        my $ff_hash = $figfams->families_containing_peg_bulk(\@ids);
1961    
1962      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1963          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1965 
1965          $count++;          $count++;
1966    
1967          my $id = $thing->acc;          my $id = $thing->acc;
1968            my $taxid   = $fig->genome_of($id);
1969          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1970          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1971          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1982 
1982          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1983          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1984          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');">);
1985            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1986    
1987          # get the linked fig id          # get the linked fig id
1988          my $fig_col;          my $fig_col;
1989          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1990              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1991          }          }
1992          else{          else{
1993              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1994          }          }
1995    
1996          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1997          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1998          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  
1999          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
2000              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
2001              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
2002              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
2003              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"});}
2004              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"});}
2005              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"});}
2006              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"});}
2007              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"});}
2008              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"});}
2009              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"});}
2010              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"});}
2011              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"});}
2012              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"});}
2013                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
2014                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2015                elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2016          }          }
2017          push(@$data,$single_domain);          push(@$data,$single_domain);
2018      }      }
   
2019      if ($count >0 ){      if ($count >0 ){
2020          $content = $data;          $content = $data;
2021      }      }
# Line 1955  Line 2037 
2037  }  }
2038    
2039  sub get_subsystems_column{  sub get_subsystems_column{
2040      my ($ids) = @_;      my ($ids,$fig) = @_;
2041    
2042      my $fig = new FIG;      #my $fig = new FIG;
2043      my $cgi = new CGI;      my $cgi = new CGI;
2044      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2045      my %column;      my %column;
# Line 1966  Line 2048 
2048          my @subsystems;          my @subsystems;
2049    
2050          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2051              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2052                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2053                  $count++;                  $ss =~ s/_/ /ig;
2054                    push (@subsystems, "-" . $ss);
2055              }              }
2056              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2057              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2063 
2063  }  }
2064    
2065  sub get_essentially_identical{  sub get_essentially_identical{
2066      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2067      my $fig = new FIG;      #my $fig = new FIG;
2068    
2069      my %id_list;      my %id_list;
2070      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);
2071    
2072      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2073            if($thing->class eq "IDENTICAL"){
2074                my $rows = $thing->rows;
2075                my $count_identical = 0;
2076                foreach my $row (@$rows) {
2077                    my $id = $row->[0];
2078          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2079              $id_list{$id} = 1;              $id_list{$id} = 1;
2080          }          }
2081      }      }
2082            }
2083        }
2084    
2085    #    foreach my $id (@maps_to) {
2086    #        if (($id ne $fid) && ($fig->function_of($id))) {
2087    #           $id_list{$id} = 1;
2088    #        }
2089    #    }
2090      return(%id_list);      return(%id_list);
2091  }  }
2092    
2093    
2094  sub get_evidence_column{  sub get_evidence_column{
2095      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2096      my $fig = new FIG;      #my $fig = new FIG;
2097      my $cgi = new CGI;      my $cgi = new CGI;
2098      my (%column, %code_attributes);      my (%column, %code_attributes);
2099    
2100      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2101      foreach my $key (@codes){      foreach my $key (@codes){
2102          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2103      }      }
# Line 2010  Line 2105 
2105      foreach my $id (@$ids){      foreach my $id (@$ids){
2106          # add evidence code with tool tip          # add evidence code with tool tip
2107          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2108    
2109          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2110              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2111              foreach my $code (@codes) {              foreach my $code (@codes) {
2112                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2113                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2117 
2117                  }                  }
2118                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2119              }              }
         }  
2120    
2121          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2122              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 2130 
2130  }  }
2131    
2132  sub get_pfam_column{  sub get_pfam_column{
2133      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2134      my $fig = new FIG;      #my $fig = new FIG;
2135      my $cgi = new CGI;      my $cgi = new CGI;
2136      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2137      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2138                                    -host     => $WebConfig::DBHOST,
2139                                    -user     => $WebConfig::DBUSER,
2140                                    -password => $WebConfig::DBPWD);
2141    
2142      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2143      foreach my $key (@codes){      foreach my $key (@codes){
2144          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2145            if ($name =~ /_/){
2146                ($name) = ($key->[1]) =~ /(.*?)_/;
2147            }
2148            push (@{$code_attributes{$key->[0]}}, $name);
2149            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2150      }      }
2151    
2152      foreach my $id (@$ids){      foreach my $id (@$ids){
2153          # add evidence code with tool tip          # add evidence code
2154          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2155          my @pfam_codes = "";          my @pfam_codes = "";
2156          my %description_codes;          my %description_codes;
2157    
2158          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2159              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2160              @pfam_codes = ();              @pfam_codes = ();
2161              foreach my $code (@codes) {  
2162                # get only unique values
2163                my %saw;
2164                foreach my $key (@ncodes) {$saw{$key}=1;}
2165                @ncodes = keys %saw;
2166    
2167                foreach my $code (@ncodes) {
2168                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2169                  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>";
2170    
2171                    # get the locations for the domain
2172                    my @locs;
2173                    foreach my $part (@{$attribute_location{$id}{$code}}){
2174                        my ($loc) = ($part) =~ /\;(.*)/;
2175                        push (@locs,$loc);
2176                    }
2177                    my %locsaw;
2178                    foreach my $key (@locs) {$locsaw{$key}=1;}
2179                    @locs = keys %locsaw;
2180    
2181                    my $locations = join (", ", @locs);
2182    
2183                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2184                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2185                  }                  }
2186                  else {                  else {
2187                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2188                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2189                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2190                  }                  }
2191              }              }
2192          }          }
# Line 2080  Line 2197 
2197    
2198  }  }
2199    
2200  sub get_prefer {  sub get_aliases {
2201      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2202    
2203      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2204        foreach my $id (@$ids){
2205            foreach my $alias (@{$$all_aliases{$id}}){
2206          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2207          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2208              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2209          }          }
2210      }      }
2211      return (" ");      return ($aliases);
2212  }  }
2213    
2214  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; $_ }
2215    
2216  sub color {  sub color {
2217      my ($evalue) = @_;      my ($evalue) = @_;
2218        my $palette = WebColors::get_palette('vitamins');
2219      my $color;      my $color;
2220      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2221          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2222      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2223      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2224          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2225      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2226      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2227          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2228      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2229      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;  
     }  
   
   
2230      return ($color);      return ($color);
2231  }  }
2232    
# Line 2152  Line 2246 
2246  }  }
2247    
2248  sub display {  sub display {
2249      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2250    
2251        $taxes = $fig->taxonomy_list();
2252    
2253      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2254      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2255      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2256      my $fig = new FIG;      my $range = $gd_window_size;
2257      my $all_regions = [];      my $all_regions = [];
2258      my $gene_associations={};      my $gene_associations={};
2259    
# Line 2182  Line 2278 
2278      my ($region_start, $region_end);      my ($region_start, $region_end);
2279      if ($beg < $end)      if ($beg < $end)
2280      {      {
2281          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2282          $region_end = $end+4000;          $region_end = $end+ ($range);
2283          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2284      }      }
2285      else      else
2286      {      {
2287          $region_start = $end-4000;          $region_start = $end-($range);
2288          $region_end = $beg+4000;          $region_end = $beg+($range);
2289          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2290          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2291          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2293 
2293    
2294      # call genes in region      # call genes in region
2295      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);
2296        #foreach my $feat (@$target_gene_features){
2297        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2298        #}
2299      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2300      my (@start_array_region);      my (@start_array_region);
2301      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2302    
2303      my %all_genes;      my %all_genes;
2304      my %all_genomes;      my %all_genomes;
2305      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2306            #if ($feature =~ /peg/){
2307      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2308      {          #}
         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;  
2309                  }                  }
2310    
2311                  push (@start_array_region, $offset);      my @selected_sims;
2312    
2313                  $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"){  
2314          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2315          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2316    
2317          # 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");  
   
2318          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2319              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2320                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2321                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2322                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2323                    #my $genome = $fig->genome_of($sim->[1]);
2324                    my $genome = $fig->genome_of($sim->acc);
2325                    #my ($genome1) = ($genome) =~ /(.*)\./;
2326                    my $lineage = $taxes->{$genome};
2327                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2328                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2329                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2330                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2331                            push (@selected_sims, $sim->acc);
2332                      }                      }
2333                  }                  }
2334                  my %saw;              }
2335                  @selected_sims = grep(!$saw{$_}++, @selected_sims);          }
2336            else{
2337                my $simcount = 0;
2338                foreach my $sim (@$sims_array){
2339                    next if ($sim->class ne "SIM");
2340                    next if ($sim->acc !~ /fig\|/);
2341    
2342                    push (@selected_sims, $sim->acc);
2343                    $simcount++;
2344                    last if ($simcount > 4);
2345              }              }
2346          }          }
2347    
2348            my %saw;
2349            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2350    
2351          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2352          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2353              #get the organism genome              #get the organism genome
# Line 2293  Line 2370 
2370              my ($region_start, $region_end);              my ($region_start, $region_end);
2371              if ($beg < $end)              if ($beg < $end)
2372              {              {
2373                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2374                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2375                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2376              }              }
2377              else              else
2378              {              {
2379                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2380                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2381                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2382                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2383                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2393 
2393    
2394      }      }
2395    
2396        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2397      # cluster the genes      # cluster the genes
2398      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2399      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2400        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2401        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2402    
2403      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2404          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2405          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2406          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2407          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2408            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2409            my $lineage = $taxes->{$region_genome};
2410            #my $lineage = $fig->taxonomy_of($region_genome);
2411            #$region_gs .= "Lineage:$lineage";
2412          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2413                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2414                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2416 
2416    
2417          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2418    
2419          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2420                                     'short_title' => "",                                     'short_title' => "",
2421                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2422                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2440 
2440    
2441              # get subsystem information              # get subsystem information
2442              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2443              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2444    
2445              my $link;              my $link;
2446              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2447                       "link" => $url_link};                       "link" => $url_link};
2448              push(@$links_list,$link);              push(@$links_list,$link);
2449    
2450              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2451              foreach my $subsystem (@subsystems){              my @subsystems;
2452                foreach my $array (@subs){
2453                    my $subsystem = $$array[0];
2454                    my $ss = $subsystem;
2455                    $ss =~ s/_/ /ig;
2456                    push (@subsystems, $ss);
2457                  my $link;                  my $link;
2458                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2459                           "link_title" => $subsystem};                           "link_title" => $ss};
2460                    push(@$links_list,$link);
2461                }
2462    
2463                if ($fid1 eq $fid){
2464                    my $link;
2465                    $link = {"link_title" => "Annotate this sequence",
2466                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2467                  push(@$links_list,$link);                  push(@$links_list,$link);
2468              }              }
2469    
# Line 2406  Line 2502 
2502                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2503                  }                  }
2504    
2505                    my $title = $fid1;
2506                    if ($fid1 eq $fid){
2507                        $title = "My query gene: $fid1";
2508                    }
2509    
2510                  $element_hash = {                  $element_hash = {
2511                      "title" => $fid1,                      "title" => $title,
2512                      "start" => $start,                      "start" => $start,
2513                      "end" =>  $stop,                      "end" =>  $stop,
2514                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2521 
2521                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2522                  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;}
2523                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2524    
2525                    if ($fid1 eq $fid){
2526                        $element_hash = {
2527                            "title" => 'Query',
2528                            "start" => $start,
2529                            "end" =>  $stop,
2530                            "type"=> 'bigbox',
2531                            "color"=> $color,
2532                            "zlayer" => "1"
2533                            };
2534    
2535                        # if there is an overlap, put into second line
2536                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2537                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2538                    }
2539              }              }
2540          }          }
2541          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2542          $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);
2543      }      }
2544      return $gd;      return ($gd, \@selected_sims);
2545  }  }
2546    
2547  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2611 
2611      }      }
2612    
2613      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2614          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2615              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2616                  foreach $y (@$x) {                  foreach $y (@$x) {
2617                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2629 
2629      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2630      return ($i < @$xL);      return ($i < @$xL);
2631  }  }
2632    
2633    #############################################
2634    #############################################
2635    package Observation::Commentary;
2636    
2637    use base qw(Observation);
2638    
2639    =head3 display_protein_commentary()
2640    
2641    =cut
2642    
2643    sub display_protein_commentary {
2644        my ($self,$dataset,$mypeg,$fig) = @_;
2645    
2646        my $all_rows = [];
2647        my $content;
2648        #my $fig = new FIG;
2649        my $cgi = new CGI;
2650        my $count = 0;
2651        my $peg_array = [];
2652        my (%evidence_column, %subsystems_column,  %e_identical);
2653    
2654        if (@$dataset != 1){
2655            foreach my $thing (@$dataset){
2656                if ($thing->class eq "SIM"){
2657                    push (@$peg_array, $thing->acc);
2658                }
2659            }
2660            # get the column for the evidence codes
2661            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2662    
2663            # get the column for the subsystems
2664            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2665    
2666            # get essentially identical seqs
2667            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2668        }
2669        else{
2670            push (@$peg_array, @$dataset);
2671        }
2672    
2673        my $selected_sims = [];
2674        foreach my $id (@$peg_array){
2675            last if ($count > 10);
2676            my $row_data = [];
2677            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2678            $org = $fig->org_of($id);
2679            $function = $fig->function_of($id);
2680            if ($mypeg ne $id){
2681                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2682                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2683                if (defined($e_identical{$id})) { $id_cell .= "*";}
2684            }
2685            else{
2686                $function_cell = "&nbsp;&nbsp;$function";
2687                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2688                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2689            }
2690    
2691            push(@$row_data,$id_cell);
2692            push(@$row_data,$org);
2693            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2694            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2695            push(@$row_data, $fig->translation_length($id));
2696            push(@$row_data,$function_cell);
2697            push(@$all_rows,$row_data);
2698            push (@$selected_sims, $id);
2699            $count++;
2700        }
2701    
2702        if ($count >0){
2703            $content = $all_rows;
2704        }
2705        else{
2706            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2707        }
2708        return ($content,$selected_sims);
2709    }
2710    
2711    sub display_protein_history {
2712        my ($self, $id,$fig) = @_;
2713        my $all_rows = [];
2714        my $content;
2715    
2716        my $cgi = new CGI;
2717        my $count = 0;
2718        foreach my $feat ($fig->feature_annotations($id)){
2719            my $row = [];
2720            my $col1 = $feat->[2];
2721            my $col2 = $feat->[1];
2722            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2723            my $text = $feat->[3];
2724    
2725            push (@$row, $col1);
2726            push (@$row, $col2);
2727            push (@$row, $text);
2728            push (@$all_rows, $row);
2729            $count++;
2730        }
2731        if ($count > 0){
2732            $content = $all_rows;
2733        }
2734        else {
2735            $content = "There is no history for this PEG";
2736        }
2737    
2738        return($content);
2739    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3