Mercurial > repos > willmclaren > ensembl_vep
comparison variant_effect_predictor/Bio/EnsEMBL/Variation/Individual.pm @ 0:21066c0abaf5 draft
Uploaded
author | willmclaren |
---|---|
date | Fri, 03 Aug 2012 10:04:48 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:21066c0abaf5 |
---|---|
1 =head1 LICENSE | |
2 | |
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and | |
4 Genome Research Limited. All rights reserved. | |
5 | |
6 This software is distributed under a modified Apache license. | |
7 For license details, please see | |
8 | |
9 http://www.ensembl.org/info/about/code_licence.html | |
10 | |
11 =head1 CONTACT | |
12 | |
13 Please email comments or questions to the public Ensembl | |
14 developers list at <dev@ensembl.org>. | |
15 | |
16 Questions may also be sent to the Ensembl help desk at | |
17 <helpdesk@ensembl.org>. | |
18 | |
19 =cut | |
20 | |
21 # Ensembl module for Bio::EnsEMBL::Variation::Individual | |
22 # | |
23 # Copyright (c) 2004 Ensembl | |
24 # | |
25 | |
26 | |
27 =head1 NAME | |
28 | |
29 Bio::EnsEMBL::Variation::Individual - A single member of a population. | |
30 | |
31 =head1 SYNOPSIS | |
32 | |
33 $individual = Bio::EnsEMBL::Variation::Individual->new | |
34 (-name => 'WI530.07', | |
35 -description => 'african', | |
36 -gender => 'Male', | |
37 -father_individual => $father_ind, | |
38 -mother_individual => $mother_ind); | |
39 | |
40 ... | |
41 | |
42 print $individual->name(), ' - ', $individual->description(), "\n"; | |
43 print "Gender: ", $individual->gender(), "\n"; | |
44 print $individual->mother_Individual->name() | |
45 if($individual->mother_Individual()); | |
46 print $individual->father_Individual->name() | |
47 if($individual->father_Individual()); | |
48 | |
49 | |
50 | |
51 =head1 DESCRIPTION | |
52 | |
53 This is a class representing a single individual. An individual may be part | |
54 of one population or several. A pedigree may be constructed using the father_Individual | |
55 and mother_Individual attributes. | |
56 | |
57 =head1 METHODS | |
58 | |
59 =cut | |
60 | |
61 | |
62 use strict; | |
63 use warnings; | |
64 | |
65 package Bio::EnsEMBL::Variation::Individual; | |
66 | |
67 use Bio::EnsEMBL::Utils::Exception qw(throw warning); | |
68 use Bio::EnsEMBL::Utils::Argument qw(rearrange); | |
69 use Bio::EnsEMBL::Variation::Sample; | |
70 | |
71 our @ISA = ('Bio::EnsEMBL::Variation::Sample'); | |
72 | |
73 =head2 new | |
74 | |
75 Arg [-dbID] : | |
76 int - unique internal identifier | |
77 Arg [-ADAPTOR] : | |
78 Bio::EnsEMBL::Variation::DBSQL::IndividualAdaptor | |
79 Arg [-NAME] : | |
80 string - name of this individual | |
81 Arg [-DESCRIPTION] : | |
82 string description - description of this individual | |
83 Arg [-GENDER] : | |
84 string - must be one of 'Male', 'Female', 'Unknown' | |
85 Arg [-FATHER_INDIVIDUAL] : | |
86 Bio::EnsEMBL::Variation::Individual - the father of this individual | |
87 Arg [-MOTHER_INDIVIDUAL] : | |
88 Bio::EnsEMBL::Variation::Individual - the mother of this individual | |
89 Arg [-MOTHER_INDIVIDUAL_SAMPLE_ID] : | |
90 int - set the internal id of the mother individual so that the actual | |
91 mother Individual object can be retrieved on demand. | |
92 Arg [-FATHER_INDIVIDUAL_SAMPLE_ID]: | |
93 int - set the internal id of the mother individual so that the actual | |
94 mother Individual object can be retrieved on demand. | |
95 Arg [-TYPE_INDIVIDUAL]: | |
96 int - name for the type of the individual (fully or partly inbred, outbred or mutant | |
97 Arg [-TYPE_DESCRIPTION]: | |
98 string - description of the type of individual | |
99 Example : $individual = Bio::EnsEMBL::Variation::Individual->new | |
100 (-name => 'WI530.07', | |
101 -description => 'african', | |
102 -gender => 'Male', | |
103 -father_individual => $father_ind, | |
104 -mother_individual => $mother_ind, | |
105 -type_individual => 'outbred', | |
106 -type_description => 'a single organism which breeds freely'); | |
107 Description: Constructor Instantiates an Individual object. | |
108 Returntype : Bio::EnsEMBL::Variation::Individual | |
109 Exceptions : throw if gender arg is provided but not valid | |
110 Caller : general | |
111 Status : At Risk | |
112 | |
113 =cut | |
114 | |
115 sub new { | |
116 my $caller = shift; | |
117 my $class = ref($caller) || $caller; | |
118 | |
119 my ($dbID, $adaptor, $name, $desc, $display_flag, $gender, $father, $mother, $type_name, $type_desc, | |
120 $father_id, $mother_id) = | |
121 rearrange([qw(dbID adaptor name description display gender | |
122 father_individual mother_individual | |
123 type_individual type_description | |
124 father_individual_sample_id mother_individual_sample_id)], @_); | |
125 | |
126 if(defined($gender)) { | |
127 $gender = ucfirst(lc($gender)); | |
128 if($gender ne 'Male' && $gender ne 'Female' && $gender ne 'Unknown') { | |
129 throw('Gender must be one of "Male","Female","Unknown"'); | |
130 } | |
131 } | |
132 | |
133 if (defined($type_name)){ | |
134 $type_name = ucfirst(lc($type_name)); | |
135 if ($type_name ne 'Fully_inbred' && $type_name ne 'Partly_inbred' && $type_name ne 'Outbred' && $type_name ne 'Mutant'){ | |
136 throw('Type of individual must of one of: "fully_inbred", "partly_inbred", "outbred", "mutant"'); | |
137 } | |
138 } | |
139 | |
140 return bless { | |
141 'dbID' => $dbID, | |
142 'adaptor' => $adaptor, | |
143 'name' => $name, | |
144 'description' => $desc, | |
145 'display' => $display_flag, | |
146 'gender' => $gender, | |
147 'father_individual' => $father, | |
148 'mother_individual' => $mother, | |
149 'type_individual' => $type_name, | |
150 'type_description' => $type_desc, | |
151 '_mother_individual_sample_id' => $mother_id, | |
152 '_father_individual_sample_id' => $father_id, | |
153 }, $class; | |
154 } | |
155 | |
156 | |
157 =head2 type_individual | |
158 | |
159 Arg [1] : int $newval (optional) | |
160 The new value to set the type_individual attribute to | |
161 Example : $type_individual = $obj->type_individual(); | |
162 Description : Getter/Setter for the type_individual attribute | |
163 Returntype : int | |
164 Exceptions : none | |
165 Caller : general | |
166 Status : At Risk | |
167 | |
168 =cut | |
169 | |
170 sub type_individual{ | |
171 my $self = shift; | |
172 if (@_){ | |
173 my $new_name = shift; | |
174 return $self->{'type_individual'} = $new_name; | |
175 } | |
176 return $self->{'type_individual'}; | |
177 } | |
178 | |
179 =head2 type_description | |
180 | |
181 Arg [1] : int $newval (optional) | |
182 The new value to set the type_description attribute to | |
183 Example : $type_description = $obj->type_description(); | |
184 Description : Getter/Setter for the type_description attribute | |
185 Returntype : int | |
186 Exceptions : none | |
187 Caller : general | |
188 Status : At Risk | |
189 | |
190 =cut | |
191 | |
192 sub type_description{ | |
193 my $self = shift; | |
194 if (@_){ | |
195 my $new_desc = shift; | |
196 return $self->{'type_description'} = $new_desc; | |
197 } | |
198 return $self->{'type_description'}; | |
199 } | |
200 | |
201 =head2 gender | |
202 | |
203 Arg [1] : string $newval (optional) | |
204 The new value to set the gender attribute to | |
205 Example : $gender = $obj->gender() | |
206 Description: Getter/Setter for the gender attribute | |
207 Returntype : string | |
208 Exceptions : none | |
209 Caller : general | |
210 Status : At Risk | |
211 | |
212 =cut | |
213 | |
214 sub gender{ | |
215 my $self = shift; | |
216 | |
217 if(@_) { | |
218 my $gender = ucfirst(lc(shift)); | |
219 | |
220 if($gender ne 'Male' && $gender ne 'Female' && $gender ne 'Unknown') { | |
221 throw('Gender must be one of "Male","Female","Unknown"'); | |
222 } | |
223 $self->{'gender'} = $gender; | |
224 } | |
225 | |
226 return $self->{'gender'}; | |
227 } | |
228 | |
229 | |
230 =head2 display | |
231 | |
232 Arg [1] : string $newval (optional) | |
233 The new value to set the display attribute to | |
234 Example : $display = $obj->display() | |
235 Description: Getter/Setter for the display attribute | |
236 Returntype : string | |
237 Exceptions : none | |
238 Caller : general | |
239 Status : At Risk | |
240 | |
241 =cut | |
242 | |
243 sub display{ | |
244 my $self = shift; | |
245 | |
246 if(@_) { | |
247 my $display = uc(shift); | |
248 | |
249 if($display ne 'UNDISPLAYABLE' && $display ne 'REFERENCE' && $display ne 'DISPLAYABLE' && $display ne 'DEFAULT') { | |
250 throw('Display flag must be one of "REFERENCE", "DEFAULT", "DISPLAYABLE", "UNDISPLAYABLE"'); | |
251 } | |
252 | |
253 $self->{'display'} = $display; | |
254 } | |
255 | |
256 return $self->{'display'}; | |
257 } | |
258 | |
259 | |
260 =head2 get_all_Populations | |
261 | |
262 Args : none | |
263 Example : $pops = $ind->get_all_Populations(); | |
264 Description : Getter for the Populations for this Individual. Returns | |
265 empty list if there are none. | |
266 ReturnType : listref of Bio::EnsEMBL::Population | |
267 Exceptions : none | |
268 Caller : general | |
269 Status : At Risk | |
270 | |
271 =cut | |
272 | |
273 sub get_all_Populations{ | |
274 my $self = shift; | |
275 | |
276 if(!defined($self->{populations})) { | |
277 if (defined ($self->{'adaptor'})){ | |
278 my $pop_adaptor = $self->{'adaptor'}->db()->get_PopulationAdaptor(); | |
279 $self->{populations} = $pop_adaptor->fetch_all_by_Individual($self); | |
280 } | |
281 } | |
282 | |
283 return $self->{populations}; | |
284 } | |
285 | |
286 | |
287 | |
288 =head2 father_Individual | |
289 | |
290 Arg [1] : string $newval (optional) | |
291 The new value to set the father_Individual attribute to | |
292 Example : $father_Individual = $obj->father_Individual() | |
293 Description: Getter/Setter for the father of this Individual. If this | |
294 has not been set manually and this Individual has an attached | |
295 adaptor, an attempt will be made to lazy-load it from the | |
296 database. | |
297 Returntype : string | |
298 Exceptions : none | |
299 Caller : general | |
300 Status : At Risk | |
301 | |
302 =cut | |
303 | |
304 sub father_Individual{ | |
305 my $self = shift; | |
306 | |
307 if(@_) { | |
308 my $ind = shift; | |
309 if(defined($ind) && (!ref($ind) || | |
310 !$ind->isa('Bio::EnsEMBL::Variation::Individual'))) { | |
311 throw('Bio::EnsEMBL::Variation::Individual arg expected'); | |
312 } | |
313 if($ind->gender() eq 'Female') { | |
314 throw("Father individual may not have gender of Female"); | |
315 } | |
316 return $self->{'father_individual'} = $ind; | |
317 } | |
318 | |
319 # lazy-load mother if we can | |
320 if(!defined($self->{'father_individual'}) && $self->adaptor() && | |
321 defined($self->{'_father_individual_sample_id'})) { | |
322 $self->{'father_individual'} = | |
323 $self->adaptor->fetch_by_dbID($self->{'_father_individual_sample_id'}); | |
324 } | |
325 | |
326 return $self->{'father_individual'}; | |
327 } | |
328 | |
329 | |
330 | |
331 =head2 mother_Individual | |
332 | |
333 Arg [1] : string $newval (optional) | |
334 The new value to set the mother_Individual attribute to | |
335 Example : $mother_Individual = $obj->mother_Individual() | |
336 Description: Getter/Setter for the mother of this individual. If this | |
337 has not been set manually and this Individual has an attached | |
338 adaptor, an attempt will be made to lazy-load it from the | |
339 database. | |
340 Returntype : string | |
341 Exceptions : none | |
342 Caller : general | |
343 Status : At Risk | |
344 | |
345 =cut | |
346 | |
347 sub mother_Individual{ | |
348 my $self = shift; | |
349 | |
350 if(@_) { | |
351 my $ind = shift; | |
352 if(defined($ind) && (!ref($ind) || | |
353 !$ind->isa('Bio::EnsEMBL::Variation::Individual'))) { | |
354 throw('Bio::EnsEMBL::Variation::Individual arg expected'); | |
355 } | |
356 if($ind->gender() eq 'Male') { | |
357 throw("Mother individual may not have gender of Male"); | |
358 } | |
359 return $self->{'mother_individual'} = $ind; | |
360 } | |
361 | |
362 # lazy-load mother if we can | |
363 if(!defined($self->{'mother_individual'}) && $self->adaptor() && | |
364 defined($self->{'_mother_individual_sample_id'})) { | |
365 $self->{'mother_individual'} = | |
366 $self->adaptor->fetch_by_dbID($self->{'_mother_individual_sample_id'}); | |
367 } | |
368 | |
369 return $self->{'mother_individual'}; | |
370 } | |
371 | |
372 | |
373 | |
374 =head2 get_all_child_Individuals | |
375 | |
376 Arg [1] : none | |
377 Example : foreach my $c (@{$ind->get_all_child_Individuals}) { | |
378 print "Child: " $c->name(), "\n"; | |
379 } | |
380 Description: Retrieves all individuals from the database which are children | |
381 of this individual. This will only work if this Individual | |
382 object has been stored in the database and has an attached | |
383 adaptor. | |
384 Returntype : reference to list of Bio::EnsEMBL::Variation::Individual objects | |
385 Exceptions : warning if this object does not have an attached adaptor | |
386 Caller : general | |
387 Status : At Risk | |
388 | |
389 =cut | |
390 | |
391 sub get_all_child_Individuals { | |
392 my $self = shift; | |
393 | |
394 if(!$self->adaptor()) { | |
395 warning("Cannot retrieve child individuals without attached adaptor."); | |
396 } | |
397 | |
398 return $self->adaptor()->fetch_all_by_parent_Individual($self); | |
399 | |
400 } | |
401 | |
402 1; |