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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
##' Number of tips, nodes and edges found in a tree.
##'
##' Function to return the number of tips, nodes and edges found in a
##' tree in the \code{phylo4} or \code{phylo4d} format.
##' @title nTips, nNodes, nEdges
##' @aliases nTips
##' @param x a \code{phylo4} or \code{phylo4d} object
##' @return a numeric vector indicating the number of tips, nodes or
##' edge respectively.
##' @docType methods
##' @export
##' @include phylo4-class.R phylo4-methods.R
##' @include oldclasses-class.R
##' @rdname nTips-methods
setGeneric("nTips", function(x) {
standardGeneric("nTips")
})
##' @rdname nTips-methods
##' @aliases nTips,phylo4-method
setMethod("nTips", signature(x="phylo4"), function(x) {
E <- edges(x)
if(nrow(E) == 0)
return(0)
else {
## at this time NAs are not allowed in edge matrix
## sum(tabulate(E[, 1]) == 0)
nTipsFastCpp(E[, 1])
}
})
##' @rdname nTips-methods
##' @aliases nTips,phylo-method
setMethod("nTips", signature(x="phylo"),
function(x) {
Ntip(x)
})
##' @rdname nTips-methods
##' @aliases nNodes
##' @export
setGeneric("nNodes", function(x) {
standardGeneric("nNodes")
})
##' @rdname nTips-methods
##' @aliases nNodes,phylo4-method
setMethod("nNodes", signature(x="phylo4"), function(x) {
E <- edges(x, drop.root=TRUE)
if(nrow(E) == 0) {
return(0)
} else {
return(length(unique(E[, 1])))
}
})
##' @rdname nTips-methods
##' @aliases nEdges
##' @export
setGeneric("nEdges", function(x) {
standardGeneric("nEdges")
})
##' @rdname nTips-methods
##' @aliases nEdges,phylo4-method
setMethod("nEdges", signature(x="phylo4"),
function(x) {
nrow(x@edge)
})
#########################################################
### Edge accessors
#########################################################
##' Edges accessors
##'
##' Access or modify information about the edges.
##'
##' @param x a \code{phylo4} or \code{phylo4d} object.
##' @param drop.root logical (default FALSE), should the edge
##' connecting the root be included in the edge matrix?
##' @param \dots Optional arguments used by specific methods. (None
##' used at present).
##' @return \describe{
##' \item{\code{edges}}{returns the edge matrix that represent the
##' ancestor-descendant relationships among the nodes of the tree.}
##'
##' \item{\code{edgeOrder}}{returns the order in which the edge matrix
##' is in.}
##'
##' \item{\code{internalEdges}}{returns a logical vector indicating
##' internal edges (edges that connect an internal node to
##' another). This vector is named with the \code{edgeId}}.
##'
##' \item{\code{terminalEdges}}{returns a logical vector indicating
##' terminal edges (edges that connect an internal node to a
##' tip). This vector is named with the \code{edgeId} }}
##' @author Ben Bolker, Francois Michonneau, Thibaut Jombart
##' @seealso reorder, edgeId
##' @examples
##' data(geospiza)
##' edges(geospiza)
##' edgeOrder(geospiza)
##' geoPost <- reorder(geospiza, "postorder")
##' edgeOrder(geoPost)
##' ## with a binary tree this should always be true
##' identical(!terminalEdges(geospiza), internalEdges(geospiza))
##' @export
##' @docType methods
##' @rdname edges-accessors
##' @include phylo4-methods.R
setGeneric("edges", function(x, ...) {
standardGeneric("edges")
})
##' @rdname edges-accessors
##' @aliases edges,phylo4-method
setMethod("edges", signature(x="phylo4"),
function(x, drop.root=FALSE) {
e <- x@edge
if (drop.root) e <- e[e[, 1] != 0, ]
e
})
##### -------- edgeOrder
##' @rdname edges-accessors
##' @aliases edgeOrder
##' @export
setGeneric("edgeOrder", function(x, ...) {
standardGeneric("edgeOrder")
})
##' @rdname edges-accessors
##' @aliases edgeOrder,phylo4-method
setMethod("edgeOrder", signature(x="phylo4"),
function(x) {
x@order
})
##### -------- internalEdges
##' @rdname edges-accessors
##' @aliases internalEdges
##' @export
setGeneric("internalEdges", function(x) {
standardGeneric("internalEdges")
})
##' @rdname edges-accessors
##' @aliases internalEdges,phylo4-method
setMethod("internalEdges", signature(x="phylo4"),
function(x) {
res <- edges(x)[, 2] %in% nodeId(x, "internal")
names(res) <- edgeId(x, "all")
res
})
##### -------- terminalEdges
##' @rdname edges-accessors
##' @aliases terminalEdges
##' @export
setGeneric("terminalEdges", function(x) {
standardGeneric("terminalEdges")
})
##' @rdname edges-accessors
##' @aliases terminalEdges,phylo4-method
setMethod("terminalEdges", signature(x="phylo4"),
function(x) {
res <- edges(x)[, 2] %in% nodeId(x, "tip")
names(res) <- edgeId(x, "all")
res
})
|
