[adegenet-commits] r837 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 4 12:30:49 CET 2011
Author: jombart
Date: 2011-03-04 12:30:49 +0100 (Fri, 04 Mar 2011)
New Revision: 837
Modified:
pkg/R/dapc.R
pkg/R/import.R
pkg/R/loadingplot.R
pkg/man/dapc.Rd
pkg/man/loadingplot.Rd
pkg/man/read.PLINK.Rd
Log:
DAPC var.contr fixed.
Loadingplot odd naming/labelling fixed.
read.PLINK got rid of ploidy=2
Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/R/dapc.R 2011-03-04 11:30:49 UTC (rev 837)
@@ -7,7 +7,7 @@
## dapc.data.frame
#################
dapc.data.frame <- function(x, grp, n.pca=NULL, n.da=NULL,
- center=TRUE, scale=FALSE, var.contrib=FALSE,
+ center=TRUE, scale=FALSE, var.contrib=TRUE,
pca.select=c("nbEig","percVar"), perc.pca=NULL, ..., dudi=NULL){
## FIRST CHECKS
@@ -100,7 +100,7 @@
## optional: get loadings of alleles
if(var.contrib){
- res$var.contr <- as.matrix(U) %*% as.matrix(ldaX$scaling)
+ res$var.contr <- as.matrix(U) %*% as.matrix(ldaX$scaling[,1:n.da,drop=FALSE])
f1 <- function(x){
temp <- sum(x*x)
if(temp < 1e-12) return(rep(0, length(x)))
@@ -131,7 +131,7 @@
## dapc.genind
#############
dapc.genind <- function(x, pop=NULL, n.pca=NULL, n.da=NULL,
- scale=FALSE, scale.method=c("sigma", "binom"), truenames=TRUE, all.contrib=FALSE,
+ scale=FALSE, scale.method=c("sigma", "binom"), truenames=TRUE, var.contrib=TRUE,
pca.select=c("nbEig","percVar"), perc.pca=NULL, ...){
## FIRST CHECKS
@@ -160,7 +160,7 @@
## CALL DATA.FRAME METHOD ##
res <- dapc(X, grp=pop.fac, n.pca=n.pca, n.da=n.da,
- center=FALSE, scale=FALSE, var.contrib=all.contrib,
+ center=FALSE, scale=FALSE, var.contrib=var.contrib,
pca.select=pca.select, perc.pca=perc.pca)
res$call <- match.call()
@@ -213,17 +213,24 @@
## data.frames
cat("\n")
- sumry <- array("", c(5, 4), list(1:5, c("data.frame", "nrow", "ncol", "content")))
+ if(!is.null(x$var.contr)){
+ sumry <- array("", c(6, 4), list(1:6, c("data.frame", "nrow", "ncol", "content")))
+ } else {
+ sumry <- array("", c(5, 4), list(1:5, c("data.frame", "nrow", "ncol", "content")))
+ }
sumry[1, ] <- c("$tab", nrow(x$tab), ncol(x$tab), "retained PCs of PCA")
sumry[2, ] <- c("$loadings", nrow(x$loadings), ncol(x$loadings), "loadings of variables")
sumry[3, ] <- c("$ind.coord", nrow(x$ind.coord), ncol(x$ind.coord), "coordinates of individuals (principal components)")
sumry[4, ] <- c("$grp.coord", nrow(x$grp.coord), ncol(x$grp.coord), "coordinates of groups")
sumry[5, ] <- c("$posterior", nrow(x$posterior), ncol(x$posterior), "posterior membership probabilities")
+ if(!is.null(x$var.contr)){
+ sumry[6, ] <- c("$var.contr", nrow(x$var.contr), ncol(x$var.contr), "contribution of original variables")
+ }
class(sumry) <- "table"
print(sumry)
cat("\nother elements: ")
- if (length(names(x)) > 13)
+ if (length(names(x)) > 14)
cat(names(x)[14:(length(names(x)))], "\n")
else cat("NULL\n")
}
Modified: pkg/R/import.R
===================================================================
--- pkg/R/import.R 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/R/import.R 2011-03-04 11:30:49 UTC (rev 837)
@@ -895,7 +895,7 @@
## EXTRACT INFO AND RETURN OBJECT ##
## return a genlight
- if(!is.null(x)){
+ if(!is.null(x)){
## match data
ord <- match(locNames(x), txt[,2]) # check that it is the 2nd column
if(!inherits(x, "genlight")) stop("x is not a genlight object")
@@ -920,7 +920,7 @@
########################
## Function read.PLINK
########################
-read.PLINK <- function(file, map.file=NULL, quiet=FALSE, chunkSize=1000, ploidy=2,
+read.PLINK <- function(file, map.file=NULL, quiet=FALSE, chunkSize=1000,
multicore=require("multicore"), n.cores=NULL, ...){
## HANDLE ARGUMENTS ##
ext <- .readExt(file)
@@ -977,10 +977,10 @@
txt <- lapply(txt, function(e) suppressWarnings(as.integer(e[-(1:6)])))
if(multicore){
- res <- c(res, mclapply(txt, function(e) new("SNPbin", snp=e, ploidy=ploidy),
+ 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 {
- res <- c(res, lapply(txt, function(e) new("SNPbin", snp=e, ploidy=ploidy)) )
+ res <- c(res, lapply(txt, function(e) new("SNPbin", snp=e, ploidy=2)) )
}
lines.to.skip <-lines.to.skip + length(txt)
Modified: pkg/R/loadingplot.R
===================================================================
--- pkg/R/loadingplot.R 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/R/loadingplot.R 2011-03-04 11:30:49 UTC (rev 837)
@@ -5,14 +5,18 @@
loadingplot.default <- function(x, at=NULL, threshold=quantile(x,0.75), axis=1, fac=NULL, byfac=FALSE,
- lab=rownames(x), cex.lab=0.7, cex.fac=1, lab.jitter=0,
+ lab=NULL, cex.lab=0.7, cex.fac=1, lab.jitter=0,
main="Loading plot", xlab="Variables", ylab="Loadings", srt=0, adj=NULL, ...){
## some checks
- if(is.data.frame(x) || is.matrix(x)){
- temp <- rownames(x)
+ if(is.data.frame(x) | is.matrix(x)){
+ if(is.null(lab)) {lab <- rownames(x)}
x <- x[,axis]
names(x) <- temp
+ } else {
+ if(is.null(lab)) {lab <- names(x)}
}
+ lab <- rep(lab, length=length(x))
+
if(!is.numeric(x)) stop("x is not numeric")
if(any(is.na(x))) stop("NA entries in x")
if(any(x<0)) {
Modified: pkg/man/dapc.Rd
===================================================================
--- pkg/man/dapc.Rd 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/man/dapc.Rd 2011-03-04 11:30:49 UTC (rev 837)
@@ -37,13 +37,13 @@
}
\usage{
\method{dapc}{data.frame}(x, grp, n.pca=NULL, n.da=NULL, center=TRUE,
- scale=FALSE,var.contrib=FALSE, pca.select=c("nbEig","percVar"),
+ scale=FALSE,var.contrib=TRUE, pca.select=c("nbEig","percVar"),
perc.pca=NULL, \ldots, dudi=NULL)
\method{dapc}{matrix}(x, \ldots)
\method{dapc}{genind}(x, pop=NULL, n.pca=NULL, n.da=NULL, scale=FALSE,
- scale.method=c("sigma", "binom"), truenames=TRUE, all.contrib=FALSE,
+ scale.method=c("sigma", "binom"), truenames=TRUE, var.contrib=TRUE,
pca.select=c("nbEig","percVar"), perc.pca=NULL, \ldots)
\method{dapc}{dudi}(x, grp, \ldots)
@@ -79,9 +79,9 @@
(estimated) standard deviation to account for trivial differences in
variances. Further scaling options are available for \linkS4class{genind}
objects (see argument \code{scale.method}).}
- \item{var.contrib,all.contrib}{a \code{logical} indicating whether the
+ \item{var.contrib}{a \code{logical} indicating whether the
contribution of original variables (alleles, for \linkS4class{genind} objects)
- should be provided (TRUE) or not (FALSE, default). Such output can be useful,
+ should be provided (TRUE, default) or not (FALSE). Such output can be useful,
but can also create huge matrices when there is a lot of variables.}
\item{pca.select}{a \code{character} indicating the mode of selection of PCA
axes, matching either "nbEig" or "percVar". For "nbEig", the user
@@ -213,7 +213,7 @@
## showing different scatter options ##
data(H3N2)
pop(H3N2) <- factor(H3N2$other$epid)
-dapc1 <- dapc(H3N2, all.contrib=FALSE, scale=FALSE, n.pca=150, n.da=5)
+dapc1 <- dapc(H3N2, var.contrib=FALSE, scale=FALSE, n.pca=150, n.da=5)
## remove internal segments and ellipses, different pch
scatter(dapc1, cell=0, pch=18:23, cstar=0)
Modified: pkg/man/loadingplot.Rd
===================================================================
--- pkg/man/loadingplot.Rd 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/man/loadingplot.Rd 2011-03-04 11:30:49 UTC (rev 837)
@@ -14,7 +14,7 @@
loadingplot(x, \dots)
\method{loadingplot}{default}(x, at=NULL, threshold=quantile(x,0.75), axis=1, fac=NULL, byfac=FALSE,
- lab=rownames(x), cex.lab=0.7, cex.fac=1, lab.jitter=0,
+ lab=NULL, cex.lab=0.7, cex.fac=1, lab.jitter=0,
main="Loading plot", xlab="Variables", ylab="Loadings", srt = 0, adj = NULL, \dots)
}
@@ -33,7 +33,7 @@
\item{byfac}{a logical stating whether loadings should be averaged by
groups of observations, as defined by \code{fac}.}
\item{lab}{a character vector giving the labels used to annotate
- values above the threshold.}
+ values above the threshold; if NULL, names are taken from the object.}
\item{cex.lab}{a numeric value indicating the size of annotations.}
\item{cex.fac}{a numeric value indicating the size of annotations for
groups of observations.}
Modified: pkg/man/read.PLINK.Rd
===================================================================
--- pkg/man/read.PLINK.Rd 2011-03-03 18:56:17 UTC (rev 836)
+++ pkg/man/read.PLINK.Rd 2011-03-04 11:30:49 UTC (rev 837)
@@ -9,7 +9,8 @@
software with extension '.raw' and converts it into a
\linkS4class{genlight} object. Optionally, information about SNPs can
be read from a ".map" file, either by specifying the argument
- \code{map.file} in \code{read.PLINK}, or using \code{extract.PLINKmap}.
+ \code{map.file} in \code{read.PLINK}, or using \code{extract.PLINKmap}
+ to add information to an existing \linkS4class{genlight} object.
The function reads data by chunks of several genomes (minimum 1, no
maximum) at a time, which allows one to read massive datasets with
@@ -22,7 +23,7 @@
to the '.raw' format.
}
\usage{
-read.PLINK(file, map.file=NULL, quiet=FALSE, chunkSize=1000, ploidy=2,
+read.PLINK(file, map.file=NULL, quiet=FALSE, chunkSize=1000,
multicore=require("multicore"), n.cores=NULL, \dots)
extract.PLINKmap(file, x=NULL)
@@ -41,9 +42,7 @@
\item{chunkSize}{an integer indicating the number of genomes to be
read at a time; larger values require more RAM but decrease the time
needed to read the data.}
- \item{ploidy}{an integer indicating the ploidy of the data; defaults to
- 2.}
- \item{multicore}{a logical indicating whether multiple cores -if
+ \item{multicore}{a logical indicating whether multiple cores -if
available- should be used for the computations (TRUE, default), or
not (FALSE); requires the package \code{multicore} to be installed
(see details).}
More information about the adegenet-commits
mailing list