[adegenet-commits] r723 - in pkg: R man

[noreply at r-forge.r-project.org]

Author: jombart
Date: 2010-11-24 01:01:14 +0100 (Wed, 24 Nov 2010)
New Revision: 723

Added:
   pkg/man/inbreeding.Rd
Modified:
   pkg/R/inbreeding.R
Log:
Fixed the index


Modified: pkg/R/inbreeding.R
===================================================================
--- pkg/R/inbreeding.R	2010-11-23 23:07:05 UTC (rev 722)
+++ pkg/R/inbreeding.R	2010-11-24 00:01:14 UTC (rev 723)
@@ -21,11 +21,12 @@
     tabfreq2 <- (makefreq(x = genind2genpop(x, quiet = TRUE), quiet=TRUE, truenames=truenames)$tab) ^2
     sumpi2 <- t(apply(tabfreq2, 1, tapply, x$loc.fac, sum))
 
-    ## function to check a 1-locus genotype for heterozigocity
-    ## returns 1 if heteroz, 0 otherwise
+    ## function to check a 1-locus genotype for homozigosity
+    ## returns 1 if homoz, 0 otherwise
+    ## !!! NOTE : reverse the values returned by f1 to obtain a strange thing !!!
     f1 <- function(gen){
         if(any(is.na(gen))) return(NA)
-        if(sum(abs(gen-0.5) < 1e-10)==2) return(1)
+        if(any(round(gen, 10)==1)) return(1)
         return(0)
     }
 
@@ -35,7 +36,7 @@
     } else
     X <- x$tab
 
-    heterotab <- t(apply(X, 1, tapply, x at loc.fac, f1))
+    homotab <- t(apply(X, 1, tapply, x at loc.fac, f1))
 
 
     ## get pi2 for the appropriate pop
@@ -50,7 +51,7 @@
 
 
     ## COMPUTE FINAL RESULT ##
-    num <- heterotab - tabpi2
+    num <- homotab - tabpi2
     denom <- tabpi2 * (1 - tabpi2)
     res <- num / denom
     if(res.type=="byloc") return(res)

Added: pkg/man/inbreeding.Rd
===================================================================
--- pkg/man/inbreeding.Rd	                        (rev 0)
+++ pkg/man/inbreeding.Rd	2010-11-24 00:01:14 UTC (rev 723)
@@ -0,0 +1,68 @@
+\encoding{UTF-8}
+\name{Inbreeding}
+\alias{inbreeding}
+\title{Inbreeding coefficient for diploid genotypes}
+\description{
+  WARNING: this function is under development. Please contact the author
+  (\email{t.jombart at imperial.ac.uk}) before using it.
+  
+  The function \code{inbreeding} computes Balloux's inbreeding
+  coefficient for each individual of a \linkS4class{genind}
+  objects. Results can be averaged over loci or detailed per locus. By
+  default, \code{inbreeding} also produces a graphical output of the results.
+}
+\usage{
+inbreeding(x, pop=NULL, truenames=TRUE, res.type=c("mean","byloc"), plot=TRUE, \ldots)
+}
+\arguments{
+  \item{x}{an object of class \linkS4class{genind}.}
+  \item{pop}{a factor giving the 'population' of each individual. If NULL,
+    pop is seeked from \code{pop(x)}. Note that the term population refers in
+    fact to any grouping of individuals'.}
+  \item{truenames}{a logical indicating whether true names should be
+    used (TRUE, default) instead of generic labels (FALSE); used if
+    res.type is "matrix".}
+ \item{res.type}{a character string matching "mean" or "byloc",
+   specifying whether results should be averaged over loci ("mean") or
+   detailed by locus ("byloc").}
+ \item{plot}{a logical indicating whether a graphical
+   output should be produced (TRUE, default), or not (FALSE).}
+ \item{\ldots}{other arguments to be passed to \code{plot}.}
+}
+\value{
+  A vector (if res.type is "mean"), or a matrix (if res.type is "byloc")
+  of inbreeding coefficient values.
+}
+\seealso{
+  \code{\link{Hs}}, \code{\link[hierfstat]{varcomp.glob}},
+  \code{\link{gstat.randtest}}
+}
+\references{
+  Brown AR, Hosken DJ, Balloux F, et al. 2009 Genetic variation,
+  inbreeding and chemical exposure - combined effects in wildlife and
+  critical considerations for ecotoxicology. Philosophical Transactions
+  of the Royal Society B, London 364: 3377 - 3390
+}
+\details{
+  Let \eqn{p_i} refer to the allele frequencies in a population. Let
+  \eqn{h} be an variable which equates 1 if the individual is
+  heterozygote, and 0 otherwise. For one locus, Balloux's inbreeding coefficient is
+  defined as:
+
+  \eqn{  \frac{h - \sum_i p_i^2}{ \sum_i p_i^2 (1- \sum_i p_i^2)} } \cr
+
+  For multi-locus genotypes, inbreeding values are averaged over the loci.
+}
+\author{
+  Implementation: Thibaut Jombart \email{t.jombart at imperial.ac.uk}\cr
+  Formula by Francois Balloux \email{f.balloux at imperial.ac.uk}
+}
+\examples{
+## cat colonies of Nancy
+data(nancycats)
+inbreeding(nancycats)
+
+## French/African cattle breeds
+data(microbov)
+inbreeding(microbov)
+}