[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.21, Thu Jun 28 22:08:05 2007 UTC revision 1.24, Tue Jul 10 20:11:38 2007 UTC
# Line 26  Line 26 
26    
27  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
28    
 Example:  
   
   
 use FIG;  
 use Observation;  
   
 my $fig = new FIG;  
 my $fid = "fig|83333.1.peg.3";  
   
 my $observations = Observation::get_objects($fid);  
 foreach my $observation (@$observations) {  
     print "ID: " . $fid . "\n";  
     print "Start: " . $observation->start() . "\n";  
     ...  
 }  
   
 B<return an array of objects>  
   
   
 print "$Observation->acc\n" prints the Accession number if present for the Observation  
   
29  =cut  =cut
30    
31  =head1 BACKGROUND  =head1 BACKGROUND
# Line 70  Line 49 
49    
50  The public methods this package provides are listed below:  The public methods this package provides are listed below:
51    
 =head3 acc()  
52    
53  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  =head3 context()
54    
55    Returns close or diverse for purposes of displaying genomic context
56    
57  =cut  =cut
58    
59  sub acc {  sub context {
60    my ($self) = @_;    my ($self) = @_;
61    
62    return $self->{acc};    return $self->{context};
63  }  }
64    
65  =head3 description()  =head3 rows()
   
 The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  
66    
67  B<Please note:>  each row in a displayed table
 Either remoteid or description is required.  
68    
69  =cut  =cut
70    
71  sub description {  sub rows {
72    my ($self) = @_;    my ($self) = @_;
73    
74    return $self->{description};    return $self->{rows};
75    }
76    
77    =head3 acc()
78    
79    A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
80    
81    =cut
82    
83    sub acc {
84      my ($self) = @_;
85      return $self->{acc};
86  }  }
87    
88  =head3 class()  =head3 class()
# Line 262  Line 250 
250      return $self->{hlength};      return $self->{hlength};
251  }  }
252    
   
   
253  =head3 evalue()  =head3 evalue()
254    
255  E-value or P-Value if present.  E-value or P-Value if present.
# Line 280  Line 266 
266    
267  Score if present.  Score if present.
268    
 B<Please note: >  
 Either score or eval are required.  
   
269  =cut  =cut
270    
271  sub score {  sub score {
# Line 290  Line 273 
273    return $self->{score};    return $self->{score};
274  }  }
275    
   
276  =head3 display()  =head3 display()
277    
278  will be different for each type  will be different for each type
# Line 303  Line 285 
285    
286  }  }
287    
288    =head3 display_table()
289    
290  =head3 rank()  will be different for each type
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
   
 Currently always returns 1.  
   
 =cut  
   
 sub rank {  
   my ($self) = @_;  
   
 #  return $self->{rank};  
   
   return 1;  
 }  
   
 =head3 supports_annotation()  
   
 Does a this observation support the annotation of its feature?  
   
 Returns  
   
 =over 3  
   
 =item 10, if feature annotation is identical to $self->description  
   
 =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()  
   
 =item undef  
   
 =back  
   
 =cut  
   
 sub supports_annotation {  
   my ($self) = @_;  
   
   # no code here so far  
   
   return $self->{supports_annotation};  
 }  
   
 =head3 url()  
   
 URL describing the subject. In case of a BLAST hit against a sequence, this URL will lead to a page displaying the sequence record for the sequence. In case of an HMM hit, the URL will be to the URL description.  
291    
292  =cut  =cut
293    
294  sub url {  sub display_table {
   my ($self) = @_;  
295    
296    my $url = get_url($self->type, $self->acc);    die "Abstract Table Method Called\n";
297    
   return $url;  
298  }  }
299    
300  =head3 get_objects()  =head3 get_objects()
301    
302  This is the B<REAL WORKHORSE> method of this Package.  This is the B<REAL WORKHORSE> method of this Package.
303    
 It will probably have to:  
   
 - get all sims for the feature  
 - get all bbhs for the feature  
 - copy information from sim to bbh (bbh have no match location etc)  
 - get pchs (difficult)  
 - get attributes (there is code for this that in get_attribute_based_observations  
 - get_attributes_based_observations returns an array of arrays of hashes like this"  
   
   my $dataset  
      [  
        [ { name => 'acc', value => '1234' },  
         { name => 'from', value => '4' },  
         { name => 'to', value => '400' },  
         ....  
        ],  
        [ { name => 'acc', value => '456' },  
         { name => 'from', value => '1' },  
         { name => 'to', value => '100' },  
         ....  
        ],  
        ...  
      ];  
    return $datasets;  
  }  
   
 It will invoke the required calls to the SEED API to retrieve the information required.  
   
