-## DNA.R (2008-12-22)
+## DNA.R (2009-10-02)
## Manipulations and Comparisons of DNA Sequences
-## Copyright 2002-2008 Emmanuel Paradis
+## Copyright 2002-2009 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
if (length(i)) x[-i] else x
}
- if (class(x) != "DNAbin") x <- as.DNAbin(x)
+ if (!inherits(x, "DNAbin")) x <- as.DNAbin(x)
if (is.matrix(x)) {
n <- dim(x)[1]
y <- vector("list", n)
for (i in 1:n) y[[i]] <- x[i, ]
+ names(y) <- rownames(x)
x <- y
rm(y)
}
"[.DNAbin" <- function(x, i, j, drop = TRUE)
{
+ oc <- oldClass(x)
class(x) <- NULL
if (is.matrix(x)) {
if (nargs() == 2 && !missing(i)) ans <- x[i]
if (missing(i)) i <- 1:length(x)
ans <- x[i]
}
- structure(ans, class = "DNAbin")
+ class(ans) <- oc
+ ans
}
as.matrix.DNAbin <- function(x, ...)
{
- if (is.matrix(x)) return(x)
if (is.list(x)) {
if (length(unique(unlist(lapply(x, length)))) != 1)
stop("DNA sequences in list not of the same length.")
ans
}
+c.DNAbin <- function(..., recursive = FALSE)
+ structure(NextMethod("c"), class = "DNAbin")
+
print.DNAbin <- function(x, ...)
{
n <- 1 # <- if is.vector(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