maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / Phenotype / Phenotype.pm
blob69efe9ece3893454ad0de83dc63ade69de335454
2 # BioPerl module for Bio::Phenotype::Phenotype
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Christian M. Zmasek <czmasek-at-burnham.org> or <cmzmasek@yahoo.com>
8 # (c) Christian M. Zmasek, czmasek-at-burnham.org, 2002.
9 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
11 # You may distribute this module under the same terms as perl itself.
12 # Refer to the Perl Artistic License (see the license accompanying this
13 # software package, or see http://www.perl.com/language/misc/Artistic.html)
14 # for the terms under which you may use, modify, and redistribute this module.
16 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
17 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
18 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
20 # You may distribute this module under the same terms as perl itself
22 # POD documentation - main docs before the code
24 =head1 NAME
26 Bio::Phenotype::Phenotype - A class for modeling phenotypes
28 =head1 SYNOPSIS
30 #get Bio::Phenotype::PhenotypeI somehow
32 print $phenotype->name(), "\n";
33 print $phenotype->description(), "\n";
35 my @keywords = ( "achondroplasia", "dwarfism" );
36 $phenotype->add_keywords( @keywords );
37 foreach my $keyword ( $phenotype->each_keyword() ) {
38 print $keyword, "\n";
40 $phenotype->remove_keywords();
43 foreach my $gene_symbol ( $phenotype->each_gene_symbol() ) {
44 print $gene_symbol, "\n";
47 foreach my $corr ( $phenotype->each_Correlate() ) {
48 # Do something with $corr
51 foreach my $var ( $phenotype->each_Variant() ) {
52 # Do something with $var (mutation)
55 foreach my $measure ( $phenotype->each_Measure() ) {
56 # Do something with $measure
60 =head1 DESCRIPTION
62 This superclass implements common methods for classes modelling phenotypes.
63 Bio::Phenotype::OMIM::OMIMentry is an example of an instantiable phenotype
64 class (the design of this interface was partially guided by the need
65 to model OMIM entries).
66 Please note. This class provides methods to associate mutations
67 (methods "each_Variant", ...) and genotypes (methods "each_Genotype", ...)
68 with phenotypes. Yet, these aspects might need some future enhancements,
69 especially since there is no "genotype" class yet.
71 =head1 FEEDBACK
73 =head2 Mailing Lists
75 User feedback is an integral part of the evolution of this and other
76 Bioperl modules. Send your comments and suggestions preferably to the
77 Bioperl mailing lists Your participation is much appreciated.
79 bioperl-l@bioperl.org - General discussion
80 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
82 =head2 Support
84 Please direct usage questions or support issues to the mailing list:
86 I<bioperl-l@bioperl.org>
88 rather than to the module maintainer directly. Many experienced and
89 reponsive experts will be able look at the problem and quickly
90 address it. Please include a thorough description of the problem
91 with code and data examples if at all possible.
93 =head2 Reporting Bugs
95 report bugs to the Bioperl bug tracking system to help us keep track
96 the bugs and their resolution. Bug reports can be submitted via the
97 web:
99 https://github.com/bioperl/bioperl-live/issues
101 =head1 AUTHOR
103 Christian M. Zmasek
105 Email: czmasek-at-burnham.org or cmzmasek@yahoo.com
107 WWW: http://monochrome-effect.net/
109 Address:
111 Genomics Institute of the Novartis Research Foundation
112 10675 John Jay Hopkins Drive
113 San Diego, CA 92121
115 =head1 APPENDIX
117 The rest of the documentation details each of the object
118 methods. Internal methods are usually preceded with a _
120 =cut
123 # Let the code begin...
126 package Bio::Phenotype::Phenotype;
127 use strict;
129 use Bio::Species;
130 use Bio::Variation::VariantI;
131 use Bio::Annotation::DBLink;
132 use Bio::Annotation::Reference;
133 use Bio::Phenotype::Measure;
134 use Bio::Phenotype::Correlate;
135 use Bio::Map::CytoPosition;
136 use Bio::Range;
139 use base qw(Bio::Root::Root Bio::Phenotype::PhenotypeI);
144 =head2 new
146 Title : new
147 Usage : $obj = Bio::Phenotype::Phenotype->new( -name => "XY",
148 -description => "This is ..." );
149 Function: Creates a new Phenotype object.
150 Returns : A new Phenotype object.
151 Args : -name => the name
152 -description => the description of this phenotype
153 -species => ref to the the species
154 -comment => a comment
156 =cut
158 sub new {
160 my( $class,@args ) = @_;
162 my $self = $class->SUPER::new( @args );
164 my ( $name,
165 $description,
166 $species,
167 $comment )
168 = $self->_rearrange( [ qw( NAME
169 DESCRIPTION
170 SPECIES
171 COMMENT ) ], @args );
173 $self->init();
175 $name && $self->name( $name );
176 $description && $self->description( $description );
177 $species && $self->species( $species );
178 $comment && $self->comment( $comment );
180 return $self;
182 } # new
185 =head2 init
187 Title : init()
188 Usage : $obj->init();
189 Function: Initializes this OMIMentry to all "" and empty lists.
190 Returns :
191 Args :
193 =cut
195 sub init {
197 my( $self ) = @_;
200 $self->name( "" );
201 $self->description( "" );
202 my $species = Bio::Species->new();
203 $species->classification( qw( sapiens Homo ) );
204 $self->species( $species );
205 $self->comment( "" );
206 $self->remove_Correlates();
207 $self->remove_References();
208 $self->remove_CytoPositions();
209 $self->remove_gene_symbols();
210 $self->remove_Genotypes();
211 $self->remove_DBLinks();
212 $self->remove_keywords();
213 $self->remove_Variants();
214 $self->remove_Measures();
216 } # init
219 =head2 name
221 Title : name
222 Usage : $obj->name( "r1" );
224 print $obj->name();
225 Function: Set/get for the name or id of this phenotype.
226 Returns : A name or id [scalar].
227 Args : A name or id [scalar] (optional).
229 =cut
231 sub name {
232 my ( $self, $value ) = @_;
234 if ( defined $value ) {
235 $self->{ "_name" } = $value;
238 return $self->{ "_name" };
240 } # name
243 =head2 description
245 Title : description
246 Usage : $obj->description( "This is ..." );
248 print $obj->description();
249 Function: Set/get for the description of this phenotype.
250 Returns : A description [scalar].
251 Args : A description [scalar] (optional).
253 =cut
255 sub description {
256 my $self = shift;
257 return $self->{ "_description" } = shift if(@_);
258 return $self->{ "_description" };
261 =head2 species
263 Title : species
264 Usage : $obj->species( $species );
266 $species = $obj->species();
267 Function: Set/get for the species of this phenotype.
268 Returns : A species [Bio::Species].
269 Args : A species [Bio::Species] (optional).
271 =cut
273 sub species {
274 my ( $self, $value ) = @_;
276 if ( defined $value ) {
277 $self->_check_ref_type( $value, "Bio::Species" );
278 $self->{ "_species" } = $value;
281 return $self->{ "_species" };
283 } # species
285 =head2 comment
287 Title : comment
288 Usage : $obj->comment( "putative" );
290 print $obj->comment();
291 Function: Set/get for a comment about this phenotype.
292 Returns : A comment [scalar].
293 Args : A comment [scalar] (optional).
295 =cut
297 sub comment {
298 my $self = shift;
299 return $self->{ "_comment" } = shift if(@_);
300 return $self->{ "_comment" };
301 } # comment
304 =head2 each_gene_symbol
306 Title : each_gene_symbol()
307 Usage : @gs = $obj->each_gene_symbol();
308 Function: Returns a list of gene symbols [scalars, most likely Strings]
309 associated with this phenotype.
310 Returns : A list of scalars.
311 Args :
313 =cut
315 sub each_gene_symbol {
316 my ( $self ) = @_;
318 return @{$self->{"_gene_symbols"}} if exists($self->{"_gene_symbols"});
319 return ();
320 } # each_gene_symbol
323 =head2 add_gene_symbols
325 Title : add_gene_symbols
326 Usage : $obj->add_gene_symbols( @gs );
328 $obj->add_gene_symbols( $gs );
329 Function: Pushes one or more gene symbols [scalars, most likely Strings]
330 into the list of gene symbols.
331 Returns :
332 Args : scalar(s).
334 =cut
336 sub add_gene_symbols {
337 my ( $self, @values ) = @_;
339 return unless( @values );
341 push( @{ $self->{ "_gene_symbols" } }, @values );
343 } # add_gene_symbols
346 =head2 remove_gene_symbols
348 Usage : $obj->remove_gene_symbols();
349 Function: Deletes (and returns) the list of gene symbols [scalars,
350 most likely Strings] associated with this phenotype.
351 Returns : A list of scalars.
352 Args :
354 =cut
356 sub remove_gene_symbols {
357 my ( $self ) = @_;
359 my @a = $self->each_gene_symbol();
360 $self->{ "_gene_symbols" } = [];
361 return @a;
363 } # remove_gene_symbols
368 =head2 each_Variant
370 Title : each_Variant()
371 Usage : @vs = $obj->each_Variant();
372 Function: Returns a list of Bio::Variation::VariantI implementing objects
373 associated with this phenotype.
374 This is for representing the actual mutation(s) causing this
375 phenotype.
376 {* The "variants" data member and its methods will/might need to be
377 changed/improved in one way or another, CZ 09/06/02 *}
378 Returns : A list of Bio::Variation::VariantI implementing objects.
379 Args :
381 =cut
383 sub each_Variant {
384 my ( $self ) = @_;
386 return @{ $self->{ "_variants" } } if exists($self->{ "_variants" });
387 return ();
388 } # each_Variant
391 =head2 add_Variants
393 Usage : $obj->add_Variants( @vs );
395 $obj->add_Variants( $v );
396 Function: Pushes one or more Bio::Variation::VariantI implementing objects
397 into the list of Variants.
398 Returns :
399 Args : Bio::Variation::VariantI implementing object(s).
401 =cut
403 sub add_Variants {
404 my ( $self, @values ) = @_;
406 return unless( @values );
408 foreach my $value ( @values ) {
409 $self->_check_ref_type( $value, "Bio::Variation::VariantI" );
412 push( @{ $self->{ "_variants" } }, @values );
414 } # add_Variants
417 =head2 remove_Variants
419 Title : remove_Variants
420 Usage : $obj->remove_Variants();
421 Function: Deletes (and returns) the list of Bio::Variation::VariantI implementing
422 objects associated with this phenotype.
423 Returns : A list of Bio::Variation::VariantI implementing objects.
424 Args :
426 =cut
428 sub remove_Variants {
429 my ( $self ) = @_;
431 my @a = $self->each_Variant();
432 $self->{ "_variants" } = [];
433 return @a;
435 } # remove_Variants
440 =head2 each_Reference
442 Title : each_Reference()
443 Usage : @refs = $obj->each_Reference();
444 Function: Returns a list of Bio::Annotation::Reference objects
445 associated with this phenotype.
446 Returns : A list of Bio::Annotation::Reference objects.
447 Args :
449 =cut
451 sub each_Reference {
452 my ( $self ) = @_;
454 return @{ $self->{ "_references" } } if exists($self->{ "_references" });
455 return ();
456 } # each_Reference
459 =head2 add_References
461 Title : add_References
462 Usage : $obj->add_References( @refs );
464 $obj->add_References( $ref );
465 Function: Pushes one or more Bio::Annotation::Reference objects
466 into the list of References.
467 Returns :
468 Args : Bio::Annotation::Reference object(s).
470 =cut
472 sub add_References {
473 my ( $self, @values ) = @_;
475 return unless( @values );
477 foreach my $value ( @values ) {
478 $self->_check_ref_type( $value, "Bio::Annotation::Reference" );
481 push( @{ $self->{ "_references" } }, @values );
483 } # add_References
486 =head2 remove_References
488 Title : remove_References()
489 Usage : $obj->remove_References();
490 Function: Deletes (and returns) the list of Bio::Annotation::Reference objects
491 associated with this phenotype.
492 Returns : A list of Bio::Annotation::Reference objects.
493 Args :
495 =cut
497 sub remove_References {
498 my ( $self ) = @_;
500 my @a = $self->each_Reference();
501 $self->{ "_references" } = [];
502 return @a;
504 } # remove_References
509 =head2 each_CytoPosition
511 Title : each_CytoPosition()
512 Usage : @cps = $obj->each_CytoPosition();
513 Function: Returns a list of Bio::Map::CytoPosition objects
514 associated with this phenotype.
515 Returns : A list of Bio::Map::CytoPosition objects.
516 Args :
518 =cut
520 sub each_CytoPosition {
521 my ( $self ) = @_;
523 return @{$self->{"_cyto_positions"}} if exists($self->{"_cyto_positions"});
524 return ();
525 } # each_CytoPosition
528 =head2 add_CytoPositions
530 Title : add_CytoPositions
531 Usage : $obj->add_CytoPositions( @cps );
533 $obj->add_CytoPositions( $cp );
534 Function: Pushes one or more Bio::Map::CytoPosition objects
535 into the list of CytoPositions.
536 Returns :
537 Args : Bio::Map::CytoPosition object(s).
539 =cut
541 sub add_CytoPositions {
542 my ( $self, @values ) = @_;
544 return unless( @values );
546 foreach my $value ( @values ) {
547 $self->_check_ref_type( $value, "Bio::Map::CytoPosition" );
550 push( @{ $self->{ "_cyto_positions" } }, @values );
552 } # add_CytoPositions
555 =head2 remove_CytoPositions
557 Title : remove_CytoPositions
558 Usage : $obj->remove_CytoPositions();
559 Function: Deletes (and returns) the list o fBio::Map::CytoPosition objects
560 associated with this phenotype.
561 Returns : A list of Bio::Map::CytoPosition objects.
562 Args :
564 =cut
566 sub remove_CytoPositions {
567 my ( $self ) = @_;
569 my @a = $self->each_CytoPosition();
570 $self->{ "_cyto_positions" } = [];
571 return @a;
573 } # remove_CytoPositions
578 =head2 each_Correlate
580 Title : each_Correlate()
581 Usage : @corrs = $obj->each_Correlate();
582 Function: Returns a list of Bio::Phenotype::Correlate objects
583 associated with this phenotype.
584 (Correlates are correlating phenotypes in different species;
585 inspired by mouse correlates of human phenotypes in the OMIM
586 database.)
587 Returns : A list of Bio::Phenotype::Correlate objects.
588 Args :
590 =cut
592 sub each_Correlate {
593 my ( $self ) = @_;
595 return @{ $self->{ "_correlates" } } if exists($self->{ "_correlates" });
596 return ();
597 } # each_Correlate
602 =head2 add_Correlates
604 Title : add_Correlates
605 Usage : $obj->add_Correlates( @corrs );
607 $obj->add_Correlates( $corr );
608 Function: Pushes one or more Bio::Phenotype::Correlate objects
609 into the list of Correlates.
610 Returns :
611 Args : Bio::Phenotype::Correlate object(s).
613 =cut
615 sub add_Correlates {
616 my ( $self, @values ) = @_;
618 return unless( @values );
620 foreach my $value ( @values ) {
621 $self->_check_ref_type( $value, "Bio::Phenotype::Correlate" );
624 push( @{ $self->{ "_correlates" } }, @values );
626 } # add_Correlates
629 =head2 remove_Correlates
631 Title : remove_Correlates
632 Usage : $obj->remove_Correlates();
633 Function: Deletes (and returns) the list of Bio::Phenotype::Correlate objects
634 associated with this phenotype.
635 Returns : A list of Bio::Phenotype::Correlate objects.
636 Args :
638 =cut
640 sub remove_Correlates {
641 my ( $self ) = @_;
643 my @a = $self->each_Correlate();
644 $self->{ "_correlates" } = [];
645 return @a;
647 } # remove_Correlates
652 =head2 each_Measure
654 Title : each_Measure()
655 Usage : @ms = $obj->each_Measure();
656 Function: Returns a list of Bio::Phenotype::Measure objects
657 associated with this phenotype.
658 (Measure is for biochemically defined phenotypes
659 or any other types of measures.)
660 Returns : A list of Bio::Phenotype::Measure objects.
661 Args :
663 =cut
665 sub each_Measure {
666 my ( $self ) = @_;
668 return @{ $self->{ "_measures" } } if exists($self->{ "_measures" });
669 return ();
670 } # each_Measure
673 =head2 add_Measures
675 Title : add_Measures
676 Usage : $obj->add_Measures( @ms );
678 $obj->add_Measures( $m );
679 Function: Pushes one or more Bio::Phenotype::Measure objects
680 into the list of Measures.
681 Returns :
682 Args : Bio::Phenotype::Measure object(s).
684 =cut
686 sub add_Measures {
687 my ( $self, @values ) = @_;
689 return unless( @values );
691 foreach my $value ( @values ) {
692 $self->_check_ref_type( $value, "Bio::Phenotype::Measure" );
695 push( @{ $self->{ "_measures" } }, @values );
697 } # add_Measures
700 =head2 remove_Measures
702 Title : remove_Measures
703 Usage : $obj->remove_Measures();
704 Function: Deletes (and returns) the list of Bio::Phenotype::Measure objects
705 associated with this phenotype.
706 Returns : A list of Bio::Phenotype::Measure objects.
707 Args :
709 =cut
711 sub remove_Measures {
712 my ( $self ) = @_;
714 my @a = $self->each_Measure();
715 $self->{ "_measures" } = [];
716 return @a;
718 } # remove_Measures
723 =head2 each_keyword
725 Title : each_keyword()
726 Usage : @kws = $obj->each_keyword();
727 Function: Returns a list of key words [scalars, most likely Strings]
728 associated with this phenotype.
729 Returns : A list of scalars.
730 Args :
732 =cut
734 sub each_keyword {
735 my ( $self ) = @_;
737 return @{ $self->{ "_keywords" } } if exists($self->{ "_keywords" });
738 return ();
739 } # each_keyword
742 =head2 add_keywords
744 Title : add_keywords
745 Usage : $obj->add_keywords( @kws );
747 $obj->add_keywords( $kw );
748 Function: Pushes one or more keywords [scalars, most likely Strings]
749 into the list of key words.
750 Returns :
751 Args : scalar(s).
753 =cut
755 sub add_keywords {
756 my ( $self, @values ) = @_;
758 return unless( @values );
760 push( @{ $self->{ "_keywords" } }, @values );
762 } # add_keywords
765 =head2 remove_keywords
767 Title : remove_keywords
768 Usage : $obj->remove_keywords();
769 Function: Deletes (and returns) the list of key words [scalars,
770 most likely Strings] associated with this phenotype.
771 Returns : A list of scalars.
772 Args :
774 =cut
776 sub remove_keywords {
777 my ( $self ) = @_;
779 my @a = $self->each_keyword();
780 $self->{ "_keywords" } = [];
781 return @a;
783 } # remove_keywords
788 =head2 each_DBLink
790 Title : each_DBLink()
791 Usage : @dbls = $obj->each_DBLink();
792 Function: Returns a list of Bio::Annotation::DBLink objects
793 associated with this phenotype.
794 Returns : A list of Bio::Annotation::DBLink objects.
795 Args :
797 =cut
799 sub each_DBLink {
800 my ( $self ) = @_;
802 return @{ $self->{ "_db_links" } } if exists($self->{ "_db_links" });
803 return ();
807 =head2 add_DBLinks
809 Title : add_DBLinks
810 Usage : $obj->add_DBLinks( @dbls );
812 $obj->add_DBLinks( $dbl );
813 Function: Pushes one or more Bio::Annotation::DBLink objects
814 into the list of DBLinks.
815 Returns :
816 Args : Bio::Annotation::DBLink object(s).
818 =cut
820 sub add_DBLinks {
821 my ( $self, @values ) = @_;
823 return unless( @values );
825 foreach my $value ( @values ) {
826 $self->_check_ref_type( $value, "Bio::Annotation::DBLink" );
829 push( @{ $self->{ "_db_links" } }, @values );
831 } # add_DBLinks
834 =head2 remove_DBLinks
836 Title : remove_DBLinks
837 Usage : $obj->remove_DBLinks();
838 Function: Deletes (and returns) the list of Bio::Annotation::DBLink objects
839 associated with this phenotype.
840 Returns : A list of Bio::Annotation::DBLink objects.
841 Args :
843 =cut
845 sub remove_DBLinks {
846 my ( $self ) = @_;
848 my @a = $self->each_DBLink();
849 $self->{ "_db_links" } = [];
850 return @a;
852 } # remove_DBLinks
857 =head2 each_Genotype
859 Title : each_Reference()
860 Usage : @gts = $obj->each_Reference();
861 Function: Returns a list of "Genotype" objects
862 associated with this phenotype.
863 {* the "genotypes" data member and its methods certainly will/needs to be
864 changed/improved in one way or another since there is
865 no "Genotype" class yet, CZ 09/06/02 *}
866 Returns : A list of "Genotype" objects.
867 Args :
869 =cut
871 sub each_Genotype {
872 my ( $self ) = @_;
874 return @{ $self->{ "_genotypes" } } if exists($self->{ "_genotypes" });
875 return ();
876 } # each_Genotype
879 =head2 add_Genotypes
881 Title : add_Genotypes
882 Usage : $obj->add_Genotypes( @gts );
884 $obj->add_Genotypes( $gt );
885 Function: Pushes one or more "Genotypes"
886 into the list of "Genotypes".
887 Returns :
888 Args : "Genotypes(s)".
890 =cut
892 sub add_Genotypes {
893 my ( $self, @values ) = @_;
895 return unless( @values );
897 #foreach my $value ( @values ) {
898 # $self->_check_ref_type( $value, "Bio::GenotypeI" );
901 push( @{ $self->{ "_genotypes" } }, @values );
903 } # add_Genotypes
906 =head2 remove_Genotypes
908 Title : remove_Genotypes
909 Usage : $obj->remove_Genotypes();
910 Function: Deletes (and returns) the list of "Genotype" objects
911 associated with this phenotype.
912 Returns : A list of "Genotype" objects.
913 Args :
915 =cut
917 sub remove_Genotypes {
918 my ( $self ) = @_;
920 my @a = $self->each_Genotype();
921 $self->{ "_genotypes" } = [];
922 return @a;
924 } # remove_Genotypes
927 =head2 _check_ref_type
929 Title : _check_ref_type
930 Usage : $self->_check_ref_type( $value, "Bio::Annotation::DBLink" );
931 Function: Checks for the correct type.
932 Returns :
933 Args : The value to be checked, the expected class.
935 =cut
937 sub _check_ref_type {
938 my ( $self, $value, $expected_class ) = @_;
940 if ( ! defined( $value ) ) {
941 $self->throw( ( caller( 1 ) )[ 3 ] .": Found [undef"
942 ."] where [$expected_class] expected" );
944 elsif ( ! ref( $value ) ) {
945 $self->throw( ( caller( 1 ) )[ 3 ] .": Found scalar"
946 ." where [$expected_class] expected" );
948 elsif ( ! $value->isa( $expected_class ) ) {
949 $self->throw( ( caller( 1 ) )[ 3 ] .": Found [". ref( $value )
950 ."] where [$expected_class] expected" );
952 } # _check_ref_type