304  =cut  =cut
305    
306  sub get_objects {  sub get_objects {
307      my ($self,$fid,$classes) = @_;      my ($self,$fid,$scope) = @_;
308    
309      my $objects = [];      my $objects = [];
310      my @matched_datasets=();      my @matched_datasets=();
# Line 403  Line 312 
312      # call function that fetches attribute based observations      # call function that fetches attribute based observations
313      # returns an array of arrays of hashes      # returns an array of arrays of hashes
314    
315      if(scalar(@$classes) < 1){      if($scope){
316          get_attribute_based_observations($fid,\@matched_datasets);          get_cluster_observations($fid,\@matched_datasets,$scope);
         get_sims_observations($fid,\@matched_datasets);  
         get_identical_proteins($fid,\@matched_datasets);  
         get_functional_coupling($fid,\@matched_datasets);  
317      }      }
318      else{      else{
319          my %domain_classes;          my %domain_classes;
320          my $identical_flag=0;          $domain_classes{'CDD'} = 1;
         my $pch_flag=0;  
         my $location_flag = 0;  
         my $sims_flag=0;  
         my $cluster_flag = 0;  
         my $pdb_flag = 0;  
         foreach my $class (@$classes){  
             if($class =~ /(IPR|CDD|PFAM)/){  
                 $domain_classes{$class} = 1;  
             }  
             elsif ($class eq "IDENTICAL")  
             {  
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)  
             {  
                 $location_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_flag = 1;  
             }  
             elsif ($class eq "CLUSTER")  
             {  
                 $cluster_flag = 1;  
             }  
             elsif ($class eq "PDB")  
             {  
                 $pdb_flag = 1;  
             }  
   
         }  
   
         if ($identical_flag ==1)  
         {  
321              get_identical_proteins($fid,\@matched_datasets);              get_identical_proteins($fid,\@matched_datasets);
         }  
         if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {  
322              get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);              get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
         }  
         if ($pch_flag == 1)  
         {  
             get_functional_coupling($fid,\@matched_datasets);  
         }  
         if ($sims_flag == 1)  
         {  
323              get_sims_observations($fid,\@matched_datasets);              get_sims_observations($fid,\@matched_datasets);
324          }          get_functional_coupling($fid,\@matched_datasets);
   
         if ($location_flag == 1)  
         {  
325              get_attribute_based_location_observations($fid,\@matched_datasets);              get_attribute_based_location_observations($fid,\@matched_datasets);
         }  
         if ($cluster_flag == 1)  
         {  
             get_cluster_observations($fid,\@matched_datasets);  
         }  
         if ($pdb_flag == 1)  
         {  
326              get_pdb_observations($fid,\@matched_datasets);              get_pdb_observations($fid,\@matched_datasets);
327          }          }
328    
   
     }  
   
329      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
330          my $object;          my $object;
331          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
# Line 519  Line 365 
365    
366  =cut  =cut
367    
   
 =head3 get_url (internal)  
   
 get_url() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
   
 Info from both attributes is combined with a table of base URLs stored in this function.  
   
 =cut  
   
 sub get_url {  
   
  my ($self) = @_;  
  my $url='';  
   
 # a hash with a URL for each observation; identified by name()  
 #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\  
 #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\  
 #                          'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'PIR'    => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'FIGFAM' => '',\  
 #                          'sim'=> "http://www.theseed.org/linkin.cgi?id=",\  
 #                          'bbh'=> "http://www.theseed.org/linkin.cgi?id="  
 #};  
   
 # if (defined $URL{$self->name}) {  
 #     $url = $URL{$self->name}.$self->acc;  
 #     return $url;  
 # }  
 # else  
      return undef;  
 }  
   
 =head3 get_display_method (internal)  
   
 get_display_method() return a valid URL or undef for any observation.  
   
 URLs are constructed by looking at the Accession acc()  and  name()  
 and Info from both attributes is combined with a table of base URLs stored in this function.  
   
 =cut  
   
 sub get_display_method {  
   
  my ($self) = @_;  
   
 # a hash with a URL for each observation; identified by name()  
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
   
 #if (defined $URL{$self->name}) {  
 #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;  
 #     return $url;  
 # }  
 # else  
      return undef;  
 }  
   
   
368  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
369    
370      # 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)
# Line 613  Line 398 
398                                 'type' => "dom" ,                                 'type' => "dom" ,
399                                 'evalue' => $evalue,                                 'evalue' => $evalue,
400                                 'start' => $from,                                 'start' => $from,
401                                 'stop' => $to                                 'stop' => $to,
402                                   'fig_id' => $fid,
403                                   'score' => $raw_evalue
404                                 };                                 };
405    
406                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 629  Line 416 
416    
417      my $location_attributes = ['SignalP','CELLO','TMPRED'];      my $location_attributes = ['SignalP','CELLO','TMPRED'];
418    
419      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED','fig_id' => $fid};
420      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {
421          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
422          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 661  Line 448 
448    
449  }  }
450    
   
 =head3 get_attribute_based_evidence (internal)  
   
 This method retrieves evidence from the attribute server  
   
 =cut  
   
 sub get_attribute_based_observations{  
   
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$datasets_ref) = (@_);  
   
     my $_myfig = new FIG;  
   
     foreach my $attr_ref ($_myfig->get_attributes($fid)) {  
   
         # convert the ref into a string for easier handling  
         my ($string) = "@$attr_ref";  
   
 #       print "S:$string\n";  
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
   
         # THIS SHOULD BE DONE ANOTHER WAY FM->TD  
         # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc  
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
   
         if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {  
   
             # some keys are composite CDD::1233244 or PFAM:PF1233  
   
             if ( $key =~ /::/ ) {  
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
             }  
   
             my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );  
   
             my $evalue= 255;  
             if (defined $raw_evalue) { # some of the tool do not give us an evalue  
   
                 my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  
                 my ($new_k, $new_exp);  
   
                 #  
                 #  THIS DOES NOT WORK PROPERLY  
                 #  
                 if($raw_evalue =~/(\d+).(\d+)/){  
   
 #                   $new_exp = (1000+$expo);  
         #           $new_k = $k / 100;  
   
                 }  
                 $evalue = "0.01"#new_k."e-".$new_exp;  
             }  
   
             # unroll it all into an array of hashes  
             # this needs to be done differently for different types of observations  
             my $dataset = [ { name => 'class', value => $key },  
                             { name => 'acc' , value => $acc},  
                             { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  
                             { name => 'evalue', value => $evalue },  
                             { name => 'start', value => $from},  
                             { name => 'stop' , value => $to}  
                             ];  
   
             push (@{$datasets_ref} ,$dataset);  
         }  
     }  
 }  
   
