From noreply at r-forge.r-project.org Tue Jun 4 12:14:25 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 4 Jun 2013 12:14:25 +0200 (CEST)
Subject: [adegenet-commits] r1137 - pkg/R
Message-ID: <20130604101425.AE8F0180491@r-forge.r-project.org>
Author: jombart
Date: 2013-06-04 12:14:25 +0200 (Tue, 04 Jun 2013)
New Revision: 1137
Modified:
pkg/R/dapc.R
Log:
added warning to xvalDapc
Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R 2013-05-28 19:58:19 UTC (rev 1136)
+++ pkg/R/dapc.R 2013-06-04 10:14:25 UTC (rev 1137)
@@ -88,8 +88,8 @@
n.da <- as.integer(readLines(n = 1))
}
- n.da <- min(n.da, length(levels(grp))-1, n.pca) # can't be more than K-1 disc. func., or more than n.pca
- n.da <- round(n.da)
+ ##n.da <- min(n.da, length(levels(grp))-1, n.pca) # can't be more than K-1 disc. func., or more than n.pca
+ n.da <- round(min(n.da, lda.dim)) # can't be more than K-1 disc. func., or more than n.pca
predX <- predict(ldaX, dimen=n.da)
@@ -1020,9 +1020,11 @@
## FUNCTION GETTING THE % OF ACCURATE PREDICTION FOR ONE NUMBER OF PCA PCs ##
## n.pca is a number of retained PCA PCs
+ VOID.GRP <- FALSE # will be TRUE if empty group happened
get.prop.pred <- function(n.pca){
f1 <- function(){
toKeep <- sample(1:N, N.training)
+ if(!(all(table(grp[toKeep])>0) & all(table(grp[-toKeep])>0))) VOID.GRP <<- TRUE
temp.pca <- pcaX
temp.pca$li <- temp.pca$li[toKeep,,drop=FALSE]
temp.dapc <- suppressWarnings(dapc(x[toKeep,,drop=FALSE], grp[toKeep], n.pca=n.pca, n.da=n.da, dudi=temp.pca))
@@ -1031,7 +1033,7 @@
out <- mean(temp.pred$assign==grp[-toKeep])
}
if(result=="groupMean"){
- out <- mean(tapply(temp.pred$assign==grp[-toKeep], grp[-toKeep], mean))
+ out <- mean(tapply(temp.pred$assign==grp[-toKeep], grp[-toKeep], mean), na.rm=TRUE)
}
return(out)
}
@@ -1041,6 +1043,7 @@
## GET %SUCCESSFUL OF ACCURATE PREDICTION FOR ALL VALUES ##
res.all <- unlist(lapply(n.pca, get.prop.pred))
+ if(VOID.GRP) warning("At least one group was absent from the training / validating sets.\nTry using smaller training sets.")
res <- data.frame(n.pca=rep(n.pca, each=n.rep), success=res.all)
return(res)
} # end xvalDapc.data.frame
From noreply at r-forge.r-project.org Wed Jun 5 14:47:25 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 5 Jun 2013 14:47:25 +0200 (CEST)
Subject: [adegenet-commits] r1138 - in pkg: . R man vignettes
Message-ID: <20130605124725.5F9E718554D@r-forge.r-project.org>
Author: jombart
Date: 2013-06-05 14:47:25 +0200 (Wed, 05 Jun 2013)
New Revision: 1138
Added:
pkg/R/xvalDapc.R
pkg/man/xvalDapc.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/SNPbin.R
pkg/R/auxil.R
pkg/R/dapc.R
pkg/R/find.clust.R
pkg/R/gengraph.R
pkg/R/glFunctions.R
pkg/R/glHandle.R
pkg/R/glSim.R
pkg/R/gstat.randtest.R
pkg/R/haploGen.R
pkg/R/import.R
pkg/R/monmonier.R
pkg/R/mutations.R
pkg/R/seqTrack.R
pkg/R/sequences.R
pkg/R/setAs.R
pkg/R/spca.R
pkg/R/spca.rtests.R
pkg/man/adegenet.package.Rd
pkg/man/auxil.Rd
pkg/man/dapc.Rd
pkg/man/dapcGraphics.Rd
pkg/man/dapcIllus.Rd
pkg/man/fasta2genlight.Rd
pkg/man/glAux.Rd
pkg/man/glPca.Rd
pkg/man/monmonier.Rd
pkg/man/nancycats.Rd
pkg/man/read.PLINK.Rd
pkg/man/read.snp.Rd
pkg/man/seploc.Rd
pkg/vignettes/adegenet-genomics.Rnw
pkg/vignettes/adegenet-spca.Rnw
Log:
release 1.3-9: changing dependencies / imports
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/DESCRIPTION 2013-06-05 12:47:25 UTC (rev 1138)
@@ -1,12 +1,13 @@
Package: adegenet
-Version: 1.3-8
-Date: 2013/04/24
+Version: 1.3-9
+Date: 2013/06/04
Title: adegenet: an R package for the exploratory analysis of genetic and genomic data.
Author: Thibaut Jombart, Ismail Ahmed, Federico Calboli, Anne Cori, Tobias Erik Reiners, Peter Solymos
Maintainer: Thibaut Jombart
-Suggests: genetics, spdep, tripack, pegas, seqinr, adehabitat, multicore, akima, maps, splancs, hierfstat
-Depends: R (>= 2.10), methods, MASS, ade4, igraph, ape
+Suggests: genetics, spdep, tripack, pegas, seqinr, adehabitat, parallel, akima, maps, splancs, hierfstat
+Depends: R (>= 2.14), ade4
+Imports: methods, MASS, igraph, ape
Description: Classes and functions for genetic data analysis within the multivariate framework.
-Collate: classes.R basicMethods.R handling.R auxil.R setAs.R SNPbin.R glHandle.R glFunctions.R glSim.R find.clust.R hybridize.R scale.R fstat.R import.R seqTrack.R chooseCN.R genind2genpop.R loadingplot.R sequences.R gstat.randtest.R makefreq.R colorplot.R monmonier.R spca.R coords.monmonier.R haploGen.R old2new.R spca.rtests.R dapc.R haploPop.R PCtest.R dist.genpop.R Hs.R propShared.R export.R HWE.R propTyped.R inbreeding.R glPlot.R gengraph.R simOutbreak.R mutations.R zzz.R
+Collate: classes.R basicMethods.R handling.R auxil.R setAs.R SNPbin.R glHandle.R glFunctions.R glSim.R find.clust.R hybridize.R scale.R fstat.R import.R seqTrack.R chooseCN.R genind2genpop.R loadingplot.R sequences.R gstat.randtest.R makefreq.R colorplot.R monmonier.R spca.R coords.monmonier.R haploGen.R old2new.R spca.rtests.R dapc.R xvalDapc.R haploPop.R PCtest.R dist.genpop.R Hs.R propShared.R export.R HWE.R propTyped.R inbreeding.R glPlot.R gengraph.R simOutbreak.R mutations.R zzz.R
License: GPL (>=2)
LazyLoad: yes
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/NAMESPACE 2013-06-05 12:47:25 UTC (rev 1138)
@@ -1,17 +1,17 @@
-# Default NAMESPACE created by R
-# Remove the previous line if you edit this file
-# Export all names
+## Export all names
exportPattern(".")
-# Import all packages listed as Imports or Depends
-import(
- utils,
- methods,
- MASS,
- ade4,
- igraph
-)
+## Export all classes
+exportClassPattern(".")
-# Load DLL
+## Import all packages listed as Imports or Depends
+import(utils,methods,MASS,ade4,igraph,ape)
+
+## Declare S3 methods
+S3method(scatter, dapc)
+S3method(scatter, glPca)
+
+## Load DLL
useDynLib(adegenet)
+
Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/SNPbin.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -163,9 +163,9 @@
########################
## genlight constructor
########################
-setMethod("initialize", "genlight", function(.Object, ..., multicore=require("multicore"), n.cores=NULL) {
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+setMethod("initialize", "genlight", function(.Object, ..., parallel=require("parallel"), n.cores=NULL) {
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -206,7 +206,7 @@
}
}
##input$gen <- lapply(1:nrow(input$gen), function(i) as.integer(input$gen[i,]))
- if(multicore){
+ if(parallel){
x at gen <- mclapply(1:nrow(input$gen), function(i) new("SNPbin", as.integer(input$gen[i,])),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
} else {
@@ -234,7 +234,7 @@
}
## create SNPbin list
- if(multicore){
+ if(parallel){
x at gen <- mclapply(input$gen, function(e) new("SNPbin",e), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
} else {
x at gen <- lapply(input$gen, function(e) new("SNPbin",e))
@@ -261,7 +261,7 @@
}
## create SNPbin list
- if(multicore){
+ if(parallel){
x at gen <- mclapply(1:nrow(input$gen), function(i) f1(input$gen[i,]), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
} else {
x at gen <- lapply(1:nrow(input$gen), function(i) f1(input$gen[i,]))
Modified: pkg/R/auxil.R
===================================================================
--- pkg/R/auxil.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/auxil.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -276,9 +276,18 @@
## pre-defined palettes ##
## mono color
-bluepal <- colorRampPalette(c("lightgrey","blue"))
-redpal <- colorRampPalette(c("lightgrey","red"))
-greenpal <- colorRampPalette(c("lightgrey","green3"))
+bluepal <- colorRampPalette(c("#F7FBFF","#DEEBF7","#C6DBEF",
+ "#9ECAE1","#6BAED6","#4292C6",
+ "#2171B5","#08519C","#08306B"))
+redpal <- colorRampPalette(c("#FFF5F0","#FEE0D2","#FCBBA1",
+ "#FC9272","#FB6A4A","#EF3B2C",
+ "#CB181D","#A50F15","#67000D"))
+greenpal <- colorRampPalette(c("#F7FCF5","#E5F5E0","#C7E9C0",
+ "#A1D99B","#74C476","#41AB5D",
+ "#238B45","#006D2C","#00441B"))
+greypal <- colorRampPalette(c("#FFFFFF","#F0F0F0","#D9D9D9",
+ "#BDBDBD","#969696","#737373",
+ "#525252","#252525","#000000"))
## bi-color
flame <- colorRampPalette(c("gold","red3"))
@@ -289,7 +298,12 @@
lightseasun <- colorRampPalette(c("deepskyblue2","gold","red1"))
deepseasun <- colorRampPalette(c("blue2","gold","red2"))
wasp <- colorRampPalette(c("yellow2","brown", "black"))
+spectral <- colorRampPalette(c("#D53E4F","#F46D43","#FDAE61",
+ "#FEE08B","#FFFFBF","#E6F598",
+ "#ABDDA4","#66C2A5","#3288BD"))
## psychedelic
-funky <- colorRampPalette(c("blue","green3","gold","orange","red","brown4","purple","pink2"))
-
+funky <- colorRampPalette(c("#A6CEE3","#1F78B4","#B2DF8A",
+ "#33A02C","#FB9A99","#E31A1C",
+ "#FDBF6F","#FF7F00","#CAB2D6",
+ "#6A3D9A","#FFFF99","#B15928"))
Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/dapc.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -11,8 +11,8 @@
pca.select=c("nbEig","percVar"), perc.pca=NULL, ..., dudi=NULL){
## FIRST CHECKS
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
grp <- as.factor(grp)
if(length(grp) != nrow(x)) stop("Inconsistent length for grp")
pca.select <- match.arg(pca.select)
@@ -156,8 +156,8 @@
pca.select=c("nbEig","percVar"), perc.pca=NULL, ...){
## FIRST CHECKS
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
if(!is.genind(x)) stop("x must be a genind object.")
@@ -219,8 +219,8 @@
scale=FALSE, var.contrib=TRUE, pca.info=TRUE,
pca.select=c("nbEig","percVar"), perc.pca=NULL, glPca=NULL, ...){
## FIRST CHECKS ##
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
if(!inherits(x, "genlight")) stop("x must be a genlight object.")
pca.select <- match.arg(pca.select)
@@ -457,7 +457,7 @@
## summary.dapc
##############
summary.dapc <- function(object, ...){
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
x <- object
res <- list()
@@ -494,7 +494,7 @@
cstar = 1, cellipse = 1.5, axesell = FALSE, label = levels(grp), clabel = 1, xlim = NULL, ylim = NULL,
grid = FALSE, addaxes = TRUE, origin = c(0,0), include.origin = TRUE, sub = "", csub = 1, possub = "bottomleft",
cgrid = 1, pixmap = NULL, contour = NULL, area = NULL, ...){
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
ONEDIM <- xax==yax | ncol(x$ind.coord)==1
## recycle color and pch
@@ -535,7 +535,7 @@
sub = sub, csub = csub, possub = possub, cgrid = cgrid, pixmap = pixmap, contour = contour, area = area)
## add minimum spanning tree if needed
- if(mstree && require(ade4)){
+ if(mstree){
meanposi <- apply(x$tab,2, tapply, grp, mean)
D <- dist(meanposi)^2
tre <- ade4::mstree(D)
@@ -627,7 +627,7 @@
## assignplot
############
assignplot <- function(x, only.grp=NULL, subset=NULL, new.pred=NULL, cex.lab=.75, pch=3){
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
if(!inherits(x, "dapc")) stop("x is not a dapc object")
## handle data from predict.dapc ##
@@ -688,7 +688,7 @@
############
compoplot <- function(x, only.grp=NULL, subset=NULL, new.pred=NULL, col=NULL, lab=NULL,
legend=TRUE, txt.leg=NULL, ncol=4, posi=NULL, cleg=.8, bg=transp("white"), ...){
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
if(!inherits(x, "dapc")) stop("x is not a dapc object")
Modified: pkg/R/find.clust.R
===================================================================
--- pkg/R/find.clust.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/find.clust.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -12,9 +12,9 @@
pca.select=c("nbEig","percVar"), perc.pca=NULL,..., dudi=NULL){
## CHECKS ##
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
- if(!require(stats)) stop("package stats is required")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(stats)) stop("package stats is required")
stat <- match.arg(stat)
pca.select <- match.arg(pca.select)
@@ -192,13 +192,13 @@
########################
find.clusters.genind <- function(x, clust=NULL, n.pca=NULL, n.clust=NULL, stat=c("BIC", "AIC", "WSS"), choose.n.clust=TRUE,
criterion=c("diffNgroup", "min","goesup", "smoothNgoesup", "goodfit"),
- max.n.clust=round(nrow(x at tab)/10), n.iter=1e5, n.start=10,
- scale=FALSE, truenames=TRUE, ...){
+ max.n.clust=round(nrow(x at tab)/10), n.iter=1e5, n.start=10,
+ scale=FALSE, truenames=TRUE, ...){
## CHECKS ##
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
- if(!require(stats)) stop("package stats is required")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(stats)) stop("package stats is required")
if(!is.genind(x)) stop("x must be a genind object.")
stat <- match.arg(stat)
@@ -246,9 +246,9 @@
scale=FALSE, pca.select=c("nbEig","percVar"), perc.pca=NULL, glPca=NULL, ...){
## CHECKS ##
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
- if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
- if(!require(stats)) stop("package stats is required")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(MASS, quietly=TRUE)) stop("MASS library is required.")
+ ## if(!require(stats)) stop("package stats is required")
if(!inherits(x, "genlight")) stop("x is not a genlight object.")
stat <- match.arg(stat)
pca.select <- match.arg(pca.select)
Modified: pkg/R/gengraph.R
===================================================================
--- pkg/R/gengraph.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/gengraph.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -27,7 +27,7 @@
gengraph.matrix <- function(x, cutoff=NULL, ngrp=NULL, computeAll=FALSE, plot=TRUE, show.graph=TRUE, col.pal=funky,
truenames=TRUE, ...){
## CHECKS ##
- if(!require("igraph")) stop("igraph is required")
+ ## if(!require("igraph")) stop("igraph is required")
## IF COMPUTEALL IS TRUE ##
if(computeAll){
@@ -145,7 +145,7 @@
############
gengraph.dist <- function(x, cutoff=NULL, ngrp=NULL, computeAll=FALSE, plot=TRUE, show.graph=TRUE, col.pal=funky, truenames=TRUE, ...){
## CHECKS ##
- if(!require("igraph")) stop("igraph is required")
+ ## if(!require("igraph")) stop("igraph is required")
## USE MATRIX METHOD ##
res <- gengraph(as.matrix(x), cutoff=cutoff, ngrp=ngrp, computeAll=computeAll, plot=plot, show.graph=show.graph, col.pal=col.pal,
@@ -165,7 +165,7 @@
gengraph.genind <- function(x, cutoff=NULL, ngrp=NULL, computeAll=FALSE, plot=TRUE, show.graph=TRUE, col.pal=funky,
truenames=TRUE, ...){
## CHECKS ##
- if(!require("igraph")) stop("igraph is required")
+ ## if(!require("igraph")) stop("igraph is required")
## COMPUTE DISTANCES ##
x$tab[is.na(x$tab)] <- 0
@@ -194,7 +194,7 @@
gengraph.genpop <- function(x, cutoff=NULL, ngrp=NULL, computeAll=FALSE, plot=TRUE, show.graph=TRUE, col.pal=funky, method=1,
truenames=TRUE, ...){
## CHECKS ##
- if(!require("igraph")) stop("igraph is required")
+ ## if(!require("igraph")) stop("igraph is required")
## COMPUTE DISTANCES ##
x$tab[is.na(x$tab)] <- 0
@@ -226,8 +226,8 @@
gengraph.DNAbin <- function(x, cutoff=NULL, ngrp=NULL, computeAll=FALSE, plot=TRUE, show.graph=TRUE, col.pal=funky,
truenames=TRUE, ...){
## CHECKS ##
- if(!require("igraph")) stop("igraph is required")
- if(!require("ape")) stop("ape is required")
+ ## if(!require("igraph")) stop("igraph is required")
+ ## if(!require("ape")) stop("ape is required")
## COMPUTE DISTANCES ##
D <- as.matrix(round(dist.dna(x,model="raw", pairwise.deletion = TRUE)*ncol(x)))
Modified: pkg/R/glFunctions.R
===================================================================
--- pkg/R/glFunctions.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/glFunctions.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -172,12 +172,12 @@
## between centred/scaled vectors
## of SNPs
glDotProd <- function(x, center=FALSE, scale=FALSE, alleleAsUnit=FALSE,
- multicore=require("multicore"), n.cores=NULL){
+ parallel=require("parallel"), n.cores=NULL){
if(!inherits(x, "genlight")) stop("x is not a genlight object")
## SOME CHECKS ##
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -187,7 +187,7 @@
ind.names <- indNames(x)
- if(!multicore){ # DO NOT USE MULTIPLE CORES
+ if(!parallel){ # DO NOT USE MULTIPLE CORES
## GET INPUTS TO C PROCEDURE ##
if(center){
mu <- glMean(x,alleleAsUnit=alleleAsUnit)
@@ -277,7 +277,7 @@
## PCA for genlight objects
##
glPca <- function(x, center=TRUE, scale=FALSE, nf=NULL, loadings=TRUE, alleleAsUnit=FALSE,
- useC=TRUE, multicore=require("multicore"), n.cores=NULL,
+ useC=TRUE, parallel=require("parallel"), n.cores=NULL,
returnDotProd=FALSE, matDotProd=NULL){
if(!inherits(x, "genlight")) stop("x is not a genlight object")
@@ -300,8 +300,8 @@
## == if non-C code is used ==
if(!useC){
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -358,7 +358,7 @@
## COMPUTE ALL POSSIBLE DOT PRODUCTS (XX^T / n) ##
allComb <- combn(1:nInd(x), 2)
- if(multicore){
+ if(parallel){
allProd <- unlist(mclapply(1:ncol(allComb), function(i) dotProd(x at gen[[allComb[1,i]]], x at gen[[allComb[2,i]]], myPloidy[allComb[1,i]], myPloidy[allComb[2,i]]),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE))
} else {
@@ -374,7 +374,7 @@
allProd <- as.matrix(allProd)
## compute the diagonal
- if(multicore){
+ if(parallel){
temp <- unlist(mclapply(1:nInd(x), function(i) dotProd(x at gen[[i]], x at gen[[i]], myPloidy[i], myPloidy[i]),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE))/nInd(x)
} else {
@@ -382,7 +382,7 @@
}
diag(allProd) <- temp
} else { # === use C computations ====
- allProd <- glDotProd(x, center=center, scale=scale, alleleAsUnit=alleleAsUnit, multicore=multicore, n.cores=n.cores)/nInd(x)
+ allProd <- glDotProd(x, center=center, scale=scale, alleleAsUnit=alleleAsUnit, parallel=parallel, n.cores=n.cores)/nInd(x)
}
} else { # END NEED TO COMPUTE DOTPROD
if(!all(dim(matDotProd)==nInd(x))) stop("matDotProd has wrong dimensions.")
@@ -511,7 +511,7 @@
grid = TRUE, addaxes = TRUE, origin = c(0,0), include.origin = TRUE,
sub = "", csub = 1, possub = "bottomleft", cgrid = 1,
pixmap = NULL, contour = NULL, area = NULL, ...){
- if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
+ ## if(!require(ade4, quietly=TRUE)) stop("ade4 library is required.")
## set par
@@ -757,20 +757,20 @@
## TEST PARALLELE C COMPUTATIONS IN GLPCA ##
## first dataset
## x <- new("genlight", lapply(1:50, function(i) sample(c(0,1,2,NA), 1e5, prob=c(.5, .40, .09, .01), replace=TRUE)))
-## system.time(pca1 <- glPca(x, multi=FALSE, useC=FALSE, nf=1)) # no C, no multicore: 43 sec
+## system.time(pca1 <- glPca(x, multi=FALSE, useC=FALSE, nf=1)) # no C, no parallel: 43 sec
## system.time(pca2 <- glPca(x, multi=FALSE, useC=TRUE, nf=1)) # just C: 248 sec
-## system.time(pca3 <- glPca(x, multi=TRUE, useC=FALSE, nf=1, n.core=7)) # just multicore: 16 sec
-## system.time(pca4 <- glPca(x, multi=TRUE, useC=TRUE, nf=1, n.core=7)) # C and multicore: 65 sec
+## system.time(pca3 <- glPca(x, multi=TRUE, useC=FALSE, nf=1, n.core=7)) # just parallel: 16 sec
+## system.time(pca4 <- glPca(x, multi=TRUE, useC=TRUE, nf=1, n.core=7)) # C and parallel: 65 sec
## all.equal(pca1$scores^2, pca2$scores^2) # must be TRUE
## all.equal(pca1$scores^2, pca3$scores^2) # must be TRUE
## all.equal(pca1$scores^2, pca4$scores^2) # must be TRUE
## second dataset
## x <- new("genlight", lapply(1:500, function(i) sample(c(0,1,2,NA), 1e4, prob=c(.5, .40, .09, .01), replace=TRUE)))
-## system.time(pca1 <- glPca(x, multi=FALSE, useC=FALSE, nf=1)) # no C, no multicore: 418 sec
+## system.time(pca1 <- glPca(x, multi=FALSE, useC=FALSE, nf=1)) # no C, no parallel: 418 sec
## system.time(pca2 <- glPca(x, multi=FALSE, useC=TRUE, nf=1)) # just C: 496 sec
-## system.time(pca3 <- glPca(x, multi=TRUE, useC=FALSE, nf=1, n.core=7)) # just multicore: 589 sec
-## system.time(pca4 <- glPca(x, multi=TRUE, useC=TRUE, nf=1, n.core=7)) # C and multicore: 315 sec
+## system.time(pca3 <- glPca(x, multi=TRUE, useC=FALSE, nf=1, n.core=7)) # just parallel: 589 sec
+## system.time(pca4 <- glPca(x, multi=TRUE, useC=TRUE, nf=1, n.core=7)) # C and parallel: 315 sec
## all.equal(pca1$scores^2, pca2$scores^2) # must be TRUE
## all.equal(pca1$scores^2, pca3$scores^2) # must be TRUE
## all.equal(pca1$scores^2, pca4$scores^2) # must be TRUE
Modified: pkg/R/glHandle.R
===================================================================
--- pkg/R/glHandle.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/glHandle.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -81,7 +81,7 @@
##x <- as.matrix(x)[, j, drop=FALSE] # maybe need to process one row at a time
x <- new("genlight", gen=new.gen, pop=ori.pop, ploidy=ori.ploidy,
ind.names=old.ind.names, loc.names=new.loc.names,
- chromosome=new.chr, position=new.position, alleles=new.alleles, other=old.other, multicore=FALSE,...)
+ chromosome=new.chr, position=new.position, alleles=new.alleles, other=old.other, parallel=FALSE,...)
}
return(x)
@@ -248,12 +248,12 @@
## seploc
##########
setMethod("seploc", signature(x="genlight"), function(x, n.block=NULL, block.size=NULL, random=FALSE,
- multicore=require(multicore), n.cores=NULL){
+ parallel=require(parallel), n.cores=NULL){
## CHECKS ##
if(is.null(n.block) & is.null(block.size)) stop("n.block and block.size are both missing.")
if(!is.null(n.block) & !is.null(block.size)) stop("n.block and block.size are both provided.")
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -285,7 +285,7 @@
fac.block <- sample(fac.block)
}
- if(multicore){
+ if(parallel){
if(random){
res <- mclapply(levels(fac.block), function(lev) x[,sample(which(fac.block==lev))],
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
Modified: pkg/R/glSim.R
===================================================================
--- pkg/R/glSim.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/glSim.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -29,7 +29,7 @@
## AUXIL FUNCTIONS ##
if(LD) { # LD - use mvrnorm
- if(!require(MASS)) stop("MASS package is missing.")
+ ## if(!require(MASS)) stop("MASS package is missing.")
QUANT <- qnorm(seq(0,1, le=ploidy+2), 0,1) # quantiles needed for continuous->discrete
f1 <- function(n,p){
Modified: pkg/R/gstat.randtest.R
===================================================================
--- pkg/R/gstat.randtest.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/gstat.randtest.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -10,7 +10,6 @@
if(x at ploidy != as.integer(2)) stop("not implemented for non-diploid genotypes")
checkType(x)
if(!require(hierfstat)) stop("hierfstat package is required. Please install it.")
- if(!require(ade4)) stop("ade4 package is required. Please install it.")
if(is.null(pop)) pop <- x at pop
if(is.null(pop)) pop <- as.factor(rep("P1",nrow(x at tab)))
Modified: pkg/R/haploGen.R
===================================================================
--- pkg/R/haploGen.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/haploGen.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -16,7 +16,7 @@
ini.n=1, ini.xy=NULL){
## CHECKS ##
- if(!require(ape)) stop("The ape package is required.")
+ ## if(!require(ape)) stop("The ape package is required.")
## HANDLE ARGUMENTS ##
@@ -559,8 +559,8 @@
## as.igraph.haploGen
######################
as.igraph.haploGen <- function(x, col.pal=redpal, ...){
- if(!require(igraph)) stop("package igraph is required for this operation")
- if(!require(ape)) stop("package ape is required for this operation")
+ ## if(!require(igraph)) stop("package igraph is required for this operation")
+ ## if(!require(ape)) stop("package ape is required for this operation")
## GET DAG ##
from <- x$ances
@@ -602,7 +602,7 @@
## plot.haploGen
#################
plot.haploGen <- function(x, y=NULL, col.pal=redpal, ...){
- if(!require(igraph)) stop("igraph is required")
+ ## if(!require(igraph)) stop("igraph is required")
## get graph ##
g <- as.igraph(x, col.pal=col.pal)
Modified: pkg/R/import.R
===================================================================
--- pkg/R/import.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/import.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -722,13 +722,13 @@
# Function read.snp
#######################
read.snp <- function(file, quiet=FALSE, chunkSize=1000,
- multicore=require("multicore"), n.cores=NULL, ...){
+ parallel=require("parallel"), n.cores=NULL, ...){
ext <- .readExt(file)
ext <- toupper(ext)
if(ext != "SNP") warning("wrong file extension - '.snp' expected")
if(!quiet) cat("\n Reading biallelic SNP data file into a genlight object... \n\n")
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -801,7 +801,7 @@
ind.lab <- gsub("(^[[:space:]]+)|([[:space:]]+$)", "", ind.lab)
temp <- strsplit(txt[ID.INDIV+1], "")
temp <- lapply(temp, function(e) suppressWarnings(as.integer(e)))
- if(multicore){
+ if(parallel){
res <- c(res, mclapply(temp, function(e) new("SNPbin", e),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE) )
} else {
@@ -861,7 +861,7 @@
other <- list(chromosome = misc.info$chromosome)
}
- res <- new("genlight", gen=res, ind.names=ind.names, position=misc.info$position, loc.all=misc.info$allele, ploidy=misc.info$ploidy, pop=misc.info$population, other=other, multicore=multicore)
+ res <- new("genlight", gen=res, ind.names=ind.names, position=misc.info$position, loc.all=misc.info$allele, ploidy=misc.info$ploidy, pop=misc.info$population, other=other, parallel=parallel)
if(!quiet) cat("\n...done.\n\n")
@@ -923,14 +923,14 @@
## Function read.PLINK
########################
read.PLINK <- function(file, map.file=NULL, quiet=FALSE, chunkSize=1000,
- multicore=require("multicore"), n.cores=NULL, ...){
+ parallel=require("parallel"), n.cores=NULL, ...){
## HANDLE ARGUMENTS ##
ext <- .readExt(file)
ext <- toupper(ext)
if(ext != "RAW") warning("wrong file extension - '.raw' expected")
if(!quiet) cat("\n Reading PLINK raw format into a genlight object... \n\n")
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -978,7 +978,7 @@
## build SNPbin objects
txt <- lapply(txt, function(e) suppressWarnings(as.integer(e[-(1:6)])))
- if(multicore){
+ if(parallel){
res <- c(res, mclapply(txt, function(e) new("SNPbin", snp=e, ploidy=2),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE) )
} else {
@@ -1000,7 +1000,7 @@
## BUILD FINAL OBJECT ##
if(!quiet) cat("\n Building final object... \n")
- res <- new("genlight",res, ploidy=2, multicore=multicore)
+ res <- new("genlight",res, ploidy=2, parallel=parallel)
indNames(res) <- misc.info$IID
pop(res) <- misc.info$FID
locNames(res) <- loc.names
@@ -1037,14 +1037,14 @@
## Function fasta2genlight
###########################
fasta2genlight <- function(file, quiet=FALSE, chunkSize=1000, saveNbAlleles=FALSE,
- multicore=require("multicore"), n.cores=NULL, ...){
+ parallel=require("parallel"), n.cores=NULL, ...){
## HANDLE ARGUMENTS ##
ext <- .readExt(file)
ext <- toupper(ext)
if(!ext %in% c("FASTA", "FA", "FAS")) warning("wrong file extension - '.fasta', '.fa' or '.fas' expected")
if(!quiet) cat("\n Converting FASTA alignment into a genlight object... \n\n")
- if(multicore && !require(multicore)) stop("multicore package requested but not installed")
- if(multicore && is.null(n.cores)){
+ if(parallel && !require(parallel)) stop("parallel package requested but not installed")
+ if(parallel && is.null(n.cores)){
n.cores <- parallel:::detectCores()
}
@@ -1089,7 +1089,7 @@
nb.ind <- length(grep("^>", txt))
IND.LAB <- c(IND.LAB, sub(">","",txt[grep("^>", txt)])) # find individuals' labels
txt <- split(txt, rep(1:nb.ind, each=LINES.PER.IND)) # split per individuals
- if(multicore){
+ if(parallel){
txt <- mclapply(txt, function(e) strsplit(paste(e[-1], collapse=""), split=""),
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE) # each genome -> one vector
} else {
@@ -1147,7 +1147,7 @@
## read SNPs
nb.ind <- length(grep("^>", txt))
txt <- split(txt, rep(1:nb.ind, each=LINES.PER.IND)) # split per individuals
- if(multicore){
+ if(parallel){
txt <- mclapply(txt, function(e) strsplit(paste(e[-1], collapse=""), split="")[[1]][snp.posi],
mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE) # each genome -> one SNP vector
} else {
@@ -1167,7 +1167,7 @@
## BUILD FINAL OBJECT ##
if(!quiet) cat("\n Building final object... \n")
- res <- new("genlight",res, ploidy=1, multicore=multicore)
+ res <- new("genlight",res, ploidy=1, parallel=parallel)
indNames(res) <- IND.LAB
alleles(res) <- sapply(POOL[snp.posi], paste, collapse="/")
position(res) <- which(snp.posi)
@@ -1191,7 +1191,6 @@
## Function fasta2DNAbin
###########################
fasta2DNAbin <- function(file, quiet=FALSE, chunkSize=10, snpOnly=FALSE){
- if(!require(ape)) stop("ape package is needed")
## HANDLE ARGUMENTS ##
ext <- .readExt(file)
Modified: pkg/R/monmonier.R
===================================================================
--- pkg/R/monmonier.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/monmonier.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -9,7 +9,7 @@
#####################
monmonier <- function(xy, dist, cn, threshold=NULL, bd.length=NULL, nrun=1,
skip.local.diff=rep(0,nrun), scanthres=is.null(threshold), allowLoop=TRUE){
-if(!require(spdep) & !require(ade4)) stop("The package spdep is required but not installed")
+if(!require(spdep)) stop("The package spdep is required but not installed")
if(!inherits(cn,"nb")) stop('cn is not a nb object')
if(is.data.frame(xy)) xy <- as.matrix(xy)
if(!is.matrix(xy)) stop('xy must be a matrix')
Modified: pkg/R/mutations.R
===================================================================
--- pkg/R/mutations.R 2013-06-04 10:14:25 UTC (rev 1137)
+++ pkg/R/mutations.R 2013-06-05 12:47:25 UTC (rev 1138)
@@ -14,7 +14,6 @@
## METHOD FOR DNABIN
findMutations.DNAbin <- function(x, from=NULL, to=NULL, allcomb=TRUE, ...){
## CHECKS ##
- if(!require(ape)) stop("the ape package is needed")
if(!inherits(x,"DNAbin")) stop("x is not a DNAbin object")
x <- as.matrix(x)
@@ -86,7 +85,6 @@
## METHOD FOR DNABIN
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/adegenet -r 1138
From noreply at r-forge.r-project.org Wed Jun 5 14:54:43 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 5 Jun 2013 14:54:43 +0200 (CEST)
Subject: [adegenet-commits] r1139 - / pkg/vignettes
Message-ID: <20130605125443.6D49318554D@r-forge.r-project.org>
Author: jombart
Date: 2013-06-05 14:54:43 +0200 (Wed, 05 Jun 2013)
New Revision: 1139
Modified:
/
pkg/vignettes/
Log:
not sure what change's been made here
Property changes on:
___________________________________________________________________
Added: svn:ignore
+ *.tar.gz
Property changes on: pkg/vignettes
___________________________________________________________________
Added: svn:ignore
+ *.pdf
From noreply at r-forge.r-project.org Wed Jun 5 15:03:34 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 5 Jun 2013 15:03:34 +0200 (CEST)
Subject: [adegenet-commits] r1140 - www
Message-ID: <20130605130334.C7337185363@r-forge.r-project.org>
Author: jombart
Date: 2013-06-05 15:03:34 +0200 (Wed, 05 Jun 2013)
New Revision: 1140
Modified:
www/download.html
www/literature.html
www/news.html
Log:
changes to the website to reflect new version
Modified: www/download.html
===================================================================
--- www/download.html 2013-06-05 12:54:43 UTC (rev 1139)
+++ www/download.html 2013-06-05 13:03:34 UTC (rev 1140)
@@ -30,14 +30,16 @@
The current stable
- version (adegenet_1.3-8) is available as:
- - linux sources
- - MacOS X binary
- - Windows binary
+ version (adegenet_1.3-9) is available as:
+ - linux
+ sources
+ - MacOS X binary
+ - Windows binary
The devel version
- (adegenet_1.3-9) is also available from R-Forge's daily snapshots.
It can be installed directly from R console using:
@@ -50,6 +52,7 @@
+
Patches correct minor bugs or implement new functionnalities, and
will be included into the next CRAN release. It is recommended to
@@ -64,6 +67,7 @@
+
a patch.
addedFeatures.R: (for adegenet
@@ -77,6 +81,17 @@
monospace;">
Older versions:
+ adegenet _1.3-8
+ - linux
+ sources
+ - MacOS
+ X binary
+ - Windows
+ binary
+
adegenet _1.3-7
- linux sources
- MacOS X binary
Modified: www/literature.html
===================================================================
--- www/literature.html 2013-06-05 12:54:43 UTC (rev 1139)
+++ www/literature.html 2013-06-05 13:03:34 UTC (rev 1140)
@@ -67,6 +67,7 @@
+
the bublisher's website]
@@ -103,6 +104,7 @@
+
abstract]
- the paper presenting the spatial
@@ -124,6 +126,7 @@
+
principal component analysis (sPCA, function spca), global and
@@ -148,6 +151,7 @@
+
cryptic spatial patterns in genetic variability by a new
multivariate method. Heredity
101: 92-103. doi:
@@ -173,6 +177,7 @@
+
abstract]
@@ -200,6 +205,7 @@
+
simulations of genealoies of haplotypes (haploGen):
Jombart T, Eggo RM, Dodd PJ, Balloux F (2010)
@@ -227,6 +233,7 @@
+
of Principal Components (DAPC, functions find.clusters
@@ -262,6 +269,7 @@
+
Behaviour76:
87-95.
@@ -286,6 +294,7 @@
+
Genomics9: 256.
@@ -325,6 +334,7 @@
+
marmota.Molecular
@@ -343,6 +353,7 @@
+
Ecology 18:
1491-1503.
@@ -400,6 +411,7 @@
+
australis in North America. Biological Invasions. doi:
10.1007/s10530-010-9699-6.
@@ -561,6 +573,7 @@
+
Oct 6. [Epub ahead of print]
[24] SANTOS, H., BURBAN, C., ROUSSELET, J.,
@@ -583,6 +596,7 @@
+
pityocampa, Lepidoptera, Notodontidae). Journal of Evolutionary Biology,
no. doi: 10.1111/j.1420-9101.2010.02147.x
@@ -610,6 +624,7 @@
+
Vol. Sci. Pap. ICCAT, 65(3): 988-995
[26] Vandewoestijne
@@ -630,6 +645,7 @@
+
S, Van Dyck H,
2010 Population Genetic
@@ -653,6 +669,7 @@
+
ONE5(11): e13810. doi:10.1371/journal.pone.0013810
@@ -687,6 +704,7 @@
+
DOI: 10.1007/s10329-010-0232-4
@@ -758,6 +776,7 @@
+
tetradactylum: Polynemidae). Molecular Ecology,
20: no. doi: 10.1111/j.1365-294X.2011.05097.x
@@ -787,6 +806,7 @@
+
neoformans Variety grubii Multilocus Sequence
Types from Thailand Are Consistent with an Ancestral African
Origin. PLoS
@@ -1048,6 +1068,7 @@
+
10.1007/s10709-012-9640-2
[76] Samantha Baldwin, Meeghan Pither-Joyce, Kathryn Wright,
@@ -1726,10 +1747,22 @@
Amietophrynus mauritanicus (Schlegel, 1841). Conservation
Genetics Resources. DOI: 10.1007/s12686-013-9963-z
+ [193] Roullier C, Duputi? A, Wennekes P, Benoit L, Fern?ndez
+ Bringas VM, et al. (2013) Disentangling the Origins of
+ Cultivated Sweet Potato (Ipomoea batatas (L.) Lam.). PLoS ONE
+ 8(5): e62707. doi:10.1371/journal.pone.0062707
+ [194] Boattini A, Martinez-Cruz B, Sarno S, Harmant C, Useli A,
+ et al. (2013) Uniparental Markers in Italy Reveal a Sex-Biased
+ Genetic Structure and Different Historical Strata. PLoS ONE
+ 8(5): e65441. doi:10.1371/journal.pone.0065441
+
+
+
+
* adegenet not or wrongly cited, but actually
used in the paper.
Modified: www/news.html
===================================================================
--- www/news.html 2013-06-05 12:54:43 UTC (rev 1139)
+++ www/news.html 2013-06-05 13:03:34 UTC (rev 1140)
@@ -1,7 +1,7 @@
-
news
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+