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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Oct 9 19:04:27 CEST 2008


Author: jombart
Date: 2008-10-09 19:04:27 +0200 (Thu, 09 Oct 2008)
New Revision: 187

Modified:
   pkg/R/scale.R
   pkg/R/spca.R
   pkg/TODO
   pkg/man/scale.Rd
   pkg/man/spca.Rd
Log:
Some improvements on scaling in spca; scaleGen improved (no longer try to scale alleles with null variance).


Modified: pkg/R/scale.R
===================================================================
--- pkg/R/scale.R	2008-10-09 12:18:35 UTC (rev 186)
+++ pkg/R/scale.R	2008-10-09 17:04:27 UTC (rev 187)
@@ -6,12 +6,13 @@
 setMethod("scaleGen", "genind", function(x, center=TRUE, scale=TRUE,
                                       method=c("sigma", "binom"), missing=c("NA","0","mean"), truenames=TRUE){
 
+    THRES <- 1e-10
     method <- match.arg(method)
     missing <- match.arg(missing)
 
     ## handle "missing" arg
     if(missing %in% c("0","mean")){
-        x <- na.replace(x,method=missing)
+        x <- na.replace(x, method=missing, quiet=TRUE)
     }
     
     ## handle specific cases
@@ -34,6 +35,16 @@
     
     ## return result
     res <- scale(X, center=center, scale=scale)
+    
+    ## issue a warning if some variances are null
+    temp <- attr(res,"scaled:scale") < THRES
+    if(any(temp)) {
+        warning("Some scaling values are null.\n Corresponding alleles are removed.")
+        res <- res[, !temp]
+        attr(res,"scaled:center") <- attr(res,"scaled:center")[!temp]
+        attr(res,"scaled:scale") <- attr(res,"scaled:scale")[!temp]
+    }
+
     return(res)
 })
 
@@ -44,6 +55,7 @@
 setMethod("scaleGen", "genpop", function(x, center=TRUE, scale=TRUE,
                                       method=c("sigma", "binom"),  missing=c("NA","0","mean"), truenames=TRUE){
 
+    THRES <- 1e-10
     method <- match.arg(method)
     missing <- match.arg(missing)
     
@@ -64,5 +76,15 @@
     ## return result
 
     res <- scale(X, center=center, scale=scale)
+    
+    ## issue a warning if some variances are null
+    temp <- attr(res,"scaled:scale") < THRES
+    if(any(temp)) {
+        warning("Some scaling values are null.\n Corresponding alleles are removed.")
+        res <- res[, !temp]
+        attr(res,"scaled:center") <- attr(res,"scaled:center")[!temp]
+        attr(res,"scaled:scale") <- attr(res,"scaled:scale")[!temp]
+    }
+
     return(res)
 })

Modified: pkg/R/spca.R
===================================================================
--- pkg/R/spca.R	2008-10-09 12:18:35 UTC (rev 186)
+++ pkg/R/spca.R	2008-10-09 17:04:27 UTC (rev 187)
@@ -16,9 +16,9 @@
 ################
 # Function spca
 ################
