[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