[adegenet-commits] r453 - in pkg: . R man misc misc/bug-report.1.2-3.03
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 15 12:49:39 CEST 2009
Author: jombart
Date: 2009-10-15 12:49:38 +0200 (Thu, 15 Oct 2009)
New Revision: 453
Added:
pkg/misc/bug-report.1.2-3.03/
pkg/misc/bug-report.1.2-3.03/FIXED
pkg/misc/bug-report.1.2-3.03/code.R
Modified:
pkg/R/export.R
pkg/R/makefreq.R
pkg/R/zzz.R
pkg/TODO
pkg/man/df2genind.Rd
Log:
Fixed all bugs for the next version.
Modified: pkg/R/export.R
===================================================================
--- pkg/R/export.R 2009-10-14 13:06:39 UTC (rev 452)
+++ pkg/R/export.R 2009-10-15 10:49:38 UTC (rev 453)
@@ -125,7 +125,7 @@
#####################
# Function genind2df
#####################
-genind2df <- function(x, pop=NULL, sep="", usepop=TRUE){
+genind2df <- function(x, pop=NULL, sep="", usepop=TRUE, oneColPerAll=FALSE){
if(!is.genind(x)) stop("x is not a valid genind object")
## checkType(x)
@@ -135,6 +135,10 @@
levels(pop) <- x at pop.names
}
+ if(oneColPerAll){
+ sep <- "/"
+ }
+
## PA case ##
if(x at type=="PA"){
temp <- truenames(x)
@@ -148,7 +152,7 @@
}
}
- return(res)
+ return(res) # exit here
}
## codom case ##
@@ -169,10 +173,30 @@
kGen <- lapply(1:length(kX), function(i) apply(kX[[i]],1,recod,x at all.names[[i]]))
names(kGen) <- x at loc.names
+ ## if use one column per allele
+ if(oneColPerAll){
+ f1 <- function(vec){ # to repeat NA with seperators
+ vec[is.na(vec)] <- paste(rep("NA",x at ploidy), collapse=sep)
+ return(vec)
+ }
+ temp <- lapply(kGen, f1)
+ temp <- lapply(temp, strsplit,sep)
+
+ res <- lapply(temp, function(e) matrix(unlist(e), ncol=x at ploidy, byrow=TRUE))
+ res <- data.frame(res,stringsAsFactors=FALSE)
+ names(res) <- paste(rep(locNames(x),each=x at ploidy), 1:x at ploidy, sep=".")
+
+ ## handle pop here
+ if(!is.null(pop) & usepop) res <- cbind.data.frame(pop,res,stringsAsFactors=FALSE)
+
+ return(res) # exit here
+ } # end if oneColPerAll
+
+ ## build the final data.frame
res <- cbind.data.frame(kGen,stringsAsFactors=FALSE)
## handle pop here
- if(!is.null(pop) & usepop) res <- cbind.data.frame(pop,res)
+ if(!is.null(pop) & usepop) res <- cbind.data.frame(pop,res,stringsAsFactors=FALSE)
return(res)
}
Modified: pkg/R/makefreq.R
===================================================================
--- pkg/R/makefreq.R 2009-10-14 13:06:39 UTC (rev 452)
+++ pkg/R/makefreq.R 2009-10-15 10:49:38 UTC (rev 453)
@@ -19,6 +19,9 @@
tabcount <- x at tab
eff.pop <- t(apply(tabcount,1,function(r) tapply(r,x at loc.fac,sum,na.rm=TRUE)))
+ if(nLoc(x)==1){ # fix for nloc==1
+ eff.pop <- t(eff.pop)
+ }
# tabfreq is a pop x loci table of allelic frequencies
tabfreq <- t(apply(tabcount,1,function(r) unlist(tapply(r,x at loc.fac,f1))))
Modified: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R 2009-10-14 13:06:39 UTC (rev 452)
+++ pkg/R/zzz.R 2009-10-15 10:49:38 UTC (rev 453)
@@ -1,12 +1,9 @@
.First.lib <- function (lib, pkg){
#.initAdegenetClasses()
#.initAdegenetUtils()
- library.dynam("adegenet", pkg, lib)
- cat(" ==========================\n")
- cat(" adegenet 1.2-3 is loaded \n")
- cat(" ==========================\n\n")
+ library.dynam("adegenet", pkg, lib)
+ startup.txt <- " ==========================\n adegenet 1.2-3 is loaded\n ==========================\n\n - to start, type '?adegenet'\n - to browse adegenet website, type 'adegenetWeb()'\n - to post questions/comments: adegenet-forum at lists.r-forge.r-project.org\n\n"
- cat(" - to start, type '?adegenet'\n")
- cat(" - to browse adegenet website, type 'adegenetWeb()'\n")
- cat(" - to post questions/comments: adegenet-forum at lists.r-forge.r-project.org\n\n")
+ packageStartupMessage(startup.txt)
+
}
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2009-10-14 13:06:39 UTC (rev 452)
+++ pkg/TODO 2009-10-15 10:49:38 UTC (rev 453)
@@ -30,10 +30,10 @@
# CODE ISSUES:
==============
* 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) -- 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) -- done.
+o use packageStartupMessage() instead of cat in .First.lib -- done
+o bug: makefreq does not work after a seploc (bug 1.2-3.03) -- done
+o 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.
+o fix bug 1.2-3.02 (propShared issue) -- done.
# DOCUMENTATION ISSUES:
@@ -44,7 +44,7 @@
# NEW IMPLEMENTATIONS:
=====================
-* allow genind2df to export alleles on separate columns
+o allow genind2df to export alleles on separate columns -- done
# TESTING:
Modified: pkg/man/df2genind.Rd
===================================================================
--- pkg/man/df2genind.Rd 2009-10-14 13:06:39 UTC (rev 452)
+++ pkg/man/df2genind.Rd 2009-10-15 10:49:38 UTC (rev 453)
@@ -15,17 +15,15 @@
(\code{ncode} argument). Uncomplete strings are filled with "0" at the
begining. \cr
- Whenever provided, marker names should not include any dot ('.'), as
- everything after a dot is removed when parsing marker names.\cr
-
-
The function \code{genind2df} converts a \linkS4class{genind} back to
- such a data.frame.
+ such a data.frame. Alleles of a given locus can be coded as a single
+ character string (with specified separators), or provided on different
+ columns (see \code{oneColPerAll} argument).
}
\usage{
df2genind(X, sep=NULL, ncode=NULL, ind.names=NULL, loc.names=NULL,
pop=NULL, missing=NA, ploidy=2, type=c("codom","PA"))
-genind2df(x,pop=NULL, sep="", usepop=TRUE)
+genind2df(x,pop=NULL, sep="", usepop=TRUE, oneColPerAll=FALSE)
}
\arguments{
\item{X}{a matrix or a data.frame (see decription)}
@@ -44,7 +42,10 @@
allozymes); 'PA' stands for 'presence/absence' markers (e.g. AFLP, RAPD).}
\item{x}{a \linkS4class{genind} object}
\item{usepop}{a logical stating whether the population (argument \code{pop}
- or \code{x at pop} should be used (TRUE, default) or not (FALSE).}
+ or \code{x at pop} should be used (TRUE, default) or not (FALSE)).}
+ \item{oneColPerAll}{a logical stating whether alleles of one locus should be
+ provided on separate columns (TRUE) rather than as a single character
+ string (FALSE, default).}
}
\details{=== There are 3 treatments for missing values === \cr
@@ -68,14 +69,19 @@
\code{\link{read.fstat}}, \code{\link{read.structure}}}
\author{Thibaut Jombart \email{t.jombart at imperial.ac.uk} }
\examples{
-df <- data.frame(loc1=c("11","11","12","32"),
-loc2=c(NA,"34","55","15"),loc3=c("22","22","21","22"))
-row.names(df) <- .genlab("geontype",4)
+## simple example
+df <- data.frame(locusA=c("11","11","12","32"),
+locusB=c(NA,"34","55","15"),locusC=c("22","22","21","22"))
+row.names(df) <- .genlab("genotype",4)
df
-obj <- df2genind(df)
+obj <- df2genind(df, ploidy=2)
obj
truenames(obj)
+
+## converting a genind as data.frame
genind2df(obj)
+genind2df(obj, sep="/")
+genind2df(obj, oneColPerAll=TRUE)
}
\keyword{manip}
Added: pkg/misc/bug-report.1.2-3.03/FIXED
===================================================================
--- pkg/misc/bug-report.1.2-3.03/FIXED (rev 0)
+++ pkg/misc/bug-report.1.2-3.03/FIXED 2009-10-15 10:49:38 UTC (rev 453)
@@ -0,0 +1 @@
+This bug has been fixed.
\ No newline at end of file
Added: pkg/misc/bug-report.1.2-3.03/code.R
===================================================================
--- pkg/misc/bug-report.1.2-3.03/code.R (rev 0)
+++ pkg/misc/bug-report.1.2-3.03/code.R 2009-10-15 10:49:38 UTC (rev 453)
@@ -0,0 +1,6 @@
+##
+## makefreq doesn't work after seploc
+##
+data(nancycats)
+x <- seploc(genind2genpop(nancycats))$fca37
+makefreq(x)
More information about the adegenet-commits
mailing list