[adegenet-commits] r750 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 26 18:01:34 CET 2010
Author: jombart
Date: 2010-12-26 18:01:34 +0100 (Sun, 26 Dec 2010)
New Revision: 750
Modified:
pkg/R/SNPbin.R
pkg/R/handling.R
Log:
progress...
Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R 2010-12-26 14:29:57 UTC (rev 749)
+++ pkg/R/SNPbin.R 2010-12-26 17:01:34 UTC (rev 750)
@@ -28,7 +28,7 @@
loc.names = "charOrNULL",
loc.all = "charOrNULL",
ploidy = "integer"),
- prototype(gen = list(0), n.loc = integer(0), ind.names = NULL, loc.names = NULL, loc.all = NULL, ploidy = 1L))
+ prototype(gen = list(), n.loc = integer(0), ind.names = NULL, loc.names = NULL, loc.all = NULL, ploidy = 1L))
@@ -153,13 +153,23 @@
input$gen <- lapply(input$gen, as.integer)
} else { # all seems fine
x at gen <- input$gen
+ if(is.null(input$ind.names)){
+ input$ind.names <- names(input$gen)
+ }
}
}
## input$gen is a matrix or a data.frame
if(is.matrix(input$gen) | is.data.frame(input$gen)){
- input$gen <- lapply(1:nrow(input$gen), function(i) input$gen[i,])
+ if(is.null(input$ind.names)){
+ input$ind.names <- rownames(input$gen)
+ }
+ if(is.null(input$loc.names)){
+ input$loc.names <- colnames(input$gen)
+ }
+ input$gen <- lapply(1:nrow(input$gen), function(i) input$gen[i,])
+
}
@@ -176,84 +186,94 @@
}
}
+ ## name individuals if needed
+ if(is.null(input$ind.names)){
+ input$ind.names <- names(input$gen)
+ }
+
## create SNPbin list
- x at snp <- lapply(input$gen, function(e) new("SNPbin",e))
+ x at gen <- lapply(input$gen, function(e) new("SNPbin",e))
}
}
- ## HANDLE INPUT$IND.NAMES ##
- if(!is.null(input$ind.names)){
- input$ind.names <- as.character(input$ind.names)
+ if(length(x at gen) > 0) { # if non-emtpy object
+ ## HANDLE INPUT$IND.NAMES ##
+ if(!is.null(input$ind.names)){
+ input$ind.names <- as.character(input$ind.names)
- ## check length consistency
- if(length(input$ind.names) != length(x at gen)) stop("Inconsistent length for ind.names.")
+ ## check length consistency
+ if(length(input$ind.names) != nInd(x)) stop("Inconsistent length for ind.names.")
- ## ## name list and each SNPbin ## THIS DUPLICATES THE INFORMATION
- ## names(x at gen) <- input$ind.names
- ## for(i in 1:length(x at gen)){
- ## x at gen[[i]]@label <- input$ind.names[i]
- ## }
- }
+ ## ## name list and each SNPbin ## THIS DUPLICATES THE INFORMATION
+ ## names(x at gen) <- input$ind.names
+ ## for(i in 1:length(x at gen)){
+ ## x at gen[[i]]@label <- input$ind.names[i]
+ ## }
+ }
- ## HANDLE INPUT$N.LOC ##
- if(!is.null(input$n.loc)){ # n.loc is provided
- input$n.loc <- as.integer(input$n.loc)
+ ## HANDLE INPUT$N.LOC ##
+ if(!is.null(input$n.loc)){ # n.loc is provided
+ input$n.loc <- as.integer(input$n.loc)
- ## check length consistency
- if(input$n.loc != nLoc(x at gen[[1]])) {
- warning("Inconsistent number of loci (n.loc) - ignoring this argument.")
- } else {
- x at n.loc <- input$n.loc
+ ## check length consistency
+ if(input$n.loc != nLoc(x at gen[[1]])) {
+ warning("Inconsistent number of loci (n.loc) - ignoring this argument.")
+ } else {
+ x at n.loc <- input$n.loc
+ }
+ } else { # n.loc is not provided
+ x at n.loc <- nLoc(x at gen[[1]])
}
- } else { # n.loc is not provided
- x at n.loc <- nLoc(x at gen[[1]])
- }
- ## HANDLE INPUT$PLOIDY ##
- if(!is.null(input$ploidy)){ # ploidy is provided
- input$ploidy <- as.integer(input$ploidy)
- input$ploidy <- rep(input$ploidy, length=length(x at gen))
- x at ploidy <- input$ploidy
- } else { # ploidy is not provided
- x at ploidy <- sapply(x at gen, function(e) e at ploidy)
- }
+ ## HANDLE INPUT$PLOIDY ##
+ if(!is.null(input$ploidy)){ # ploidy is provided
+ input$ploidy <- as.integer(input$ploidy)
+ input$ploidy <- rep(input$ploidy, length=length(x at gen))
+ x at ploidy <- input$ploidy
+ } else { # ploidy is not provided
+ x at ploidy <- sapply(x at gen, function(e) e at ploidy)
+ }
- ## HANDLE INPUT$LOC.NAMES ##
- if(!is.null(input$loc.names) && length(input$loc.names)>0){ # ploidy is provided
- input$loc.names <- as.character(input$loc.names)
+ ## HANDLE INPUT$LOC.NAMES ##
+ if(!is.null(input$loc.names) && length(input$loc.names)>0){ # ploidy is provided
+ input$loc.names <- as.character(input$loc.names)
- ## check length consistency
- if(length(input$loc.names) != x at n.loc){
- warning("Inconsistent length for loc.names - ignoring this argument.")
- } else {
- x at loc.names <- input$loc.names
+ ## check length consistency
+ if(length(input$loc.names) != x at n.loc){
+ warning("Inconsistent length for loc.names - ignoring this argument.")
+ } else {
+ x at loc.names <- input$loc.names
+ }
}
- }
- ## HANDLE INPUT$LOC.ALL ##
- if(!is.null(input$loc.all) && length(input$loc.all)>0){ # ploidy is provided
- input$loc.all <- as.character(input$loc.all)
+ ## HANDLE INPUT$LOC.ALL ##
+ if(!is.null(input$loc.all) && length(input$loc.all)>0){ # ploidy is provided
+ input$loc.all <- as.character(input$loc.all)
- ## check length consistency
- if(length(input$loc.all) != x at n.loc){
- warning("Inconsistent length for loc.all - ignoring this argument.")
- } else {
- ## check string consistency (format is e.g. "a/t")
- if(any(grep("^[[:alpha:]]{1}/[[:alpha:]]{1}$", input$loc.all) != 1:length(x at gen))){
- input$loc.all <- gsub("[[:space:]]","", input$loc.all)
- warning("Miss-formed strings in loc.all (must be e.g. 'c/g') - ignoring this argument.")
+ ## check length consistency
+ if(length(input$loc.all) != x at n.loc){
+ warning("Inconsistent length for loc.all - ignoring this argument.")
} else {
- x at loc.all <- input$loc.all
+ ## check string consistency (format is e.g. "a/t")
+ if(any(grep("^[[:alpha:]]{1}/[[:alpha:]]{1}$", input$loc.all) != 1:length(x at gen))){
+ input$loc.all <- gsub("[[:space:]]","", input$loc.all)
+ warning("Miss-formed strings in loc.all (must be e.g. 'c/g') - ignoring this argument.")
+ } else {
+ x at loc.all <- input$loc.all
+ }
}
}
- }
+ } # end if non-empty @gen
+
+ ## RETURN OBJECT ##
+ return(x)
}) # end genlight constructor
@@ -301,6 +321,11 @@
})
+setMethod("nInd","genlight", function(x,...){
+ return(length(x at gen))
+})
+
+
setMethod("$","SNPbin",function(x,name) {
return(slot(x,name))
})
Modified: pkg/R/handling.R
===================================================================
--- pkg/R/handling.R 2010-12-26 14:29:57 UTC (rev 749)
+++ pkg/R/handling.R 2010-12-26 17:01:34 UTC (rev 750)
@@ -517,6 +517,23 @@
+#######
+# nInd
+#######
+setGeneric("nInd", function(x,...){
+ standardGeneric("nInd")
+})
+
+
+
+setMethod("nInd","genind", function(x,...){
+ return(nrow(x at tab))
+})
+
+
+
+
+
######
# pop
######
More information about the adegenet-commits
mailing list