X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2FDNA.R;h=dea2d60ddffbb907e575fa2596de76b83ab7ef48;hb=2419de65ffb4f7c45eb8c2448bcba3d0df64744f;hp=72e12582617e0927bdc5d9a2a884d5784b6c46fb;hpb=dca7b216e929337836a18374147b13eb793ffd95;p=ape.git

diff --git a/R/DNA.R b/R/DNA.R
index 72e1258..dea2d60 100644
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,12 +1,19 @@
-## 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) {
@@ -49,7 +56,7 @@ as.alignment <- function(x)
     obj
 }
 
-"[.DNAbin" <- function(x, i, j, drop = TRUE)
+"[.DNAbin" <- function(x, i, j, drop = FALSE)
 {
     oc <- oldClass(x)
     class(x) <- NULL
@@ -90,6 +97,9 @@ rbind.DNAbin <- function(...)
     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.")
@@ -106,6 +116,9 @@ cbind.DNAbin <-
     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) {
@@ -144,29 +157,24 @@ cbind.DNAbin <-
 }
 
 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)
@@ -183,9 +191,9 @@ summary.DNAbin <- function(object, printlen = 6, digits = 3, ...)
             }
             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"
@@ -196,10 +204,10 @@ summary.DNAbin <- function(object, printlen = 6, digits = 3, ...)
         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")
@@ -292,7 +300,10 @@ dist.dna <- function(x, model = "K80", variance = FALSE, gamma = 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