-## DNA.R (2009-05-19)
+## DNA.R (2010-03-16)
## Manipulations and Comparisons of DNA Sequences
-## Copyright 2002-2009 Emmanuel Paradis
+## Copyright 2002-2010 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
obj <- list(...)
n <- length(obj)
if (n == 1) return(obj[[1]])
+ for (i in 1:n)
+ if (!is.matrix(obj[[1]]))
+ stop("the 'rbind' method for \"DNAbin\" accepts only matrices")
NC <- unlist(lapply(obj, ncol))
if (length(unique(NC)) > 1)
stop("matrices do not have the same number of columns.")
obj <- list(...)
n <- length(obj)
if (n == 1) return(obj[[1]])
+ for (i in 1:n)
+ if (!is.matrix(obj[[1]]))
+ stop("the 'cbind' method for \"DNAbin\" accepts only matrices")
NR <- unlist(lapply(obj, nrow))
for (i in 1:n) class(obj[[i]]) <- NULL
if (check.names) {
}
c.DNAbin <- function(..., recursive = FALSE)
+{
+ if (!all(unlist(lapply(list(...), is.list))))
+ stop("the 'c' method for \"DNAbin\" accepts only lists")
structure(NextMethod("c"), class = "DNAbin")
+}
print.DNAbin <- function(x, ...)
{
if (is.list(x)) lapply(x, f) else f(x)
}
-base.freq <- function(x)
+base.freq <- function(x, freq = FALSE)
{
if (is.list(x)) x <- unlist(x)
n <- length(x)
- BF <- .C("BaseProportion", x, n, double(4),
+ BF <- .C("BaseProportion", x, n, double(4), freq,
DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")[[3]]
names(BF) <- letters[c(1, 3, 7, 20)]
BF
seg.sites <- function(x)
{
if (is.list(x)) x <- as.matrix(x)
- n <- dim(x)
- s <- n[2]
- n <- n[1]
+ if (is.vector(x)) n <- 1
+ else { # 'x' is a matrix
+ n <- dim(x)
+ s <- n[2]
+ n <- n[1]
+ }
+ if (n == 1) return(integer(0))
ans <- .C("SegSites", x, n, s, integer(s),
DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
which(as.logical(ans[[4]]))
}
-nuc.div <- function(x, variance = FALSE, pairwise.deletion = FALSE)
-{
- if (pairwise.deletion && variance)
- warning("cannot compute the variance of nucleotidic diversity\nwith pairwise deletion: try 'pairwise.deletion = FALSE' instead.")
- if (is.list(x)) x <- as.matrix(x)
- n <- dim(x)[1]
- ans <- sum(dist.dna(x, "raw", pairwise.deletion = pairwise.deletion))/
- (n*(n - 1)/2)
- if (variance) {
- var <- (n + 1)*ans/(3*(n + 1)*dim(x)[2]) + 2*(n^2 + n + 3)*ans/(9*n*(n - 1))
- ans <- c(ans, var)
- }
- ans
-}
-
dist.dna <- function(x, model = "K80", variance = FALSE, gamma = FALSE,
pairwise.deletion = FALSE, base.freq = NULL,
as.matrix = FALSE)
{
MODELS <- c("RAW", "JC69", "K80", "F81", "K81", "F84", "T92", "TN93",
"GG95", "LOGDET", "BH87", "PARALIN", "N")
- imod <- which(MODELS == toupper(model))
+ imod <- pmatch(toupper(model), MODELS)
+ if (is.na(imod))
+ stop(paste("'model' must be one of:",
+ paste("\"", MODELS, "\"", sep = "", collapse = " ")))
if (imod == 11 && variance) {
warning("computing variance temporarily not available for model BH87.")
variance <- FALSE