R/heterozygosity.R

   1 ## heterozygosity.R (2002-08-28)
   2
   3 ##   Heterozygosity at a Locus Using Gene Frequencies
   4
   5 ## Copyright 2002 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 heterozygosity <- function(x, variance = FALSE)
  11 {
  12     if (!is.factor(x)) {
  13         if (is.numeric(x)) {
  14             n <- sum(x)
  15             k <- length(x)
  16             freq <- x/n
  17         }
  18         else x <- factor(x)
  19     }
  20     if (is.factor(x)) { # ne pas remplacer par `else'...
  21         n <- length(x)
  22         k <- nlevels(x)
  23         freq <- table(x)/n
  24     }
  25     sp2 <- sum(freq^2)
  26     H <- n * (1 - sp2) / (n - 1)
  27     if (variance) {
  28         sp3 <- sum(freq^3)
  29         var.H <- 2 * (2 * (n - 2) * (sp3 - sp2^2) + sp2 - sp2^2) / (n * (n - 1))
  30         return(c(H, var.H))
  31     }
  32     else return(H)
  33 }
  34
  35 H <- function(x, variance = FALSE) heterozygosity(x, variance)