X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2FDNA.R;h=c751c5088812c96c893666233c83db0db91ff906;hb=2db1869a11e5d88afb74ddeea5ea1c5c3aadf249;hp=7599265ea7ba08f3792cfd3fc5034b0b75889b61;hpb=4ceef408de61dc86f0a93b0396aecc6e30cc0d70;p=ape.git

diff --git a/R/DNA.R b/R/DNA.R
index 7599265..c751c50 100644
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,4 +1,4 @@
-## DNA.R (2009-05-10)
+## DNA.R (2009-10-02)
 
 ##   Manipulations and Comparisons of DNA Sequences
 
@@ -19,6 +19,7 @@ del.gaps <- function(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)
     }
@@ -142,6 +143,9 @@ cbind.DNAbin <-
     ans
 }
 
+c.DNAbin <- function(..., recursive = FALSE)
+    structure(NextMethod("c"), class = "DNAbin")
+
 print.DNAbin <- function(x, ...)
 {
     n <- 1 # <- if is.vector(x)
@@ -255,11 +259,11 @@ as.character.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
@@ -270,36 +274,28 @@ GC.content <- function(x) sum(base.freq(x)[2:3])
 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