-
Notifications
You must be signed in to change notification settings - Fork 1
/
tree_okbData.R
72 lines (68 loc) · 2.69 KB
/
tree_okbData.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#' Plot phylogenies with frequencies of unique sequences
#'
#' This function plots a phylogeny built from the unique sequences
#' together with a representation of the abundance (frequencies) of
#' these in the data.
#'
#' @param x an \linkS4class{obkData} object.
#' @param ncatmax an integer giving the number of categories of
#' haplotype frequency
#' @param colfun a function to define the colours
#' @return nothing, the results are printed on the current graphical device.
#' @author Emmanuel Paradis
#'
#' @details First, the unique sequences are extracted using the
#' function \code{haplotype} (in \pkg{pegas}). Then, a
#' neighbor-joigning (NJ) tree is built. The tree is plotted on the
#' left-hand side of the graph, and the frequencies of each unique
#' sequence is represented in two ways: coloured labels at the tips of
#' the tree (with the colour scale drawn at the top), and a horizontal
#' barplot on the right-hand side of the graph.
#'
#' The functions scan the data for the different genes and plots the
#' output successively (the user is asked to type enter)
#'
#' @examples
#' \dontrun{
#' require(OutbreakTools)
#' data(ToyOutbreak)
#' tree_okbData(ToyOutbreak)
#' }
tree_okbData <- function(x, ncatmax = 10, colfun = topo.colors)
{
require(pegas)
DNA <- x@dna@dna
LOCI <- names(DNA)
cat("okbData object has", length(LOCI), "genetic data set(s)\n")
for (i in seq_along(LOCI)) {
cat("Processing data from", LOCI[i], "\n")
dna <- DNA[[i]]
h <- haplotype(dna)
nh <- nrow(h)
attr(h, "index") <- lapply(attr(h, "index"), function(x) rownames(dna)[x])
names(attr(h, "index")) <- rownames(h) <- paste0("uniqseqID", seq_len(nh))
phy <- nj(dist.dna(h, "N", pairwise.deletion = TRUE))
hfreq <- sapply(attr(h, "index"), length)
rangehfreq <- range(hfreq)
if (rangehfreq[2] < 10) ncatmax <- rangehfreq[2]
sq <- seq(rangehfreq[1] - 1, rangehfreq[2], length.out = ncatmax)
cat <- cut(hfreq, sq)
co <- colfun(ncatmax)
n <- Ntip(phy)
cat("Type enter to continue\n")
readLines(n = 1)
lttcoords <- ltt.plot.coords(phy, backward = FALSE)
xlm <- lttcoords[nrow(lttcoords), 1] + max(hfreq)
plot(phy, show.tip.label = FALSE, x.lim = xlm)
axisPhylo()
phydataplot(hfreq, phy, "b")
tiplabels(text = " ", bg = co[cat], adj = 0)
mtext(LOCI[i], at = 0, font = 2)
psr <- par("usr")
xx <- psr[2]/2
yy <- psr[4] * (0.5 + 0.5/par("plt")[4])
legend(xx, yy, legend = round(sq[-1], 1), pch = 22, pt.bg = co,
pt.cex = 2, bty = "n", xjust = 0.5, yjust = 0.5,
horiz = TRUE, xpd = TRUE)
}
}