[adegenet-commits] r870 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri May 13 17:20:15 CEST 2011
Author: jombart
Date: 2011-05-13 17:20:15 +0200 (Fri, 13 May 2011)
New Revision: 870
Modified:
pkg/DESCRIPTION
pkg/R/fstat.R
pkg/R/gstat.randtest.R
pkg/man/export.Rd
pkg/man/fstat.Rd
Log:
Try a fix for package broken - hierfstat would be the culprit
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2011-05-09 09:14:04 UTC (rev 869)
+++ pkg/DESCRIPTION 2011-05-13 15:20:15 UTC (rev 870)
@@ -7,7 +7,7 @@
and contributed datasets from: Katayoun Moazami-Goudarzi, Denis Laloe,
Dominique Pontier, Daniel Maillard, Francois Balloux
Maintainer: Thibaut Jombart <t.jombart at imperial.ac.uk>
-Suggests: genetics, hierfstat, spdep, tripack, ape, pegas, graph, RBGL, seqinr, multicore
+Suggests: genetics, spdep, tripack, ape, pegas, graph, RBGL, seqinr, multicore
Depends: methods, MASS, ade4
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 zzz.R
Modified: pkg/R/fstat.R
===================================================================
--- pkg/R/fstat.R 2011-05-09 09:14:04 UTC (rev 869)
+++ pkg/R/fstat.R 2011-05-13 15:20:15 UTC (rev 870)
@@ -5,22 +5,24 @@
# Wrapper for fst estimator from hierfstat package
#
fstat <- function(x, pop=NULL, fstonly=FALSE){
- ## misc checks
- if(!is.genind(x)) stop("x is not a valid genind object")
- if(!require(hierfstat)) stop("hierfstat package is required. Please install it.")
- if(x at ploidy != as.integer(2)) stop("not implemented for non-diploid genotypes")
- checkType(x)
+ cat("\nSorry, hierfstat package has been disabled - this function will be restored in a future release.\n")
+ return(invisible())
+ ## ## misc checks
+ ## if(!is.genind(x)) stop("x is not a valid genind object")
+ ## if(!require(hierfstat)) stop("hierfstat package is required. Please install it.")
+ ## if(x at ploidy != as.integer(2)) stop("not implemented for non-diploid genotypes")
+ ## checkType(x)
- if(is.null(pop)) pop <- x at pop
- if(is.null(pop)) stop("no pop factor provided")
- if(length(pop)!=nrow(x at tab)) stop("pop has a wrong length.")
+ ## if(is.null(pop)) pop <- x at pop
+ ## if(is.null(pop)) stop("no pop factor provided")
+ ## if(length(pop)!=nrow(x at tab)) stop("pop has a wrong length.")
- ## computations
- dat <- genind2hierfstat(x)[,-1]
- res <- varcomp.glob(levels=data.frame(pop), loci=dat)$F
+ ## ## computations
+ ## dat <- genind2hierfstat(x)[,-1]
+ ## res <- varcomp.glob(levels=data.frame(pop), loci=dat)$F
- if(fstonly) {res <- res[1,1]}
- return(res)
+ ## if(fstonly) {res <- res[1,1]}
+ ## return(res)
}
Modified: pkg/R/gstat.randtest.R
===================================================================
--- pkg/R/gstat.randtest.R 2011-05-09 09:14:04 UTC (rev 869)
+++ pkg/R/gstat.randtest.R 2011-05-13 15:20:15 UTC (rev 870)
@@ -3,57 +3,59 @@
##########################
gstat.randtest <- function(x,pop=NULL, method=c("global","within","between"),
sup.pop=NULL, sub.pop=NULL, nsim=499){
+ cat("\nSorry, hierfstat package has been disabled - this function will be restored in a future release.\n")
+ return(invisible())
- if(!is.genind(x)) stop("x is not a valid genind object")
- 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.genind(x)) stop("x is not a valid genind object")
+ ## 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)))
- if(length(pop)!=nrow(x at tab)) stop("pop has a wrong length.")
+ ## if(is.null(pop)) pop <- x at pop
+ ## if(is.null(pop)) pop <- as.factor(rep("P1",nrow(x at tab)))
+ ## if(length(pop)!=nrow(x at tab)) stop("pop has a wrong length.")
- met <- tolower(method[1])
- if(met=="within" && is.null(sup.pop)) stop("Method 'within' chosen but 'sup.pop' is not provided.")
- if(met=="between" && is.null(sub.pop)) stop("Method 'between' chosen but 'sub.pop' is not provided.")
+ ## met <- tolower(method[1])
+ ## if(met=="within" && is.null(sup.pop)) stop("Method 'within' chosen but 'sup.pop' is not provided.")
+ ## if(met=="between" && is.null(sub.pop)) stop("Method 'between' chosen but 'sub.pop' is not provided.")
- # make data for hierfstat
- X <- genind2hierfstat(x=x,pop=pop)
+ ## # make data for hierfstat
+ ## X <- genind2hierfstat(x=x,pop=pop)
- # compute obs gstat
- obs <- g.stats.glob(X)$g.stats
+ ## # compute obs gstat
+ ## obs <- g.stats.glob(X)$g.stats
- pop <- X[,1]
- X <- X[,-1]
+ ## pop <- X[,1]
+ ## X <- X[,-1]
- # simulations according one of the 3 different schemes
- # note: for, lapply and sapply are all equivalent
- # recursive functions would require options("expression") to be modified...
- sim <- vector(mode="numeric",length=nsim)
+ ## # simulations according one of the 3 different schemes
+ ## # note: for, lapply and sapply are all equivalent
+ ## # recursive functions would require options("expression") to be modified...
+ ## sim <- vector(mode="numeric",length=nsim)
- if(met=="global"){
+ ## if(met=="global"){
- sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(sample(pop),X))$g.stats)
+ ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(sample(pop),X))$g.stats)
- } else if(met=="within"){
+ ## } else if(met=="within"){
- if(length(sup.pop) != length(pop)) stop("pop and sup.pop do not have the same length.")
- sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.within(sup.pop),]))$g.stats)
+ ## if(length(sup.pop) != length(pop)) stop("pop and sup.pop do not have the same length.")
+ ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.within(sup.pop),]))$g.stats)
- } else if(met=="between"){
+ ## } else if(met=="between"){
- if(length(sub.pop) != length(pop)) stop("pop and sub.pop do not have the same length.")
- sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.between(sub.pop),]))$g.stats)
+ ## if(length(sub.pop) != length(pop)) stop("pop and sub.pop do not have the same length.")
+ ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.between(sub.pop),]))$g.stats)
- } else {
- stop("Unknown method requested.")
- }
+ ## } else {
+ ## stop("Unknown method requested.")
+ ## }
- prevcall <- match.call()
+ ## prevcall <- match.call()
- res <- as.randtest(sim=sim, obs=obs, call=prevcall)
+ ## res <- as.randtest(sim=sim, obs=obs, call=prevcall)
- return(res)
+ ## return(res)
}
Modified: pkg/man/export.Rd
===================================================================
--- pkg/man/export.Rd 2011-05-09 09:14:04 UTC (rev 869)
+++ pkg/man/export.Rd 2011-05-13 15:20:15 UTC (rev 870)
@@ -49,18 +49,18 @@
}
\seealso{\code{\link{import2genind}}}
\author{Thibaut Jombart \email{t.jombart at imperial.ac.uk} }
-\examples{
-if(require(hierfstat)){
+% \examples{
+% if(require(hierfstat)){
-obj <- read.fstat(system.file("data/diploid.dat",package="hierfstat"))
+% obj <- read.fstat(system.file("data/diploid.dat",package="hierfstat"))
-X <- genind2hierfstat(obj)
-X
+% X <- genind2hierfstat(obj)
+% X
-read.fstat.data(paste(.path.package("hierfstat"),"/data/diploid.dat",sep="",collapse=""),nloc=5)
-}
-if(require(genetics)){
-genind2genotype(obj)
-}
-}
+% read.fstat.data(paste(.path.package("hierfstat"),"/data/diploid.dat",sep="",collapse=""),nloc=5)
+% }
+% if(require(genetics)){
+% genind2genotype(obj)
+% }
+% }
\keyword{manip}
\ No newline at end of file
Modified: pkg/man/fstat.Rd
===================================================================
--- pkg/man/fstat.Rd 2011-05-09 09:14:04 UTC (rev 869)
+++ pkg/man/fstat.Rd 2011-05-13 15:20:15 UTC (rev 870)
@@ -55,16 +55,16 @@
\eqn{ Fst(A,B) = \frac{(Ht - (n_A Hs(A) + n_B Hs(B))/(n_A + n_B) )}{Ht}} \cr
}
\author{ Thibaut Jombart \email{t.jombart at imperial.ac.uk} }
-\examples{
-if(require(hierfstat)){
-data(nancycats)
+% \examples{
+% if(require(hierfstat)){
+% data(nancycats)
-## Fst, Fis, Fit
-fstat(nancycats)
+% ## Fst, Fis, Fit
+% fstat(nancycats)
-## pairwise Fst
-mat.fst <- pairwise.fst(nancycats, res.type="matrix")
-mat.fst
-}
-}
+% ## pairwise Fst
+% mat.fst <- pairwise.fst(nancycats, res.type="matrix")
+% mat.fst
+% }
+% }
\keyword{multivariate}
\ No newline at end of file
More information about the adegenet-commits
mailing list