-spca <- function(obj, xy=NULL, cn=NULL, scale=FALSE, scannf=TRUE, nfposi=1, nfnega=1, type=NULL,
-                 ask=TRUE, plot.nb=TRUE, edit.nb=FALSE ,truenames=TRUE, d1=NULL, d2=NULL, k=NULL,
-                 a=NULL, dmin=NULL) {
+spca <- function(obj, xy=NULL, cn=NULL, scale=FALSE, scale.method=c("sigma","binom"), scannf=TRUE,
+                 nfposi=1, nfnega=1, type=NULL, ask=TRUE, plot.nb=TRUE, edit.nb=FALSE ,
+                 truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL){
   
   if(!any(inherits(obj,c("genind","genpop")))) stop("obj must be a genind or genpop object.")
   invisible(validObject(obj))
@@ -55,32 +55,17 @@
   if(ncol(xy) != 2) stop("xy does not have two columns.")
   if(nrow(xy) != nrow(obj at tab)) stop("obj at tab and xy must have the same row numbers.")
 
-  ## prepare data
-  f1 <- function(vec){
-    m <- mean(vec,na.rm=TRUE)
-    vec[is.na(vec)] <- m
-    return(vec)
-  }
-
-  if(is.genind(obj)) { X <- obj at tab }
-  if(is.genpop(obj)) { X <- makefreq(obj, quiet=TRUE)$tab }
-
-  ## handle NAs
-  if(any(is.na(X))){
+  ## handle NAs warning
+  if(any(is.na(obj at tab))){
       warning("NAs in data are automatically replaced (to mean allele frequency")
-      X <- apply(X,2,f1)
   }
 
-  if(truenames){
-      temp <- truenames(obj) # ! can return a list or a matrix
-      if(is.list(temp)) {temp <- temp$tab}
-      rownames(X) <- rownames(temp)
-      colnames(X) <- colnames(temp)
-  }
+  ## handle NAs, centring and scaling  
+  X <- scaleGen(obj, center=TRUE, scale=scale, method=scale.method, missing="mean", truenames=truenames)
+  
+  ## perform analyses
+  pcaX <- dudi.pca(X, center=FALSE, scale=FALSE, scannf=FALSE)
 
-  # perform analyses
-  pcaX <- dudi.pca(X, center=TRUE, scale=scale, scannf=FALSE)
-
   spcaX <- multispati(dudi=pcaX, listw=resCN, scannf=scannf, nfposi=nfposi, nfnega=nfnega)
 
   nfposi <- spcaX$nfposi

Modified: pkg/TODO
===================================================================
--- pkg/TODO	2008-10-09 12:18:35 UTC (rev 186)
+++ pkg/TODO	2008-10-09 17:04:27 UTC (rev 187)
@@ -26,7 +26,7 @@
 
 # CODE ISSUES:
 ==============
-* fix bug 1.2-2.01 (read.structure issue) -- fixed: was not a bug, just a mispecification in arguments
+* fix bug 1.2-2.01 (read.structure issue) -- fixed: was due to the default of "onerowperind" argument.
 
 
 # DOCUMENTATION ISSUES:
@@ -37,8 +37,12 @@
 # NEW IMPLEMENTATIONS:
 =====================
 * color plot for the sPCA results, based on RGB representation of Cavalli-Sforza -- done(TJ)
+* loadingplot -- done(TJ)
+* adegenetTutorial function which opens the online tutorials
+* allow for the use of na.replace and scaleGen in spca function -- done (TJ)
 
 
+
 # TESTING:
 ==========
 * 

Modified: pkg/man/scale.Rd
===================================================================
--- pkg/man/scale.Rd	2008-10-09 12:18:35 UTC (rev 186)
+++ pkg/man/scale.Rd	2008-10-09 17:04:27 UTC (rev 187)
@@ -34,7 +34,9 @@
  \item{missing}{a character giving the treatment for missing values. Can be "NA", "0" or "mean"}
  }
  \value{
-   A \linkS4class{genind} and \linkS4class{genpop} object.
+   A matrix of scaled allele frequencies with genotypes
+  (\linkS4class{genind}) or populations in (\linkS4class{genpop}) in
+  rows and alleles in columns.
 }
 \details{
   The argument \code{method} is used as follows:\cr

Modified: pkg/man/spca.Rd
===================================================================
--- pkg/man/spca.Rd	2008-10-09 12:18:35 UTC (rev 186)
+++ pkg/man/spca.Rd	2008-10-09 17:04:27 UTC (rev 187)
@@ -30,7 +30,7 @@
   space using the RGB system.\cr
 }
 \usage{
-spca(obj, xy=NULL, cn=NULL, scale=FALSE, scannf=TRUE, nfposi=1,
+spca(obj, xy=NULL, cn=NULL, scale=FALSE, scale.method=c("sigma","binom"), scannf=TRUE, nfposi=1,
   nfnega=1, type=NULL, ask=TRUE,plot.nb=TRUE, edit.nb=FALSE
   ,truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL)
 
@@ -57,6 +57,9 @@
     chooseCN.}
   \item{scale}{a logical indicating whether alleles should be scaled to
     unit variance (TRUE) or not (FALSE, default).}
+  \item{scale.method}{a character string indicating the method used for
+    scaling allele frequencies. This argument is passed to
+    \code{\link{scaleGen}} function (see ?\code{\link{scaleGen}}).}
   \item{scannf}{a logical stating whether eigenvalues should be chosen
     interactively (TRUE, default) or not (FALSE).}
   \item{nfposi}{an integer giving the number of positive eigenvalues retained



More information about the adegenet-commits mailing list