[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.52, Fri Feb 15 22:52:19 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;
# Line 86  Line 89 
89    return $self->{acc};    return $self->{acc};
90  }  }
91    
92    =head3 query()
93    
94    The query id
95    
96    =cut
97    
98    sub query {
99        my ($self) = @_;
100        return $self->{query};
101    }
102    
103    
104  =head3 class()  =head3 class()
105    
106  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 320 
320  =cut  =cut
321    
322  sub get_objects {  sub get_objects {
323      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
324    
325      my $objects = [];      my $objects = [];
326      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
327    
328      # call function that fetches attribute based observations      # call function that fetches attribute based observations
329      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 321  Line 335 
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
338          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
339          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
341          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
342          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
343          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
344            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
345      }      }
346    
347      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 334  Line 349 
349          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
350              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
351          }          }
352          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
353              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
354          }          }
355          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
356              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
357          }          }
358          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
359              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
360          }          }
361          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
362              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
363          }          }
364          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
365              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
366          }          }
367          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
368              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
369          }          }
370    
# Line 365  Line 380 
380    
381  =cut  =cut
382  sub display_housekeeping {  sub display_housekeeping {
383      my ($self,$fid) = @_;      my ($self,$fid,$fig) = @_;
384      my $fig = new FIG;      my $content = [];
385      my $content;      my $row = [];
386    
387      my $org_name = $fig->org_of($fid);      my $org_name = $fig->org_of($fid);
388      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);  
389      my $function = $fig->function_of($fid);      my $function = $fig->function_of($fid);
390      my @aliases  = $fig->feature_aliases($fid);      #my $taxonomy = $fig->taxonomy_of($org_id);
391      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);  
     }  
392    
393      if ( @subsystems ) {      push (@$row, $org_name);
394          $content .= qq(<tr><td>Subsystems</td><td>);      push (@$row, $fid);
395          foreach my $subsystem ( @subsystems ) {      push (@$row, $length);
396              $content .= join(" -- ", @$subsystem) . "<br>\n";      push (@$row, $function);
397          }  
398      }      # initialize the table for commentary and annotations
399        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
400        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
401        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
402        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
403        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
404        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
405        #$content .= qq(</table><p>\n);
406    
407      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);  
408    
409      return ($content);      return ($content);
410  }  }
# Line 435  Line 415 
415  =cut  =cut
416    
417  sub get_sims_summary {  sub get_sims_summary {
418      my ($observation, $fid) = @_;      my ($observation, $fid, $taxes, $dataset, $fig) = @_;
     my $fig = new FIG;  
419      my %families;      my %families;
420      my @sims= $fig->nsims($fid,20000,10,"fig");      #my @sims= $fig->nsims($fid,20000,10,"fig");
421    
422      foreach my $sim (@sims){      foreach my $thing (@$dataset) {
423          next if ($sim->[1] !~ /fig\|/);          next if ($thing->class ne "SIM");
424          my $genome = $fig->genome_of($sim->[1]);  
425          my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1]));          my $id      = $thing->acc;
426            my $evalue  = $thing->evalue;
427    
428            next if ($id !~ /fig\|/);
429            next if ($fig->is_deleted_fid($id));
430            my $genome = $fig->genome_of($id);
431            #my ($genome1) = ($genome) =~ /(.*)\./;
432            #my $taxonomy = $taxes->{$genome1};
433            my $taxonomy = $fig->taxonomy_of($genome); # use this if the taxonomies have been updated
434          my $parent_tax = "Root";          my $parent_tax = "Root";
435          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
436          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
# Line 451  Line 438 
438              push (@currLineage, $tax);              push (@currLineage, $tax);
439              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
440              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
441                if (defined ($families{evalue}{$tax})){
442                    if ($sim->[10] < $families{evalue}{$tax}){
443                        $families{evalue}{$tax} = $evalue;
444                        $families{color}{$tax} = &get_taxcolor($evalue);
445                    }
446                }
447                else{
448                    $families{evalue}{$tax} = $evalue;
449                    $families{color}{$tax} = &get_taxcolor($evalue);
450                }
451    
452              $parent_tax = $tax;              $parent_tax = $tax;
453          }          }
454      }      }
# Line 473  Line 471 
471    
472  =cut  =cut
473    
474    sub get_taxcolor{
475        my ($evalue) = @_;
476        my $color;
477        if ($evalue <= 1e-170){        $color = "#FF2000";    }
478        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
479        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
480        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
481        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
482        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
483        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
484        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
485        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
486        else{        $color = "#6666FF";    }
487        return ($color);
488    }
489    
490    
491  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
492    
493      # 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)
494      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
495    
496      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
497          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
498          my @parts = split("::",$key);          my @parts = split("::",$key);
499          my $class = $parts[0];          my $class = $parts[0];
500            my $name = $parts[1];
501            next if (($class eq "PFAM") && ($name !~ /interpro/));
502    
503          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
504              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 493  Line 507 
507                  my $from = $2;                  my $from = $2;
508                  my $to = $3;                  my $to = $3;
509                  my $evalue;                  my $evalue;
510                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
511                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
512                      my $part1 = $2/100;                      my $part1 = $2/100;
513                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
514                  }                  }
515                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
516                        $evalue=$raw_evalue;
517                    }
518                  else{                  else{
519                      $evalue = "0.0";                      $evalue = "0.0";
520                  }                  }
# Line 520  Line 537 
537    
538  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
539    
540      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
541      my $fig = new FIG;      #my $fig = new FIG;
542    
543      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
544    
# Line 531  Line 548 
548                     };                     };
549    
550      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
551          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
552          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
553          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 543  Line 559 
559                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
560                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
561                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
562              }              }
563              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
564                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 582  Line 597 
597  =cut  =cut
598    
599  sub get_pdb_observations{  sub get_pdb_observations{
600      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
601    
602      my $fig = new FIG;      #my $fig = new FIG;
603    
604      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
605          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
606          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
607          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 643  Line 656 
656    
657  sub get_sims_observations{  sub get_sims_observations{
658    
659      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
660      my $fig = new FIG;      #my $fig = new FIG;
661      my @sims= $fig->nsims($fid,500,10,"fig");      my @sims= $fig->sims($fid,500,10,"fig");
662      my ($dataset);      my ($dataset);
663    
     my %id_list;  
     foreach my $sim (@sims){  
         my $hit = $sim->[1];  
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
         }  
     }  
   
     my %already;  
     my (@new_sims, @uniprot);  
664      foreach my $sim (@sims){      foreach my $sim (@sims){
665          my $hit = $sim->[1];          next if ($fig->is_deleted_fid($sim->[1]));
         my ($id) = ($hit) =~ /\|(.*)/;  
         next if (defined($already{$id}));  
         next if (defined($id_list{$hit}));  
         push (@new_sims, $sim);  
         $already{$id} = 1;  
     }  
   
     foreach my $sim (@new_sims){  
666          my $hit = $sim->[1];          my $hit = $sim->[1];
667          my $percent = $sim->[2];          my $percent = $sim->[2];
668          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 685  Line 677 
677          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
678    
679          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
680                        'query' => $sim->[0],
681                      'acc' => $hit,                      'acc' => $hit,
682                      'identity' => $percent,                      'identity' => $percent,
683                      'type' => 'seq',                      'type' => 'seq',
# Line 739  Line 732 
732    
733  sub get_identical_proteins{  sub get_identical_proteins{
734    
735      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
736      my $fig = new FIG;      #my $fig = new FIG;
737      my $funcs_ref;      my $funcs_ref;
738    
 #    my %id_list;  
739      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;  
 #    }  
   
740      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
741          my ($tmp, $who);          my ($tmp, $who);
742          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}))) {  
743              $who = &get_database($id);              $who = &get_database($id);
744              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
745          }          }
746      }      }
747    
     my ($dataset);  
