[adegenet-commits] r238 - pkg/R

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

Author: jombart
Date: 2009-01-25 17:42:43 +0100 (Sun, 25 Jan 2009)
New Revision: 238

Modified:
   pkg/R/auxil.R
   pkg/R/dist.genpop.R
   pkg/R/export.R
Log:
putting checkTypes from places to places.


Modified: pkg/R/auxil.R
===================================================================
--- pkg/R/auxil.R	2009-01-25 15:53:41 UTC (rev 237)
+++ pkg/R/auxil.R	2009-01-25 16:42:43 UTC (rev 238)
@@ -86,7 +86,8 @@
 ############
 # checkType
 ############
-checkType <- function(markType){
+checkType <- function(x){
+    markType <- x at type
     if(markType=="codom") return() # always ok for codominant markers
 
     currCall <- match.call()

Modified: pkg/R/dist.genpop.R
===================================================================
--- pkg/R/dist.genpop.R	2009-01-25 15:53:41 UTC (rev 237)
+++ pkg/R/dist.genpop.R	2009-01-25 16:42:43 UTC (rev 238)
@@ -13,11 +13,14 @@
 ############################
 # S3 method dist for genpop
 ############################
-dist.genpop <- function(x, method = 1, diag = FALSE, upper = FALSE) { 
+dist.genpop <- function(x, method = 1, diag = FALSE, upper = FALSE) {
 
   if(!is.genpop(x)) stop("x is not a valid genpop object")
 
-    
+  ## check marker type
+  checkType(x)
+
+
   METHODS = c("Nei","Edwards","Reynolds","Rodgers","Provesti")
   if (all((1:5)!=method)) {
     cat("1 = Nei 1972\n")
@@ -35,7 +38,7 @@
   X <- makefreq(x,missing="mean",quiet=TRUE)$tab
   # X is a matrix of allelic frequencies
   nlig <- nrow(X)
-  
+
   if (method == 1) { # Nei
     d <- X%*%t(X)
     vec <- sqrt(diag(d))
@@ -71,7 +74,7 @@
         daux <- sqrt(.5*daux)
         return(daux)
       }
-      
+
       d <- matrix(0,nlig,nlig)
       for(i in 1:length(kX)) {
         d <- d + dcano(kX[[i]])
@@ -86,7 +89,7 @@
         return(resloc/(2*nloc))
       }
       d <- unlist(lapply(w0,loca))
-    } 
+    }
     attr(d, "Size") <- nlig
     attr(d, "Labels") <- x at pop.names
     attr(d, "Diag") <- diag
@@ -95,5 +98,5 @@
     attr(d, "call") <- match.call()
     class(d) <- "dist"
     return(d)
-    
+
 } # end method dist for genpop

Modified: pkg/R/export.R
===================================================================
--- pkg/R/export.R	2009-01-25 15:53:41 UTC (rev 237)
+++ pkg/R/export.R	2009-01-25 16:42:43 UTC (rev 238)
@@ -17,6 +17,7 @@
 
   if(!is.genind(x)) stop("x is not a valid genind object")
   if(x at ploidy != as.integer(2)) stop("not implemented for non-diploid genotypes")
+  checkType(x)
 
   if(!require(genetics)) stop("genetics package is not required but not installed.")
   if(is.null(pop)) pop <- x at pop
@@ -70,6 +71,8 @@
 
 
 
+
+
 ############################
 # Function genind2hierfstat
 ############################
@@ -78,6 +81,7 @@
     ##   invisible(validObject(x))
     if(!is.genind(x)) stop("x is not a valid genind object")
     if(x at ploidy != as.integer(2)) stop("not implemented for non-diploid genotypes")
+    checkType(x)
 
     if(is.null(pop)) pop <- x at pop
     if(is.null(pop)) pop <- as.factor(rep("P1",nrow(x at tab)))
@@ -124,6 +128,7 @@
 genind2df <- function(x, pop=NULL, sep="", usepop=TRUE){
 
   if(!is.genind(x)) stop("x is not a valid genind object")
+  checkType(x)
 
   if(is.null(pop)) {
       pop <- x at pop