[adegenet-commits] r201 - in pkg: . R man misc/bug-report.1.2-2.02
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Nov 9 16:59:35 CET 2008
Author: jombart
Date: 2008-11-09 16:59:35 +0100 (Sun, 09 Nov 2008)
New Revision: 201
Modified:
pkg/R/import.R
pkg/R/spca.R
pkg/TODO
pkg/man/spca.Rd
pkg/misc/bug-report.1.2-2.02/PhylogenieclariasAllozymestotalmanu.gtx
Log:
Various fixes: read.genetix, spca accepts a matWeight argument, ...
Modified: pkg/R/import.R
===================================================================
--- pkg/R/import.R 2008-11-05 17:22:47 UTC (rev 200)
+++ pkg/R/import.R 2008-11-09 15:59:35 UTC (rev 201)
@@ -9,7 +9,7 @@
#
# Thibaut Jombart, avril 2006
# jombart at biomserv.univ-lyon1.fr
-#
+#
##################################################################
#######################
@@ -48,7 +48,7 @@
## make sure X is in character mode
mode(X) <- "character"
-
+
n <- nrow(X)
nloc <- ncol(X)
ploidy <- as.integer(ploidy)
@@ -102,11 +102,11 @@
n <- nrow(X)
## SET NAs IN X
X[is.na(tempX)] <- NA
-
+
# ind.names <- rownames(X) this erases the real labels
# note: if X is kept as a matrix, duplicate row names are no problem
-
+
## function to fill a matrix of char 'M' with the required
## number of zero, targetN being the total number of char required
fillWithZero <- function(M, targetN){
@@ -218,7 +218,7 @@
mat <- mat/ploidy
colnames(mat) <- col.lab
rownames(mat) <- ind.names
-
+
if(!is.na(missing)){
if(missing==0) {mat[is.na(mat)] <- 0}
if(toupper(missing)=="MEAN") {
@@ -226,11 +226,11 @@
for(j in 1:ncol(mat)) {mat[,j][is.na(mat[,j])] <- moy[j]}
}
}
-
+
prevcall <- match.call()
res <- genind( tab=mat, pop=pop, prevcall=prevcall, ploidy=ploidy )
-
+
return(res)
} # end df2genind
@@ -245,15 +245,26 @@
read.genetix <- function(file=NULL,missing=NA,quiet=FALSE) {
if(!quiet) cat("\n Converting data from GENETIX to a genind object... \n")
-
+
## read from file
if(!file.exists(file)) stop("Specified file does not exist.")
if(toupper(.readExt(file)) != "GTX") stop("File extension .gtx expected")
- # retrieve first infos
- nloc <- as.numeric(scan(file,nlines=1,what="character",quiet=TRUE)[1])
- npop <- as.numeric(scan(file,nlines=1,skip=1,what="character",quiet=TRUE)[1])
+ ## retrieve first infos
+ nloc <- as.integer(scan(file,nlines=1,what="character",quiet=TRUE)[1])
+ npop <- as.integer(scan(file,nlines=1,skip=1,what="character",quiet=TRUE)[1])
txt <- scan(file,skip=2,what="character",sep="\n",quiet=TRUE)
txt <- gsub("\t"," ",txt)
+ ## check that nloc is consistent with actual nloc (bug-report 1.2-2.02)
+ temp <- temp <- .rmspaces(txt[length(txt)])
+ nlocbis <- length(unlist(strsplit(temp, "[[:space:]]+")))-1
+ if(nloc != nlocbis) {
+ warning(paste("\n== Genetix file error == \n",
+ "Indicated number of locus (", nloc, ")\n",
+ "does not match actual number (", nlocbis, ").\n",
+ "Using ", nlocbis, " as number of locus.\n",
+ "Please check your file.", sep=""))
+ nloc <- nlocbis
+ }
loc.names <- txt[seq(1,by=2,length=nloc)]
txt <- txt[-(1:(nloc*2))]
@@ -269,7 +280,7 @@
index <- index + pop.nind[i] + 2
}
pop.names <- .rmspaces(pop.names)
-
+
## retrieve genotypes infos
txt <- txt[-c(temp,temp+1)]
txt <- .rmspaces(txt)
@@ -281,18 +292,18 @@
} else{
rownames(X) <- 1:nrow(X)
}
-
+
colnames(X) <- loc.names
-
+
## make a factor "pop" if there is more than one population
pop <- factor(rep(pop.names,pop.nind))
-
+
## pass X to df2genind
res <- df2genind(X=X, ncode=6, pop=pop, missing=missing, ploidy=2)
res at call <- match.call()
-
+
if(!quiet) cat("\n...done.\n\n")
-
+
return(res)
} # end read.genetix
@@ -314,8 +325,8 @@
# read first infos
info <- unlist(strsplit(txt[1],"([[:space:]]+)"))
# npop <- as.numeric(info[1]) ## no longer used
- nloc <- as.numeric(info[2])
-
+ nloc <- as.numeric(info[2])
+
loc.names <- txt[2:(nloc+1)]
# build genotype matrix
@@ -326,7 +337,7 @@
pop <- factor(X[,1])
if(length(levels(pop)) == 1 ) pop <- NULL
X <- X[,-1]
-
+
colnames(X) <- loc.names
rownames(X) <- 1:nrow(X)
@@ -335,11 +346,11 @@
res at ind.names <- rep("",length(res at ind.names))
names(res at ind.names) <- rownames(res at tab)
res at call <- call
-
+
if(!quiet) cat("\n...done.\n\n")
return(res)
-
+
} # end read.fstat
@@ -347,7 +358,7 @@
##########################
-# Function read.genepop
+# Function read.genepop
##########################
read.genepop <- function(file,missing=NA,quiet=FALSE){
if(!file.exists(file)) stop("Specified file does not exist.")
@@ -356,7 +367,7 @@
if(!quiet) cat("\n Converting data from a Genepop .gen file to a genind object... \n\n")
prevcall <- match.call()
-
+
txt <- scan(file,sep="\n",what="character",quiet=TRUE)
if(!quiet) cat("\nFile description: ",txt[1], "\n")
txt <- txt[-1]
@@ -387,7 +398,7 @@
# loc.names <- txt[1:nloc]
# loc.names <- gsub("^([[:blank:]]*)([[:space:]]*)","",loc.names)
# loc.names <- gsub("([[:blank:]]*)([[:space:]]*)$","",loc.names)
-
+
# txt <- txt[-(1:nloc)]
#}
@@ -399,9 +410,9 @@
loc.names <- .rmspaces(loc.names)
nloc <- length(loc.names)
txt <- txt[-locinfo.idx]
-
- # locus names have been retreived
+ # locus names have been retreived
+
# build the pop factor
# and correct the genotypes splited on more than 1 line
pop.idx <- grep("^([[:space:]]*)POP([[:space:]]*)$",toupper(txt))
@@ -420,11 +431,11 @@
# reevaluate pop index
pop.idx <- grep("^([[:space:]]*)POP([[:space:]]*)$",toupper(txt))
-
+
txt[length(txt)+1] <- "POP"
nind.bypop <- diff(grep("^([[:space:]]*)POP([[:space:]]*)$",toupper(txt)))-1
pop <- factor(rep(1:npop,nind.bypop))
-
+
txt <- txt[-c(pop.idx,length(txt))]
temp <- sapply(1:length(txt),function(i) strsplit(txt[i],","))
@@ -436,10 +447,10 @@
vec.genot <- sapply(temp,function(e) e[2])
vec.genot <- .rmspaces(vec.genot)
-
+
# X is a individual x locus genotypes matrix
X <- matrix(unlist(strsplit(vec.genot,"[[:space:]]+")),ncol=nloc,byrow=TRUE)
-
+
rownames(X) <- ind.names
colnames(X) <- loc.names
@@ -460,14 +471,14 @@
pop.names.idx <- cumsum(table(pop))
pop.names <- ind.names[pop.names.idx]
levels(pop) <- pop.names
-
+
res <- df2genind(X=X,pop=pop,missing=missing, ploidy=2)
res at call <- prevcall
-
+
if(!quiet) cat("\n...done.\n\n")
return(res)
-
+
} # end read.genepop
@@ -478,7 +489,7 @@
# Function read.structure
############################
read.structure <- function(file, n.ind=NULL, n.loc=NULL, onerowperind=NULL, col.lab=NULL, col.pop=NULL, col.others=NULL, row.marknames=NULL, NA.char="-9", pop=NULL, missing=NA, ask=TRUE, quiet=FALSE){
-
+
if(!file.exists(file)) stop("Specified file does not exist.")
if(!toupper(.readExt(file)) %in% c("STR","STRU")) stop("File extension .stru expected")
@@ -488,13 +499,13 @@
if(is.null(col.pop)) col.pop <- as.integer(0)
if(is.null(row.marknames)) row.marknames <- as.integer(0)
}
-
+
## required questions
if(is.null(n.ind)){
cat("\n How many genotypes are there? ")
n.ind <- as.integer(readLines(n = 1))
}
-
+
if(is.null(n.loc)){
cat("\n How many markers are there? ")
n.loc <- as.integer(readLines(n = 1))
@@ -519,7 +530,7 @@
if(is.null(row.marknames)){
cat("\n Which row contains the marker names ('0' if absent)? ")
row.marknames <- as.integer(readLines(n = 1))
- }
+ }
if(is.null(onerowperind)){
cat("\n Are genotypes coded by a single row (y/n)? ")
@@ -530,7 +541,7 @@
onerowperind <- FALSE
}
}
-
+
if(is.null(NA.char)){
cat("\n What is the code for missing data (default is '-9')? ")
NA.char <- as.character(readLines(n = 1))
@@ -549,7 +560,7 @@
}
txt <- gsub("([[:blank:]]+)$","",txt)
-
+
## isolate each useful component of the file
# matrix of data
if(onerowperind) {
@@ -565,8 +576,8 @@
mat <- t(as.data.frame(strsplit(mat,"[[:blank:]]+")))
rownames(mat) <- 1:n
gen <- mat[, (ncol(mat)-p+1):ncol(mat)]
-
-
+
+
# markers names
if(row.marknames != 0) {
loc.names <- .rmspaces(txt[row.marknames])
@@ -593,7 +604,7 @@
if(!is.null(col.others)){
X.other <- mat[col.others]
}
-
+
## transformations if onerowperind is FALSE
if(!onerowperind) {
temp <- seq(1,n,by=2)
@@ -605,23 +616,23 @@
## make sur that all strings in gen have the same number of characters
ncode <- max(nchar(gen))
keepCheck <- any(nchar(gen) < ncode)
-
+
while(keepCheck){
mat0 <- matrix("", ncol=ncol(gen), nrow=nrow(gen))
mat0[nchar(gen) < ncode] <- "0"
gen <- matrix(paste(mat0, gen, sep=""), nrow=nrow(mat0))
keepCheck <- any(nchar(gen) < ncode)
}
-
+
# reorder matrix of genotypes
X <- t(sapply(temp, function(i) paste(gen[i,],gen[i+1,],sep="") ))
-
+
} else { # else of "if(!onerowperind)"
temp <- seq(1,p-1,by=2)
X <- paste(gen[,temp] , gen[,temp+1], sep="")
X <- matrix(X, nrow=n.ind)
}
-
+
# replace missing values by NAs
X <- gsub(NA.char,NA,X)
rownames(X) <- ind.names
@@ -634,7 +645,7 @@
if(exists("X.other")) {res at other <- list(X=X.other)}
return(res)
-
+
}
@@ -647,7 +658,7 @@
if(!file.exists(file)) stop("Specified file does not exist.")
ext <- .readExt(file)
ext <- toupper(ext)
-
+
if(ext == "GTX")
return(read.genetix(file,missing=missing,quiet=quiet))
@@ -659,12 +670,12 @@
if(ext %in% c("STR","STRU"))
return(read.structure(file,missing=missing,quiet=quiet, ...))
-
+
# evaluated only if extension is not supported
cat("\n File format (",ext,") not supported.\n")
cat("\nSupported formats are:\nGENETIX (.gtx) \nFSTAT (.dat) \nGenepop (.gen)\n \nSTRUCTURE (.str)\n")
-
- return(invisible())
+
+ return(invisible())
}
Modified: pkg/R/spca.R
===================================================================
--- pkg/R/spca.R 2008-11-05 17:22:47 UTC (rev 200)
+++ pkg/R/spca.R 2008-11-09 15:59:35 UTC (rev 201)
@@ -6,7 +6,7 @@
#
# generic functions were derived from
# those of multispati class (ade4)
-#
+#
# T. Jombart (jombart at biomserv.univ-lyon1.fr)
# 31 may 2007
##############################################
@@ -16,39 +16,55 @@
################
# Function spca
################
-spca <- function(obj, xy=NULL, cn=NULL, scale=FALSE, scale.method=c("sigma","binom"), scannf=TRUE,
- nfposi=1, nfnega=1, type=NULL, ask=TRUE, plot.nb=TRUE, edit.nb=FALSE ,
+spca <- function(obj, xy=NULL, cn=NULL, matWeight=NULL,
+ scale=FALSE, scale.method=c("sigma","binom"),
+ scannf=TRUE, nfposi=1, nfnega=1,
+ type=NULL, ask=TRUE, plot.nb=TRUE, edit.nb=FALSE,
truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL){
-
- if(!any(inherits(obj,c("genind","genpop")))) stop("obj must be a genind or genpop object.")
- invisible(validObject(obj))
+ ## first checks
+ if(!any(inherits(obj,c("genind","genpop")))) stop("obj must be a genind or genpop object.")
+ invisible(validObject(obj))
+ if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
+ if(!require(spdep, quiet=TRUE)) stop("spdep library is required.")
+
## spatial coordinates
if(is.null(xy) & !is.null(obj$other$xy)) xy <- obj$other$xy
if(is.data.frame(xy)) xy <- as.matrix(xy)
if(!is.null(xy) & !is.matrix(xy)) stop("wrong 'xy' provided")
-
- if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
appel <- match.call()
-
- ## connection network
+
+ ## connection network from xy coordinates
if(is.null(cn)) {
- if(is.null(xy)) stop("'xy' and 'cn' are both missing")
- resCN <- chooseCN(xy=xy, ask=ask, type=type, plot.nb=plot.nb, edit.nb=edit.nb,
- result.type="listw", d1=d1, d2=d2, k=k, a=a, dmin=dmin)
- } else {
+ if(is.null(xy)) stop("'xy' and 'cn' are both missing")
+ resCN <- chooseCN(xy=xy, ask=ask, type=type, plot.nb=plot.nb, edit.nb=edit.nb,
+ result.type="listw", d1=d1, d2=d2, k=k, a=a, dmin=dmin)
+ } else if(is.null(matWeight)) { # connection network is provided without matWeight
+
+ ## cn is a 'pure' nb object (i.e., nb but not listw)
if(inherits(cn,"nb") & !inherits(cn,"listw")) {
- xy <- attr(cn,"xy") # xy coords can be retrieved from cn of class nb (not from listw)
+ xy <- attr(cn,"xy") # xy coords can be retrieved from cn of class nb (not from listw)
cn <- nb2listw(cn, style="W", zero.policy=TRUE)
}
+ ## cn is not a recognized object
if(!inherits(cn,"listw")) {
stop("cn does not have a recognized class ('nb' or 'listw', package spdep)")
} else {
+ ## cn is a listw, but not a nb object.
if(is.null(xy)) stop("listw object provided as 'cn' without providing 'xy'")
resCN <- cn
}
+ } else {
+ ## matrix of spatial weights (matWeight)
+ if(!is.matrix(matWeight)) stop("matWeight is not a matrix")
+ if(!is.numeric(matWeight)) stop("matWeight is not numeric")
+ if(nrow(matWeight) != ncol(matWeight)) stop("matWeight is not square")
+ if(nrow(matWeight) != nrow(obj at tab)) stop("dimension of datWeight does not match genetic data")
+ diag(matWeight) <- 0
+ matWeight <- prop.table(matWeight, 1)
+ resCN <- listw2mat(matWeight)
}
## check xy coordinates
@@ -60,9 +76,9 @@
warning("NAs in data are automatically replaced (to mean allele frequency")
}
- ## handle NAs, centring and scaling
+ ## handle NAs, centring and scaling
X <- scaleGen(obj, center=TRUE, scale=scale, method=scale.method, missing="mean", truenames=truenames)
-
+
## perform analyses
pcaX <- dudi.pca(X, center=FALSE, scale=FALSE, scannf=FALSE)
@@ -74,9 +90,9 @@
spcaX$xy <- xy
rownames(spcaX$xy) <- rownames(spcaX$li)
colnames(spcaX$xy) <- c("x","y")
-
+
spcaX$lw <- resCN
-
+
spcaX$call <- appel
posaxes <- if(nfposi>0) {1:nfposi} else NULL
@@ -91,7 +107,7 @@
colnames(spcaX$as) <- colnames(spcaX$c1)
temp <- row.names(spcaX$as)
row.names(spcaX$as) <- paste("PCA",temp)
-
+
class(spcaX) <- "spca"
return(spcaX)
@@ -115,21 +131,21 @@
print(x$call)
cat("\n$nfposi:", x$nfposi, "axis-components saved")
cat("\n$nfnega:", x$nfnega, "axis-components saved")
-
+
cat("\nPositive eigenvalues: ")
l0 <- sum(x$eig >= 0)
cat(signif(x$eig, 4)[1:(min(5, l0))])
- if (l0 > 5)
+ if (l0 > 5)
cat(" ...\n")
- else cat("\n")
+ else cat("\n")
cat("Negative eigenvalues: ")
l0 <- sum(x$eig <= 0)
cat(sort(signif(x$eig, 4))[1:(min(5, l0))])
- if (l0 > 5)
+ if (l0 > 5)
cat(" ...\n")
else cat("\n")
cat('\n')
- sumry <- array("", c(1, 4), list(1, c("vector", "length",
+ sumry <- array("", c(1, 4), list(1, c("vector", "length",
"mode", "content")))
sumry[1, ] <- c('$eig', length(x$eig), mode(x$eig), 'eigenvalues')
class(sumry) <- "table"
@@ -140,15 +156,15 @@
sumry[2, ] <- c("$li", nrow(x$li), ncol(x$li), "principal components: coordinates of entities ('scores')")
sumry[3, ] <- c("$ls", nrow(x$ls), ncol(x$ls), 'lag vector of principal components')
sumry[4, ] <- c("$as", nrow(x$as), ncol(x$as), 'pca axes onto spca axes')
-
+
class(sumry) <- "table"
print(sumry)
cat("\n$xy: matrix of spatial coordinates")
cat("\n$lw: a list of spatial weights (class 'listw')")
-
+
cat("\n\nother elements: ")
- if (length(names(x)) > 10)
+ if (length(names(x)) > 10)
cat(names(x)[11:(length(names(x)))], "\n")
else cat("NULL\n")
}
@@ -177,41 +193,41 @@
}
resfin <- list()
-
+
if(printres) {
cat("\nSpatial principal component analysis\n")
cat("\nCall: ")
print(object$call)
}
-
+
appel <- as.list(object$call)
## compute original pca
# prepare data
obj <- eval(appel$obj)
if(is.null(appel$truenames)) truenames <- FALSE
-
+
f1 <- function(vec){
m <- mean(vec,na.rm=TRUE)
vec[is.na(vec)] <- m
return(vec)
}
-
+
if(is.genind(obj)) { X <- obj at tab }
if(is.genpop(obj)) { X <- makefreq(obj, quiet=TRUE)$tab }
-
+
X <- apply(X,2,f1)
-
+
if(truenames){
rownames(X) <- rownames(truenames(obj))
- colnames(X) <- colnames(truenames(obj))
+ colnames(X) <- colnames(truenames(obj))
}
-
+
nfposi <- object$nfposi
nfnega <- object$nfnega
-
+
dudi <- dudi.pca(X, center=TRUE, scale=FALSE, scannf=FALSE, nf=nfposi+nfnega)
## end of pca
-
+
lw <- object$lw
# I0, Imin, Imax
@@ -232,7 +248,7 @@
names(Istat) <- c("I0","Imin","Imax")
resfin$Istat <- Istat
-
+
# les scores de l'analyse de base
nf <- dudi$nf
eig <- dudi$eig[1:nf]
@@ -249,13 +265,13 @@
resfin$pca <- res
-
+
# les scores de l'analyse spatiale
# on recalcule l'objet en gardant tous les axes
eig <- object$eig
nfposimax <- sum(eig > 0)
nfnegamax <- sum(eig < 0)
-
+
ms <- multispati(dudi=dudi, listw=lw, scannf=FALSE,
nfposi=nfposimax, nfnega=nfnegamax)
@@ -266,14 +282,14 @@
moran <- apply(as.matrix(ms$li)*as.matrix(ms$ls)*dudi$lw,2,sum)
res <- data.frame(eig=eig,var=varspa,moran=moran/varspa)
row.names(res) <- paste("Axis",1:length(eig))
-
+
if(printres) {
cat("\nsPCA eigenvalues decomposition:\n")
print(res[agarder,])
}
-
+
resfin$spca <- res
-
+
return(invisible(resfin))
}
@@ -288,7 +304,7 @@
if(!require(ade4)) stop("ade4 package is required.")
if(!require(spdep)) stop("spdep package is required.")
if(axis>ncol(x$li)) stop("wrong axis required.")
-
+
opar <- par(no.readonly = TRUE)
on.exit(par(opar))
par(mar = rep(.1,4), mfrow=c(3,2))
@@ -311,29 +327,29 @@
} else {
neig <- NULL
}
-
+
sub <- paste("Score",axis)
csub <- 2
-
+
# 1
if(n<30) clab <- 1 else clab <- 0
s.label(xy, clab=clab, include.ori=FALSE, addaxes=FALSE, neig=neig,
- cneig=1, sub="Connection network", csub=2)
-
+ cneig=1, sub="Connection network", csub=2)
+
# 2
s.image(xy,z, include.ori=FALSE, grid=TRUE, kgrid=10, cgrid=1,
sub=sub, csub=csub, possub="bottomleft")
box()
-
+
# 3
if(n<30) {neig <- nb2neig(x$lw$neighbours)} else {neig <- NULL}
s.value(xy,z, include.ori=FALSE, addaxes=FALSE, clegend=0, csize=.6,
neig=neig, sub=sub, csub=csub, possub="bottomleft")
-
+
# 4
s.value(xy,z, include.ori=FALSE, addaxes=FALSE, clegend=0, csize=.6,
method="greylevel", neig=neig, sub=sub, csub=csub, possub="bottomleft")
-
+
# 5
omar <- par("mar")
par(mar = c(0.8, 2.8, 0.8, 0.8))
@@ -343,13 +359,13 @@
if (nfnega>0) {col.w[m:(m-nfnega+1)] <- "grey"}
j <- axis
if (j>nfposi) {j <- j-nfposi +m -nfnega}
- col.w[j] <- "black"
+ col.w[j] <- "black"
barplot(x$eig, col = col.w)
scatterutil.sub(cha ="Eigenvalues", csub = 2.5, possub = "topright")
par(mar=rep(.1,4))
box()
par(mar=omar)
-
+
# 6
par(mar=c(4,4,2,1))
screeplot(x,main="Eigenvalues decomposition")
@@ -369,11 +385,11 @@
on.exit(par(las=opar))
sumry <- summary(x,printres=FALSE)
-
+
labels <- lapply(1:length(x$eig),function(i) bquote(lambda[.(i)]))
par(las=1)
-
+
xmax <- sumry$pca[1,1]*1.1
I0 <- sumry$Istat[1]
Imin <- sumry$Istat[2]
@@ -381,7 +397,7 @@
plot(x=sumry$spca[,2],y=sumry$spca[,3],type='n',xlab='Variance',ylab="Spatial autocorrelation (I)",xlim=c(0,xmax),ylim=c(Imin*1.1,Imax*1.1),yaxt='n',...)
text(x=sumry$spca[,2],y=sumry$spca[,3],do.call(expression,labels))
-
+
ytick <- c(I0,round(seq(Imin,Imax,le=5),1))
ytlab <- as.character(round(seq(Imin,Imax,le=5),1))
ytlab <- c(as.character(round(I0,1)),as.character(round(Imin,1)),ytlab[2:4],as.character(round(Imax,1)))
@@ -393,7 +409,7 @@
if(is.null(main)) main <- ("Spatial and variance components of the eigenvalues")
title(main)
-
+
return(invisible(match.call()))
}
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-11-05 17:22:47 UTC (rev 200)
+++ pkg/TODO 2008-11-09 15:59:35 UTC (rev 201)
@@ -27,7 +27,7 @@
# CODE ISSUES:
==============
* fix bug 1.2-2.01 (read.structure issue) -- fixed: was due to the default of "onerowperind" argument.
-* fix bug 1.2-2.02 (read.genetix issue)
+* fix bug 1.2-2.02 (read.genetix issue) -- fixed: was due to an error in the data file (wrong nloc); now read.genetix corrects that automatically and issues a warning. (TJ)
* fix bug 1.2-2.03 (monmonier issue)
* fix request 1.2-2.04 (implement adjusted heretozygosity in summary)
Modified: pkg/man/spca.Rd
===================================================================
--- pkg/man/spca.Rd 2008-11-05 17:22:47 UTC (rev 200)
+++ pkg/man/spca.Rd 2008-11-09 15:59:35 UTC (rev 201)
@@ -28,11 +28,17 @@
- \code{colorplot.spca}: represents principal components of sPCA in
space using the RGB system.\cr
+
+ A tutorial describes how to perform a sPCA: see
+ \url{http://adegenet.r-forge.r-project.org/files/tutorial-spca.pdf} or
+ type \code{adegenetTutorial(which="spca")}.
}
\usage{
-spca(obj, xy=NULL, cn=NULL, scale=FALSE, scale.method=c("sigma","binom"), scannf=TRUE, nfposi=1,
- nfnega=1, type=NULL, ask=TRUE,plot.nb=TRUE, edit.nb=FALSE
- ,truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL)
+spca(obj, xy=NULL, cn=NULL, matWeight=NULL,
+ scale=FALSE, scale.method=c("sigma","binom"),
+ scannf=TRUE, nfposi=1, nfnega=1,
+ type=NULL, ask=TRUE, plot.nb=TRUE, edit.nb=FALSE,
+ truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL)
\method{print}{spca}(x, \dots)
@@ -50,11 +56,14 @@
coordinates. Seeked from obj\$other\$xy if it exists when xy is not
provided. Can be NULL if a \code{nb} object is provided in
\code{cn}.\cr
- Longitude/latitude coordinates should be converted first by a given projection (see See
- Also section).}
+ Longitude/latitude coordinates should be converted first by a given
+ projection (see See Also section).}
\item{cn}{a connection network of the class 'nb' (package spdep). Can
be NULL if xy is provided. Can be easily obtained using the function
- chooseCN.}
+ chooseCN (see details).}
+ \item{matWeight}{a square matrix of spatial weights, indicating the
+ spatial proximities between entities. If provided, this argument
+ prevails over \code{cn} (see details).}
\item{scale}{a logical indicating whether alleles should be scaled to
unit variance (TRUE) or not (FALSE, default).}
\item{scale.method}{a character string indicating the method used for
@@ -101,13 +110,20 @@
\item{useLag}{a logical stating whether the lagged components
(\code{x\$ls}) should be used instead of the components (\code{x\$li}).}
}
-\details{The spatial principal component analysis (sPCA) is designed to
+\details{
+ The spatial principal component analysis (sPCA) is designed to
investigate spatial patterns in the genetic variability. Given
multilocus genotypes (individual level) or allelic frequency
(population level) and spatial coordinates, it finds individuals (or
population) scores maximizing the product of variance and spatial
autocorrelation (Moran's I). Large positive and negative eigenvalues
- correspond to global and local structures.
+ correspond to global and local structures.\cr
+
+ Spatial weights can be obtained in several ways, depending how the
+ arguments \code{xy}, \code{cn}, and \code{matWeight} are set.\cr
+ When several acceptable ways are used at the same time, priority is as
+ follows:\cr
+ \code{matWeight} > \code{cn} > \code{xy} \cr
}
\value{The class \code{spca} are given to lists with the following
components:\cr
Modified: pkg/misc/bug-report.1.2-2.02/PhylogenieclariasAllozymestotalmanu.gtx
===================================================================
--- pkg/misc/bug-report.1.2-2.02/PhylogenieclariasAllozymestotalmanu.gtx 2008-11-05 17:22:47 UTC (rev 200)
+++ pkg/misc/bug-report.1.2-2.02/PhylogenieclariasAllozymestotalmanu.gtx 2008-11-09 15:59:35 UTC (rev 201)
@@ -29,7 +29,7 @@
LDH2
3 096 100 105
6PGD
-4 050 055 090 100
+4 050 055 090 100
More information about the adegenet-commits
mailing list