748      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
749                     'type' => 'seq',                     'type' => 'seq',
750                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 779  Line 764 
764    
765  sub get_functional_coupling{  sub get_functional_coupling{
766    
767      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
768      my $fig = new FIG;      #my $fig = new FIG;
769      my @funcs = ();      my @funcs = ();
770    
771      # initialize some variables      # initialize some variables
# Line 797  Line 782 
782                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
783                    } @fc_data;                    } @fc_data;
784    
     my ($dataset);  
785      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
786                     'type' => 'fc',                     'type' => 'fc',
787                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 908  Line 892 
892      return $self->{database};      return $self->{database};
893  }  }
894    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
895  ############################################################  ############################################################
896  ############################################################  ############################################################
897  package Observation::PDB;  package Observation::PDB;
# Line 939  Line 917 
917  =cut  =cut
918    
919  sub display{  sub display{
920      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
921    
922      my $fid = $self->fig_id;      my $fid = $self->fig_id;
923      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
924                                    -host     => $WebConfig::DBHOST,
925                                    -user     => $WebConfig::DBUSER,
926                                    -password => $WebConfig::DBPWD);
927    
928      my $acc = $self->acc;      my $acc = $self->acc;
929    
# Line 963  Line 944 
944      my $lines = [];      my $lines = [];
945      my $line_data = [];      my $line_data = [];
946      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
947                            'hover_title' => 'PDB',
948                          'short_title' => "best PDB",                          'short_title' => "best PDB",
949                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
950    
951      my $fig = new FIG;      #my $fig = new FIG;
952      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
953      my $fid_stop = length($seq);      my $fid_stop = length($seq);
954    
# Line 1067  Line 1049 
1049    
1050    
1051  sub display_table{  sub display_table{
1052      my ($self) = @_;      my ($self,$fig) = @_;
1053    
1054      my $fig = new FIG;      #my $fig = new FIG;
1055      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1056      my $rows = $self->rows;      my $rows = $self->rows;
1057      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1131  Line 1113 
1113    
1114  sub display_table {  sub display_table {
1115    
1116      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1117      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1118      my $rows = $self->rows;      my $rows = $self->rows;
1119      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1146  Line 1128 
1128          # construct the score link          # construct the score link
1129          my $score = $row->[0];          my $score = $row->[0];
1130          my $toid = $row->[1];          my $toid = $row->[1];
1131          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";
1132          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1133    
1134          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1135          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1200  Line 1182 
1182      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1183      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1184    
1185      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1186                                    -host     => $WebConfig::DBHOST,
1187                                    -user     => $WebConfig::DBUSER,
1188                                    -password => $WebConfig::DBPWD);
1189    
1190      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1191      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1219  Line 1204 
1204              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1205          }          }
1206      }      }
1207        elsif($db =~ /PFAM/){
1208            my ($new_id) = ($id) =~ /(.*?)_/;
1209            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1210            if(!scalar(@$pfam_objs)){
1211                $name_title = "name";
1212                $name_value = "not available";
1213                $description_title = "description";
1214                $description_value = "not available";
1215            }
1216            else{
1217                my $pfam_obj = $pfam_objs->[0];
1218                $name_title = "name";
1219                $name_value = $pfam_obj->term;
1220                #$description_title = "description";
1221                #$description_value = $pfam_obj->description;
1222            }
1223        }
1224    
1225      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1226                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1227        my $new_short_title=$short_title;
1228        if ($short_title =~ /interpro/){
1229            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1230        }
1231        my $line_config = { 'title' => $name_value,
1232                            'hover_title', => 'Domain',
1233                            'short_title' => $new_short_title,
1234                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1235    
1236      my $name;      my $name;
1237      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1238               "value" => $name_value};      $name = {"title" => $db,
1239                 "value" => $new_id};
1240      push(@$descriptions,$name);      push(@$descriptions,$name);
1241    
1242      my $description;  #    my $description;
1243      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1244                               "value" => $description_value};  #                   "value" => $description_value};
1245      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1246    
1247      my $score;      my $score;
1248      $score = {"title" => "score",      $score = {"title" => "score",
1249                "value" => $thing->evalue};                "value" => $thing->evalue};
1250      push(@$descriptions,$score);      push(@$descriptions,$score);
1251    
1252        my $location;
1253        $location = {"title" => "location",
1254                     "value" => $thing->start . " - " . $thing->stop};
1255        push(@$descriptions,$location);
1256    
1257      my $link_id;      my $link_id;
1258      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1259          $link_id = $1;          $link_id = $1;
1260      }      }
1261    
# Line 1255  Line 1270 
1270      push(@$links_list,$link);      push(@$links_list,$link);
1271    
1272      my $element_hash = {      my $element_hash = {
1273          "title" => $thing->type,          "title" => $name_value,
1274          "start" => $thing->start,          "start" => $thing->start,
1275          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1276          "color"=> $color,          "color"=> $color,
# Line 1285  Line 1300 
1300          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1301          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1302    
1303          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1304                                    -host     => $WebConfig::DBHOST,
1305                                    -user     => $WebConfig::DBUSER,
1306                                    -password => $WebConfig::DBPWD);
1307    
1308          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1309          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1304  Line 1322 
1322                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1323              }              }
1324          }          }
1325            elsif($db =~ /PFAM/){
1326                my ($new_id) = ($id) =~ /(.*?)_/;
1327                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1328                if(!scalar(@$pfam_objs)){
1329                    $name_title = "name";
1330                    $name_value = "not available";
1331                    $description_title = "description";
1332                    $description_value = "not available";
1333                }
1334                else{
1335                    my $pfam_obj = $pfam_objs->[0];
1336                    $name_title = "name";
1337                    $name_value = $pfam_obj->term;
1338                    #$description_title = "description";
1339                    #$description_value = $pfam_obj->description;
1340                }
1341            }
1342    
1343          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1344    
# Line 1356  Line 1391 
1391      my $cello_location = $thing->cello_location;      my $cello_location = $thing->cello_location;
1392      my $cello_score = $thing->cello_score;      my $cello_score = $thing->cello_score;
1393      if($cello_location){      if($cello_location){
1394          $html .= "<p>CELLO prediction: $cello_location </p>";          $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1395          $html .= "<p>CELLO score: $cello_score </p>";          #$html .= "<p>CELLO score: $cello_score </p>";
1396      }      }
1397      return ($html);      return ($html);
1398  }  }
1399    
1400  sub display {  sub display {
1401      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1402    
1403      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1404      my $fig= new FIG;      #my $fig= new FIG;
1405      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1406    
1407      my $cleavage_prob;      my $cleavage_prob;
# Line 1394  Line 1429 
1429    
1430          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1431                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1432                                'hover_title' => 'Localization',
1433                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1434    
1435          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1418  Line 1454 
1454          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1455      }      }
1456    
 =cut  
   