451  =head3 get_pdb_observations() (internal)  =head3 get_pdb_observations() (internal)
452    
453  This methods sets the type and class for pdb observations  This methods sets the type and class for pdb observations
# Line 745  Line 459 
459    
460      my $fig = new FIG;      my $fig = new FIG;
461    
     print STDERR "get pdb obs called\n";  
462      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {      foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {
463    
464          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
# Line 767  Line 480 
480                         'acc' => $key2,                         'acc' => $key2,
481                         'evalue' => $evalue,                         'evalue' => $evalue,
482                         'start' => $start,                         'start' => $start,
483                         'stop' => $stop                         'stop' => $stop,
484                           'fig_id' => $fid
485                         };                         };
486    
487          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
488      }      }
   
489  }  }
490    
   
   
   
491  =head3 get_cluster_observations() (internal)  =head3 get_cluster_observations() (internal)
492    
493  This methods sets the type and class for cluster observations  This methods sets the type and class for cluster observations
# Line 785  Line 495 
495  =cut  =cut
496    
497  sub get_cluster_observations{  sub get_cluster_observations{
498      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$scope) = (@_);
499    
500      my $dataset = {'class' => 'CLUSTER',      my $dataset = {'class' => 'CLUSTER',
501                     'type' => 'fc'                     'type' => 'fc',
502                       'context' => $scope,
503                       'fig_id' => $fid
504                     };                     };
505      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
506  }  }
# Line 804  Line 516 
516    
517      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
518      my $fig = new FIG;      my $fig = new FIG;
 #    my @sims= $fig->nsims($fid,100,1e-20,"fig");  
