X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2FDNA.R;h=72e12582617e0927bdc5d9a2a884d5784b6c46fb;hb=dca7b216e929337836a18374147b13eb793ffd95;hp=d74d1881f432abe4dfbc8042c30da5564c114099;hpb=91cbce9b55b05cef1f7167f646bc30b3e568ebf9;p=ape.git diff --git a/R/DNA.R b/R/DNA.R index d74d188..72e1258 100644 --- a/R/DNA.R +++ b/R/DNA.R @@ -1,4 +1,4 @@ -## DNA.R (2009-05-19) +## DNA.R (2009-09-18) ## Manipulations and Comparisons of DNA Sequences @@ -259,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 @@ -274,29 +274,18 @@ 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)