1457      $color = "2";      $color = "2";
1458      if($tmpred_score){      if($tmpred_score){
1459          my $line_data =[];          my $line_data =[];
# Line 1449  Line 1483 
1483          }          }
1484          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1485      }      }
1486    =cut
1487    
1488      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){      if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1489          my $line_data =[];          my $line_data =[];
1490          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1491                              'short_title' => 'Phobius',                              'short_title' => 'TM and SP',
1492                                'hover_title' => 'Localization',
1493                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1494    
1495          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
1496              my $descriptions = [];              my $descriptions = [];
1497              my $description_phobius_tm_locations = {"title" => 'Phobius TM Location',              my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1498                               "value" => $tm_loc};                               "value" => $tm_loc};
1499              push(@$descriptions,$description_phobius_tm_locations);              push(@$descriptions,$description_phobius_tm_locations);
1500    
1501              my ($begin,$end) =split("-",$tm_loc);              my ($begin,$end) =split("-",$tm_loc);
1502    
1503              my $element_hash = {              my $element_hash = {
1504              "title" => "phobius transmembrane location",              "title" => "Phobius",
1505              "start" => $begin + 1,              "start" => $begin + 1,
1506              "end" =>  $end + 1,              "end" =>  $end + 1,
1507              "color"=> '6',              "color"=> '6',
# Line 1499  Line 1535 
1535          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1536      }      }
1537    
1538    =head3
1539      $color = "1";      $color = "1";
1540      if($signal_peptide_score){      if($signal_peptide_score){
1541          my $line_data = [];          my $line_data = [];
# Line 1507  Line 1543 
1543    
1544          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1545                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1546                                'hover_title' => 'Localization',
1547                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1548    
1549          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1531  Line 1568 
1568          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1569          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
1570      }      }
1571    =cut
1572    
1573      return ($gd);      return ($gd);
1574    
# Line 1602  Line 1640 
1640      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1641      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1642      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1643        $self->{query} = $dataset->{'query'};
1644      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1645      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1646      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1625  Line 1664 
1664  =cut  =cut
1665    
1666  sub display {  sub display {
1667      my ($self,$gd) = @_;      my ($self,$gd,$array,$fig) = @_;
1668        #my $fig = new FIG;
1669    
1670      my $fig = new FIG;      my @ids;
1671      my $peg = $self->acc;      foreach my $thing(@$array){
1672            next if ($thing->class ne "SIM");
1673            push (@ids, $thing->acc);
1674        }
1675    
1676        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1677    
1678        foreach my $thing (@$array){
1679            if ($thing->class eq "SIM"){
1680    
1681                my $peg = $thing->acc;
1682                my $query = $thing->query;
1683    
1684      my $organism = $self->organism;              my $organism = $thing->organism;
1685      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1686      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1687      my $function = $self->function;              my $function = $thing->function;
1688      my $abbrev_name = $fig->abbrev($organism);      my $abbrev_name = $fig->abbrev($organism);
1689      my $align_start = $self->qstart;              my $align_start = $thing->qstart;
1690      my $align_stop = $self->qstop;              my $align_stop = $thing->qstop;
1691      my $hit_start = $self->hstart;              my $hit_start = $thing->hstart;
1692      my $hit_stop = $self->hstop;              my $hit_stop = $thing->hstop;
1693    
1694      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;
1695    
# Line 1655  Line 1706 
1706      my $descriptions = [];      my $descriptions = [];
1707    
1708      # get subsystem information      # get subsystem information
1709      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;              my $url_link = "?page=Annotation&feature=".$peg;
   
1710      my $link;      my $link;
1711      $link = {"link_title" => $peg,      $link = {"link_title" => $peg,
1712               "link" => $url_link};               "link" => $url_link};
1713      push(@$links_list,$link);      push(@$links_list,$link);
1714    
1715      my @subsystems = $fig->peg_to_subsystems($peg);              #my @subsystems = $fig->peg_to_subsystems($peg);
1716      foreach my $subsystem (@subsystems){              my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1717                my @subsystems;
1718    
1719                foreach my $array (@subs){
1720                    my $subsystem = $$array[0];
1721                    push(@subsystems,$subsystem);
1722          my $link;          my $link;
1723          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1724                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1725          push(@$links_list,$link);          push(@$links_list,$link);
1726      }      }
1727    
1728                $link = {"link_title" => "view blast alignment",
1729                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1730                push (@$links_list,$link);
1731    
1732      my $description_function;      my $description_function;
1733      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1734                               "value" => $function};                               "value" => $function};
# Line 1690  Line 1749 
1749                          "value" => $hit_stop};                          "value" => $hit_stop};
1750      push(@$descriptions, $description_loc);      push(@$descriptions, $description_loc);
1751    
1752      my $evalue = $self->evalue;              my $evalue = $thing->evalue;
1753      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1754      {      {
1755          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1721  Line 1780 
1780          };          };
1781      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1782      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1783            }
1784        }
1785      return ($gd);      return ($gd);
   
