# Do not use directly, use through the Bio::PopGen::IO driver

  use Bio::PopGen::IO;
  my $io = Bio::PopGen::IO->new(-format => 'hapmap',
                               -file   => 'data.hapmap');

  # Some IO might support reading in a population at a time

  my @population;
  while( my $ind = $io->next_individual ) {
      push @population, $ind;
  }

    my($self, @args) = @_;

    $Bio::PopGen::Genotype::BlankAlleles='';

    my ($fieldsep,$all_sep, 
	$noheader, $start_col) = $self->_rearrange([qw(FIELD_DELIMITER
						       ALLELE_DELIMITER
						       NO_HEADER
						       STARTING_COLUMN)],
						   @args);

    $self->flag('no_header', defined $noheader ? $noheader : $NoHeader);
    $self->flag('field_delimiter',defined $fieldsep ? $fieldsep : $FieldDelim);
    $self->flag('allele_delimiter',defined $all_sep ? $all_sep : $AlleleDelim);
    $self->starting_column(defined $start_col ? $start_col : $StartingCol );

    $self->{'_header'} = undef;
    return 1;

    my $self = shift;
    my $fieldname = shift;
    return unless defined $fieldname;
    return $self->{'_flag'}->{$fieldname} = shift if @_;
    return $self->{'_flag'}->{$fieldname};

    my ($self) = @_;

    my (@cols,@rows,@idheader);
    while ($_ = $self->_readline){
	chomp($_);
	next if( /^\s*\#/ || /^\s+$/ || ! length($_) );
	if( /^rs\#\s+alleles\s+chrom\s+pos\s+strand/ ) {
	    @idheader = split $self->flag('field_delimiter');
	} else { 
	    push @cols, [split $self->flag('field_delimiter')];
	}
    }
    my $startingcol = $self->starting_column;

    $self->{'_header'} = [ map { $_->[0] } @cols];
    for my $n ($startingcol.. $#{ $cols[ 0 ]}) { 
	my $column = [ $idheader[$n],
		       map{ $_->[ $n ] } @cols ];	
	push (@rows, $column); 
    }
    $self->{'_pivot'} = [@rows];
    $self->{'_i'} = 0;

    my ($self) = @_;
    unless($self->{'_pivot'}){
	#if it's the first time then pivot the table and store.
	#Lines will now be read from the stored pivot version of the input file
	$self->_pivot;
    }

    $_ = $self->{'_pivot'}->[$self->{'_i'}++];

    return unless defined $_;

    # Store all the marker related info. Now that the pivot has taken
    # place this is in the first few lines of the file Maybe this
    # should be put in a marker object. Doesn't seem to fit too well
    # though

    my ($samp,@marker_results) = @$_;

    # at some point use all this info
    my $i = 1;
    foreach my $m ( @marker_results ) {
	$m =~ s/^\s+//;
	$m =~ s/\s+$//;
	my $markername;
	if( defined $self->{'_header'} ) {
	    $markername = $self->{'_header'}->[$i-1];
	} else { 
	    $markername = "Marker$i";
	}
	
	my @alleles = split($self->flag('allele_delimiter'), $m);
	if( @alleles != 2 ) { 
	    $self->warn("$m for $samp\n");
	} else { 
	    $m = Bio::PopGen::Genotype->new(-alleles       =>\@ alleles,
					    -marker_name   => $markername,
					    -marker_type   => 'S',          # Guess hapmap only has SNP data
					    -individual_id => $samp);
	}
	$i++; 
    }

    return new Bio::PopGen::Individual(-unique_id => $samp,
				       -genotypes =>\@ marker_results);

    my ($self) = @_;
    my @inds;
    while( my $ind = $self->next_individual ) {
	push @inds, $ind;
    }
    Bio::PopGen::Population->new(-individuals =>\@ inds);

    my ($self,@inds) = @_;

    # data from hapmap is output, not input, so 
    # we don't need a method for writing and input file

    $self->throw_not_implemented();

    my ($self,@inds) = @_;
    $self->throw_not_implemented();

    my $self = shift;

    return $self->{'starting_column'} = shift if @_;
    return $self->{'starting_column'};
}

1;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Title   : new
 Usage   : my $obj = Bio::PopGen::IO::hapmap->new();
 Function: Builds a new Bio::PopGen::IO::hapmap object 
 Returns : an instance of Bio::PopGen::IO::hapmap
 Args    : [optional, these are the current defaults] 
           -field_delimiter => ','
           -allele_delimiter=> '\s+'
           -no_header       => 0,
           -starting_column => 11