← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/PopGen/IO/csv.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/PopGen/IO/csv.pm
1
 
# $Id: csv.pm,v 1.3 2003/07/28 20:01:20 jason Exp $
 
1
# $Id: csv.pm,v 1.8.4.1 2006/10/02 23:10:23 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::PopGen::IO::csv
4
4
#
16
16
 
17
17
=head1 SYNOPSIS
18
18
 
19
 
Do not use directly, use through the Bio::PopGen::IO driver
 
19
#Do not use directly, use through the Bio::PopGen::IO driver
 
20
 
 
21
  use Bio::PopGen::IO;
 
22
  my $io = new Bio::PopGen::IO(-format => 'csv',
 
23
                               -file   => 'data.csv');
 
24
 
 
25
  # Some IO might support reading in a population at a time
 
26
 
 
27
  my @population;
 
28
  while( my $ind = $io->next_individual ) {
 
29
      push @population, $ind;
 
30
  }
20
31
 
21
32
=head1 DESCRIPTION
22
33
 
44
55
Bioperl modules. Send your comments and suggestions preferably to
45
56
the Bioperl mailing list.  Your participation is much appreciated.
46
57
 
47
 
  bioperl-l@bioperl.org              - General discussion
48
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
58
  bioperl-l@bioperl.org                  - General discussion
 
59
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
49
60
 
50
61
=head2 Reporting Bugs
51
62
 
53
64
of the bugs and their resolution. Bug reports can be submitted via
54
65
the web:
55
66
 
56
 
  http://bugzilla.bioperl.org/
 
67
  http://bugzilla.open-bio.org/
57
68
 
58
69
=head1 AUTHOR - Jason Stajich
59
70
 
75
86
 
76
87
 
77
88
package Bio::PopGen::IO::csv;
78
 
use vars qw(@ISA $FieldDelim $AlleleDelim $NoHeader);
 
89
use vars qw($FieldDelim $AlleleDelim $NoHeader);
79
90
use strict;
80
91
 
81
92
($FieldDelim,$AlleleDelim,$NoHeader) =( ',', '\s+',0);
82
93
 
83
94
# Object preamble - inherits from Bio::Root::Root
84
95
 
85
 
use Bio::PopGen::IO;
86
96
 
87
97
use Bio::PopGen::Individual;
88
98
use Bio::PopGen::Population;
89
99
use Bio::PopGen::Genotype;
90
100
 
91
 
@ISA = qw(Bio::PopGen::IO );
 
101
use base qw(Bio::PopGen::IO);
92
102
 
93
103
=head2 new
94
104
 
96
106
 Usage   : my $obj = new Bio::PopGen::IO::csv();
97
107
 Function: Builds a new Bio::PopGen::IO::csv object 
98
108
 Returns : an instance of Bio::PopGen::IO::csv
99
 
 Args    :
 
109
 Args    : [optional, these are the current defaults] 
 
110
           -field_delimiter => ','
 
111
           -allele_delimiter=> '\s+'
 
112
           -no_header       => 0,
100
113
 
101
114
 
102
115
=cut
108
121
                                           ALLELE_DELIMITER
109
122
                                           NO_HEADER)],@args);
110
123
 
 
124
 
111
125
    $self->flag('no_header', defined $noheader ? $noheader : $NoHeader);
112
126
    $self->flag('field_delimiter',defined $fieldsep ? $fieldsep : $FieldDelim);
113
127
    $self->flag('allele_delimiter',defined $all_sep ? $all_sep : $AlleleDelim);
144
158
 Title   : next_individual
145
159
 Usage   : my $ind = $popgenio->next_individual;
146
160
 Function: Retrieve the next individual from a dataset
147
 
 Returns : Bio::PopGen::IndividualI object
 
161
 Returns : L<Bio::PopGen::IndividualI> object
148
162
 Args    : none
149
163
 
150
164
 
159
173
    return if ! defined $_; 
160
174
    if( $self->flag('no_header') || 
161
175
        defined $self->{'_header'} ) {
162
 
        my ($samp,@marker_results) = split($self->flag('field_delimiter'),$_);
 
176
 
 
177
        #########new (allows field delim to be the same as the allele delim
 
178
 
 
179
        my ($samp,@marker_results);
 
180
 
 
181
        if($self->flag('field_delimiter') ne $self->flag('allele_delimiter')){
 
182
 
 
183
                ($samp,@marker_results) = split($self->flag('field_delimiter'),$_);
 
184
        }
 
185
        else{
 
186
 
 
187
                my $fielddelim = $self->flag('field_delimiter');
 
188
                my $alleledelim = $self->flag('allele_delimiter');
 
189
 
 
190
                ($samp) = /(^.+?)$fielddelim/;
 
191
                s/^.+?$fielddelim//;
 
192
        
 
193
                (@marker_results) = /([\d|\w]+$alleledelim[\d|\w]+)/g;
 
194
        
 
195
        }
 
196
 
 
197
        #########end new
 
198
 
163
199
        my $i = 1;
164
200
        foreach my $m ( @marker_results ) {
165
201
            $m =~ s/^\s+//;
171
207
                $markername = "Marker$i";
172
208
            }
173
209
            $self->debug( "markername is $markername alleles are $m\n");
 
210
 
174
211
            my @alleles = split($self->flag('allele_delimiter'), $m);
 
212
                
175
213
            $m = new Bio::PopGen::Genotype(-alleles      => \@alleles,
176
214
                                           -marker_name  => $markername,
177
215
                                           -individual_id=> $samp); 
184
222
        $self->{'_header'} = [split($self->flag('field_delimiter'),$_)];
185
223
        return $self->next_individual; # rerun loop again
186
224
    }
187
 
    return undef;
 
225
    return;
188
226
}
189
227
 
190
228
 
193
231
 Title   : next_population
194
232
 Usage   : my $ind = $popgenio->next_population;
195
233
 Function: Retrieve the next population from a dataset
196
 
 Returns : Bio::PopGen::PopulationI object
 
234
 Returns : L<Bio::PopGen::PopulationI> object
197
235
 Args    : none
198
236
 Note    : Many implementation will not implement this
199
237
 
260
298
    }    
261
299
}
262
300
 
263
 
 
264
 
 
265
301
=head2 write_population
266
302
 
267
303
 Title   : write_population
276
312
sub write_population{
277
313
    my ($self,@pops) = @_;
278
314
    my $fielddelim  = $self->flag('field_delimiter');
279
 
    my $alleledelim= $self->flag('allele_delimiter');
280
 
    
 
315
#     my $alleledelim= $self->flag('allele_delimiter');
 
316
    my $alleledelim = ' ';
281
317
    foreach my $pop ( @pops ) {
282
318
        if (! ref($pop) || ! $pop->isa('Bio::PopGen::PopulationI') ) {
283
319
            $self->warn("Cannot write an object that is not a Bio::PopGen::PopulationI object");