519      my @sims= $fig->nsims($fid,100,1e-20,"all");      my @sims= $fig->nsims($fid,100,1e-20,"all");
520      my ($dataset);      my ($dataset);
521      foreach my $sim (@sims){      foreach my $sim (@sims){
# Line 834  Line 545 
545                      'organism' => $organism,                      'organism' => $organism,
546                      'function' => $func,                      'function' => $func,
547                      'qlength' => $qlength,                      'qlength' => $qlength,
548                      'hlength' => $hlength                      'hlength' => $hlength,
549                        'fig_id' => $fid
550                      };                      };
551    
552          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
# Line 866  Line 578 
578    
579  }  }
580    
581    
582  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
583    
584  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 876  Line 589 
589    
590      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
591      my $fig = new FIG;      my $fig = new FIG;
592      my @funcs = ();      my $funcs_ref;
593    
594      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);
595    
# Line 884  Line 597 
597          my ($tmp, $who);          my ($tmp, $who);
598          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
599              $who = &get_database($id);              $who = &get_database($id);
600              push(@funcs, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
601          }          }
602      }      }
603    
604      my ($dataset);      my ($dataset);
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
605          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
606                         'type' => 'seq',                         'type' => 'seq',
607                         'database' => $who,                     'fig_id' => $fid,
608                         'function' => $assignment                     'rows' => $funcs_ref
609                         };                         };
610    
611          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
612      }  
613    
614  }  }
615    
# Line 935  Line 640 
640                    } @fc_data;                    } @fc_data;
641    
642      my ($dataset);      my ($dataset);
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
643          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
644                         'type' => 'fc',                         'type' => 'fc',
645                         'function' => $description                     'fig_id' => $fid,
646                       'rows' => \@rows
647                         };                         };
648    
649          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
     }  
 }  
   
 =head3 get_sims_and_bbhs() (internal)  
   
 This methods retrieves sims and also BBHs and fills the internal data structures.  
   
 =cut  
   
 #     sub get_sims_and_bbhs{  
   
 #       # blast m8 output format  
 #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit  
   
 #       my $Sims=();  
 #       @sims_src = $fig->sims($fid,80,500,"fig",0);  
 #       print "found $#sims_src SIMs\n";  
 #       foreach $sims (@sims_src) {  
 #           my ($sims_string) = "@$sims";  
 # #       print "$sims_string\n";  
 #           my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+  
 #                                             \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);  
 # #       print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";  
 #           $Sims{$rfid}{'eval'}=$eval;  
 #           $Sims{$rfid}{'start'}=$start;  
 #           $Sims{$rfid}{'stop'}=$stop;  
 #           print "$rfid $Sims{$rfid}{'eval'}\n";  
 #       }  
   
 #       # BBHs  
 #       my $BBHs=();  
   
 #       @bbhs_src = $fig->bbhs($fid,1.0e-10);  
 #       print "found $#bbhs_src BBHs\n";  
 #       foreach $bbh (@bbhs_src) {  
 #           #print "@$bbh\n";  
 #           my ($bbh_string) = "@$bbh";  
 #           my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);  
 #           #print "ID: $rfid, E:$eval, S:$score\n";  
 #           $BBHs{$rfid}{'eval'}=$eval;  
 #           $BBHs{$rfid}{'score'}=$score;  
 # #print "$rfid $BBHs{$rfid}{'eval'}\n";  
 #       }  
   
 #     }  
   
