adding the new function 'where'

[ape.git] / R / DNA.R

diff --git a/R/DNA.R b/R/DNA.R
index b426dbd6126728c02992f994fe408a593d2a4f27..1d0ce795037c98faf042197af5f572bb1de4d5fa 100644 (file)
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,4 +1,4 @@
-## DNA.R (2012-09-13)
+## DNA.R (2012-11-28)
 
 ##   Manipulations and Comparisons of DNA Sequences
 
@@ -471,3 +471,29 @@ image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
                horiz = TRUE, xpd = TRUE)
     }
 }
+
+where <- function(x, pattern)
+{
+    pat <- as.DNAbin(strsplit(pattern, NULL)[[1]])
+    p <- as.integer(length(pat))
+
+    foo <- function(x, pat, p) {
+        s <- as.integer(length(x))
+        if (s < p) stop("sequence shorter than the pattern")
+        ans <- .C("where", x, pat, s, p, integer(s), 0L,
+                  DUP = FALSE, NAOK = TRUE, PACKAGE = "apex")
+        n <- ans[[6]]
+        if (n) ans[[5]][seq_len(n)] - p + 2L else integer()
+    }
+
+    if (is.list(x)) return(lapply(x, foo, pat = pat, p = p))
+    if (is.matrix(x)) {
+        n <- nrow(x)
+        res <- vector("list", n)
+        for (i in seq_along(n))
+            res[[i]] <- foo(x[i, , drop = TRUE], pat, p)
+        names(res) <- rownames(x)
+        return(res)
+    }
+    foo(x, pat, p) # if x is a vector
+}