[adegenet-commits] r449 - in pkg: R man misc/bug-report.1.2-3.02
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 14 13:27:34 CEST 2009
Author: jombart
Date: 2009-10-14 13:27:33 +0200 (Wed, 14 Oct 2009)
New Revision: 449
Added:
pkg/misc/bug-report.1.2-3.02/.RData
pkg/misc/bug-report.1.2-3.02/.Rhistory
pkg/misc/bug-report.1.2-3.02/Example-modif.xls
pkg/misc/bug-report.1.2-3.02/FIXED
pkg/misc/bug-report.1.2-3.02/example.csv
Modified:
pkg/R/propShared.R
pkg/man/dist.genpop.Rd
pkg/man/propShared.Rd
pkg/misc/bug-report.1.2-3.02/code.R
Log:
Fixed bug 1.2-3.02; made a few corrections to the doc.
Modified: pkg/R/propShared.R
===================================================================
--- pkg/R/propShared.R 2009-10-14 10:32:14 UTC (rev 448)
+++ pkg/R/propShared.R 2009-10-14 11:27:33 UTC (rev 449)
@@ -22,17 +22,21 @@
## if ploidy = 1
if(x$ploidy == as.integer(1)){
- stop("not implemented for ploidy = 1")
+ ## stop("not implemented for ploidy = 1")
+ ## compute numbers of alleles used in each comparison
+ nAllByInd <- propTyped(x,"both")
+ nAll <- nAllByInd %*% t(nAllByInd)
+
## compute numbers of common alleles
- ## X <- x at tab
- ## X[is.na(X)] <- 0
- ## M <- X %*% t(X)
+ X <- x at tab
+ X[is.na(X)] <- 0
+ M <- X %*% t(X)
- ## compute numbers of alleles used in each comparison
- ## nAllByInd <- propTyped(x,by="ind") * nLoc(x)
- ## idx <- expand.grid(1:nrow(x$tab), 1:nrow(x$tab))
- ## temp <- cbind(nAllByInd[idx[,1]] , nAllByInd[idx[,2]])
- ## N <- matrix(apply(temp, 1, min), ncol=nrow(x$tab))
+ ## result
+ res <- M / nAll
+ res[is.nan(res)] <- NA # as 0/0 is NaN (when no common locus typed)
+ colnames(res) <- rownames(res) <- x$ind.names
+ return(res)
}
## if ploidy = 2
Modified: pkg/man/dist.genpop.Rd
===================================================================
--- pkg/man/dist.genpop.Rd 2009-10-14 10:32:14 UTC (rev 448)
+++ pkg/man/dist.genpop.Rd 2009-10-14 11:27:33 UTC (rev 449)
@@ -9,7 +9,7 @@
(see details).\cr
A non-euclidian distance can be transformed into an Euclidian one
- using \code{\link[pkg:ade4]{quasieuclid}} in order to perform a
+ using \code{\link[pkg:ade4]{cailliez}} in order to perform a
Principal Coordinate Analysis \code{\link[pkg:ade4]{dudi.pco}} (both
functions in \code{ade4}). \cr
@@ -102,14 +102,14 @@
Former dist.genet code by Daniel Chessel \email{chessel at biomserv.univ-lyon1.fr}\cr
and documentation by Anne B. Dufour \email{dufour at biomserv.univ-lyon1.fr}
}
-\seealso{ \code{\link[pkg:ade4]{quasieuclid}},\code{\link[pkg:ade4]{dudi.pco}}
+\seealso{ \code{\link[pkg:ade4]{cailliez}},\code{\link[pkg:ade4]{dudi.pco}}
}
\examples{
if(require(ade4)){
data(microsatt)
obj <- as.genpop(microsatt$tab)
-listDist <- lapply(1:5, function(i) quasieuclid(dist.genpop(obj,met=i)))
+listDist <- lapply(1:5, function(i) cailliez(dist.genpop(obj,met=i)))
for(i in 1:5) {attr(listDist[[i]],"Labels") <- obj at pop.names}
listPco <- lapply(listDist, dudi.pco,scannf=FALSE)
Modified: pkg/man/propShared.Rd
===================================================================
--- pkg/man/propShared.Rd 2009-10-14 10:32:14 UTC (rev 448)
+++ pkg/man/propShared.Rd 2009-10-14 11:27:33 UTC (rev 449)
@@ -13,7 +13,8 @@
\item{obj}{a \linkS4class{genind} object.}
}
\details{
- Computations of the proportion of shared alleles are computed in C.
+ Computations of the proportion of shared alleles are computed in C
+ for diploid individuals, and in efficient R code for haploid genotypes.
Proportions are computed from all available data, i.e. proportion can
be computed as far as there is at least one typed locus in common
between two genotypes.
@@ -32,13 +33,13 @@
genind2df(obj,sep="|")
## Use this similarity measure inside a PCoA
-## This is for illustration only:
+## ! This is for illustration only !
## the distance should be rendered Euclidean before
-## (e.g. using quasieuclid from package ade4).
+## (e.g. using cailliez from package ade4).
if(require(ade4)){
matSimil <- propShared(microbov)
matDist <- exp(-matSimil)
-D <- as.dist(matDist)
+D <- cailliez(as.dist(matDist))
pcoa1 <- dudi.pco(D,scannf=FALSE,nf=3)
s.class(pcoa1$li,microbov$pop,lab=microbov$pop.names)
}
Added: pkg/misc/bug-report.1.2-3.02/.RData
===================================================================
(Binary files differ)
Property changes on: pkg/misc/bug-report.1.2-3.02/.RData
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: pkg/misc/bug-report.1.2-3.02/.Rhistory
===================================================================
--- pkg/misc/bug-report.1.2-3.02/.Rhistory (rev 0)
+++ pkg/misc/bug-report.1.2-3.02/.Rhistory 2009-10-14 11:27:33 UTC (rev 449)
@@ -0,0 +1,229 @@
+mat1
+lapply(mat1, factor)
+data.frame(lapply(mat1, factor))
+as.integer(data.frame(lapply(mat1, factor)))
+data.frame(lapply(mat1, function(c) as.integer(factor(e))))
+data.frame(lapply(mat1, function(c) as.integer(factor(c))))
+matAll <- cbind(mat1,mat2)
+ matAll <- apply(matAll,1:2,as.integer)
+
+matAll <- cbind(mat1,mat2)
+
+matAll
+mat1
+mat1 <- as.data.frame(mat1)
+ mat2 <- as.data.frame(mat2)
+ mat1 <- data.frame(lapply(mat1, function(c) as.integer(factor(c))))
+ mat2 <- data.frame(lapply(mat2, function(c) as.integer(factor(c))))
+
+ matAll <- cbind(mat1,mat2)
+
+matAll
+class(matAll)
+as.matrix(matAll)
+x
+temp
+mat1
+factor(1:2, levels=(1:3)
+)
+alleleSize
+factor(c(1,3), levels=(1:3))
+factor(c('a','b'), levels=(c('a','b','x')))
+as.integer(factor(c('a','b'), levels=(c('a','b','x'))))
+factor(c('a','b'), levels=(c('a','b','x')))L
+as.integer(factor(c('a','b'), levels=(c('a','b','x'))))
+as.integer(factor(c('x','a','b'), levels=(c('a','b','x'))))
+x
+x$all.names
+x$all.names
+lapply(x$all.names, function(v) 1:length(v))
+ x at all.names <- lapply(x at all.names, function(v) 1:length(v))
+
+ temp <- genind2df(x,usepop=FALSE)
+ alleleSize <- max(apply(temp,1:2,nchar))/2
+ mat1 <- apply(temp, 1:2, substr, 1, alleleSize)
+ mat2 <- apply(temp, 1:2, substr, alleleSize+1, alleleSize*2)
+
+ matAll <- cbind(mat1,mat2)
+ matAll <- apply(matAll,1:2,as.integer)
+ matAll[is.na(matAll)] <- 0
+
+matAll
+res
+matAll
+df
+q) <-
+q()
+n
+read.csv("example.csv")
+dat <- read.csv("example.csv")
+rownames(dat) <- dat[,1]
+dat
+dat <- dat[,-1]
+dat <- dat[,-1]
+dat
+x <- df2genind(dat, sep="+")
+x <- df2genind(dat, sep="\+")
+x <- df2genind(dat, sep="\\+")
+x
+genind2df(x, sep="+")
+x
+dat
+propShared(x)
+y <- df2genind(dat)
+y <- df2genind(dat)
+install.packages("adegenet")
+propShared(x)
+rm(propShared )
+detach("package:adegenet")
+library(adegenet)
+propShared(x)
+x
+propShared(x)
+q()
+y
+propShared(x)
+x
+x at all.names <- lapply(x at all.names, function(v) 1:length(v))
+
+x
+ invisible(validObject(x))
+
+ checkType(x)
+
+x <- data.frame()
+read.table("/home/master/dev/adegenet/www/files/haplo.txt")
+x <- read.table("/home/master/dev/adegenet/www/files/haplo.txt")
+x <- df2genind(xm ploidy=1)
+x <- df2genind(x, ploidy=1)
+x
+genind2df(x)
+genind2df(x,sep="/")
+x$tab
+ x at all.names <- lapply(x at all.names, function(v) 1:length(v))
+
+x$all.names
+ nAllByInd <- propTyped(x,by="ind") * nLoc(x)
+
+nAllByInd
+x
+df <- read.table("/home/master/dev/adegenet/www/files/haplo.txt")
+dfdf <-
+df
+df
+nAllByInd
+?propTyped
+propTyped(x)
+propTyped(x,"both")
+ nAllByInd <- propTyped(x,"both")
+
+nAllByInd
+nAllByInd %*% t(nAllByInd)
+nAll <- nAllByInd %*% t(nAllByInd)
+X <- x at tab
+ X[is.na(X)] <- 0
+ M <- X %*% t(X)
+
+M
+nAll
+X / nAll
+dim(X)
+dim(nAll)
+M
+M / nAll
+ res <- M / nAll
+
+res
+class(res)
+colnames(X)
+colnames(res)
+rownames(res)
+ colnames(res) <- rownames(res) <- obj$ind.names
+
+ colnames(res) <- rownames(res) <- x$ind.names
+
+res
+df
+nAll
+1/0
+0/0
+is.na(0/0)
+is.nan(0/0)
+is.nan(NA)
+is.nan(NA)
+propShared <- function(obj){
+ x <- obj
+
+ ## convert alleles to integers (alleles may be characters)
+ x at all.names <- lapply(x at all.names, function(v) 1:length(v))
+
+ ## check that this is a valid genind
+ if(!inherits(x,"genind")) stop("obj must be a genind object.")
+ invisible(validObject(x))
+
+ ## check ploidy level
+ if(x$ploidy > 2) stop("not implemented for ploidy > 2")
+ checkType(x)
+
+
+ ## if ploidy = 1
+ if(x$ploidy == as.integer(1)){
+ ## stop("not implemented for ploidy = 1")
+ ## compute numbers of alleles used in each comparison
+ nAllByInd <- propTyped(x,"both")
+ nAll <- nAllByInd %*% t(nAllByInd)
+
+ ## compute numbers of common alleles
+ X <- x at tab
+ X[is.na(X)] <- 0
+ M <- X %*% t(X)
+
+ ## result
+ res <- M / nAll
+ res[is.nan(res)] <- NA # as 0/0 is NaN (when no common locus typed)
+ colnames(res) <- rownames(res) <- x$ind.names
+ return(res)
+ }
+
+ ## if ploidy = 2
+ if(x$ploidy == as.integer(2)){
+ ## build a matrix of genotypes (in rows) coded by integers
+ ## NAs are coded by 0
+ ## The matrix is a cbind of two matrices, storing respectively the
+ ## first and the second allele.
+ temp <- genind2df(x,usepop=FALSE)
+ alleleSize <- max(apply(temp,1:2,nchar))/2
+ mat1 <- apply(temp, 1:2, substr, 1, alleleSize)
+ mat2 <- apply(temp, 1:2, substr, alleleSize+1, alleleSize*2)
+
+ matAll <- cbind(mat1,mat2)
+ matAll <- apply(matAll,1:2,as.integer)
+ matAll[is.na(matAll)] <- 0
+
+ n <- nrow(matAll)
+ resVec <- double(n*(n-1)/2)
+ res <- .C("sharedAll", as.integer(as.matrix(matAll)),
+ n, ncol(matAll), resVec, PACKAGE="adegenet")[[4]]
+
+ attr(res,"Size") <- n
+ attr(res,"Diag") <- FALSE
+ attr(res,"Upper") <- FALSE
+ class(res) <- "dist"
+ res <- as.matrix(res)
+ } # end if ploidy = 2
+
+ diag(res) <- 1
+ rownames(res) <- x at ind.names
+ colnames(res) <- x at ind.names
+ return(res)
+}
+
+
+propShared(x)
+x
+?quasieuclid
+?lingoes
+?caillez
+?cailliez
+q()
+n
Added: pkg/misc/bug-report.1.2-3.02/Example-modif.xls
===================================================================
(Binary files differ)
Property changes on: pkg/misc/bug-report.1.2-3.02/Example-modif.xls
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: pkg/misc/bug-report.1.2-3.02/FIXED
===================================================================
--- pkg/misc/bug-report.1.2-3.02/FIXED (rev 0)
+++ pkg/misc/bug-report.1.2-3.02/FIXED 2009-10-14 11:27:33 UTC (rev 449)
@@ -0,0 +1 @@
+This bug has been fixed.
\ No newline at end of file
Modified: pkg/misc/bug-report.1.2-3.02/code.R
===================================================================
--- pkg/misc/bug-report.1.2-3.02/code.R 2009-10-14 10:32:14 UTC (rev 448)
+++ pkg/misc/bug-report.1.2-3.02/code.R 2009-10-14 11:27:33 UTC (rev 449)
@@ -18,3 +18,8 @@
## PROBLEM 2:...
+dat <- read.csv("example.csv")
+rownames(dat) <- dat[,1]
+dat <- dat[,-1]
+x <- df2genind(dat, sep="\\+")
+propShared(x)
Added: pkg/misc/bug-report.1.2-3.02/example.csv
===================================================================
--- pkg/misc/bug-report.1.2-3.02/example.csv (rev 0)
+++ pkg/misc/bug-report.1.2-3.02/example.csv 2009-10-14 11:27:33 UTC (rev 449)
@@ -0,0 +1,8 @@
+"Ind","m1","m2","m3","m4","m5","m6","m7","m8","m9","m10","m11","m12","m13","m14","m15","m16","m17","m18","m19","m20","m21","m22","m23","m24","m25","m26","m27","m28","m29","m30","m31","m32","m33","m34","m35","m36","m37","m38","m39","m40","m41","m42","m43","m44","m45","m46","m47","m48","m49","m50","m51","m52","m53","m54","m55","m56","m57","m58","m59","m60","m61","m62","m63","m64","m65","m66","m67","m68","m69","m70","m71","m72","m73","m74","m75","m76","m77","m78","m79","m80","m81","m82","m83","m84","m85","m86","m87"
+1,"393+393","277+277","204+204","247+247","85+85","244+244","371+371","94+94","171+171","191+191","435+435","134+134","107+107","172+172","118+118","105+105","116+116","350+350","175+175","231+231","108+108","294+294","271+271","395+395","NA","170+170","143+143","93+93","360+360","133+133","214+214","348+348","222+222","168+168","120+120","236+236","191+191","254+254","383+383","242+242","836+836","140+140","95+95","327+327","91+91","120+120","177+177","299+299","203+203","166+166","252+252","234+234","313+313","351+351","275+275","110+110","N+N","168+168","440+440","435+435","N+N","126+126","344+344","95+95","136+136","411+411","286+286","337+337","149+149","252+252","443+443","200+200","210+210","80+80","420+420","276+276","152+152","132+132","151+151","214+214","353+353","89+89","255+255","99+99","174+174","141+141","156+156"
+2,"393+393","NA","204+204","247+247","88+88","244+244","371+371","97+97","171+171","191+191","435+435","130+130","104+104","175+175","118+118","105+105","147+147","309+309","193+193","229+229","118+118","294+294","271+271","395+395","218+218","170+170","143+143","102+102","357+357","123+123","212+212","348+348","224+224","168+168","120+120","NA","191+191","254+254","383+383","242+242","836+836","132+132","95+95","327+327","101+101","114+114","177+177","329+329","203+203","166+166","252+252","234+234","313+313","351+351","NA","110+110","N+N","168+168","424+424","460+460","N+N","126+126","344+344","95+95","136+136","404+404","283+283","337+337","149+149","252+252","443+443","200+200","210+210","80+80","291+291","294+294","152+152","132+132","145+145","214+214","353+353","89+89","248+248","99+99","174+174","141+141","156+156"
+3,"393+393","277+277","204+204","247+247","85+85","244+244","371+371","94+94","171+171","191+191","435+435","130+130","104+104","172+172","118+118","105+105","116+116","309+309","182+182","229+229","118+118","294+294","271+271","395+395","218+218","170+170","143+143","102+102","357+357","123+123","212+212","348+348","222+222","168+168","120+120","234+234","191+191","254+254","383+383","242+242","836+836","140+140","95+95","327+327","101+101","120+120","177+177","329+329","203+203","166+166","252+252","234+234","313+313","351+351","275+275","107+107","N+N","168+168","424+424","460+460","N+N","124+124","347+347","95+95","136+136","411+411","286+286","337+337","149+149","252+252","443+443","200+200","210+210","80+80","291+291","292+292","152+152","132+132","151+151","214+214","353+353","89+89","255+255","99+99","174+174","141+141","156+156"
+4,"393+393","277+277","204+204","247+247","85+85","244+244","371+371","94+94","171+171","191+191","435+435","134+134","107+107","172+172","118+118","105+105","116+116","350+350","175+175","231+231","108+108","294+294","271+271","395+395","218+218","170+170","143+143","93+93","357+357","133+133","214+214","348+348","222+222","168+168","120+120","234+234","191+191","254+254","383+383","242+242","836+836","140+140","95+95","327+327","91+91","120+120","177+177","299+299","203+203","166+166","252+252","234+234","313+313","351+351","275+275","110+110","N+N","168+168","440+440","460+460","P+P","124+124","344+344","95+95","136+136","411+411","286+286","337+337","149+149","252+252","443+443","200+200","210+210","80+80","420+420","276+276","152+152","132+132","151+151","214+214","353+353","89+89","255+255","99+99","174+174","141+141","156+156"
+5,"393+393","277+277","204+204","247+247","88+88","244+244","371+371","97+97","171+171","191+191","435+435","130+130","104+104","175+175","118+118","105+105","147+147","353+353","193+193","229+229","118+118","294+294","271+271","395+395","218+218","170+170","143+143","102+102","357+357","123+123","212+212","348+348","224+224","168+168","120+120","234+234","191+191","254+254","383+383","242+242","836+836","132+132","95+95","327+327","101+101","116+116","177+177","329+329","203+203","166+166","252+252","234+234","313+313","351+351","272+272","110+110","N+N","168+168","440+440","460+460","P+P","126+126","344+344","95+95","136+136","404+404","283+283","337+337","149+149","252+252","443+443","200+200","210+210","80+80","291+291","294+294","152+152","132+132","145+145","214+214","353+353","89+89","248+248","99+99","174+174","141+141","156+156"
+6,"393+393","NA","204+204","247+247","85+85","244+244","371+371","94+94","171+171","191+191","489+489","134+134","104+104","172+172","118+118","105+105","145+145","309+309","182+182","229+229","118+118","294+294","271+271","395+395","218+218","170+170","143+143","102+102","357+357","123+123","214+214","348+348","222+222","168+168","120+120","234+234","191+191","254+254","383+383","242+242","836+836","140+140","95+95","327+327","101+101","120+120","177+177","329+329","203+203","166+166","252+252","234+234","313+313","351+351","272+272","110+110","N+N","164+164","440+440","460+460","P+P","124+124","347+347","95+95","136+136","411+411","286+286","337+337","149+149","252+252","443+443","200+200","210+210","80+80","291+291","294+294","152+152","132+132","151+151","214+214","353+353","89+89","255+255","99+99","174+174","141+141","156+156"
+7,"393+393","NA","204+204","247+247","85+85","NA","371+371","94+94","171+171","191+191","435+435","130+130","107+107","172+172","118+118","105+105","116+116","309+309","182+182","231+231","108+108","294+294","271+271","360+360","NA","170+170","143+143","102+102","357+357","123+123","214+214","345+345","222+222","168+168","120+120","234+234","191+191","254+254","383+383","242+242","836+836","140+140","95+95","320+320","101+101","120+120","192+192","299+299","203+203","166+166","252+252","234+234","313+313","351+351","272+272","110+110","N+N","164+164","440+440","460+460","P+P","126+126","347+347","95+95","136+136","411+411","286+286","337+337","149+149","263+263","443+443","200+200","210+210","80+80","291+291","292+292","152+152","132+132","151+151","210+210","353+353","89+89","255+255","99+99","174+174","141+141","156+156"
More information about the adegenet-commits
mailing list