650    
651    }
652    
653  =head3 new (internal)  =head3 new (internal)
654    
# Line 1004  Line 659 
659  sub new {  sub new {
660    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
661    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
662    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
663                 type => $dataset->{'type'}                 type => $dataset->{'type'},
664                   fig_id => $dataset->{'fig_id'},
665                   score => $dataset->{'score'},
666             };             };
667    
668    bless($self,$class);    bless($self,$class);
# Line 1043  Line 682 
682      return $self->{identity};      return $self->{identity};
683  }  }
684    
685    =head3 fig_id (internal)
686    
687    =cut
688    
689    sub fig_id {
690      my ($self) = @_;
691      return $self->{fig_id};
692    }
693    
694  =head3 feature_id (internal)  =head3 feature_id (internal)
695    
696    
# Line 1102  Line 750 
750      return $self->{database};      return $self->{database};
751  }  }
752    
753    sub score {
754      my ($self) = @_;
755    
756      return $self->{score};
757    }
758    
759  ############################################################  ############################################################
760  ############################################################  ############################################################
761  package Observation::PDB;  package Observation::PDB;
# Line 1127  Line 781 
781  =cut  =cut
782    
783  sub display{  sub display{
784      my ($self,$gd,$fid) = @_;      my ($self,$gd) = @_;
785    
786        my $fid = $self->fig_id;
787      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology');
788    
     print STDERR "PDB::display called\n";  
   
789      my $acc = $self->acc;      my $acc = $self->acc;
790    
791      print STDERR "acc:$acc\n";      print STDERR "acc:$acc\n";
# Line 1238  Line 891 
891    
892      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
893      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
894      $self->{id} = $dataset->{'id'};      $self->{rows} = $dataset->{'rows'};
     $self->{organism} = $dataset->{'organism'};  
     $self->{function} = $dataset->{'function'};  
     $self->{database} = $dataset->{'database'};  
895    
896      bless($self,$class);      bless($self,$class);
897      return $self;      return $self;
898  }  }
899    
900  =head3 display()  =head3 display_table()
901    
902  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
903  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1258  Line 908 
908    
909  =cut  =cut
910    
 sub display{  
     my ($self, $cgi, $dataset) = @_;  
911    
912    sub display_table{
913        my ($self) = @_;
914    
915        my $fig = new FIG;
916        my $fid = $self->fig_id;
917        my $rows = $self->rows;
918        my $cgi = new CGI;
919      my $all_domains = [];      my $all_domains = [];
920      my $count_identical = 0;      my $count_identical = 0;
921      my $content;      my $content;
922      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
923          next if ($thing->class ne "IDENTICAL");          my $id = $row->[0];
924            my $who = $row->[1];
925            my $assignment = $row->[2];
926            my $organism = $fig->org_of($fid);
927          my $single_domain = [];          my $single_domain = [];
928          push(@$single_domain,$thing->database);          push(@$single_domain,$who);
         my $id = $thing->id;  
         $count_identical++;  
929          push(@$single_domain,&HTML::set_prot_links($cgi,$id));          push(@$single_domain,&HTML::set_prot_links($cgi,$id));
930          push(@$single_domain,$thing->organism);          push(@$single_domain,$organism);
931          #push(@$single_domain,$thing->type);          push(@$single_domain,$assignment);
         push(@$single_domain,$thing->function);  
932          push(@$all_domains,$single_domain);          push(@$all_domains,$single_domain);
933            $count_identical++;
934      }      }
935    
936      if ($count_identical >0){      if ($count_identical >0){
# Line 1288  Line 944 
944    
945  1;  1;
946    
   
947  #########################################  #########################################
948  #########################################  #########################################
949  package Observation::FC;  package Observation::FC;
# Line 1300  Line 955 
955    
956      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
957      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
958      $self->{score} = $dataset->{'score'};      $self->{rows} = $dataset->{'rows'};
     $self->{id} = $dataset->{'id'};  
     $self->{function} = $dataset->{'function'};  
959    
960      bless($self,$class);      bless($self,$class);
961      return $self;      return $self;
962  }  }
963    
964  =head3 display()  =head3 display_table()
965    
966  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
967  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1319  Line 972 
972    
973  =cut  =cut
974    
975  sub display {  sub display_table {
     my ($self,$cgi,$dataset, $fid) = @_;  
976    
977        my ($self,$dataset) = @_;
978        my $fid = $self->fig_id;
979        my $rows = $self->rows;
980        my $cgi = new CGI;
981      my $functional_data = [];      my $functional_data = [];
982      my $count = 0;      my $count = 0;
983      my $content;      my $content;
984    
985      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
986          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
987          $count++;          $count++;
988    
989          # construct the score link          # construct the score link
990          my $score = $thing->score;          my $score = $row->[0];
991          my $toid = $thing->id;          my $toid = $row->[1];
992          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
993          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href=$link>$score</a>";
994    
995          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
996          push(@$single_domain,$thing->id);          push(@$single_domain,$row->[1]);
997          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
998          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
999      }      }
1000    
# Line 1477  Line 1132 
1132  }  }
1133    
1134  sub display {  sub display {
1135      my ($thing,$gd,$fid) = @_;      my ($thing,$gd) = @_;
1136    
1137        my $fid = $thing->fig_id;
1138      my $fig= new FIG;      my $fig= new FIG;
1139      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1140    
# Line 1526  Line 1182 
1182      }      }
1183    
1184      my $color = "6";      my $color = "6";
     #if(0){  
