[adegenet-commits] r844 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 9 11:53:33 CET 2011
Author: jombart
Date: 2011-03-09 11:53:33 +0100 (Wed, 09 Mar 2011)
New Revision: 844
Modified:
pkg/R/SNPbin.R
Log:
Stuff done at Cork. New slots for genlight - not finished yet.
Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R 2011-03-04 23:53:07 UTC (rev 843)
+++ pkg/R/SNPbin.R 2011-03-09 10:53:33 UTC (rev 844)
@@ -27,10 +27,13 @@
ind.names = "charOrNULL",
loc.names = "charOrNULL",
loc.all = "charOrNULL",
+ chromosome = "factorOrNULL",
+ position = "intOrNULL",
ploidy = "intOrNULL",
pop = "factorOrNULL",
other = "list"),
- prototype(gen = list(), n.loc = 0L, ind.names = NULL, loc.names = NULL, loc.all = NULL, ploidy=NULL, pop=NULL, other=list()))
+ prototype(gen = list(), n.loc = 0L, ind.names = NULL, loc.names = NULL, loc.all = NULL,
+ chromosome = NULL, position = NULL, ploidy=NULL, pop=NULL, other=list()))
@@ -127,6 +130,7 @@
if(!is.null(input$n.loc)){
x at n.loc <- as.integer(input$n.loc)
} else {
+ warning("number of SNPs (n.loc) not provided to the genlight constructor - using the maximum number given data coding.")
x at n.loc <- as.integer(length(x at snp)*8)
}
@@ -142,6 +146,7 @@
x at ploidy <- as.integer(input$ploidy)
}
+
return(x)
}) # end SNPbin constructor
@@ -273,7 +278,13 @@
## check length consistency
if(length(input$ind.names) != nInd(x)){
- stop("Inconsistent length for ind.names.")
+ warning("Inconsistent length for ind.names - storing this argument in @other.")
+ if(is.null(input$other)) {
+ input$other <- list(ind.names.wrong.length=input$ind.names)
+ } else {
+ input$other$ind.names.wrong.length <- input$ind.names
+ }
+
} else {
## assign value to the output object
x at ind.names <- input$ind.names
@@ -318,8 +329,13 @@
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.")
+ if(length(input$loc.names) != x at n.loc){ # if problem, store in @other
+ warning("Inconsistent length for loc.names - storing this argument in @other.")
+ if(is.null(input$other)) {
+ input$other <- list(loc.names.wrong.length=input$loc.names)
+ } else {
+ input$other$loc.names.wrong.length <- input$loc.names
+ }
} else {
x at loc.names <- input$loc.names
}
@@ -332,13 +348,23 @@
## check length consistency
if(length(input$loc.all) != x at n.loc){
- warning("Inconsistent length for loc.all - ignoring this argument.")
+ warning("Inconsistent length for loc.all - storing this argument in @other.")
+ if(is.null(input$other)) {
+ input$other <- list(loc.all.wrong.length=input$loc.all)
+ } else {
+ input$other$loc.all.wrong.length <- input$loc.all
+ }
} else {
## check string consistency (format is e.g. "a/t")
temp <- grep("^[[:alpha:]]{1}/[[:alpha:]]{1}$", input$loc.all)
- if(any(! 1:nLoc(x at gen[[1]]) %in% temp)){
+ if(any(! 1:nLoc(x at gen[[1]]) %in% temp)){ # if problem, store in @other
## input$loc.all <- gsub("[[:space:]]","", input$loc.all)
- warning("Miss-formed strings in loc.all (must be e.g. 'c/g') - ignoring this argument.")
+ warning("Miss-formed strings in loc.all (must be e.g. 'c/g') - storing this argument in @other.")
+ if(is.null(input$other)) {
+ input$other <- list(loc.all.misformed=input$loc.all)
+ } else {
+ input$other$loc.all.misformed <- input$loc.all
+ }
} else {
x at loc.all <- input$loc.all
}
@@ -346,11 +372,46 @@
}
+ ## HANDLE CHROMOSOME ##
+ if(!is.null(input$chromosome)){
+ if(length(input$chromosome) != x at n.loc) { # if wrong length, store in @other
+ warning("chromosome argument has inconsistent length - storing this argument in @other")
+ if(is.null(input$other)) {
+ input$other <- list(chromosome.wrong.length=input$chromosome)
+ } else {
+ input$other$chromosome.wrong.length <- input$chromosome
+ }
+ } else {
+ x at chromosome <- factor(input$chromosome)
+ }
+ }
+
+
+ ## HANDLE POSITION ##
+ if(!is.null(input$position)){
+ if(length(input$position) != x at n.loc) { # if wrong length, store in @other
+ warning("position argument has inconsistent length - storing this argument in @other")
+ if(is.null(input$other)) {
+ input$other <- list(position.wrong.length=input$position)
+ } else {
+ input$other$position.wrong.length <- input$position
+ }
+ } else {
+ x at position <- as.integer(input$position)
+ }
+ }
+
+
## HANDLE INPUT$POP ##
if(!is.null(input$pop)){
## check length consistency
if(length(input$pop) != nInd(x)){
warning("Inconsistent length for pop - ignoring this argument.")
+ if(is.null(input$other)) {
+ input$other <- list(pop.wrong.length=input$pop)
+ } else {
+ input$other$pop.wrong.length <- input$pop
+ }
} else {
x at pop <- factor(input$pop)
}
@@ -428,6 +489,14 @@
cat("\n @pop: individual membership for", length(levels(pop(object))), "populations")
}
+ if(!is.null(chr(object))){
+ cat("\n @chromosome: chromosome of the SNPs")
+ }
+
+ if(!is.null(position(object))){
+ cat("\n @position: position of the SNPs")
+ }
+
if(!is.null(other(object))){
cat("\n @other: ")
cat("a list containing: ")
@@ -561,6 +630,7 @@
## indNames
setMethod("indNames","genlight", function(x,...){
+ if(length(x at ind.names)==0) return(NULL)
return(x at ind.names)
})
@@ -579,6 +649,7 @@
## alleles
setMethod("alleles","genlight", function(x,...){
+ if(length(x at loc.all)==0) return(NULL)
return(x at loc.all)
})
@@ -596,6 +667,44 @@
})
+## chromosome
+setMethod("chromosome","genlight", function(x,...){
+ if(length(x at chromosome)==0) return(NULL)
+ return(x at chromosome)
+})
+
+
+setReplaceMethod("chromosome","genlight",function(x,value) {
+ if(is.null(value)){
+ slot(x, "chromosome", check=TRUE) <- value
+ return(x)
+ }
+ if(length(value) != nLoc(x)) stop("Vector length does no match number of loci")
+ slot(x,"chromosome",check=TRUE) <- factor(value)
+ return(x)
+})
+
+
+
+## position
+setMethod("position","genlight", function(x,...){
+ if(length(x at position)==0) return(NULL)
+ return(x at position)
+})
+
+
+setReplaceMethod("position","genlight",function(x,value) {
+ if(is.null(value)){
+ slot(x, "position", check=TRUE) <- value
+ return(x)
+ }
+ if(length(value) != nLoc(x)) stop("Vector length does no match number of loci")
+ slot(x,"position",check=TRUE) <- as.integer(value)
+ return(x)
+})
+
+
+
## NA.posi
setGeneric("NA.posi", function(x, ...) standardGeneric("NA.posi"))
More information about the adegenet-commits
mailing list