[Bioperl-guts-l] bioperl commit
Jason Stajich
jason at dev.open-bio.org
Wed Feb 12 14:56:40 EST 2003
Wed Feb 12 14:56:40 EST 2003
Update of /home/repository/bioperl/bioperl-live/Bio/PopGen
In directory dev:/tmp/cvs-serv2291
Modified Files:
PopulationI.pm Population.pm Genotype.pm
Log Message:
update the docs
bioperl-live/Bio/PopGen PopulationI.pm,1.1,1.2 Population.pm,1.1,1.2 Genotype.pm,1.1,1.2
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/PopGen/PopulationI.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /tmp/T0SKaiGe 2003-02-12 14:56:40.110006111 -0500
+++ /tmp/T1TKaiGe 2003-02-12 14:56:40.120010806 -0500
@@ -184,4 +184,22 @@
sub get_Marker{
shift->throw_not_implemented();
}
+
+
+=head2 number_individuals
+
+ Title : number_individuals
+ Usage : my $count = $pop->number_individuals;
+ Function: Get the count of the number of individuals
+ Returns : integer >= 0
+ Args : none
+
+
+=cut
+
+sub get_number_individuals{
+ my ($self) = @_;
+ $self->throw_not_implemented();
+}
+
1;
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/PopGen/Population.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /tmp/T0wLaWGe 2003-02-12 14:56:40.150006532 -0500
+++ /tmp/T1xLaWGe 2003-02-12 14:56:40.160010867 -0500
@@ -256,10 +256,12 @@
sub get_Marker{
my ($self,$markername) = @_;
+
my @genotypes = $self->get_Genotypes(-marker => $markername);
- my $marker = new Bio::PopGen::Marker(-name => $markername);
+ my $marker = new Bio::PopGen::Marker(-name => $markername);
+
if( ! @genotypes ) {
- $self->warn("No genotypes for this Marker in the population");
+ $self->warn("No genotypes for Marker $markername in the population");
} else {
my %alleles;
my $count;
@@ -272,6 +274,71 @@
}
+=head2 number_individuals
+
+ Title : number_individuals
+ Usage : my $count = $pop->number_individuals;
+ Function: Get the count of the number of individuals
+ Returns : integer >= 0
+ Args : none
+
+
+=cut
+
+sub get_number_individuals{
+ my ($self) = @_;
+ return scalar @{$self->{'_individuals'}};
+}
+
+
+=head2 get_Frequency_Homozygotes
+
+ Title : get_Frequency_Homozygotes
+ Usage : my $freq = $pop->get_Frequency_Homozygotes;
+ Function: Calculate the frequency of homozygotes in the population
+ Returns : fraction between 0 and 1
+ Args : $markername
+
+
+=cut
+sub get_Frequency_Homozygotes{
+ my ($self,$marker,$allelename) = @_;
+ my ($homozygote_count,$total);
+ foreach my $genotype ( $self->get_Genotypes($marker) ) {
+ my %alleles = map { $_ => 1} $genotype->get_Alleles();
+ # what to do for non-diploid situations?
+ if( $alleles{$allelename} ) {
+ $homozygote_count++ if( keys %alleles == 1);
+ $total++;
+ }
+ }
+ return $total ? $homozygote_count / $total : 0;
+}
+
+=head2 get_Frequency_Heterozygotes
+
+ Title : get_Frequency_Heterozygotes
+ Usage : my $freq = $pop->get_Frequency_Homozygotes;
+ Function: Calculate the frequency of homozygotes in the population
+ Returns : fraction between 0 and 1
+ Args : $markername
+
+
+=cut
+
+sub get_Frequency_Heterozygotes{
+ my ($self,$marker,$allelename) = @_;
+ my ($heterozygote_count,$total);
+ foreach my $genotype ( $self->get_Genotypes($marker) ) {
+ my %alleles = map { $_ => 1} $genotype->get_Alleles();
+ # what to do for non-diploid situations?
+ if( $alleles{$allelename} ) {
+ $heterozygote_count++ if( keys %alleles == 2);
+ $total++;
+ }
+ }
+ return $total ? $heterozygote_count / $total : 0;
+}
1;
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/PopGen/Genotype.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /tmp/T0bMayHe 2003-02-12 14:56:40.200010478 -0500
+++ /tmp/T1cMayHe 2003-02-12 14:56:40.200010478 -0500
@@ -16,7 +16,10 @@
=head1 SYNOPSIS
-Give standard usage here
+use Bio::PopGen::Genotype;
+my $genotype = new Bio::PopGen::Genotype(-marker_name => $name,
+ -individual_id => $indid,
+ -alleles => \@alleles);
=head1 DESCRIPTION
More information about the Bioperl-guts-l
mailing list