1185      if($tmpred_score){      if($tmpred_score){
1186          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1187              my $descriptions = [];              my $descriptions = [];
# Line 1650  Line 1305 
1305      return $self;      return $self;
1306  }  }
1307    
1308  =head3 display()  =head3 display_table()
1309    
1310  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1311  This code will display a table for the similarities protein  This code will display a table for the similarities protein
# Line 1659  Line 1314 
1314    
1315  =cut  =cut
1316    
1317  sub display {  sub display_table {
1318      my ($self,$cgi,$dataset) = @_;      my ($self,$dataset) = @_;
1319    
1320      my $data = [];      my $data = [];
1321      my $count = 0;      my $count = 0;
1322      my $content;      my $content;
1323      my $fig = new FIG;      my $fig = new FIG;
1324        my $cgi = new CGI;
1325      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1326          my $single_domain = [];          my $single_domain = [];
1327          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1768  Line 1423 
1423    
1424      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1425      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1426        $self->{context} = $dataset->{'context'};
1427      bless($self,$class);      bless($self,$class);
1428      return $self;      return $self;
1429  }  }
1430    
1431  sub display {  sub display {
1432      my ($self,$gd, $fid) = @_;      my ($self,$gd) = @_;
1433    
1434        my $fid = $self->fig_id;
1435        my $compare_or_coupling = $self->context;
1436        my $gd_window_size = $gd->window_size;
1437      my $fig = new FIG;      my $fig = new FIG;
1438      my $all_regions = [];      my $all_regions = [];
1439    
# Line 1785  Line 1443 
1443      # get location of the gene      # get location of the gene
1444      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
1445      my ($contig, $beg, $end);      my ($contig, $beg, $end);
1446        my %reverse_flag;
1447    
1448      if ($data =~ /(.*)_(\d+)_(\d+)$/){      if ($data =~ /(.*)_(\d+)_(\d+)$/){
1449          $contig = $1;          $contig = $1;
# Line 1792  Line 1451 
1451          $end = $3;          $end = $3;
1452      }      }
1453    
1454        my $offset;
1455      my ($region_start, $region_end);      my ($region_start, $region_end);
1456      if ($beg < $end)      if ($beg < $end)
1457      {      {
1458          $region_start = $beg - 4000;          $region_start = $beg - 4000;
1459          $region_end = $end+4000;          $region_end = $end+4000;
1460            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
1461      }      }
1462      else      else
1463      {      {
1464          $region_start = $end-4000;          $region_start = $end-4000;
1465          $region_end = $beg+4000;          $region_end = $beg+4000;
1466            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1467            $reverse_flag{$target_genome} = 1;
1468      }      }
1469    
1470      # call genes in region      # call genes in region
1471      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);
1472      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
1473      my (@start_array_region);      my (@start_array_region);
1474      push (@start_array_region, $region_start);      push (@start_array_region, $offset);
1475    
1476      my %all_genes;      my %all_genes;
1477      my %all_genomes;      my %all_genomes;
1478      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}
     my $compare_regions_flag = 1; # set it for compare regions view (0 -> no view, 1-> yes view)  
     my $functional_coupling_flag = 0; # set functional coupling for view (0 -> no view, 1-> yes view)  
1479    
1480      if ($functional_coupling_flag == 1)      if ($compare_or_coupling eq "diverse")
1481      {      {
1482          my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);          my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);
1483    
# Line 1826  Line 1487 
1487              #   last if ($coup_count > 10);              #   last if ($coup_count > 10);
1488              my ($peg1,$peg2) = @$pair;              my ($peg1,$peg2) = @$pair;
1489    
             my $location = $fig->feature_location($peg1);  
