bug fix in seg.sites + new option in base.freq

[ape.git] / R / DNA.R

diff --git a/R/DNA.R b/R/DNA.R
index 007547e5a9a2ba8b079808d370243b627fee71d5..919f0ecd88912e69ff85b2ee04181d122936eb7b 100644 (file)
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,8 +1,8 @@
-## DNA.R (2008-12-22)
+## DNA.R (2009-09-06)
 
 ##   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.
@@ -14,11 +14,12 @@ del.gaps <- function(x)
         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)
     }
@@ -50,6 +51,7 @@ as.alignment <- function(x)
 
 "[.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]
@@ -63,12 +65,12 @@ as.alignment <- function(x)
         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.")
@@ -141,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)
@@ -254,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
@@ -269,9 +274,13 @@ 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]]))