[adegenet-commits] r267 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 4 19:15:36 CET 2009
Author: jombart
Date: 2009-02-04 19:15:36 +0100 (Wed, 04 Feb 2009)
New Revision: 267
Added:
pkg/man/isPoly.Rd
Modified:
pkg/R/handling.R
pkg/man/accessors.Rd
Log:
Added isPoly, and use drop arg in [ method.
Modified: pkg/R/handling.R
===================================================================
--- pkg/R/handling.R 2009-02-02 18:32:26 UTC (rev 266)
+++ pkg/R/handling.R 2009-02-04 18:15:36 UTC (rev 267)
@@ -210,8 +210,15 @@
} # end loc argument
prevcall <- match.call()
+
tab <- tab[i, j, ...,drop=FALSE]
+ if(drop){
+ allNb <- apply(tab, 2, sum, na.rm=TRUE) # allele absolute frequencies
+ toKeep <- (allNb > 1e-10)
+ tab <- tab[,toKeep, drop=FALSE]
+ }
+
res <- genind(tab,pop=pop,prevcall=prevcall, ploidy=x at ploidy, type=x at type)
## handle 'other' slot
@@ -261,6 +268,12 @@
prevcall <- match.call()
tab <- tab[i, j, ...,drop=FALSE]
+ if(drop){
+ allNb <- apply(tab, 2, sum, na.rm=TRUE) # allele absolute frequencies
+ toKeep <- (allNb > 1e-10)
+ tab <- tab[,toKeep, drop=FALSE]
+ }
+
res <- genpop(tab,prevcall=prevcall)
## handle 'other' slot
@@ -513,8 +526,73 @@
+#########
+# isPoly
+#########
+setGeneric("isPoly", function(x, ...) standardGeneric("isPoly"))
+## genind method ##
+setMethod("isPoly", signature(x="genind"), function(x, by=c("locus","allele"), thres=1/100){
+ ## misc checks
+ checkType(x)
+ if(!is.genind(x)) stop("x is not a valid genind object")
+ by <- match.arg(by)
+
+ ## main computations
+ allNb <- apply(x at tab, 2, sum, na.rm=TRUE) # allele absolute frequencies
+
+ if(by=="locus"){
+ f1 <- function(vec){
+ if(sum(vec) < 1e-10) return(FALSE)
+ vec <- vec/sum(vec, na.rm=TRUE)
+ if(sum(vec >= thres) >= 2) return(TRUE)
+ return(FALSE)
+ }
+
+ toKeep <- tapply(allNb, x at loc.fac, f1)
+ } else { # i.e. if mode==allele
+ toKeep <- (allNb >= thres)
+ }
+
+ return(toKeep)
+}) # end isPoly
+
+
+
+
+
+## genpop method ##
+setMethod("isPoly", signature(x="genpop"), function(x, by=c("locus","allele"), thres=1/100){
+
+ ## misc checks
+ checkType(x)
+ if(!is.genpop(x)) stop("x is not a valid genind object")
+ by <- match.arg(by)
+
+ ## main computations
+ allNb <- apply(x at tab, 2, sum, na.rm=TRUE) # alleles absolute frequencies
+
+ if(by=="locus"){
+ f1 <- function(vec){
+ if(sum(vec) < 1e-10) return(FALSE)
+ vec <- vec/sum(vec, na.rm=TRUE)
+ if(sum(vec >= thres) >= 2) return(TRUE)
+ return(FALSE)
+ }
+
+ toKeep <- tapply(allNb, x at loc.fac, f1)
+ } else { # i.e. if mode==allele
+ toKeep <- allNb >= thres
+ }
+
+ return(toKeep)
+}) # end isPoly
+
+
+
+
+
######################
## miscellanous utils
######################
Modified: pkg/man/accessors.Rd
===================================================================
--- pkg/man/accessors.Rd 2009-02-02 18:32:26 UTC (rev 266)
+++ pkg/man/accessors.Rd 2009-02-04 18:15:36 UTC (rev 267)
@@ -34,9 +34,14 @@
specified in the \code{loc} argument (using generic names, not true
names; in this example, only the first and the third locus would be
retained)\cr
-
+ - "obj[1:3, drop=TRUE]" returns the first 3 genotypes/populations of
+ "obj", but retaining only alleles that are present in this subset (as
+ opposed to keeping all alleles of "obj", which is the default
+ behavior).\cr
+
The argument \code{treatOther} handles the treatment of objects in the
- \code{@other} slot (see details).
+ \code{@other} slot (see details). The argument \code{drop} can be set
+ to TRUE to drop alleles that are no longer represented in the subset.
}
\section{Methods}{
\describe{
@@ -59,9 +64,14 @@
handled through the argument \code{treatOther}, a logical defaulting
to TRUE. If set to FALSE, the \code{@other} component is not
returned.\cr
+
Note that only matrix-like, vector-like and lists can be proceeded in
\code{@other}. Other kind of objects will issue a warning an be
returned as they are.\cr
+
+ The \code{drop} argument can be set to TRUE to retain only alleles
+ that are present in the subset. To achieve better control of
+ polymorphism of the data, see \code{\link{isPoly}}.
}
\examples{
data(nancycats)
@@ -91,6 +101,10 @@
obj$loc.fac
obj$loc.names
+# using 'drop':
+truenames(nancycats[1:2])$tab
+truenames(nancycats[1:2, drop=TRUE])$tab
+
# illustrate how 'other' slot is handled
colonies <- genind2genpop(nancycats)
colonies at other$aChar <- "This will not be proceeded"
Added: pkg/man/isPoly.Rd
===================================================================
--- pkg/man/isPoly.Rd (rev 0)
+++ pkg/man/isPoly.Rd 2009-02-04 18:15:36 UTC (rev 267)
@@ -0,0 +1,34 @@
+\name{isPoly-methods}
+\docType{methods}
+\alias{isPoly}
+\alias{isPoly-methods}
+\alias{isPoly,genind-method}
+\alias{isPoly,genpop-method}
+\title{ Assess polymorphism in genind/genpop objects }
+\description{
+ The simple function \code{isPoly} can be used to check which loci are
+ polymorphic, or alternatively to check which alleles give rise to polymorphism.
+}
+\usage{
+\S4method{isPoly}{genind}(x, by=c("locus","allele"), thres=1/100)
+\S4method{isPoly}{genpop}(x, by=c("locus","allele"), thres=1/100)
+}
+\arguments{
+ \item{x}{a \linkS4class{genind} and \linkS4class{genpop} object}
+ \item{by}{a character being "locus" or "allele", indicating whether
+ results should indicate polymorphic loci ("locus"), or alleles giving
+ rise to polymorphism ("allele").}
+ \item{thres}{a numeric value giving the minimum frequency of an allele
+ giving rise to polymorphism (defaults to 0.01).}
+ }
+ \value{
+ A vector of logicals.
+}
+\author{Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr} }
+\examples{
+data(nancycats)
+isPoly(nancycats,by="loc", thres=0.1)
+isPoly(nancycats[1:3],by="loc", thres=0.1)
+}
+\keyword{methods}
+\keyword{manip}
More information about the adegenet-commits
mailing list