1786  }  }
1787    
1788  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1733  Line 1792 
1792  =cut  =cut
1793    
1794  sub display_domain_composition {  sub display_domain_composition {
1795      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1796    
1797      my $fig = new FIG;      #$fig = new FIG;
1798      my $peg = $self->acc;      my $peg = $self->acc;
1799    
1800      my $line_data = [];      my $line_data = [];
# Line 1743  Line 1802 
1802      my $descriptions = [];      my $descriptions = [];
1803    
1804      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1805        #my @domain_query_results = ();
1806      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1807          my $key = @$dqr[1];          my $key = @$dqr[1];
1808          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1768  Line 1827 
1827              }              }
1828          }          }
1829    
1830          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1831                                    -host     => $WebConfig::DBHOST,
1832                                    -user     => $WebConfig::DBUSER,
1833                                    -password => $WebConfig::DBPWD);
1834          my ($name_value,$description_value);          my ($name_value,$description_value);
1835    
1836          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1829  Line 1891 
1891      }      }
1892    
1893      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
1894                            'hover_title' => 'Domain',
1895                          'short_title' => $peg,                          'short_title' => $peg,
1896                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1897    
# Line 1848  Line 1911 
1911  =cut  =cut
1912    
1913  sub display_table {  sub display_table {
1914      my ($self,$dataset, $scroll_list, $query_fid) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1915    
1916      my $data = [];      my $data = [];
1917      my $count = 0;      my $count = 0;
1918      my $content;      my $content;
1919      my $fig = new FIG;      #my $fig = new FIG;
1920      my $cgi = new CGI;      my $cgi = new CGI;
1921      my @ids;      my @ids;
1922      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
# Line 1862  Line 1925 
1925      }      }
1926    
1927      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1928        my @attributes = $fig->get_attributes(\@ids);
1929    
1930      # get the column for the subsystems      # get the column for the subsystems
1931      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
1932    
1933      # get the column for the evidence codes      # get the column for the evidence codes
1934      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1935    
1936      # get the column for pfam_domain      # get the column for pfam_domain
1937      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1938    
1939      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1940      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
1941        #my $alias_col = {};
1942    
1943      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1944          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1881  Line 1946 
1946          $count++;          $count++;
1947    
1948          my $id = $thing->acc;          my $id = $thing->acc;
1949            my $taxid   = $fig->genome_of($id);
1950          my $iden    = $thing->identity;          my $iden    = $thing->identity;
1951          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
1952          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1898  Line 1963 
1963          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
1964          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
1965          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');">);
1966            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1967    
1968          # get the linked fig id          # get the linked fig id
1969          my $fig_col;          my $fig_col;
1970          if (defined ($e_identical{$id})){          if (defined ($e_identical{$id})){
1971              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id) . "*";
1972          }          }
1973          else{          else{
1974              $fig_col = &HTML::set_prot_links($cgi,$id);              $fig_col = "<a href='?page=Annotation&feature=$id'>$id</a>";#&HTML::set_prot_links($cgi,$id);
1975          }          }
1976    
1977          push(@$single_domain,$box_col);                        # permanent column          push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1978          push(@$single_domain,$fig_col);                        # permanent column                "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1979          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  
1980          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
1981              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1982              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1983              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1984              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"});}
1985              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"});}
1986              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"});}
1987              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"});}
1988              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"});}
1989              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"});}
1990              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"});}
1991              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"});}
1992              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"});}
1993              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"});}
1994                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1995                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
1996          }          }
1997          push(@$data,$single_domain);          push(@$data,$single_domain);
1998      }      }
   
