[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download) (as text)

1 : mkubal 1.1 package Observation;
2 :    
3 :     require Exporter;
4 :     @EXPORT_OK = qw(get_objects);
5 :    
6 :     use strict;
7 :     use warnings;
8 : arodri7 1.6 use Table;
9 : mkubal 1.1
10 :     1;
11 :    
12 : mkubal 1.8 # $Id: Observation.pm,v 1.7 2007/06/19 21:55:39 mkubal Exp $
13 : mkubal 1.1
14 :     =head1 NAME
15 :    
16 :     Observation -- A presentation layer for observations in SEED.
17 :    
18 :     =head1 DESCRIPTION
19 :    
20 :     The SEED environment contains various sources of information for sequence features. The purpose of this library is to provide a
21 :     single interface to this data.
22 :    
23 :     The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
24 :    
25 :     Example:
26 :    
27 :     use FIG;
28 :     use Observation;
29 :    
30 : paczian 1.2 my $fig = new FIG;
31 :     my $fid = "fig|83333.1.peg.3";
32 :    
33 :     my $observations = Observation::get_objects($fid);
34 :     foreach my $observation (@$observations) {
35 :     print "ID: " . $fid . "\n";
36 :     print "Start: " . $observation->start() . "\n";
37 :     ...
38 :     }
39 : mkubal 1.1
40 :     B<return an array of objects>
41 :    
42 :    
43 :     print "$Observation->acc\n" prints the Accession number if present for the Observation
44 :    
45 :     =cut
46 :    
47 :     =head1 BACKGROUND
48 :    
49 :     =head2 Data incorporated in the Observations
50 :    
51 :     As the goal of this library is to provide an integrated view, we combine diverse sources of evidence.
52 :    
53 :     =head3 SEED core evidence
54 :    
55 :     The core SEED data structures provided by FIG.pm. These are Similarities, BBHs and PCHs.
56 :    
57 :     =head3 Attribute based Evidence
58 :    
59 :     We use the SEED attribute infrastructure to store information computed by a variety of computational procedures.
60 :    
61 :     These are e.g. InterPro hits via InterProScan (ipr), NCBI Conserved Domain Database Hits via PSSM(cdd),
62 :     PFAM hits via HMM(pfam), SignalP results(signalp), and various others.
63 :    
64 :     =head1 METHODS
65 :    
66 :     The public methods this package provides are listed below:
67 :    
68 :     =head3 acc()
69 :    
70 :     A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
71 :    
72 :     =cut
73 :    
74 :     sub acc {
75 :     my ($self) = @_;
76 :    
77 :     return $self->{acc};
78 :     }
79 :    
80 :     =head3 description()
81 :    
82 :     The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.
83 :    
84 :     B<Please note:>
85 :     Either remoteid or description is required.
86 :    
87 :     =cut
88 :    
89 :     sub description {
90 :     my ($self) = @_;
91 :    
92 : arodri7 1.5 return $self->{description};
93 : mkubal 1.1 }
94 :    
95 :     =head3 class()
96 :    
97 :     The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
98 :     B<Please note> the connection of class and display_method and URL.
99 : mkubal 1.7
100 : mkubal 1.1 Current valid classes are:
101 :    
102 :     =over 9
103 :    
104 : mkubal 1.3 =item SIM (seq)
105 : mkubal 1.1
106 : mkubal 1.3 =item BBH (seq)
107 : mkubal 1.1
108 : mkubal 1.3 =item PCH (fc)
109 : mkubal 1.1
110 : mkubal 1.3 =item FIGFAM (seq)
111 : mkubal 1.1
112 : mkubal 1.3 =item IPR (dom)
113 : mkubal 1.1
114 : mkubal 1.3 =item CDD (dom)
115 : mkubal 1.1
116 : mkubal 1.3 =item PFAM (dom)
117 : mkubal 1.1
118 : mkubal 1.3 =item SIGNALP (dom)
119 : mkubal 1.1
120 : mkubal 1.3 =item CELLO(loc)
121 : mkubal 1.1
122 : mkubal 1.3 =item TMHMM (loc)
123 : mkubal 1.1
124 : mkubal 1.3 =item HMMTOP (loc)
125 : mkubal 1.1
126 :     =back
127 :    
128 :     =cut
129 :    
130 :     sub class {
131 :     my ($self) = @_;
132 :    
133 :     return $self->{class};
134 :     }
135 :    
136 :     =head3 type()
137 :    
138 :     The type of evidence (required).
139 :    
140 :     Where type is one of the following:
141 :    
142 :     =over 8
143 :    
144 :     =item seq=Sequence similarity
145 :    
146 :     =item dom=domain based match
147 :    
148 :     =item loc=Localization of the feature
149 :    
150 :     =item fc=Functional coupling.
151 :    
152 :     =back
153 :    
154 :     =cut
155 :    
156 :     sub type {
157 :     my ($self) = @_;
158 :    
159 :     return $self->{acc};
160 :     }
161 :    
162 :     =head3 start()
163 :    
164 :     Start of hit in query sequence.
165 :    
166 :     =cut
167 :    
168 :     sub start {
169 :     my ($self) = @_;
170 :    
171 :     return $self->{start};
172 :     }
173 :    
174 :     =head3 end()
175 :    
176 :     End of the hit in query sequence.
177 :    
178 :     =cut
179 :    
180 :     sub stop {
181 :     my ($self) = @_;
182 :    
183 :     return $self->{stop};
184 :     }
185 :    
186 :     =head3 evalue()
187 :    
188 :     E-value or P-Value if present.
189 :    
190 :     =cut
191 :    
192 :     sub evalue {
193 :     my ($self) = @_;
194 :    
195 :     return $self->{evalue};
196 :     }
197 :    
198 :     =head3 score()
199 :    
200 :     Score if present.
201 :    
202 :     B<Please note: >
203 :     Either score or eval are required.
204 :    
205 :     =cut
206 :    
207 :     sub score {
208 :     my ($self) = @_;
209 :     return $self->{score};
210 :     }
211 :    
212 :    
213 :     =head3 display_method()
214 :    
215 :     If available use the function specified here to display the "raw" observation.
216 :     In the case of a BLAST alignment of fid1 and fid2 a cgi script
217 :     will be called to display the results of running the command "bl2seq fid1 fid2".
218 :    
219 :     B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
220 :    
221 :     =cut
222 :    
223 : mkubal 1.7 sub display {
224 : mkubal 1.1
225 : mkubal 1.7 die "Abstract Method Called\n";
226 : mkubal 1.1
227 :     }
228 :    
229 : mkubal 1.7
230 : mkubal 1.1 =head3 rank()
231 :    
232 :     Returns an integer from 1 - 10 indicating the importance of this observations.
233 :    
234 :     Currently always returns 1.
235 :    
236 :     =cut
237 :    
238 :     sub rank {
239 :     my ($self) = @_;
240 :    
241 :     # return $self->{rank};
242 :    
243 :     return 1;
244 :     }
245 :    
246 :     =head3 supports_annotation()
247 :    
248 :     Does a this observation support the annotation of its feature?
249 :    
250 :     Returns
251 :    
252 :     =over 3
253 :    
254 :     =item 10, if feature annotation is identical to $self->description
255 :    
256 :     =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()
257 :    
258 :     =item undef
259 :    
260 :     =back
261 :    
262 :     =cut
263 :    
264 :     sub supports_annotation {
265 :     my ($self) = @_;
266 :    
267 :     # no code here so far
268 :    
269 :     return $self->{supports_annotation};
270 :     }
271 :    
272 :     =head3 url()
273 :    
274 :     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.
275 :    
276 :     =cut
277 :    
278 :     sub url {
279 :     my ($self) = @_;
280 :    
281 :     my $url = get_url($self->type, $self->acc);
282 :    
283 :     return $url;
284 :     }
285 :    
286 :     =head3 get_objects()
287 :    
288 :     This is the B<REAL WORKHORSE> method of this Package.
289 :    
290 :     It will probably have to:
291 :    
292 :     - get all sims for the feature
293 :     - get all bbhs for the feature
294 :     - copy information from sim to bbh (bbh have no match location etc)
295 :     - get pchs (difficult)
296 :     - get attributes (there is code for this that in get_attribute_based_observations
297 :     - get_attributes_based_observations returns an array of arrays of hashes like this"
298 :    
299 : mkubal 1.7 my $dataset
300 : mkubal 1.1 [
301 :     [ { name => 'acc', value => '1234' },
302 :     { name => 'from', value => '4' },
303 :     { name => 'to', value => '400' },
304 :     ....
305 :     ],
306 :     [ { name => 'acc', value => '456' },
307 :     { name => 'from', value => '1' },
308 :     { name => 'to', value => '100' },
309 :     ....
310 :     ],
311 :     ...
312 :     ];
313 :     return $datasets;
314 :     }
315 :    
316 :     It will invoke the required calls to the SEED API to retrieve the information required.
317 :    
318 :     =cut
319 :    
320 :     sub get_objects {
321 : mkubal 1.7 my ($self,$fid,$classes) = @_;
322 :    
323 :    
324 :     my $objects = [];
325 :     my @matched_datasets=();
326 : mkubal 1.1
327 : mkubal 1.7 # call function that fetches attribute based observations
328 :     # returns an array of arrays of hashes
329 :    
330 :     if(scalar(@$classes) < 1){
331 :     get_attribute_based_observations($fid,\@matched_datasets);
332 :     get_sims_observations($fid,\@matched_datasets);
333 :     get_identical_proteins($fid,\@matched_datasets);
334 :     get_functional_coupling($fid,\@matched_datasets);
335 :     }
336 :     else{
337 :     #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based
338 :     my %domain_classes;
339 :     foreach my $class (@$classes){
340 :     if($class =~/(IPR|CDD|PFAM)/){
341 :     $domain_classes{$class} = 1;
342 :    
343 :     }
344 :     }
345 :     get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
346 : arodri7 1.5
347 : mkubal 1.7 #add CELLO and SignalP later
348 : mkubal 1.1 }
349 : mkubal 1.7
350 :     foreach my $dataset (@matched_datasets) {
351 :     my $object;
352 :     if($dataset->{'type'} eq "dom"){
353 :     $object = Observation::Domain->new($dataset);
354 :     }
355 :     push (@$objects, $object);
356 : mkubal 1.1 }
357 : mkubal 1.7
358 :     return $objects;
359 : mkubal 1.1
360 :     }
361 :    
362 :     =head1 Internal Methods
363 :    
364 :     These methods are not meant to be used outside of this package.
365 :    
366 :     B<Please do not use them outside of this package!>
367 :    
368 :     =cut
369 :    
370 :    
371 :     =head3 get_url (internal)
372 :    
373 :     get_url() return a valid URL or undef for any observation.
374 :    
375 :     URLs are constructed by looking at the Accession acc() and name()
376 :    
377 :     Info from both attributes is combined with a table of base URLs stored in this function.
378 :    
379 :     =cut
380 :    
381 :     sub get_url {
382 :    
383 :     my ($self) = @_;
384 :     my $url='';
385 :    
386 :     # a hash with a URL for each observation; identified by name()
387 :     #my $URL => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\
388 :     # 'IPR' => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\
389 :     # 'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\
390 :     # 'PIR' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\
391 :     # 'FIGFAM' => '',\
392 :     # 'sim'=> "http://www.theseed.org/linkin.cgi?id=",\
393 :     # 'bbh'=> "http://www.theseed.org/linkin.cgi?id="
394 :     #};
395 :    
396 :     # if (defined $URL{$self->name}) {
397 :     # $url = $URL{$self->name}.$self->acc;
398 :     # return $url;
399 :     # }
400 :     # else
401 :     return undef;
402 :     }
403 :    
404 :     =head3 get_display_method (internal)
405 :    
406 :     get_display_method() return a valid URL or undef for any observation.
407 :    
408 :     URLs are constructed by looking at the Accession acc() and name()
409 :     and Info from both attributes is combined with a table of base URLs stored in this function.
410 :    
411 :     =cut
412 :    
413 :     sub get_display_method {
414 :    
415 :     my ($self) = @_;
416 :    
417 :     # a hash with a URL for each observation; identified by name()
418 :     #my $URL => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\
419 :     # 'bbh'=> "http://www.theseed.org/featalign.cgi?id1="
420 :     # };
421 :    
422 :     #if (defined $URL{$self->name}) {
423 :     # $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;
424 :     # return $url;
425 :     # }
426 :     # else
427 :     return undef;
428 :     }
429 :    
430 : mkubal 1.7
431 :     sub get_attribute_based_domain_observations{
432 :    
433 :     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
434 :     my ($fid,$domain_classes,$datasets_ref) = (@_);
435 :    
436 :     my $fig = new FIG;
437 :    
438 :     foreach my $attr_ref ($fig->get_attributes($fid)) {
439 :     my $key = @$attr_ref[1];
440 :     my @parts = split("::",$key);
441 :     my $class = $parts[0];
442 :    
443 :     if($domain_classes->{$parts[0]}){
444 :     my $val = @$attr_ref[2];
445 : mkubal 1.8 if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
446 : mkubal 1.7 my $raw_evalue = $1;
447 : mkubal 1.8 my $from = $2;
448 :     my $to = $3;
449 : mkubal 1.7 my $evalue;
450 :     if($raw_evalue =~/(\d+)\.(\d+)/){
451 :     my $part2 = 1000 - $1;
452 :     my $part1 = $2/100;
453 :     $evalue = $part1."e-".$part2;
454 :     }
455 :     else{
456 : mkubal 1.8 $evalue = "0.0";
457 : mkubal 1.7 }
458 :    
459 :     my $dataset = {'class' => $class,
460 :     'acc' => $key,
461 :     'type' => "dom" ,
462 :     'evalue' => $evalue,
463 :     'start' => $from,
464 :     'stop' => $to
465 :     };
466 :    
467 :     push (@{$datasets_ref} ,$dataset);
468 :     }
469 :     }
470 :     }
471 :     }
472 :    
473 : mkubal 1.1 =head3 get_attribute_based_evidence (internal)
474 :    
475 :     This method retrieves evidence from the attribute server
476 :    
477 :     =cut
478 :    
479 :     sub get_attribute_based_observations{
480 :    
481 :     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
482 :     my ($fid,$datasets_ref) = (@_);
483 :    
484 :     my $_myfig = new FIG;
485 :    
486 :     foreach my $attr_ref ($_myfig->get_attributes($fid)) {
487 :    
488 :     # convert the ref into a string for easier handling
489 :     my ($string) = "@$attr_ref";
490 :    
491 :     # print "S:$string\n";
492 :     my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);
493 :    
494 :     # THIS SHOULD BE DONE ANOTHER WAY FM->TD
495 :     # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc
496 :     # as fas as possible this should be configured so that the type of observation and the regexp are
497 :     # stored somewhere for easy expansion
498 :     #
499 :    
500 :     if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {
501 :    
502 :     # some keys are composite CDD::1233244 or PFAM:PF1233
503 :    
504 :     if ( $key =~ /::/ ) {
505 :     my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);
506 :     $val=$restkey.";".$val;
507 :     $key=$firstkey;
508 :     }
509 :    
510 :     my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );
511 :    
512 :     my $evalue= 255;
513 :     if (defined $raw_evalue) { # some of the tool do not give us an evalue
514 :    
515 :     my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);
516 :     my ($new_k, $new_exp);
517 :    
518 :     #
519 :     # THIS DOES NOT WORK PROPERLY
520 :     #
521 :     if($raw_evalue =~/(\d+).(\d+)/){
522 :    
523 :     # $new_exp = (1000+$expo);
524 :     # $new_k = $k / 100;
525 :    
526 :     }
527 :     $evalue = "0.01"#new_k."e-".$new_exp;
528 :     }
529 :    
530 :     # unroll it all into an array of hashes
531 :     # this needs to be done differently for different types of observations
532 :     my $dataset = [ { name => 'class', value => $key },
533 :     { name => 'acc' , value => $acc},
534 :     { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD
535 :     { name => 'evalue', value => $evalue },
536 :     { name => 'start', value => $from},
537 :     { name => 'stop' , value => $to}
538 :     ];
539 :    
540 :     push (@{$datasets_ref} ,$dataset);
541 :     }
542 :     }
543 :     }
544 :    
545 : mkubal 1.3 =head3 get_sims_observations() (internal)
546 :    
547 :     This methods retrieves sims fills the internal data structures.
548 :    
549 :     =cut
550 :    
551 :     sub get_sims_observations{
552 :    
553 :     my ($fid,$datasets_ref) = (@_);
554 : mkubal 1.4 my $fig = new FIG;
555 :     my @sims= $fig->nsims($fid,100,1e-20,"fig");
556 :     my ($dataset);
557 : mkubal 1.3 foreach my $sim (@sims){
558 : mkubal 1.4 my $hit = $sim->[1];
559 :     my $evalue = $sim->[10];
560 :     my $from = $sim->[8];
561 :     my $to = $sim->[9];
562 :     $dataset = [ { name => 'class', value => "SIM" },
563 : mkubal 1.3 { name => 'acc' , value => $hit},
564 :     { name => 'type', value => "seq"} ,
565 :     { name => 'evalue', value => $evalue },
566 :     { name => 'start', value => $from},
567 :     { name => 'stop' , value => $to}
568 :     ];
569 : mkubal 1.4 push (@{$datasets_ref} ,$dataset);
570 : mkubal 1.3 }
571 :     }
572 :    
573 : arodri7 1.5 =head3 get_identical_proteins() (internal)
574 :    
575 :     This methods retrieves sims fills the internal data structures.
576 :    
577 :     =cut
578 :    
579 :     sub get_identical_proteins{
580 :    
581 :     my ($fid,$datasets_ref) = (@_);
582 :     my $fig = new FIG;
583 :     my @funcs = ();
584 :    
585 :     my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
586 :    
587 :     foreach my $id (@maps_to) {
588 :     my ($tmp, $who);
589 : arodri7 1.6 if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
590 : arodri7 1.5 if ($id =~ /^fig\|/) { $who = "FIG" }
591 :     elsif ($id =~ /^gi\|/) { $who = "NCBI" }
592 :     elsif ($id =~ /^^[NXYZA]P_/) { $who = "RefSeq" }
593 :     elsif ($id =~ /^sp\|/) { $who = "SwissProt" }
594 :     elsif ($id =~ /^uni\|/) { $who = "UniProt" }
595 :     elsif ($id =~ /^tigr\|/) { $who = "TIGR" }
596 :     elsif ($id =~ /^pir\|/) { $who = "PIR" }
597 :     elsif ($id =~ /^kegg\|/) { $who = "KEGG" }
598 :     elsif ($id =~ /^tr\|/) { $who = "TrEMBL" }
599 :     elsif ($id =~ /^eric\|/) { $who = "ASAP" }
600 :    
601 :     push(@funcs, [$id,$who,$tmp]);
602 :     }
603 :     }
604 :    
605 :     my ($dataset);
606 :     foreach my $row (@funcs){
607 :     my $id = $row->[0];
608 :     my $organism = $fig->org_of($fid);
609 :     my $who = $row->[1];
610 :     my $assignment = $row->[2];
611 :     $dataset = [ { name => 'class', value => "IDENTICAL" },
612 :     { name => 'id' , value => $id},
613 :     { name => 'organism', value => "$organism"} ,
614 :     { name => 'database', value => $who },
615 :     { name => 'description' , value => $assignment}
616 :     ];
617 :     push (@{$datasets_ref} ,$dataset);
618 :     }
619 :    
620 :     }
621 :    
622 : arodri7 1.6 =head3 get_functional_coupling() (internal)
623 :    
624 :     This methods retrieves the functional coupling of a protein given a peg ID
625 :    
626 :     =cut
627 :    
628 :     sub get_functional_coupling{
629 :    
630 :     my ($fid,$datasets_ref) = (@_);
631 :     my $fig = new FIG;
632 :     my @funcs = ();
633 :    
634 :     # initialize some variables
635 :     my($sc,$neigh);
636 :    
637 :     # set default parameters for coupling and evidence
638 :     my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
639 :    
640 :     # get the fc data
641 :     my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
642 :    
643 :     # retrieve data
644 :     my @rows = map { ($sc,$neigh) = @$_;
645 :     [$sc,$neigh,scalar $fig->function_of($neigh)]
646 :     } @fc_data;
647 :    
648 :     my ($dataset);
649 :     foreach my $row (@rows){
650 :     my $id = $row->[1];
651 :     my $score = $row->[0];
652 :     my $description = $row->[2];
653 :     $dataset = [ { name => 'class', value => "FC" },
654 :     { name => 'score' , value => $score},
655 :     { name => 'id', value => "$id"} ,
656 :     { name => 'description' , value => $description}
657 :     ];
658 :     push (@{$datasets_ref} ,$dataset);
659 :     }
660 :     }
661 : arodri7 1.5
662 : mkubal 1.1 =head3 get_sims_and_bbhs() (internal)
663 :    
664 :     This methods retrieves sims and also BBHs and fills the internal data structures.
665 :    
666 :     =cut
667 :    
668 :     # sub get_sims_and_bbhs{
669 :    
670 :     # # blast m8 output format
671 :     # # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit
672 :    
673 :     # my $Sims=();
674 :     # @sims_src = $fig->sims($fid,80,500,"fig",0);
675 :     # print "found $#sims_src SIMs\n";
676 :     # foreach $sims (@sims_src) {
677 :     # my ($sims_string) = "@$sims";
678 :     # # print "$sims_string\n";
679 :     # my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+
680 :     # \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);
681 :     # # print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";
682 :     # $Sims{$rfid}{'eval'}=$eval;
683 :     # $Sims{$rfid}{'start'}=$start;
684 :     # $Sims{$rfid}{'stop'}=$stop;
685 :     # print "$rfid $Sims{$rfid}{'eval'}\n";
686 :     # }
687 :    
688 :     # # BBHs
689 :     # my $BBHs=();
690 :    
691 :     # @bbhs_src = $fig->bbhs($fid,1.0e-10);
692 :     # print "found $#bbhs_src BBHs\n";
693 :     # foreach $bbh (@bbhs_src) {
694 :     # #print "@$bbh\n";
695 :     # my ($bbh_string) = "@$bbh";
696 :     # my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);
697 :     # #print "ID: $rfid, E:$eval, S:$score\n";
698 :     # $BBHs{$rfid}{'eval'}=$eval;
699 :     # $BBHs{$rfid}{'score'}=$score;
700 :     # #print "$rfid $BBHs{$rfid}{'eval'}\n";
701 :     # }
702 :    
703 :     # }
704 :    
705 :    
706 :    
707 :     =head3 new (internal)
708 :    
709 :     Instantiate a new object.
710 :    
711 :     =cut
712 :    
713 :     sub new {
714 : mkubal 1.7 my ($class,$dataset) = @_;
715 :    
716 : mkubal 1.1
717 : mkubal 1.7 #$self = { acc => '',
718 :     # description => '',
719 :     # class => '',
720 :     # type => '',
721 :     # start => '',
722 :     # stop => '',
723 :     # evalue => '',
724 :     # score => '',
725 :     # display_method => '',
726 :     # feature_id => '',
727 :     # rank => '',
728 :     # supports_annotation => '',
729 :     # id => '',
730 :     # organism => '',
731 :     # who => ''
732 :     # };
733 : mkubal 1.1
734 : mkubal 1.7 my $self = { class => $dataset->{'class'},
735 :     type => $dataset->{'type'}
736 :     };
737 :    
738 :     bless($self,$class);
739 : mkubal 1.1
740 :     return $self;
741 :     }
742 :    
743 :     =head3 feature_id (internal)
744 :    
745 :    
746 :     =cut
747 :    
748 :     sub feature_id {
749 :     my ($self) = @_;
750 :    
751 :     return $self->{feature_id};
752 :     }
753 : arodri7 1.5
754 :     =head3 id (internal)
755 :    
756 :     Returns the ID of the identical sequence
757 :    
758 :     =cut
759 :    
760 :     sub id {
761 :     my ($self) = @_;
762 :    
763 :     return $self->{id};
764 :     }
765 :    
766 :     =head3 organism (internal)
767 :    
768 :     Returns the organism of the identical sequence
769 :    
770 :     =cut
771 :    
772 :     sub organism {
773 :     my ($self) = @_;
774 :    
775 :     return $self->{organism};
776 :     }
777 :    
778 :     =head3 database (internal)
779 :    
780 :     Returns the database of the identical sequence
781 :    
782 :     =cut
783 :    
784 :     sub database {
785 :     my ($self) = @_;
786 :    
787 :     return $self->{database};
788 :     }
789 :    
790 : arodri7 1.6 #package Observation::Identical;
791 :     #1;
792 :     #
793 :     #our @ISA = qw(Observation); # inherits all the methods from Observation
794 :    
795 :     =head3 display_identical()
796 :    
797 :     If available use the function specified here to display the "raw" observation.
798 :     This code will display a table for the identical protein
799 :    
800 :    
801 :     B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
802 :    
803 :     =cut
804 :    
805 :     sub display_identical {
806 :     my ($self, $fid, $cgi) = @_;
807 :    
808 :     my $content;
809 :     my $array=Observation->get_objects($fid);
810 :    
811 :     my $all_domains = [];
812 :     my $count_identical = 0;
813 :     foreach my $thing (@$array) {
814 :     next if ($thing->class ne "IDENTICAL");
815 :     my $single_domain = [];
816 :     push(@$single_domain,$thing->class);
817 :     my $id = $thing->id;
818 :     $count_identical++;
819 :     push(@$single_domain,&HTML::set_prot_links($cgi,$id));
820 :     push(@$single_domain,$thing->organism);
821 :     push(@$single_domain,$thing->database);
822 :     push(@$single_domain,$thing->description);
823 :     push(@$all_domains,$single_domain);
824 :     }
825 :    
826 :     if ($count_identical >0){
827 :     my $table_component = $self->application->component('DomainTable');
828 :    
829 :     $table_component->columns ([ { 'name' => 'Name', 'filter' => 1 },
830 :     { 'name' => 'ID' },
831 :     { 'name' => 'Organism' },
832 :     { 'name' => 'Database' },
833 :     { 'name' => 'Assignment' }
834 :     ]);
835 :     $table_component->data($all_domains);
836 :     $table_component->show_top_browse(1);
837 :     $table_component->show_bottom_browse(1);
838 :     $table_component->items_per_page(50);
839 :     $table_component->show_select_items_per_page(1);
840 :     $content .= $table_component->output();
841 :     }
842 :     else{
843 :     $content = "<p>This PEG does not have any essentially identical proteins</p>";
844 :     }
845 :     return ($content);
846 :     }
847 : mkubal 1.7
848 :     package Observation::Domain;
849 :    
850 :     use base qw(Observation);
851 :    
852 :     sub new {
853 :    
854 :     my ($class,$dataset) = @_;
855 :     my $self = $class->SUPER::new($dataset);
856 :     $self->{evalue} = $dataset->{'evalue'};
857 :     $self->{acc} = $dataset->{'acc'};
858 :     $self->{start} = $dataset->{'start'};
859 :     $self->{stop} = $dataset->{'stop'};
860 :    
861 :     bless($self,$class);
862 :     return $self;
863 :     }
864 :    
865 :     sub display {
866 :     my ($thing,$gd) = @_;
867 :     my $lines = [];
868 :     my $line_config = { 'title' => $thing->acc,
869 :     'short_title' => $thing->type,
870 :     'basepair_offset' => '1' };
871 :     my $color = "4";
872 :    
873 :     my $line_data = [];
874 :     my $links_list = [];
875 :     my $descriptions = [];
876 :    
877 :     my $description_function;
878 :     $description_function = {"title" => $thing->class,
879 :     "value" => $thing->acc};
880 :    
881 :     push(@$descriptions,$description_function);
882 :    
883 :     my $score;
884 :     $score = {"title" => "score",
885 :     "value" => $thing->evalue};
886 :     push(@$descriptions,$score);
887 :    
888 :     my $link_id;
889 :     if ($thing->acc =~/CDD::(\d+)/){
890 :     $link_id = $1;
891 :     }
892 :    
893 :     my $link;
894 :     $link = {"link_title" => $thing->acc,
895 :     "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};
896 :     push(@$links_list,$link);
897 :    
898 :     my $element_hash = {
899 :     "title" => $thing->type,
900 :     "start" => $thing->start,
901 :     "end" => $thing->stop,
902 :     "color"=> $color,
903 :     "zlayer" => '2',
904 :     "links_list" => $links_list,
905 :     "description" => $descriptions};
906 :    
907 :     push(@$line_data,$element_hash);
908 :     $gd->add_line($line_data, $line_config);
909 :    
910 :     return $gd;
911 :    
912 :     }
913 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3