new alex()

[ape.git] / R / DNA.R

diff --git a/R/DNA.R b/R/DNA.R
index 747117d9600e3d7f0a94a85292e45750c9a41a79..abf3a4343a33b4d456a6d1edfe549855249d55d0 100644 (file)
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,8 +1,8 @@
-## DNA.R (2011-03-16)
+## DNA.R (2012-02-14)
 
 ##   Manipulations and Comparisons of DNA Sequences
 
-## Copyright 2002-2011 Emmanuel Paradis
+## Copyright 2002-2012 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -227,7 +227,7 @@ print.DNAbin <- function(x, printlen = 6, digits = 3, ...)
 as.DNAbin <- function(x, ...) UseMethod("as.DNAbin")
 
 ._cs_ <- c("a", "g", "c", "t", "r", "m", "w", "s", "k",
-           "y", "v", "h",  "d", "b", "n", "-", "?")
+           "y", "v", "h", "d", "b", "n", "-", "?")
 
 ._bs_ <- c(136, 72, 40, 24, 192, 160, 144, 96, 80,
            48, 224, 176, 208, 112, 240, 4, 2)
@@ -353,16 +353,17 @@ dist.dna <- function(x, model = "K80", variance = FALSE, gamma = FALSE,
                      as.matrix = FALSE)
 {
     MODELS <- c("RAW", "JC69", "K80", "F81", "K81", "F84", "T92", "TN93",
-                "GG95", "LOGDET", "BH87", "PARALIN", "N", "TS", "TV")
+                "GG95", "LOGDET", "BH87", "PARALIN", "N", "TS", "TV",
+                "INDEL", "INDELBLOCK")
     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.")
+        warning("computing variance not available for model BH87")
         variance <- FALSE
     }
-    if (gamma && imod %in% c(1, 5:7, 9:15)) {
+    if (gamma && imod %in% c(1, 5:7, 9:17)) {
         warning(paste("gamma-correction not available for model", model))
         gamma <- FALSE
     }
@@ -371,9 +372,13 @@ dist.dna <- function(x, model = "K80", variance = FALSE, gamma = FALSE,
     n <- dim(x)
     s <- n[2]
     n <- n[1]
+
     if (imod %in% c(4, 6:8)) {
         BF <- if (is.null(base.freq)) base.freq(x) else base.freq
     } else BF <- 0
+
+    if (imod %in% 16:17) pairwise.deletion <- TRUE
+
     if (!pairwise.deletion) {
         keep <- .C("GlobalDeletionDNA", x, n, s,
                    rep(1L, s), PACKAGE = "ape")[[4]]
@@ -418,16 +423,18 @@ image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
     y <- integer(N <- length(x))
     ncl <- length(what)
     col <- rep(col, length.out = ncl)
+    brks <- 0.5:(ncl + 0.5)
     sm <- 0L
     for (i in ncl:1) {
         k <- ._bs_[._cs_ == what[i]]
         sel <- which(x == k)
-        if (ll <- length(sel)) {
+        if (L <- length(sel)) {
             y[sel] <- i
-            sm <- sm + ll
+            sm <- sm + L
         } else {
             what <- what[-i]
             col <- col[-i]
+            brks <- brks[-i]
         }
     }
     dim(y) <- dx
@@ -439,10 +446,11 @@ image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
         co <- c(bg, col)
         leg.txt <- c(toupper(what), "others")
         leg.co <- c(col, bg)
+        brks <- c(-0.5, brks)
     }
     yaxt <- if (show.labels) "n" else "s"
-    image(1:s, 1:n, t(y), col = co, xlab = xlab,
-          ylab = ylab, yaxt = yaxt, ...)
+    graphics::image.default(1:s, 1:n, t(y), col = co, xlab = xlab,
+                            ylab = ylab, yaxt = yaxt, breaks = brks, ...)
     if (show.labels)
         mtext(rownames(x), side = 2, line = 0.1, at = 1:n,
               cex = cex.lab, adj = 1, las = 1)