1999      if ($count >0 ){      if ($count >0 ){
2000          $content = $data;          $content = $data;
2001      }      }
# Line 1955  Line 2017 
2017  }  }
2018    
2019  sub get_subsystems_column{  sub get_subsystems_column{
2020      my ($ids) = @_;      my ($ids,$fig) = @_;
2021    
2022      my $fig = new FIG;      #my $fig = new FIG;
2023      my $cgi = new CGI;      my $cgi = new CGI;
2024      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2025      my %column;      my %column;
# Line 1966  Line 2028 
2028          my @subsystems;          my @subsystems;
2029    
2030          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2031              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2032                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2033                  $count++;                  $ss =~ s/_/ /ig;
2034                    push (@subsystems, "-" . $ss);
2035              }              }
2036              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2037              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 1981  Line 2043 
2043  }  }
2044    
2045  sub get_essentially_identical{  sub get_essentially_identical{
2046      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2047      my $fig = new FIG;      #my $fig = new FIG;
2048    
2049      my %id_list;      my %id_list;
2050      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);
2051    
2052      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2053            if($thing->class eq "IDENTICAL"){
2054                my $rows = $thing->rows;
2055                my $count_identical = 0;
2056                foreach my $row (@$rows) {
2057                    my $id = $row->[0];
2058          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2059              $id_list{$id} = 1;              $id_list{$id} = 1;
2060          }          }
2061      }      }
2062            }
2063        }
2064    
2065    #    foreach my $id (@maps_to) {
2066    #        if (($id ne $fid) && ($fig->function_of($id))) {
2067    #           $id_list{$id} = 1;
2068    #        }
2069    #    }
2070      return(%id_list);      return(%id_list);
2071  }  }
2072    
2073    
2074  sub get_evidence_column{  sub get_evidence_column{
2075      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2076      my $fig = new FIG;      #my $fig = new FIG;
2077      my $cgi = new CGI;      my $cgi = new CGI;
2078      my (%column, %code_attributes);      my (%column, %code_attributes);
2079    
2080      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2081      foreach my $key (@codes){      foreach my $key (@codes){
2082          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2083      }      }
# Line 2010  Line 2085 
2085      foreach my $id (@$ids){      foreach my $id (@$ids){
2086          # add evidence code with tool tip          # add evidence code with tool tip
2087          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2088    
2089          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2090              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2091              foreach my $code (@codes) {              foreach my $code (@codes) {
2092                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2093                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2025  Line 2097 
2097                  }                  }
2098                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2099              }              }
         }  
2100    
2101          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2102              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 2110 
2110  }  }
2111    
2112  sub get_pfam_column{  sub get_pfam_column{
2113      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2114      my $fig = new FIG;      #my $fig = new FIG;
2115      my $cgi = new CGI;      my $cgi = new CGI;
2116      my (%column, %code_attributes);      my (%column, %code_attributes, %attribute_locations);
2117      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2118                                    -host     => $WebConfig::DBHOST,
2119                                    -user     => $WebConfig::DBUSER,
2120                                    -password => $WebConfig::DBPWD);
2121    
2122      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2123      foreach my $key (@codes){      foreach my $key (@codes){
2124          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2125            if ($name =~ /_/){
2126                ($name) = ($key->[1]) =~ /(.*?)_/;
2127            }
2128            push (@{$code_attributes{$key->[0]}}, $name);
2129            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2130      }      }
2131    
2132      foreach my $id (@$ids){      foreach my $id (@$ids){
2133          # add evidence code with tool tip          # add evidence code
2134          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2135          my @pfam_codes = "";          my @pfam_codes = "";
2136          my %description_codes;          my %description_codes;
2137    
2138          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2139              my @codes;              my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
2140              @pfam_codes = ();              @pfam_codes = ();
2141              foreach my $code (@codes) {  
2142                # get only unique values
2143                my %saw;
2144                foreach my $key (@ncodes) {$saw{$key}=1;}
2145                @ncodes = keys %saw;
2146    
2147                foreach my $code (@ncodes) {
2148                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2149                  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://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2150    
2151                    # get the locations for the domain
2152                    my @locs;
2153                    foreach my $part (@{$attribute_location{$id}{$code}}){
2154                        my ($loc) = ($part) =~ /\;(.*)/;
2155                        push (@locs,$loc);
2156                    }
2157                    my %locsaw;
2158                    foreach my $key (@locs) {$locsaw{$key}=1;}
2159                    @locs = keys %locsaw;
2160    
2161                    my $locations = join (", ", @locs);
2162    
2163                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
2164                      push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");                      push(@pfam_codes, "$parts[1] ($locations)");
2165                  }                  }
2166                  else {                  else {
2167                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                      my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2168                      $description_codes{$parts[1]} = ${$$description[0]}{term};                      $description_codes{$parts[1]} = ${$$description[0]}{term};
2169                      push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");                      push(@pfam_codes, "$pfam_link ($locations)");
2170                  }                  }
2171              }              }
2172          }          }
# Line 2080  Line 2177 
2177    
2178  }  }
2179    
2180  sub get_prefer {  sub get_aliases {
2181      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2182    
2183      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2184        foreach my $id (@$ids){
2185            foreach my $alias (@{$$all_aliases{$id}}){
2186          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2187          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2188              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2189          }          }
2190      }      }
2191      return (" ");      return ($aliases);
2192  }  }
2193    
2194  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; $_ }
2195    
2196  sub color {  sub color {
2197      my ($evalue) = @_;      my ($evalue) = @_;
2198        my $palette = WebColors::get_palette('vitamins');
2199      my $color;      my $color;
2200      if ($evalue <= 1e-170){      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2201          $color = 51;      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2202      }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2203      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2204          $color = 52;      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2205      }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2206      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2207          $color = 53;      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2208      }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2209      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;  
     }  
   
   