1490              my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);              my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1491                $pair_genome = $fig->genome_of($peg1);
1492    
1493                my $location = $fig->feature_location($peg1);
1494              if($location =~/(.*)_(\d+)_(\d+)$/){              if($location =~/(.*)_(\d+)_(\d+)$/){
1495                  $pair_contig = $1;                  $pair_contig = $1;
1496                  $pair_beg = $2;                  $pair_beg = $2;
# Line 1836  Line 1499 
1499                  {                  {
1500                      $pair_region_start = $pair_beg - 4000;                      $pair_region_start = $pair_beg - 4000;
1501                      $pair_region_stop = $pair_end+4000;                      $pair_region_stop = $pair_end+4000;
1502                        $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
1503                  }                  }
1504                  else                  else
1505                  {                  {
1506                      $pair_region_start = $pair_end-4000;                      $pair_region_start = $pair_end-4000;
1507                      $pair_region_stop = $pair_beg+4000;                      $pair_region_stop = $pair_beg+4000;
1508                        $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1509                        $reverse_flag{$pair_genome} = 1;
1510                  }                  }
1511    
1512                  push (@start_array_region, $pair_region_start);                  push (@start_array_region, $offset);
1513    
                 $pair_genome = $fig->genome_of($peg1);  
1514                  $all_genomes{$pair_genome} = 1;                  $all_genomes{$pair_genome} = 1;
1515                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                  my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1516                  push(@$all_regions,$pair_features);                  push(@$all_regions,$pair_features);
# Line 1855  Line 1520 
1520          }          }
1521      }      }
1522    
1523      if ($compare_regions_flag)      elsif ($compare_or_coupling eq "close")
1524      {      {
1525          # make a hash of genomes that are phylogenetically close          # make a hash of genomes that are phylogenetically close
1526          #my $close_threshold = ".26";          #my $close_threshold = ".26";
# Line 1884  Line 1549 
1549              foreach my $peg1 (@$feature_list){              foreach my $peg1 (@$feature_list){
1550                  my $location = $fig->feature_location($peg1);                  my $location = $fig->feature_location($peg1);
1551                  my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);                  my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);
1552                    $pair_genome = $fig->genome_of($peg1);
1553    
1554                  if($location =~/(.*)_(\d+)_(\d+)$/){                  if($location =~/(.*)_(\d+)_(\d+)$/){
1555                      $pair_contig = $1;                      $pair_contig = $1;
1556                      $pair_beg = $2;                      $pair_beg = $2;
# Line 1892  Line 1559 
1559                      {                      {
1560                          $pair_region_start = $pair_beg - 4000;                          $pair_region_start = $pair_beg - 4000;
1561                          $pair_region_stop = $pair_end + 4000;                          $pair_region_stop = $pair_end + 4000;
1562                          print STDERR "begFIG: $peg1, START:$pair_region_start, END: $pair_region_stop";                          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
1563                      }                      }
1564                      else                      else
1565                      {                      {
1566                          $pair_region_start = $pair_end-4000;                          $pair_region_start = $pair_end-4000;
1567                          $pair_region_stop = $pair_beg+4000;                          $pair_region_stop = $pair_beg+4000;
1568                          print STDERR "endFIG: $peg1, START:$pair_region_start, END: $pair_region_stop";                          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
1569                            $reverse_flag{$pair_genome} = 1;
1570                      }                      }
1571    
1572                      push (@start_array_region, $pair_region_start);                      push (@start_array_region, $offset);
   
                     $pair_genome = $fig->genome_of($peg1);  
1573                      $all_genomes{$pair_genome} = 1;                      $all_genomes{$pair_genome} = 1;
1574                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);                      my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);
1575                      push(@$all_regions,$pair_features);                      push(@$all_regions,$pair_features);
# Line 2027  Line 1693 
1693                              'basepair_offset' => '0'                              'basepair_offset' => '0'
1694                              };                              };
1695    
1696          my $offset = shift @start_array_region;          my $offsetting = shift @start_array_region;
1697    
1698          my $line_data = [];          my $line_data = [];
1699          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
# Line 2069  Line 1735 
1735              my $fid_location = $fig->feature_location($fid1);              my $fid_location = $fig->feature_location($fid1);
1736              if($fid_location =~/(.*)_(\d+)_(\d+)$/){              if($fid_location =~/(.*)_(\d+)_(\d+)$/){
1737                  my($start,$stop);                  my($start,$stop);
1738                  $start = $2 - $offset;                  $start = $2 - $offsetting;
1739                  $stop = $3 - $offset;                  $stop = $3 - $offsetting;
1740    
1741                    if (defined($reverse_flag{$region_genome})){
1742                        $start = $gd_window_size - $start;
1743                        $stop = $gd_window_size - $stop;
1744                    }
1745    
1746                  $element_hash = {                  $element_hash = {
1747                      "title" => $fid1,                      "title" => $fid1,
1748                      "start" => $start,                      "start" => $start,

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.24

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3