[adegenet-commits] r447 - in pkg: . R misc/bug-report.1.2-3.01
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 14 11:51:58 CEST 2009
Author: jombart
Date: 2009-10-14 11:51:58 +0200 (Wed, 14 Oct 2009)
New Revision: 447
Added:
pkg/misc/bug-report.1.2-3.01/.RData
pkg/misc/bug-report.1.2-3.01/.Rhistory
pkg/misc/bug-report.1.2-3.01/FIXED
Modified:
pkg/R/classes.R
pkg/TODO
pkg/misc/bug-report.1.2-3.01/df2genindbug.R
Log:
Fixed bug 1.2-3.01
Modified: pkg/R/classes.R
===================================================================
--- pkg/R/classes.R 2009-10-14 09:08:44 UTC (rev 446)
+++ pkg/R/classes.R 2009-10-14 09:51:58 UTC (rev 447)
@@ -274,7 +274,8 @@
## loc names is not type-dependent
temp <- colnames(X)
- temp <- gsub("[.].*$","",temp)
+ ## temp <- gsub("[.].*$","",temp)
+ temp <- gsub("[.][^.]*$", "", temp)
temp <- .rmspaces(temp)
loc.names <- unique(temp)
nloc <- length(loc.names)
@@ -385,7 +386,8 @@
## loc names is not type-dependent
temp <- colnames(X)
- temp <- gsub("[.].*$","",temp)
+ ## temp <- gsub("[.].*$","",temp)
+ temp <- gsub("[.][^.]*$", "", temp)
temp <- .rmspaces(temp)
loc.names <- unique(temp)
nloc <- length(loc.names)
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2009-10-14 09:08:44 UTC (rev 446)
+++ pkg/TODO 2009-10-14 09:51:58 UTC (rev 447)
@@ -32,7 +32,8 @@
* fix request 1.2-2.04 (implement adjusted heretozygosity in summary)
* use packageStartupMessage() instead of cat in .First.lib
* bug: makefreq does not work after a seploc
-* fix bug 1.2-3.01 (df2genind issue)
+* fix bug 1.2-3.01 (df2genind issue) -- done: was not actually a bug, but the "." used in loc names; no longer a pb now.
+* fix bug 1.2-3.02 (propShared issue)
# DOCUMENTATION ISSUES:
Added: pkg/misc/bug-report.1.2-3.01/.RData
===================================================================
(Binary files differ)
Property changes on: pkg/misc/bug-report.1.2-3.01/.RData
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: pkg/misc/bug-report.1.2-3.01/.Rhistory
===================================================================
--- pkg/misc/bug-report.1.2-3.01/.Rhistory (rev 0)
+++ pkg/misc/bug-report.1.2-3.01/.Rhistory 2009-10-14 09:51:58 UTC (rev 447)
@@ -0,0 +1,158 @@
+df
+X
+colnames(X)
+colnames(X) <- NULL
+X
+genind2df(X)
+df2genind(X)
+Q
+undebug(df2genind)
+df2genind(X)
+df2genind(X,sep="/")
+df2genind(X,sep="/")$loc.names
+colnames(X)
+colnames(X) <- c('a','b','c')
+df2genind(X,sep="/")$loc.names
+toto <- df2genind(X,sep="/")
+toto
+geind2df(toto)
+genind2df(toto)
+genind2df(toto,sep="/")
+X
+df=matrix(c('a/b','a/a','a/b','x/x','NA','x/y'),nrow=2)
+colnames(df)=paste("locus",1:3,sep=".")
+rownames(df)=1:2
+df # looks ok
+
+df
+colnames(df)
+grep("[.][^.]*[.]",colnames(df))
+grep("[.][^.]*[.]", "toto")
+grep("[.][^.]*[.]", "toto..")
+grep("[.][^.]*[.]", "toto.1.2")
+gsub("[.][^.]*$", "", "toto.1.2")
+gsub("[.][^.]*$", "", "toto.1..a.s.as.2")
+gsub("[.][^.]*$", "", "toto.1")
+transX
+gsub("[.][^.]*$", "", colnames(transX))
+gsub("^.*[.]","",colnames(transX))
+transX
+genind <- function(tab,pop=NULL,prevcall=NULL,ploidy=2,type=c("codom","PA")){
+ ## handle arguments
+ X <- as.matrix(tab)
+ if(is.null(colnames(X))) stop("tab columns have no name.")
+ if(is.null(rownames(X))) {rownames(X) <- 1:nrow(X)}
+
+ type <- match.arg(type)
+ ploidy <- as.integer(ploidy)
+ nind <- nrow(X)
+
+
+ ## HANDLE LABELS ##
+
+ ## loc names is not type-dependent
+ temp <- colnames(X)
+ ## temp <- gsub("[.].*$","",temp)
+ temp <- gsub("[.][^.]*$", "", temp)
+ temp <- .rmspaces(temp)
+ loc.names <- unique(temp)
+ nloc <- length(loc.names)
+ loc.codes <- .genlab("L",nloc)
+ names(loc.names) <- loc.codes
+
+ ## ind names is not type-dependent either
+ ind.codes <- .genlab("", nind)
+ ind.names <- .rmspaces(rownames(X))
+ names(ind.names) <- ind.codes
+ rownames(X) <- ind.codes
+
+
+ if(type=="codom"){
+ ## loc.nall
+ loc.nall <- table(temp)[match(loc.names,names(table(temp)))]
+ loc.nall <- as.integer(loc.nall)
+ names(loc.nall) <- loc.codes
+
+ ## loc.fac
+ loc.fac <- rep(loc.codes,loc.nall)
+
+ ## alleles name
+ temp <- colnames(X)
+ temp <- gsub("^.*[.]","",temp)
+ temp <- .rmspaces(temp)
+ all.names <- split(temp,loc.fac)
+ all.codes <- lapply(all.names,function(e) .genlab("",length(e)))
+ for(i in 1:length(all.names)){
+ names(all.names[[i]]) <- all.codes[[i]]
+ }
+
+ colnames(X) <- paste(loc.fac,unlist(all.codes),sep=".")
+ loc.fac <- as.factor(loc.fac)
+ } else { # end if type=="codom" <=> if type=="PA"
+ colnames(X) <- loc.codes
+ loc.fac <- NULL
+ all.names <- NULL
+ loc.nall <- NULL
+ }
+
+ ## Ideally I should use an 'initialize' method here
+ res <- new("genind")
+ res at tab <- X
+ res at ind.names <- ind.names
+ res at loc.names <- loc.names
+ res at loc.nall <- loc.nall
+ res at loc.fac <- loc.fac
+ res at all.names <- all.names
+
+ ## populations name (optional)
+ ## beware, keep levels of pop sorted in
+ ## there order of appearance
+ if(!is.null(pop)) {
+ # convert pop to a factor if it is not
+ if(!is.factor(pop)) {pop <- factor(pop)}
+ pop.lab <- .genlab("P",length(levels(pop)) )
+ # put pop levels in appearance order
+ pop <- as.character(pop)
+ pop <- factor(pop, levels=unique(pop))
+ temp <- pop
+ # now levels are correctly ordered
+ levels(pop) <- pop.lab
+ res at pop <- pop
+ pop.names <- as.character(levels(temp))
+ names(pop.names) <- as.character(levels(res at pop))
+ res at pop.names <- pop.names
+ }
+
+ ## ploidy
+ plo <- as.integer(ploidy)
+ if(plo < as.integer(1)) stop("ploidy inferior to 1")
+ res at ploidy <- plo
+
+ ## type of marker
+ res at type <- as.character(type)
+
+ if(is.null(prevcall)) {prevcall <- match.call()}
+ res at call <- prevcall
+
+ return(res)
+
+} # end genind
+
+genind(transX)
+genind(transX)$loc.names
+genind2df(genind(transX))
+Q()
+q()
+n
+df=matrix(c('a/b','a/a','a/b','x/x','NA','x/y'),nrow=2)
+colnames(df)=paste("locus",1:3,sep=".")
+rownames(df)=1:2
+df # looks ok
+
+toto=df2genind(df, sep="/", ploidy=2)
+toto
+toto at tab # only one locus !?!
+
+genind2df(toto,sep="/")
+q()
+y
Added: pkg/misc/bug-report.1.2-3.01/FIXED
===================================================================
--- pkg/misc/bug-report.1.2-3.01/FIXED (rev 0)
+++ pkg/misc/bug-report.1.2-3.01/FIXED 2009-10-14 09:51:58 UTC (rev 447)
@@ -0,0 +1 @@
+This bug has been fixed.
\ No newline at end of file
Modified: pkg/misc/bug-report.1.2-3.01/df2genindbug.R
===================================================================
--- pkg/misc/bug-report.1.2-3.01/df2genindbug.R 2009-10-14 09:08:44 UTC (rev 446)
+++ pkg/misc/bug-report.1.2-3.01/df2genindbug.R 2009-10-14 09:51:58 UTC (rev 447)
@@ -6,7 +6,4 @@
toto=df2genind(df, sep="/", ploidy=2)
toto
toto at tab # only one locus !?!
-
-
-## and then this is wrong too:
-propShared(toto)
+genind2df(toto,sep="/")
More information about the adegenet-commits
mailing list