2210      return ($color);      return ($color);
2211  }  }
2212    
# Line 2152  Line 2226 
2226  }  }
2227    
2228  sub display {  sub display {
2229      my ($self,$gd,$selected_taxonomies) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2230    
2231      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2232      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2233      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2234      my $fig = new FIG;      my $range = $gd_window_size;
2235      my $all_regions = [];      my $all_regions = [];
2236      my $gene_associations={};      my $gene_associations={};
2237    
# Line 2182  Line 2256 
2256      my ($region_start, $region_end);      my ($region_start, $region_end);
2257      if ($beg < $end)      if ($beg < $end)
2258      {      {
2259          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2260          $region_end = $end+4000;          $region_end = $end+ ($range);
2261          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2262      }      }
2263      else      else
2264      {      {
2265          $region_start = $end-4000;          $region_start = $end-($range);
2266          $region_end = $beg+4000;          $region_end = $beg+($range);
2267          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2268          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2269          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2197  Line 2271 
2271    
2272      # call genes in region      # call genes in region
2273      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);
2274        #foreach my $feat (@$target_gene_features){
2275        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2276        #}
2277      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2278      my (@start_array_region);      my (@start_array_region);
2279      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2280    
2281      my %all_genes;      my %all_genes;
2282      my %all_genomes;      my %all_genomes;
2283      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2284            #if ($feature =~ /peg/){
2285      if ($compare_or_coupling eq "diverse")              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2286      {          #}
         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;  
2287                  }                  }
2288    
2289                  push (@start_array_region, $offset);      my @selected_sims;
2290    
2291                  $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"){  
2292          # get the selected boxes          # get the selected boxes
         #my @selected_taxonomy = ("Streptococcaceae", "Enterobacteriales");  
2293          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2294    
2295          # 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");  
   
2296          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2297              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2298                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2299                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2300                  my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));  
2301                    #my $genome = $fig->genome_of($sim->[1]);
2302                    my $genome = $fig->genome_of($sim->acc);
2303                    #my ($genome1) = ($genome) =~ /(.*)\./;
2304                    #my $lineage = $taxes->{$genome1};
2305                    my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2306                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2307                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2308                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2309                            push (@selected_sims, $sim->acc);
2310                      }                      }
2311                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2312              }              }
2313          }          }
2314            else{
2315                my $simcount = 0;
2316                foreach my $sim (@$sims_array){
2317                    next if ($sim->class ne "SIM");
2318                    next if ($sim->acc !~ /fig\|/);
2319    
2320                    push (@selected_sims, $sim->acc);
2321                    $simcount++;
2322                    last if ($simcount > 4);
2323                }
2324            }
2325    
2326            my %saw;
2327            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2328    
2329          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2330          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
# Line 2293  Line 2348 
2348              my ($region_start, $region_end);              my ($region_start, $region_end);
2349              if ($beg < $end)              if ($beg < $end)
2350              {              {
2351                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2352                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2353                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2354              }              }
2355              else              else
2356              {              {
2357                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2358                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2359                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2360                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2361                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2316  Line 2371 
2371    
2372      }      }
2373    
2374        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2375      # cluster the genes      # cluster the genes
2376      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2377      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2378        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2379        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2380    
2381      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2382          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2383          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2384          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2385          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2386            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2387            #my $lineage = $taxes->{$genome1};
2388            my $lineage = $fig->taxonomy_of($region_genome);
2389            #$region_gs .= "Lineage:$lineage";
2390          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2391                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
2392                              'basepair_offset' => '0'                              'basepair_offset' => '0'
# Line 2332  Line 2394 
2394    
2395          my $offsetting = shift @start_array_region;          my $offsetting = shift @start_array_region;
2396    
2397          my $second_line_config = { 'title' => "$region_gs",          my $second_line_config = { 'title' => "$lineage",
2398                                     'short_title' => "",                                     'short_title' => "",
2399                                     'basepair_offset' => '0',                                     'basepair_offset' => '0',
2400                                     'no_middle_line' => '1'                                     'no_middle_line' => '1'
# Line 2356  Line 2418 
2418    
2419              # get subsystem information              # get subsystem information
2420              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2421              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2422    
2423              my $link;              my $link;
2424              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2425                       "link" => $url_link};                       "link" => $url_link};
2426              push(@$links_list,$link);              push(@$links_list,$link);
2427    
2428              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2429              foreach my $subsystem (@subsystems){              my @subsystems;
2430                foreach my $array (@subs){
2431                    my $subsystem = $$array[0];
2432                    my $ss = $subsystem;
2433                    $ss =~ s/_/ /ig;
2434                    push (@subsystems, $ss);
2435                  my $link;                  my $link;
2436                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2437                           "link_title" => $subsystem};                           "link_title" => $ss};
2438                    push(@$links_list,$link);
2439                }
2440    
2441                if ($fid1 eq $fid){
2442                    my $link;
2443                    $link = {"link_title" => "Annotate this sequence",
2444                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2445                  push(@$links_list,$link);                  push(@$links_list,$link);
2446              }              }
2447    
# Line 2406  Line 2480 
2480                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2481                  }                  }
2482    
2483                    my $title = $fid1;
2484                    if ($fid1 eq $fid){
2485                        $title = "My query gene: $fid1";
2486                    }
2487    
2488                  $element_hash = {                  $element_hash = {
2489                      "title" => $fid1,                      "title" => $title,
2490                      "start" => $start,                      "start" => $start,
2491                      "end" =>  $stop,                      "end" =>  $stop,
2492                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2420  Line 2499 
2499                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2500                  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;}
2501                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2502    
2503                    if ($fid1 eq $fid){
2504                        $element_hash = {
2505                            "title" => 'Query',
2506                            "start" => $start,
2507                            "end" =>  $stop,
2508                            "type"=> 'bigbox',
2509                            "color"=> $color,
2510                            "zlayer" => "1"
2511                            };
2512    
2513                        # if there is an overlap, put into second line
2514                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2515                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2516                    }
2517              }              }
2518          }          }
2519          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2520          $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);
2521      }      }
2522      return $gd;      return ($gd, \@selected_sims);
2523  }  }
2524    
2525  sub cluster_genes {  sub cluster_genes {
# Line 2495  Line 2589 
2589      }      }
2590    
2591      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2592          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2593              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2594                  foreach $y (@$x) {                  foreach $y (@$x) {
2595                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2513  Line 2607 
2607      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2608      return ($i < @$xL);      return ($i < @$xL);
2609  }  }
2610    
2611    #############################################
2612    #############################################
2613    package Observation::Commentary;
2614    
2615    use base qw(Observation);
2616    
2617    =head3 display_protein_commentary()
2618    
2619    =cut
2620    
2621    sub display_protein_commentary {
2622        my ($self,$dataset,$mypeg,$fig) = @_;
2623    
2624        my $all_rows = [];
2625        my $content;
2626        #my $fig = new FIG;
2627        my $cgi = new CGI;
2628        my $count = 0;
2629        my $peg_array = [];
2630        my (%evidence_column, %subsystems_column,  %e_identical);
2631    
2632        if (@$dataset != 1){
2633            foreach my $thing (@$dataset){
2634                if ($thing->class eq "SIM"){
2635                    push (@$peg_array, $thing->acc);
2636                }
2637            }
2638            # get the column for the evidence codes
2639            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2640    
2641            # get the column for the subsystems
2642            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2643    
2644            # get essentially identical seqs
2645            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2646        }
2647        else{
2648            push (@$peg_array, @$dataset);
2649        }
2650    
2651        my $selected_sims = [];
2652        foreach my $id (@$peg_array){
2653            last if ($count > 10);
2654            my $row_data = [];
2655            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2656            $org = $fig->org_of($id);
2657            $function = $fig->function_of($id);
2658            if ($mypeg ne $id){
2659                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2660                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2661                if (defined($e_identical{$id})) { $id_cell .= "*";}
2662            }
2663            else{
2664                $function_cell = "&nbsp;&nbsp;$function";
2665                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2666                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2667            }
2668    
2669            push(@$row_data,$id_cell);
2670            push(@$row_data,$org);
2671            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2672            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2673            push(@$row_data, $fig->translation_length($id));
2674            push(@$row_data,$function_cell);
2675            push(@$all_rows,$row_data);
2676            push (@$selected_sims, $id);
2677            $count++;
2678        }
2679    
2680        if ($count >0){
2681            $content = $all_rows;
2682        }
2683        else{
2684            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2685        }
2686        return ($content,$selected_sims);
2687    }
2688    
2689    sub display_protein_history {
2690        my ($self, $id,$fig) = @_;
2691        my $all_rows = [];
2692        my $content;
2693    
2694        my $cgi = new CGI;
2695        my $count = 0;
2696        foreach my $feat ($fig->feature_annotations($id)){
2697            my $row = [];
2698            my $col1 = $feat->[2];
2699            my $col2 = $feat->[1];
2700            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2701            my $text = $feat->[3];
2702    
2703            push (@$row, $col1);
2704            push (@$row, $col2);
2705            push (@$row, $text);
2706            push (@$all_rows, $row);
2707            $count++;
2708        }
2709        if ($count > 0){
2710            $content = $all_rows;
2711        }
2712        else {
2713            $content = "There is no history for this PEG";
2714        }
2715    
2716        return($content);
2717    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3