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

Annotation of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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 : arodri7 1.6 # $Id: Observation.pm,v 1.5 2007/06/13 17:56:35 arodri7 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 :    
100 :     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 :    
210 :     return $self->{score};
211 :     }
212 :    
213 :    
214 :     =head3 display_method()
215 :    
216 :     If available use the function specified here to display the "raw" observation.
217 :     In the case of a BLAST alignment of fid1 and fid2 a cgi script
218 :     will be called to display the results of running the command "bl2seq fid1 fid2".
219 :    
220 :     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.
221 :    
222 :     =cut
223 :    
224 :     sub display_method {
225 :     my ($self) = @_;
226 :    
227 :     # add code here
228 :    
229 :     return $self->{display_method};
230 :     }
231 :    
232 :     =head3 rank()
233 :    
234 :     Returns an integer from 1 - 10 indicating the importance of this observations.
235 :    
236 :     Currently always returns 1.
237 :    
238 :     =cut
239 :    
240 :     sub rank {
241 :     my ($self) = @_;
242 :    
243 :     # return $self->{rank};
244 :    
245 :     return 1;
246 :     }
247 :    
248 :     =head3 supports_annotation()
249 :    
250 :     Does a this observation support the annotation of its feature?
251 :    
252 :     Returns
253 :    
254 :     =over 3
255 :    
256 :     =item 10, if feature annotation is identical to $self->description
257 :    
258 :     =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()
259 :    
260 :     =item undef
261 :    
262 :     =back
263 :    
264 :     =cut
265 :    
266 :     sub supports_annotation {
267 :     my ($self) = @_;
268 :    
269 :     # no code here so far
270 :    
271 :     return $self->{supports_annotation};
272 :     }
273 :    
274 :     =head3 url()
275 :    
276 :     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.
277 :    
278 :     =cut
279 :    
280 :     sub url {
281 :     my ($self) = @_;
282 :    
283 :     my $url = get_url($self->type, $self->acc);
284 :    
285 :     return $url;
286 :     }
287 :    
288 :     =head3 get_objects()
289 :    
290 :     This is the B<REAL WORKHORSE> method of this Package.
291 :    
292 :     It will probably have to:
293 :    
294 :     - get all sims for the feature
295 :     - get all bbhs for the feature
296 :     - copy information from sim to bbh (bbh have no match location etc)
297 :     - get pchs (difficult)
298 :     - get attributes (there is code for this that in get_attribute_based_observations
299 :     - get_attributes_based_observations returns an array of arrays of hashes like this"
300 :    
301 :     my $datasets =
302 :     [
303 :     [ { name => 'acc', value => '1234' },
304 :     { name => 'from', value => '4' },
305 :     { name => 'to', value => '400' },
306 :     ....
307 :     ],
308 :     [ { name => 'acc', value => '456' },
309 :     { name => 'from', value => '1' },
310 :     { name => 'to', value => '100' },
311 :     ....
312 :     ],
313 :     ...
314 :     ];
315 :     return $datasets;
316 :     }
317 :    
318 :     It will invoke the required calls to the SEED API to retrieve the information required.
319 :    
320 :     =cut
321 :    
322 :     sub get_objects {
323 :     my ($self,$fid) = @_;
324 :    
325 : mkubal 1.3 my $objects = [];
326 : mkubal 1.1 my @matched_datasets=();
327 :    
328 : mkubal 1.3 # call function that fetches attribute based observations
329 : mkubal 1.1 # returns an array of arrays of hashes
330 :     #
331 :     get_attribute_based_observations($fid,\@matched_datasets);
332 :    
333 : mkubal 1.3 # read sims
334 :     get_sims_observations($fid,\@matched_datasets);
335 : arodri7 1.5
336 :     # read identical proteins list of sequences
337 :     get_identical_proteins($fid,\@matched_datasets);
338 :    
339 : arodri7 1.6 # read functional coupling
340 :     get_functional_coupling($fid,\@matched_datasets);
341 :    
342 : mkubal 1.1 # read sims + bbh (enrich BBHs with sims coordindates etc)
343 :     # read pchs
344 :     # read figfam match data from 48hr directory (BobO knows how do do this!)
345 :     # what sources of evidence did I miss?
346 :    
347 :     foreach my $dataset (@matched_datasets) {
348 :     my $object = $self->new();
349 :     foreach my $attribute (@$dataset) {
350 :     $object->{$attribute->{'name'}} = $attribute->{'value'};
351 :     }
352 :     # $object->{$attribute->{'feature_id'}} = $attribute->{$fid};
353 :     push (@$objects, $object);
354 :     }
355 :    
356 :    
357 :     return $objects;
358 :     }
359 :    
360 :     =head1 Internal Methods
361 :    
362 :     These methods are not meant to be used outside of this package.
363 :    
364 :     B<Please do not use them outside of this package!>
365 :    
366 :     =cut
367 :    
368 :    
369 :     =head3 get_url (internal)
370 :    
371 :     get_url() return a valid URL or undef for any observation.
372 :    
373 :     URLs are constructed by looking at the Accession acc() and name()
374 :    
375 :     Info from both attributes is combined with a table of base URLs stored in this function.
376 :    
377 :     =cut
378 :    
379 :     sub get_url {
380 :    
381 :     my ($self) = @_;
382 :     my $url='';
383 :    
384 :     # a hash with a URL for each observation; identified by name()
385 :     #my $URL => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\
386 :     # 'IPR' => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\
387 :     # 'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\
388 :     # 'PIR' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\
389 :     # 'FIGFAM' => '',\
390 :     # 'sim'=> "http://www.theseed.org/linkin.cgi?id=",\
391 :     # 'bbh'=> "http://www.theseed.org/linkin.cgi?id="
392 :     #};
393 :    
394 :     # if (defined $URL{$self->name}) {
395 :     # $url = $URL{$self->name}.$self->acc;
396 :     # return $url;
397 :     # }
398 :     # else
399 :     return undef;
400 :     }
401 :    
402 :     =head3 get_display_method (internal)
403 :    
404 :     get_display_method() return a valid URL or undef for any observation.
405 :    
406 :     URLs are constructed by looking at the Accession acc() and name()
407 :     and Info from both attributes is combined with a table of base URLs stored in this function.
408 :    
409 :     =cut
410 :    
411 :     sub get_display_method {
412 :    
413 :     my ($self) = @_;
414 :    
415 :     # a hash with a URL for each observation; identified by name()
416 :     #my $URL => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\
417 :     # 'bbh'=> "http://www.theseed.org/featalign.cgi?id1="
418 :     # };
419 :    
420 :     #if (defined $URL{$self->name}) {
421 :     # $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;
422 :     # return $url;
423 :     # }
424 :     # else
425 :     return undef;
426 :     }
427 :    
428 :     =head3 get_attribute_based_evidence (internal)
429 :    
430 :     This method retrieves evidence from the attribute server
431 :    
432 :     =cut
433 :    
434 :     sub get_attribute_based_observations{
435 :    
436 :     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
437 :     my ($fid,$datasets_ref) = (@_);
438 :    
439 :     my $_myfig = new FIG;
440 :    
441 :     foreach my $attr_ref ($_myfig->get_attributes($fid)) {
442 :    
443 :     # convert the ref into a string for easier handling
444 :     my ($string) = "@$attr_ref";
445 :    
446 :     # print "S:$string\n";
447 :     my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);
448 :    
449 :     # THIS SHOULD BE DONE ANOTHER WAY FM->TD
450 :     # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc
451 :     # as fas as possible this should be configured so that the type of observation and the regexp are
452 :     # stored somewhere for easy expansion
453 :     #
454 :    
455 :     if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {
456 :    
457 :     # some keys are composite CDD::1233244 or PFAM:PF1233
458 :    
459 :     if ( $key =~ /::/ ) {
460 :     my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);
461 :     $val=$restkey.";".$val;
462 :     $key=$firstkey;
463 :     }
464 :    
465 :     my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );
466 :    
467 :     my $evalue= 255;
468 :     if (defined $raw_evalue) { # some of the tool do not give us an evalue
469 :    
470 :     my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);
471 :     my ($new_k, $new_exp);
472 :    
473 :     #
474 :     # THIS DOES NOT WORK PROPERLY
475 :     #
476 :     if($raw_evalue =~/(\d+).(\d+)/){
477 :    
478 :     # $new_exp = (1000+$expo);
479 :     # $new_k = $k / 100;
480 :    
481 :     }
482 :     $evalue = "0.01"#new_k."e-".$new_exp;
483 :     }
484 :    
485 :     # unroll it all into an array of hashes
486 :     # this needs to be done differently for different types of observations
487 :     my $dataset = [ { name => 'class', value => $key },
488 :     { name => 'acc' , value => $acc},
489 :     { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD
490 :     { name => 'evalue', value => $evalue },
491 :     { name => 'start', value => $from},
492 :     { name => 'stop' , value => $to}
493 :     ];
494 :    
495 :     push (@{$datasets_ref} ,$dataset);
496 :     }
497 :     }
498 :     }
499 :    
500 : mkubal 1.3 =head3 get_sims_observations() (internal)
501 :    
502 :     This methods retrieves sims fills the internal data structures.
503 :    
504 :     =cut
505 :    
506 :     sub get_sims_observations{
507 :    
508 :     my ($fid,$datasets_ref) = (@_);
509 : mkubal 1.4 my $fig = new FIG;
510 :     my @sims= $fig->nsims($fid,100,1e-20,"fig");
511 :     my ($dataset);
512 : mkubal 1.3 foreach my $sim (@sims){
513 : mkubal 1.4 my $hit = $sim->[1];
514 :     my $evalue = $sim->[10];
515 :     my $from = $sim->[8];
516 :     my $to = $sim->[9];
517 :     $dataset = [ { name => 'class', value => "SIM" },
518 : mkubal 1.3 { name => 'acc' , value => $hit},
519 :     { name => 'type', value => "seq"} ,
520 :     { name => 'evalue', value => $evalue },
521 :     { name => 'start', value => $from},
522 :     { name => 'stop' , value => $to}
523 :     ];
524 : mkubal 1.4 push (@{$datasets_ref} ,$dataset);
525 : mkubal 1.3 }
526 :     }
527 :    
528 : arodri7 1.5 =head3 get_identical_proteins() (internal)
529 :    
530 :     This methods retrieves sims fills the internal data structures.
531 :    
532 :     =cut
533 :    
534 :     sub get_identical_proteins{
535 :    
536 :     my ($fid,$datasets_ref) = (@_);
537 :     my $fig = new FIG;
538 :     my @funcs = ();
539 :    
540 :     my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
541 :    
542 :     foreach my $id (@maps_to) {
543 :     my ($tmp, $who);
544 : arodri7 1.6 if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
545 : arodri7 1.5 if ($id =~ /^fig\|/) { $who = "FIG" }
546 :     elsif ($id =~ /^gi\|/) { $who = "NCBI" }
547 :     elsif ($id =~ /^^[NXYZA]P_/) { $who = "RefSeq" }
548 :     elsif ($id =~ /^sp\|/) { $who = "SwissProt" }
549 :     elsif ($id =~ /^uni\|/) { $who = "UniProt" }
550 :     elsif ($id =~ /^tigr\|/) { $who = "TIGR" }
551 :     elsif ($id =~ /^pir\|/) { $who = "PIR" }
552 :     elsif ($id =~ /^kegg\|/) { $who = "KEGG" }
553 :     elsif ($id =~ /^tr\|/) { $who = "TrEMBL" }
554 :     elsif ($id =~ /^eric\|/) { $who = "ASAP" }
555 :    
556 :     push(@funcs, [$id,$who,$tmp]);
557 :     }
558 :     }
559 :    
560 :     my ($dataset);
561 :     foreach my $row (@funcs){
562 :     my $id = $row->[0];
563 :     my $organism = $fig->org_of($fid);
564 :     my $who = $row->[1];
565 :     my $assignment = $row->[2];
566 :     $dataset = [ { name => 'class', value => "IDENTICAL" },
567 :     { name => 'id' , value => $id},
568 :     { name => 'organism', value => "$organism"} ,
569 :     { name => 'database', value => $who },
570 :     { name => 'description' , value => $assignment}
571 :     ];
572 :     push (@{$datasets_ref} ,$dataset);
573 :     }
574 :    
575 :     }
576 :    
577 : arodri7 1.6 =head3 get_functional_coupling() (internal)
578 :    
579 :     This methods retrieves the functional coupling of a protein given a peg ID
580 :    
581 :     =cut
582 :    
583 :     sub get_functional_coupling{
584 :    
585 :     my ($fid,$datasets_ref) = (@_);
586 :     my $fig = new FIG;
587 :     my @funcs = ();
588 :    
589 :     # initialize some variables
590 :     my($sc,$neigh);
591 :    
592 :     # set default parameters for coupling and evidence
593 :     my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
594 :    
595 :     # get the fc data
596 :     my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
597 :    
598 :     # retrieve data
599 :     my @rows = map { ($sc,$neigh) = @$_;
600 :     [$sc,$neigh,scalar $fig->function_of($neigh)]
601 :     } @fc_data;
602 :    
603 :     my ($dataset);
604 :     foreach my $row (@rows){
605 :     my $id = $row->[1];
606 :     my $score = $row->[0];
607 :     my $description = $row->[2];
608 :     $dataset = [ { name => 'class', value => "FC" },
609 :     { name => 'score' , value => $score},
610 :     { name => 'id', value => "$id"} ,
611 :     { name => 'description' , value => $description}
612 :     ];
613 :     push (@{$datasets_ref} ,$dataset);
614 :     }
615 :     }
616 : arodri7 1.5
617 : mkubal 1.1 =head3 get_sims_and_bbhs() (internal)
618 :    
619 :     This methods retrieves sims and also BBHs and fills the internal data structures.
620 :    
621 :     =cut
622 :    
623 :     # sub get_sims_and_bbhs{
624 :    
625 :     # # blast m8 output format
626 :     # # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit
627 :    
628 :     # my $Sims=();
629 :     # @sims_src = $fig->sims($fid,80,500,"fig",0);
630 :     # print "found $#sims_src SIMs\n";
631 :     # foreach $sims (@sims_src) {
632 :     # my ($sims_string) = "@$sims";
633 :     # # print "$sims_string\n";
634 :     # my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+
635 :     # \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);
636 :     # # print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";
637 :     # $Sims{$rfid}{'eval'}=$eval;
638 :     # $Sims{$rfid}{'start'}=$start;
639 :     # $Sims{$rfid}{'stop'}=$stop;
640 :     # print "$rfid $Sims{$rfid}{'eval'}\n";
641 :     # }
642 :    
643 :     # # BBHs
644 :     # my $BBHs=();
645 :    
646 :     # @bbhs_src = $fig->bbhs($fid,1.0e-10);
647 :     # print "found $#bbhs_src BBHs\n";
648 :     # foreach $bbh (@bbhs_src) {
649 :     # #print "@$bbh\n";
650 :     # my ($bbh_string) = "@$bbh";
651 :     # my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);
652 :     # #print "ID: $rfid, E:$eval, S:$score\n";
653 :     # $BBHs{$rfid}{'eval'}=$eval;
654 :     # $BBHs{$rfid}{'score'}=$score;
655 :     # #print "$rfid $BBHs{$rfid}{'eval'}\n";
656 :     # }
657 :    
658 :     # }
659 :    
660 :    
661 :    
662 :     =head3 new (internal)
663 :    
664 :     Instantiate a new object.
665 :    
666 :     =cut
667 :    
668 :     sub new {
669 :     my ($self) = @_;
670 :    
671 :     $self = { acc => '',
672 :     description => '',
673 :     class => '',
674 :     type => '',
675 :     start => '',
676 :     stop => '',
677 :     evalue => '',
678 :     score => '',
679 :     display_method => '',
680 :     feature_id => '',
681 :     rank => '',
682 : arodri7 1.5 supports_annotation => '',
683 :     id => '',
684 :     organism => '',
685 :     who => ''
686 : mkubal 1.1 };
687 :    
688 :     bless($self, 'Observation');
689 :    
690 :     return $self;
691 :     }
692 :    
693 :     =head3 feature_id (internal)
694 :    
695 :     Returns the ID of the feature these Observations belong to.
696 :    
697 :     =cut
698 :    
699 :     sub feature_id {
700 :     my ($self) = @_;
701 :    
702 :     return $self->{feature_id};
703 :     }
704 : arodri7 1.5
705 :     =head3 id (internal)
706 :    
707 :     Returns the ID of the identical sequence
708 :    
709 :     =cut
710 :    
711 :     sub id {
712 :     my ($self) = @_;
713 :    
714 :     return $self->{id};
715 :     }
716 :    
717 :     =head3 organism (internal)
718 :    
719 :     Returns the organism of the identical sequence
720 :    
721 :     =cut
722 :    
723 :     sub organism {
724 :     my ($self) = @_;
725 :    
726 :     return $self->{organism};
727 :     }
728 :    
729 :     =head3 database (internal)
730 :    
731 :     Returns the database of the identical sequence
732 :    
733 :     =cut
734 :    
735 :     sub database {
736 :     my ($self) = @_;
737 :    
738 :     return $self->{database};
739 :     }
740 :    
741 : arodri7 1.6 #package Observation::Identical;
742 :     #1;
743 :     #
744 :     #our @ISA = qw(Observation); # inherits all the methods from Observation
745 :    
746 :     =head3 display_identical()
747 :    
748 :     If available use the function specified here to display the "raw" observation.
749 :     This code will display a table for the identical protein
750 :    
751 :    
752 :     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.
753 :    
754 :     =cut
755 :    
756 :     sub display_identical {
757 :     my ($self, $fid, $cgi) = @_;
758 :    
759 :     my $content;
760 :     my $array=Observation->get_objects($fid);
761 :    
762 :     my $all_domains = [];
763 :     my $count_identical = 0;
764 :     foreach my $thing (@$array) {
765 :     next if ($thing->class ne "IDENTICAL");
766 :     my $single_domain = [];
767 :     push(@$single_domain,$thing->class);
768 :     my $id = $thing->id;
769 :     $count_identical++;
770 :     push(@$single_domain,&HTML::set_prot_links($cgi,$id));
771 :     push(@$single_domain,$thing->organism);
772 :     push(@$single_domain,$thing->database);
773 :     push(@$single_domain,$thing->description);
774 :     push(@$all_domains,$single_domain);
775 :     }
776 :    
777 :     if ($count_identical >0){
778 :     my $table_component = $self->application->component('DomainTable');
779 :    
780 :     $table_component->columns ([ { 'name' => 'Name', 'filter' => 1 },
781 :     { 'name' => 'ID' },
782 :     { 'name' => 'Organism' },
783 :     { 'name' => 'Database' },
784 :     { 'name' => 'Assignment' }
785 :     ]);
786 :     $table_component->data($all_domains);
787 :     $table_component->show_top_browse(1);
788 :     $table_component->show_bottom_browse(1);
789 :     $table_component->items_per_page(50);
790 :     $table_component->show_select_items_per_page(1);
791 :     $content .= $table_component->output();
792 :     }
793 :     else{
794 :     $content = "<p>This PEG does not have any essentially identical proteins</p>";
795 :     }
796 :     return ($content);
797 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3