[adegenet-commits] r122 - pkg/R

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

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

Added:
   pkg/R/scale.R
Log:
Added a file for scale method.


Added: pkg/R/scale.R
===================================================================
--- pkg/R/scale.R	                        (rev 0)
+++ pkg/R/scale.R	2008-06-12 16:05:18 UTC (rev 122)
@@ -0,0 +1,32 @@
+################
+# scale methods
+################
+setGeneric("scaleGen", function(x,...){standardGeneric("scaleGen")})
+
+setMethod("scaleGen", "genind", function(x, center=TRUE, scale=TRUE,
+                                      method=c("sigma", "binom"), truenames=TRUE){
+
+    method <- match.arg(method)
+    
+    ## handle specific cases
+    if(scale & tolower(method)=="binom"){
+        ## get allele freq
+        temp <- apply(x$tab,2,mean,na.rm=TRUE)
+        ## coerce sum of alleles freq to one (in case of missing data)
+        temp <- tapply(temp, x$loc.fac, function(vec) return(vec/sum(vec)))
+        pbar <- unlist(temp)
+
+        scale <- sqrt(pbar*(1-pbar))
+    }
+
+    X <- x$tab
+    ## handle truenames
+    if(truenames){
+        X <- truenames(x)
+        if(is.list(X)) { X <- X$tab }
+    }
+    
+    ## return result
+    res <- scale(X, center=center, scale=scale)
+    return(res)
+})