[adegenet-commits] r121 - in pkg: . R man

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

Author: jombart
Date: 2008-06-12 12:05:28 +0200 (Thu, 12 Jun 2008)
New Revision: 121

Added:
   pkg/R/setAs.R
   pkg/man/as-methods.Rd
Modified:
   pkg/DESCRIPTION
   pkg/R/fstat.R
   pkg/TODO
Log:
Added a few as methods.
Started a function for classical fst computation.


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2008-06-02 13:18:11 UTC (rev 120)
+++ pkg/DESCRIPTION	2008-06-12 10:05:28 UTC (rev 121)
@@ -9,4 +9,4 @@
 Description: Classes and functions for genetic data analysis within the multivariate framework.
 License: GPL (>=2)
 LazyLoad: yes
-Collate: classes.R auxil.R makefreq.R chooseCN.R dist.genpop.R export.R gstat.randtest.R HWE.R import.R monmonier.R coords.monmonier.R spca.R spca.rtests.R zzz.R hybridize.R fstat.R propShared.R
\ No newline at end of file
+Collate: classes.R auxil.R makefreq.R chooseCN.R dist.genpop.R export.R setAs.R gstat.randtest.R HWE.R import.R monmonier.R coords.monmonier.R spca.R spca.rtests.R zzz.R hybridize.R fstat.R propShared.R
\ No newline at end of file

Modified: pkg/R/fstat.R
===================================================================
--- pkg/R/fstat.R	2008-06-02 13:18:11 UTC (rev 120)
+++ pkg/R/fstat.R	2008-06-12 10:05:28 UTC (rev 121)
@@ -1,6 +1,9 @@
 #################
 # fstat function
 #################
+#
+# Wrapper for fst estimator from hierfstat package
+#
 fstat <- function(x, pop=NULL, fstonly=FALSE){
     ## misc checks
     if(!is.genind(x)) stop("x is not a valid genind object")
@@ -17,3 +20,25 @@
     if(fstonly) {res <- res[1,1]}
     return(res)
 }
+
+
+
+###############
+# fst function
+###############
+#
+# classical fst sensu Weir 1996 Genetic data analysis II pp. 166-167
+#
+fst <- function(x, pop=NULL){
+    ## misc checks
+    if(!is.genind(x)) stop("x is not a valid genind object")
+    if(!require(hierfstat)) stop("hierfstat package is required. Please install it.")
+    
+    if(is.null(pop)) pop <- x at pop
+    if(is.null(pop)) stop("no pop factor provided")
+    if(length(pop)!=nrow(x at tab)) stop("pop has a wrong length.")
+
+    ## computations
+    
+    return(res)
+}

Added: pkg/R/setAs.R
===================================================================
--- pkg/R/setAs.R	                        (rev 0)
+++ pkg/R/setAs.R	2008-06-12 10:05:28 UTC (rev 121)
@@ -0,0 +1,69 @@
+#############
+# S4 methods
+#############
+setAs("genind", "data.frame", function(from, to) {
+    return(from at tab)
+})
+
+
+
+setAs("genpop", "data.frame", function(from, to) {
+    return(from at tab)
+})
+
+
+
+setAs("genind", "matrix", function(from, to) {
+    return(from at tab)
+})
+
+
+
+setAs("genpop", "matrix", function(from, to) {
+    return(from at tab)
+})
+
+
+
+setAs("genind", "genpop", function(from, to) {
+    if(!is.genind(from)) stop("object is not a valid genind")
+
+    x <- genind2genpop(from, quiet=TRUE)
+    warning("You had better use genind2genpop to specify treatment of NAs")
+
+    return(x at tab)
+})
+
+
+
+
+##############
+# S3 versions
+##############
+as.data.frame.genind <- function(x,...){
+    return(as(x,"data.frame"))
+}
+
+
+
+as.data.frame.genpop <- function(x,...){
+    return(as(x,"data.frame"))
+}
+
+
+
+as.matrix.genind <- function(x,...){
+    return(as(x,"matrix"))
+}
+
+
+
+as.matrix.genpop <- function(x,...){
+    return(as(x,"matrix"))
+}
+
+
+
+as.genpop.genind <- function(x,...){
+    return(as(x,"genpop"))
+}

Modified: pkg/TODO
===================================================================
--- pkg/TODO	2008-06-02 13:18:11 UTC (rev 120)
+++ pkg/TODO	2008-06-12 10:05:28 UTC (rev 121)
@@ -35,6 +35,7 @@
 # NEW IMPLEMENTATIONS:
 =====================
 * implement different levels of ploidy in genind / genpop objects.
+* implement classical Fst sensu Weir 1996
 
 # TESTING:
 ==========

Added: pkg/man/as-methods.Rd
===================================================================
--- pkg/man/as-methods.Rd	                        (rev 0)
+++ pkg/man/as-methods.Rd	2008-06-12 10:05:28 UTC (rev 121)
@@ -0,0 +1,48 @@
+\name{as methods in adegenet}
+\docType{methods}
+\alias{as-method}
+\alias{as,genind,data.frame-method}
+\alias{as,genpop,data.frame-method}
+\alias{as,genind,matrix-method}
+\alias{as,genpop,matrix-method}
+\alias{as,genind,genpop-method}
+\alias{coerce,genind,data.frame-method}
+\alias{coerce,genpop,data.frame-method}
+\alias{coerce,genind,matrix-method}
+\alias{coerce,genpop,matrix-method}
+\alias{coerce,genind,genpop-method}
+\alias{as.data.frame.genind}
+\alias{as.data.frame.genpop}
+\alias{as.matrix.genind}
+\alias{as.matrix.genpop}
+\alias{as.genpop.genind}
+\title{Converting genind/genpop objects to other classes}
+\section{Usage}{
+\code{as(object, Class)}
+}
+\section{Arguments}{
+\describe{
+  \item{\code{object}}{a \linkS4class{genind} or a \linkS4class{genpop} object.}
+  \item{\code{Class}}{the name of the class to which the object should
+    be coerced, for instance \code{"data.frame"} or \code{"matrix"}.}
+}
+}
+\description{
+ These S3 and S4 methods are used to coerce \linkS4class{genind} and
+ \linkS4class{genpop} objects to matrix-like objects. In most cases,
+ this is equivalent to calling the \code{@tab} slot.
+}
+\section{Methods}{
+  \item{coerce}{from one object class to another using
+    \code{as(object,"Class")}, where the \code{object} is of the old
+    class and the returned object is of the new class \code{"Class"}.
+  }
+}
+
+\author{Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr}}
+\examples{
+data(microbov)
+x <- na.replace(microbov,method="0")
+as(x[1:3],"data.frame")
+}
+\keyword{methods}
\ No newline at end of file