|
0
|
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;
|
