-## DNA.R (2009-09-18)
+## DNA.R (2010-05-17)
## 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.
+labels.DNAbin <- function(object, ...)
+{
+ if (is.list(object)) return(names(object))
+ if (is.matrix(object)) return(rownames(object))
+ NULL
+}
+
del.gaps <- function(x)
{
deleteGaps <- function(x) {
obj
}
-"[.DNAbin" <- function(x, i, j, drop = TRUE)
+"[.DNAbin" <- function(x, i, j, drop = FALSE)
{
oc <- oldClass(x)
class(x) <- NULL
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)
- structure(NextMethod("c"), class = "DNAbin")
-
-print.DNAbin <- function(x, ...)
{
- n <- 1 # <- if is.vector(x)
- if (is.list(x)) n <- length(x)
- else if (is.matrix(x)) n <- dim(x)[1]
- if (n > 1) cat(n, "DNA sequences in binary format.\n")
- else cat("1 DNA sequence in binary format.\n")
+ if (!all(unlist(lapply(list(...), is.list))))
+ stop("the 'c' method for \"DNAbin\" accepts only lists")
+ structure(NextMethod("c"), class = "DNAbin")
}
-summary.DNAbin <- function(object, printlen = 6, digits = 3, ...)
+print.DNAbin <- function(x, printlen = 6, digits = 3, ...)
{
- if (is.list(object)) {
- n <- length(object)
- nms <- names(object)
+ if (is.list(x)) {
+ n <- length(x)
+ nms <- names(x)
if (n == 1) {
cat("1 DNA sequence in binary format stored in a list.\n\n")
- cat("Sequence length:", length(object[[1]]), "\n\n")
+ cat("Sequence length:", length(x[[1]]), "\n\n")
cat("Label:", nms, "\n\n")
} else {
cat(n, "DNA sequences in binary format stored in a list.\n\n")
- tmp <- unlist(lapply(object, length))
+ tmp <- unlist(lapply(x, length))
mini <- min(tmp)
maxi <- max(tmp)
if (mini == maxi)
}
cat("\nLabels:", paste(nms, collapse = " "), TAIL)
}
- } else if (is.matrix(object)) {
- nd <- dim(object)
- nms <- rownames(object)
+ } else if (is.matrix(x)) {
+ nd <- dim(x)
+ nms <- rownames(x)
cat(nd[1], "DNA sequences in binary format stored in a matrix.\n\n")
cat("All sequences of same length:", nd[2], "\n")
TAIL <- "\n\n"
cat("\nLabels:", paste(nms, collapse = " "), TAIL)
} else {
cat("1 DNA sequence in binary format stored in a vector.\n\n")
- cat("Sequence length:", length(object), "\n\n")
+ cat("Sequence length:", length(x), "\n\n")
}
cat("Base composition:\n")
- print(round(base.freq(object), digits))
+ print(round(base.freq(x), digits))
}
as.DNAbin <- function(x, ...) UseMethod("as.DNAbin")
{
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