[adegenet-commits] r242 - pkg/R

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

Author: jombart
Date: 2009-01-25 18:31:35 +0100 (Sun, 25 Jan 2009)
New Revision: 242

Modified:
   pkg/R/auxil.R
   pkg/R/scale.R
   pkg/R/setAs.R
   pkg/R/spca.R
Log:
First draft of type migration achieved.


Modified: pkg/R/auxil.R
===================================================================
--- pkg/R/auxil.R	2009-01-25 17:10:31 UTC (rev 241)
+++ pkg/R/auxil.R	2009-01-25 17:31:35 UTC (rev 242)
@@ -100,7 +100,12 @@
 ############
 # checkType
 ############
-checkType <- function(markType=x at type){
+checkType <- function(x){
+    if(is.character(x)){
+        markType <- x
+    } else {
+        markType <- x at type
+    }
 
     if(markType=="codom") return() # always ok for codominant markers
 
@@ -109,7 +114,7 @@
 
     ## names of functions which are ok for dominant markers
     PAOk <- c("genind","genpop","genind2genpop","summary",
-                 "truenames","seppop","na.replace","nLoc")
+                 "truenames","seppop","na.replace","nLoc","scaleGen","spca")
 
     PAWarn <- c("df2genind")
 

Modified: pkg/R/scale.R
===================================================================
--- pkg/R/scale.R	2009-01-25 17:10:31 UTC (rev 241)
+++ pkg/R/scale.R	2009-01-25 17:31:35 UTC (rev 242)
@@ -9,6 +9,8 @@
     THRES <- 1e-10
     method <- match.arg(method)
     missing <- match.arg(missing)
+    checkType(x)
+    if(method=="binom" & x at type=="PA") stop("This scaling is not available for presence/absence markers.")
 
     ## handle "missing" arg
     if(missing %in% c("0","mean")){
@@ -62,6 +64,8 @@
     THRES <- 1e-10
     method <- match.arg(method)
     missing <- match.arg(missing)
+    checkType(x)
+    if(method=="binom" & x at type=="PA") stop("This scaling is not available for presence/absence markers.")
 
     ## make allele frequencies here
     if(x at type=="codom"){

Modified: pkg/R/setAs.R
===================================================================
--- pkg/R/setAs.R	2009-01-25 17:10:31 UTC (rev 241)
+++ pkg/R/setAs.R	2009-01-25 17:31:35 UTC (rev 242)
@@ -40,6 +40,7 @@
 setOldClass("ktab")
 setAs("genind", "ktab", function(from, to) {
     if(!require(ade4)) stop("package ade4 is required")
+    checkType(from)
     res <- ktab.data.frame(df=as.data.frame(from), blocks=from at loc.nall, rownames=from at ind.names,
                            colnames=unlist(from at all.names), tabnames=from at loc.names)
     return(res)
@@ -50,6 +51,7 @@
 
 setAs("genpop", "ktab", function(from, to) {
     if(!require(ade4)) stop("package ade4 is required")
+    checkType(from)
     res <- ktab.data.frame(df=as.data.frame(from), blocks=from at loc.nall, rownames=from at pop.names,
                            colnames=unlist(from at all.names), tabnames=from at loc.names)
     return(res)

Modified: pkg/R/spca.R
===================================================================
--- pkg/R/spca.R	2009-01-25 17:10:31 UTC (rev 241)
+++ pkg/R/spca.R	2009-01-25 17:31:35 UTC (rev 242)
@@ -24,9 +24,11 @@
     ## first checks
     if(!any(inherits(obj,c("genind","genpop")))) stop("obj must be a genind or genpop object.")
     invisible(validObject(obj))
+    checkType(obj)
     if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
     if(!require(spdep, quiet=TRUE)) stop("spdep library is required.")
 
+
     ## handle xy coordinates
     if(is.null(xy) & (inherits(cn,"nb") & !inherits(cn,"listw")) ){
                      xy <- attr(cn,"xy")  # xy can be retrieved from a nb object (not from listw)